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