source: LMDZ6/branches/Amaury_dev/libf/dyn3d/lmdz_dynetat0.f90 @ 5227

Last change on this file since 5227 was 5224, checked in by abarral, 14 months ago

Merge r5204 r5205
Light lint
Correct missing IOIPSL includes
File size: 10.9 KB
Line 
1MODULE lmdz_dynetat0
2  IMPLICIT NONE; PRIVATE
3  PUBLIC dynetat0
4CONTAINS
5
6  SUBROUTINE dynetat0(fichnom, vcov, ucov, teta, q, masse, ps, phis, time)
7
8    !-------------------------------------------------------------------------------
9    ! Authors: P. Le Van , L.Fairhead
10    !-------------------------------------------------------------------------------
11    ! Purpose: Initial state reading.
12    !-------------------------------------------------------------------------------
13    USE lmdz_infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName, &
14            new2oldH2O, newHNO3, oldHNO3, getKey
15    USE lmdz_strings, ONLY: maxlen, msg, strStack, real2str, int2str
16    USE netcdf, ONLY: nf90_open, nf90_nowrite, nf90_inq_varid, nf90_close, nf90_get_var, nf90_noerr
17    USE control_mod, ONLY: planet_type
18    USE lmdz_assert_eq, ONLY: assert_eq
19    USE comvert_mod, ONLY: pa, preff
20    USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad
21    USE logic_mod, ONLY: fxyhypb, ysinus
22    USE serre_mod, ONLY: clon, clat, grossismx, grossismy
23    USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time
24    USE ener_mod, ONLY: etot0, ptot0, ztot0, stot0, ang0
25    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS
26    USE lmdz_iniprint, ONLY: lunout, prt_level
27    USE lmdz_comgeom2
28    USE lmdz_strings, ONLY: strIdx
29    USE ioipsl, ONLY: getin
30
31    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
32    USE lmdz_paramet
33    IMPLICIT NONE
34
35
36    !===============================================================================
37    ! Arguments:
38    CHARACTER(LEN = *), INTENT(IN) :: fichnom          !--- FILE NAME
39    REAL, INTENT(OUT) :: vcov(iip1, jjm, llm)        !--- V COVARIANT WIND
40    REAL, INTENT(OUT) :: ucov(iip1, jjp1, llm)        !--- U COVARIANT WIND
41    REAL, INTENT(OUT) :: teta(iip1, jjp1, llm)        !--- POTENTIAL TEMP.
42    REAL, INTENT(OUT) :: q(iip1, jjp1, llm, nqtot)  !--- TRACERS
43    REAL, INTENT(OUT) :: masse(iip1, jjp1, llm)        !--- MASS PER CELL
44    REAL, INTENT(OUT) :: ps(iip1, jjp1)            !--- GROUND PRESSURE
45    REAL, INTENT(OUT) :: phis(iip1, jjp1)            !--- GEOPOTENTIAL
46    !===============================================================================
47    ! Local variables:
48    CHARACTER(LEN = maxlen) :: mesg, var, modname, oldVar
49    INTEGER, PARAMETER :: length = 100
50    INTEGER :: iq, fID, vID, idecal, iqParent, iName, iZone, iPhase, ix
51    REAL :: time, tnat, alpha_ideal, tab_cntrl(length)    !--- RUN PARAMS TABLE
52    LOGICAL :: lSkip, ll, ltnat1
53    !-------------------------------------------------------------------------------
54    modname = "dynetat0"
55
56    !--- Initial state file opening
57    var = fichnom
58    CALL err(nf90_open(var, nf90_nowrite, fID), "open", var)
59    CALL get_var1("controle", tab_cntrl)
60
61    !!! AS: idecal is a hack to be able to read planeto starts...
62    !!!     .... while keeping everything OK for LMDZ EARTH
63    IF(planet_type=="generic") THEN
64      CALL msg('NOTE NOTE NOTE : Planeto-like start files', modname)
65      idecal = 4
66      annee_ref = 2000
67    ELSE
68      CALL msg('NOTE NOTE NOTE : Earth-like start files', modname)
69      idecal = 5
70      annee_ref = tab_cntrl(5)
71    END IF
72    im = tab_cntrl(1)
73    jm = tab_cntrl(2)
74    lllm = tab_cntrl(3)
75    day_ref = tab_cntrl(4)
76    rad = tab_cntrl(idecal + 1)
77    omeg = tab_cntrl(idecal + 2)
78    g = tab_cntrl(idecal + 3)
79    cpp = tab_cntrl(idecal + 4)
80    kappa = tab_cntrl(idecal + 5)
81    daysec = tab_cntrl(idecal + 6)
82    dtvr = tab_cntrl(idecal + 7)
83    etot0 = tab_cntrl(idecal + 8)
84    ptot0 = tab_cntrl(idecal + 9)
85    ztot0 = tab_cntrl(idecal + 10)
86    stot0 = tab_cntrl(idecal + 11)
87    ang0 = tab_cntrl(idecal + 12)
88    pa = tab_cntrl(idecal + 13)
89    preff = tab_cntrl(idecal + 14)
90
91    clon = tab_cntrl(idecal + 15)
92    clat = tab_cntrl(idecal + 16)
93    grossismx = tab_cntrl(idecal + 17)
94    grossismy = tab_cntrl(idecal + 18)
95
96    IF (tab_cntrl(idecal + 19)==1.)  THEN
97      fxyhypb = .TRUE.
98      !   dzoomx   = tab_cntrl(25)
99      !   dzoomy   = tab_cntrl(26)
100      !   taux     = tab_cntrl(28)
101      !   tauy     = tab_cntrl(29)
102    ELSE
103      fxyhypb = .FALSE.
104      ysinus = tab_cntrl(idecal + 22)==1.
105    END IF
106
107    day_ini = tab_cntrl(30)
108    itau_dyn = tab_cntrl(31)
109    start_time = tab_cntrl(32)
110
111    !-------------------------------------------------------------------------------
112    CALL msg('rad, omeg, g, cpp, kappa = ' // TRIM(strStack(real2str([rad, omeg, g, cpp, kappa]))), modname)
113    CALL check_dim(im, iim, 'im', 'im')
114    CALL check_dim(jm, jjm, 'jm', 'jm')
115    CALL check_dim(lllm, llm, 'lm', 'lllm')
116    CALL get_var1("rlonu", rlonu)
117    CALL get_var1("rlatu", rlatu)
118    CALL get_var1("rlonv", rlonv)
119    CALL get_var1("rlatv", rlatv)
120    CALL get_var2("cu", cu)
121    CALL get_var2("cv", cv)
122    CALL get_var2("aire", aire)
123    var = "temps"
124    IF(nf90_inq_varid(fID, var, vID)/=nf90_noerr) THEN
125      CALL msg('Missing field <temps> ; trying with <Time>', modname)
126      var = "Time"
127      CALL err(nf90_inq_varid(fID, var, vID), "inq", var)
128    END IF
129    CALL err(nf90_get_var(fID, vID, time), "get", var)
130    CALL get_var2("phisinit", phis)
131    CALL get_var3("ucov", ucov)
132    CALL get_var3("vcov", vcov)
133    CALL get_var3("teta", teta)
134    CALL get_var3("masse", masse)
135    CALL get_var2("ps", ps)
136
137    !--- Tracers
138    ll = .FALSE.
139    IF (CPPKEY_REPROBUS) THEN
140      ll = nf90_inq_varid(fID, 'HNO3tot', vID) /= nf90_noerr                                 !--- DETECT OLD REPRO start.nc FILE
141    END IF
142    ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1)
143    DO iq = 1, nqtot
144      var = tracers(iq)%name
145      oldVar = new2oldH2O(var)
146      lSkip = ll .AND. var == 'HNO3'                                                       !--- FORCE "HNO3_g" READING FOR "HNO3"
147      IF (CPPKEY_REPROBUS) THEN
148        ix = strIdx(newHNO3, var); IF(ix /= 0) oldVar = oldHNO3(ix)                          !--- REPROBUS HNO3 exceptions
149      END IF
150      IF (CPPKEY_INCA) THEN
151        IF(var == 'O3') oldVar = 'OX'                                                        !--- DEAL WITH INCA OZONE EXCEPTION
152      END IF
153      !--------------------------------------------------------------------------------------------------------------------------
154      IF(nf90_inq_varid(fID, var, vID) == nf90_noerr .AND. .NOT.lSkip) THEN                !=== REGULAR CASE: AVAILABLE VARIABLE
155        CALL err(nf90_get_var(fID, vID, q(:, :, :, iq)), "get", var)
156        !--------------------------------------------------------------------------------------------------------------------------
157      ELSE IF(nf90_inq_varid(fID, oldVar, vID) == nf90_noerr) THEN                         !=== TRY WITH ALTERNATE NAME
158        CALL msg('Missing tracer <' // TRIM(var) // '> => initialized to <' // TRIM(oldVar) // '>', modname)
159        CALL err(nf90_get_var(fID, vID, q(:, :, :, iq)), "get", oldVar)
160        !--------------------------------------------------------------------------------------------------------------------------
161      ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN                          !=== WATER ISOTOPES
162        iName = tracers(iq)%iso_iName
163        iPhase = tracers(iq)%iso_iPhase
164        iqParent = tracers(iq)%iqParent
165        IF(tracers(iq)%iso_iZone == 0) THEN
166          IF(ltnat1) THEN
167            tnat = 1.0
168            alpha_ideal = 1.0
169            CALL msg(' !!!  Beware: alpha_ideal put to 1  !!!', modname)
170          ELSE
171            IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
172                    CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
173          END IF
174          CALL msg('Missing tracer <' // TRIM(var) // '> => initialized with a simplified Rayleigh distillation law.', modname)
175          q(:, :, :, iq) = q(:, :, :, iqParent) * tnat * (q(:, :, :, iqParent) / 30.e-3)**(alpha_ideal - 1.)
176        ELSE
177          CALL msg('Missing tracer <' // TRIM(var) // '> => initialized to its parent isotope concentration.', modname)
178          ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à
179          ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme
180          ! les parents. Sinon, c'est nul.
181          ! j'ai fait ça en attendant, mais il faudrait initialiser proprement en
182          ! remplacant 1 par izone_init dans la ligne qui suit.
183          IF(tracers(iq)%iso_iZone == 1) THEN
184            q(:, :, :, iq) = q(:, :, :, iqIsoPha(iName, iPhase))
185          ELSE
186            q(:, :, :, iq) = 0.
187          END IF
188        END IF
189        !--------------------------------------------------------------------------------------------------------------------------
190      ELSE                                                                                 !=== MISSING: SET TO 0
191        CALL msg('Missing tracer <' // TRIM(var) // '> => initialized to zero', modname)
192        q(:, :, :, iq) = 0.
193        !--------------------------------------------------------------------------------------------------------------------------
194      END IF
195    END DO
196
197    CALL err(nf90_close(fID), "close", fichnom)
198    day_ini = day_ini + INT(time)
199    time = time - INT(time)
200
201
202  CONTAINS
203
204
205    SUBROUTINE check_dim(n1, n2, str1, str2)
206      INTEGER, INTENT(IN) :: n1, n2
207      CHARACTER(LEN = *), INTENT(IN) :: str1, str2
208      CHARACTER(LEN = maxlen) :: s1, s2
209      IF(n1/=n2) CALL abort_gcm(TRIM(modname), 'value of "' // TRIM(str1) // '" = ' // TRIM(int2str(n1)) // &
210              ' read in starting file differs from gcm value of "' // TRIM(str2) // '" = ' // TRIM(int2str(n2)), 1)
211    END SUBROUTINE check_dim
212
213
214    SUBROUTINE get_var1(var, v)
215      CHARACTER(LEN = *), INTENT(IN) :: var
216      REAL, INTENT(OUT) :: v(:)
217      CALL err(nf90_inq_varid(fID, var, vID), "inq", var)
218      CALL err(nf90_get_var(fID, vID, v), "get", var)
219    END SUBROUTINE get_var1
220
221
222    SUBROUTINE get_var2(var, v)
223      CHARACTER(LEN = *), INTENT(IN) :: var
224      REAL, INTENT(OUT) :: v(:, :)
225      CALL err(nf90_inq_varid(fID, var, vID), "inq", var)
226      CALL err(nf90_get_var(fID, vID, v), "get", var)
227    END SUBROUTINE get_var2
228
229
230    SUBROUTINE get_var3(var, v)
231      CHARACTER(LEN = *), INTENT(IN) :: var
232      REAL, INTENT(OUT) :: v(:, :, :)
233      CALL err(nf90_inq_varid(fID, var, vID), "inq", var)
234      CALL err(nf90_get_var(fID, vID, v), "get", var)
235    END SUBROUTINE get_var3
236
237
238    SUBROUTINE err(ierr, typ, nam)
239      INTEGER, INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
240      CHARACTER(LEN = *), INTENT(IN) :: typ    !--- TYPE OF OPERATION
241      CHARACTER(LEN = *), INTENT(IN) :: nam    !--- FIELD/FILE NAME
242      IF(ierr==nf90_noerr) RETURN
243      SELECT CASE(typ)
244      CASE('inq');   mesg = "Field <" // TRIM(nam) // "> is missing"
245      CASE('get');   mesg = "Reading failed for <" // TRIM(nam) // ">"
246      CASE('open');  mesg = "File opening failed for <" // TRIM(nam) // ">"
247      CASE('close'); mesg = "File closing failed for <" // TRIM(nam) // ">"
248      END SELECT
249      CALL ABORT_gcm(TRIM(modname), TRIM(mesg), ierr)
250    END SUBROUTINE err
251
252  END SUBROUTINE dynetat0
253END MODULE lmdz_dynetat0
Note: See TracBrowser for help on using the repository browser.