[5185] | 1 | SUBROUTINE dynetat0_loc(fichnom, vcov, ucov, teta, q, masse, ps, phis, time) |
---|
[5099] | 2 | |
---|
[5185] | 3 | !------------------------------------------------------------------------------- |
---|
| 4 | ! Authors: P. Le Van , L.Fairhead |
---|
| 5 | !------------------------------------------------------------------------------- |
---|
| 6 | ! Purpose: Initial state reading. |
---|
| 7 | !------------------------------------------------------------------------------- |
---|
[2299] | 8 | USE parallel_lmdz |
---|
[5185] | 9 | USE lmdz_infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName |
---|
[5117] | 10 | USE lmdz_strings, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx |
---|
[5185] | 11 | USE netcdf, ONLY: nf90_open, nf90_nowrite, nf90_inquire_dimension, nf90_inq_varid, & |
---|
| 12 | nf90_close, nf90_get_var, nf90_inquire_variable, nf90_noerr |
---|
[5117] | 13 | USE lmdz_readTracFiles, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey |
---|
[2299] | 14 | USE control_mod, ONLY: planet_type |
---|
[5113] | 15 | USE lmdz_assert_eq, ONLY: assert_eq |
---|
[5185] | 16 | USE comvert_mod, ONLY: pa, preff |
---|
[4120] | 17 | USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad |
---|
[2603] | 18 | USE logic_mod, ONLY: fxyhypb, ysinus |
---|
[2598] | 19 | USE serre_mod, ONLY: clon, clat, grossismx, grossismy |
---|
[4120] | 20 | USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn, start_time |
---|
[5185] | 21 | USE ener_mod, ONLY: etot0, ptot0, ztot0, stot0, ang0 |
---|
| 22 | USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS |
---|
[5118] | 23 | USE lmdz_iniprint, ONLY: lunout, prt_level |
---|
[5136] | 24 | USE lmdz_comgeom |
---|
[4120] | 25 | |
---|
[5185] | 26 | USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm |
---|
[5159] | 27 | USE lmdz_paramet |
---|
[2299] | 28 | IMPLICIT NONE |
---|
[5159] | 29 | |
---|
| 30 | |
---|
[5185] | 31 | !=============================================================================== |
---|
| 32 | ! Arguments: |
---|
| 33 | CHARACTER(LEN = *), INTENT(IN) :: fichnom !--- FILE NAME |
---|
| 34 | REAL, INTENT(OUT) :: vcov(ijb_v:ije_v, llm) !--- V COVARIANT WIND |
---|
| 35 | REAL, INTENT(OUT) :: ucov(ijb_u:ije_u, llm) !--- U COVARIANT WIND |
---|
| 36 | REAL, INTENT(OUT) :: teta(ijb_u:ije_u, llm) !--- POTENTIAL TEMP. |
---|
| 37 | REAL, INTENT(OUT) :: q(ijb_u:ije_u, llm, nqtot)!--- TRACERS |
---|
| 38 | REAL, INTENT(OUT) :: masse(ijb_u:ije_u, llm) !--- MASS PER CELL |
---|
| 39 | REAL, INTENT(OUT) :: ps(ijb_u:ije_u) !--- GROUND PRESSURE |
---|
| 40 | REAL, INTENT(OUT) :: phis(ijb_u:ije_u) !--- GEOPOTENTIAL |
---|
| 41 | !=============================================================================== |
---|
| 42 | ! Local variables: |
---|
| 43 | CHARACTER(LEN = maxlen) :: mesg, var, modname, oldVar |
---|
| 44 | INTEGER, PARAMETER :: length = 100 |
---|
[4301] | 45 | INTEGER :: iq, fID, vID, idecal, ierr, iqParent, iName, iZone, iPhase, ix |
---|
[5185] | 46 | REAL :: time, tab_cntrl(length) !--- RUN PARAMS TABLE |
---|
| 47 | REAL :: tnat, alpha_ideal |
---|
| 48 | REAL, ALLOCATABLE :: vcov_glo(:, :), masse_glo(:, :), ps_glo(:) |
---|
| 49 | REAL, ALLOCATABLE :: ucov_glo(:, :), q_glo(:, :), phis_glo(:) |
---|
| 50 | REAL, ALLOCATABLE :: teta_glo(:, :) |
---|
[4301] | 51 | LOGICAL :: lSkip, ll |
---|
[5185] | 52 | LOGICAL, PARAMETER :: tnat1 = .TRUE. |
---|
| 53 | !------------------------------------------------------------------------------- |
---|
| 54 | modname = "dynetat0_loc" |
---|
[1632] | 55 | |
---|
[5185] | 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) |
---|
[1632] | 60 | |
---|
[5185] | 61 | !!! AS: idecal is a hack to be able to read planeto starts... |
---|
| 62 | !!! .... while keeping everything OK for LMDZ EARTH |
---|
[2299] | 63 | IF(planet_type=="generic") THEN |
---|
[4120] | 64 | CALL msg('NOTE NOTE NOTE : Planeto-like start files', modname) |
---|
[2299] | 65 | idecal = 4 |
---|
[5185] | 66 | annee_ref = 2000 |
---|
[2299] | 67 | ELSE |
---|
[4120] | 68 | CALL msg('NOTE NOTE NOTE : Earth-like start files', modname) |
---|
[2299] | 69 | idecal = 5 |
---|
[5185] | 70 | annee_ref = tab_cntrl(5) |
---|
[2299] | 71 | END IF |
---|
[5185] | 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) |
---|
[5099] | 90 | |
---|
[5185] | 91 | clon = tab_cntrl(idecal + 15) |
---|
| 92 | clat = tab_cntrl(idecal + 16) |
---|
| 93 | grossismx = tab_cntrl(idecal + 17) |
---|
| 94 | grossismy = tab_cntrl(idecal + 18) |
---|
[5099] | 95 | |
---|
[5185] | 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) |
---|
[2299] | 102 | ELSE |
---|
| 103 | fxyhypb = .FALSE. |
---|
[5185] | 104 | ysinus = tab_cntrl(idecal + 22)==1. |
---|
[2299] | 105 | END IF |
---|
[1632] | 106 | |
---|
[5185] | 107 | day_ini = tab_cntrl(30) |
---|
| 108 | itau_dyn = tab_cntrl(31) |
---|
[2615] | 109 | start_time = tab_cntrl(32) |
---|
[1632] | 110 | |
---|
[5185] | 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_var1("cu", cu) |
---|
| 121 | CALL get_var1("cv", cv) |
---|
| 122 | CALL get_var1("aire", aire) |
---|
[1632] | 123 | |
---|
[5185] | 124 | var = "temps" |
---|
| 125 | IF(nf90_inq_varid(fID, var, vID)/=nf90_noerr) THEN |
---|
[4120] | 126 | CALL msg('missing field <temps> ; trying with <Time>', modname) |
---|
[5185] | 127 | var = "Time" |
---|
| 128 | CALL err(nf90_inq_varid(fID, var, vID), "inq", var) |
---|
[2299] | 129 | END IF |
---|
[5185] | 130 | CALL err(nf90_get_var(fID, vID, time), "get", var) |
---|
[1632] | 131 | |
---|
[2299] | 132 | ALLOCATE(phis_glo(ip1jmp1)) |
---|
[5185] | 133 | CALL get_var1("phisinit", phis_glo) |
---|
| 134 | phis (ijb_u:ije_u) = phis_glo(ijb_u:ije_u); DEALLOCATE(phis_glo) |
---|
[1632] | 135 | |
---|
[5185] | 136 | ALLOCATE(ucov_glo(ip1jmp1, llm)) |
---|
| 137 | CALL get_var2("ucov", ucov_glo) |
---|
| 138 | ucov (ijb_u:ije_u, :) = ucov_glo(ijb_u:ije_u, :); DEALLOCATE(ucov_glo) |
---|
[1673] | 139 | |
---|
[5185] | 140 | ALLOCATE(vcov_glo(ip1jm, llm)) |
---|
| 141 | CALL get_var2("vcov", vcov_glo) |
---|
| 142 | vcov (ijb_v:ije_v, :) = vcov_glo(ijb_v:ije_v, :); DEALLOCATE(vcov_glo) |
---|
[1632] | 143 | |
---|
[5185] | 144 | ALLOCATE(teta_glo(ip1jmp1, llm)) |
---|
| 145 | CALL get_var2("teta", teta_glo) |
---|
| 146 | teta (ijb_u:ije_u, :) = teta_glo(ijb_u:ije_u, :); DEALLOCATE(teta_glo) |
---|
[1632] | 147 | |
---|
[5185] | 148 | ALLOCATE(masse_glo(ip1jmp1, llm)) |
---|
| 149 | CALL get_var2("masse", masse_glo) |
---|
| 150 | masse(ijb_u:ije_u, :) = masse_glo(ijb_u:ije_u, :); DEALLOCATE(masse_glo) |
---|
| 151 | |
---|
[2299] | 152 | ALLOCATE(ps_glo(ip1jmp1)) |
---|
[5185] | 153 | CALL get_var1("ps", ps_glo) |
---|
| 154 | ps (ijb_u:ije_u) = ps_glo(ijb_u:ije_u); DEALLOCATE(ps_glo) |
---|
[1632] | 155 | |
---|
[5185] | 156 | !--- Tracers |
---|
| 157 | ALLOCATE(q_glo(ip1jmp1, llm)) |
---|
[4301] | 158 | ll = .FALSE. |
---|
[5185] | 159 | IF (CPPKEY_REPROBUS) THEN |
---|
| 160 | ll = nf90_inq_varid(fID, 'HNO3tot', vID) /= nf90_noerr !--- DETECT OLD REPRO start.nc FILE |
---|
| 161 | END IF |
---|
| 162 | DO iq = 1, nqtot |
---|
[4120] | 163 | var = tracers(iq)%name |
---|
[4301] | 164 | oldVar = new2oldH2O(var) |
---|
| 165 | lSkip = ll .AND. var == 'HNO3' !--- FORCE "HNO3_g" READING FOR "HNO3" |
---|
[5185] | 166 | IF (CPPKEY_REPROBUS) THEN |
---|
| 167 | ix = strIdx(newHNO3, var); IF(ix /= 0) oldVar = oldHNO3(ix) !--- REPROBUS HNO3 exceptions |
---|
| 168 | END IF |
---|
[5091] | 169 | IF (CPPKEY_INCA) THEN |
---|
| 170 | IF(var == 'O3') oldVar = 'OX' !--- DEAL WITH INCA OZONE EXCEPTION |
---|
| 171 | END IF |
---|
[4265] | 172 | !-------------------------------------------------------------------------------------------------------------------------- |
---|
[5101] | 173 | IF(nf90_inq_varid(fID, var, vID) == nf90_noerr .AND. .NOT.lSkip) THEN !=== REGULAR CASE: AVAILABLE VARIABLE |
---|
[5185] | 174 | CALL get_var2(var, q_glo); q(ijb_u:ije_u, :, iq) = q_glo(ijb_u:ije_u, :) |
---|
| 175 | !-------------------------------------------------------------------------------------------------------------------------- |
---|
[5101] | 176 | ELSE IF(nf90_inq_varid(fID, oldVar, vID) == nf90_noerr) THEN !=== TRY WITH ALTERNATE NAME |
---|
[5185] | 177 | CALL msg('Tracer <' // TRIM(var) // '> is missing => initialized to <' // TRIM(oldVar) // '>', modname) |
---|
| 178 | CALL get_var2(oldVar, q_glo); q(ijb_u:ije_u, :, iq) = q_glo(ijb_u:ije_u, :) |
---|
| 179 | !-------------------------------------------------------------------------------------------------------------------------- |
---|
[4120] | 180 | ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN !=== WATER ISOTOPES |
---|
[5185] | 181 | iName = tracers(iq)%iso_iName |
---|
| 182 | iPhase = tracers(iq)%iso_iPhase |
---|
[4120] | 183 | iqParent = tracers(iq)%iqParent |
---|
| 184 | IF(tracers(iq)%iso_iZone == 0) THEN |
---|
[5185] | 185 | IF (tnat1) THEN |
---|
| 186 | tnat = 1.0 |
---|
| 187 | alpha_ideal = 1.0 |
---|
| 188 | WRITE(*, *) 'attention dans dynetat0: les alpha_ideal sont a 1' |
---|
| 189 | else |
---|
[4984] | 190 | IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) & |
---|
[5185] | 191 | CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1) |
---|
| 192 | endif |
---|
| 193 | CALL msg('Tracer <' // TRIM(var) // '> is missing => initialized with a simplified Rayleigh distillation law.', modname) |
---|
| 194 | q(ijb_u:ije_u, :, iq) = q(ijb_u:ije_u, :, iqParent) * tnat * (q(ijb_u:ije_u, :, iqParent) / 30.e-3)**(alpha_ideal - 1.) |
---|
| 195 | ! Camille 9 mars 2023: point de vigilence: initialisation incohérente |
---|
| 196 | ! avec celle de xt_ancien dans la physiq. |
---|
[4120] | 197 | ELSE |
---|
[5185] | 198 | CALL msg('Tracer <' // TRIM(var) // '> is missing => initialized to its parent isotope concentration.', modname) |
---|
| 199 | ! Camille 9 mars 2023: attention!! seuls les tags qui correspondent à |
---|
| 200 | ! izone=izone_init (définie dans isotrac_mod) sont initialisés comme |
---|
| 201 | ! les parents. Sinon, c'est nul. |
---|
| 202 | ! j'ai fait ça en attendant, mais il faudrait initialiser proprement en |
---|
| 203 | ! remplacant 1 par izone_init dans la ligne qui suit. |
---|
| 204 | IF(tracers(iq)%iso_iZone == 1) THEN |
---|
| 205 | q(ijb_u:ije_u, :, iq) = q(ijb_u:ije_u, :, iqIsoPha(iName, iPhase)) |
---|
| 206 | ELSE |
---|
| 207 | q(ijb_u:ije_u, :, iq) = 0. |
---|
| 208 | ENDIF |
---|
[4120] | 209 | END IF |
---|
[5185] | 210 | !-------------------------------------------------------------------------------------------------------------------------- |
---|
[4120] | 211 | ELSE !=== MISSING: SET TO 0 |
---|
[5185] | 212 | CALL msg('Tracer <' // TRIM(var) // '> is missing => initialized to zero', modname) |
---|
| 213 | q(ijb_u:ije_u, :, iq) = 0. |
---|
| 214 | !-------------------------------------------------------------------------------------------------------------------------- |
---|
[2299] | 215 | END IF |
---|
| 216 | END DO |
---|
| 217 | DEALLOCATE(q_glo) |
---|
[5185] | 218 | CALL err(nf90_close(fID), "close", fichnom) |
---|
| 219 | day_ini = day_ini + INT(time) |
---|
| 220 | time = time - INT(time) |
---|
[1673] | 221 | |
---|
| 222 | |
---|
[5185] | 223 | CONTAINS |
---|
[1632] | 224 | |
---|
| 225 | |
---|
[5185] | 226 | SUBROUTINE check_dim(n1, n2, str1, str2) |
---|
| 227 | INTEGER, INTENT(IN) :: n1, n2 |
---|
| 228 | CHARACTER(LEN = *), INTENT(IN) :: str1, str2 |
---|
| 229 | CHARACTER(LEN = maxlen) :: s1, s2 |
---|
| 230 | IF(n1/=n2) CALL abort_gcm(TRIM(modname), 'value of "' // TRIM(str1) // '" = ' // TRIM(int2str(n1)) // & |
---|
| 231 | ' read in starting file differs from gcm value of "' // TRIM(str2) // '" = ' // TRIM(int2str(n2)), 1) |
---|
| 232 | END SUBROUTINE check_dim |
---|
[1632] | 233 | |
---|
| 234 | |
---|
[5185] | 235 | SUBROUTINE get_var1(var, v) |
---|
| 236 | CHARACTER(LEN = *), INTENT(IN) :: var |
---|
| 237 | REAL, INTENT(OUT) :: v(:) |
---|
| 238 | REAL, ALLOCATABLE :: w2(:, :), w3(:, :, :) |
---|
| 239 | INTEGER :: nn(3), dids(3), k, nd, ntot |
---|
[1632] | 240 | |
---|
[5185] | 241 | CALL err(nf90_inq_varid(fID, var, vID), "inq", var) |
---|
| 242 | ierr = nf90_inquire_variable(fID, vID, ndims = nd) |
---|
| 243 | IF(nd==1) THEN |
---|
| 244 | CALL err(nf90_get_var(fID, vID, v), "get", var); RETURN |
---|
| 245 | END IF |
---|
| 246 | ierr = nf90_inquire_variable(fID, vID, dimids = dids) |
---|
| 247 | DO k = 1, nd; ierr = nf90_inquire_dimension(fID, dids(k), len = nn(k)); |
---|
| 248 | END DO |
---|
| 249 | ntot = PRODUCT(nn(1:nd)) |
---|
| 250 | SELECT CASE(nd) |
---|
| 251 | CASE(2); ALLOCATE(w2(nn(1), nn(2))) |
---|
| 252 | CALL err(nf90_get_var(fID, vID, w2), "get", var) |
---|
| 253 | v = RESHAPE(w2, [ntot]); DEALLOCATE(w2) |
---|
| 254 | CASE(3); ALLOCATE(w3(nn(1), nn(2), nn(3))) |
---|
| 255 | CALL err(nf90_get_var(fID, vID, w3), "get", var) |
---|
| 256 | v = RESHAPE(w3, [ntot]); DEALLOCATE(w3) |
---|
| 257 | END SELECT |
---|
| 258 | END SUBROUTINE get_var1 |
---|
[1632] | 259 | |
---|
[5185] | 260 | SUBROUTINE get_var2(var, v) |
---|
| 261 | CHARACTER(LEN = *), INTENT(IN) :: var |
---|
| 262 | REAL, INTENT(OUT) :: v(:, :) |
---|
| 263 | REAL, ALLOCATABLE :: w4(:, :, :, :), w3(:, :, :) |
---|
| 264 | INTEGER :: nn(4), dids(4), k, nd |
---|
[3967] | 265 | |
---|
[5185] | 266 | CALL err(nf90_inq_varid(fID, var, vID), "inq", var) |
---|
| 267 | ierr = nf90_inquire_variable(fID, vID, ndims = nd) |
---|
[3967] | 268 | |
---|
[5185] | 269 | IF(nd==1) THEN |
---|
| 270 | CALL err(nf90_get_var(fID, vID, v), "get", var); RETURN |
---|
| 271 | END IF |
---|
| 272 | ierr = nf90_inquire_variable(fID, vID, dimids = dids) |
---|
[3967] | 273 | |
---|
[5185] | 274 | DO k = 1, nd; ierr = nf90_inquire_dimension(fID, dids(k), len = nn(k)); |
---|
| 275 | END DO |
---|
[3967] | 276 | |
---|
[5185] | 277 | SELECT CASE(nd) |
---|
| 278 | CASE(3); ALLOCATE(w3(nn(1), nn(2), nn(3))) |
---|
| 279 | CALL err(nf90_get_var(fID, vID, w3), "get", var) |
---|
| 280 | v = RESHAPE(w3, [nn(1) * nn(2), nn(3)]); DEALLOCATE(w3) |
---|
| 281 | CASE(4); ALLOCATE(w4(nn(1), nn(2), nn(3), nn(4))) |
---|
| 282 | CALL err(nf90_get_var(fID, vID, w4), "get", var) |
---|
| 283 | v = RESHAPE(w4, [nn(1) * nn(2), nn(3)]); DEALLOCATE(w4) |
---|
| 284 | END SELECT |
---|
| 285 | END SUBROUTINE get_var2 |
---|
[3967] | 286 | |
---|
[1632] | 287 | |
---|
[5185] | 288 | SUBROUTINE err(ierr, typ, nam) |
---|
| 289 | INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE |
---|
| 290 | CHARACTER(LEN = *), INTENT(IN) :: typ !--- TYPE OF OPERATION |
---|
| 291 | CHARACTER(LEN = *), INTENT(IN) :: nam !--- FIELD/FILE NAME |
---|
| 292 | IF(ierr==nf90_noerr) RETURN |
---|
| 293 | SELECT CASE(typ) |
---|
| 294 | CASE('inq'); mesg = "Field <" // TRIM(nam) // "> is missing" |
---|
| 295 | CASE('get'); mesg = "Reading failed for <" // TRIM(nam) // ">" |
---|
| 296 | CASE('open'); mesg = "File opening failed for <" // TRIM(nam) // ">" |
---|
| 297 | CASE('close'); mesg = "File closing failed for <" // TRIM(nam) // ">" |
---|
| 298 | END SELECT |
---|
| 299 | CALL ABORT_gcm(TRIM(modname), TRIM(mesg), ierr) |
---|
| 300 | END SUBROUTINE err |
---|
[1632] | 301 | |
---|
[2299] | 302 | END SUBROUTINE dynetat0_loc |
---|