Changeset 5230 for LMDZ6/branches/Amaury_dev/libf/phylmd/infotrac_phy.F90
- Timestamp:
- Sep 25, 2024, 1:15:00 PM (3 weeks ago)
- Location:
- LMDZ6/branches/Amaury_dev
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev
- Property svn:mergeinfo changed
/LMDZ6/trunk merged: 5216
- Property svn:mergeinfo changed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/infotrac_phy.F90
r5223 r5230 3 3 MODULE infotrac_phy 4 4 5 USE lmdz_strings, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx 6 USE lmdz_readTracFiles, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, & 7 delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, & 8 addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate, iqWIsoPha, nbIso, ntiso, isoName, isoCheck, new2oldH2O 5 USE lmdz_strings, ONLY: msg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount, strIdx 6 USE lmdz_readTracFiles, ONLY: readTracersFiles, maxTableWidth, isot_type, addPhase, addKey, iH2O, & 7 indexUpdate, trac_type, testTracersFiles, processIsotopes, tracers, delPhase, getKey, tran0, & 8 isoKeys, isoName, isoZone, isoPhas, isoSelect, itZonIso, nbIso, isotope, & 9 niso, ntiso, nzone, nphas, iqWIsoPha, iqIsoPha, ixIso, isoCheck, new2oldH2O 9 10 IMPLICIT NONE 10 11 … … 17 18 PUBLIC :: conv_flg, pbl_flg !--- Convection & boundary layer activation keys 18 19 PUBLIC :: new2oldH2O !--- For backwards compatibility in phyetat0 19 20 PUBLIC :: addPhase, delPhase !--- Add/remove the phase from the name of a tracer 20 21 PUBLIC :: nbtr_bin, nbtr_sulgas !--- Number of aerosols bins and sulfur gases for StratAer model 21 22 PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat … … 26 27 !=== FOR ISOTOPES: Specific to water 27 28 PUBLIC :: iH2O !--- Value of "ixIso" for "H2O" isotopes class 28 29 PUBLIC :: ivap, iliq, isol 29 30 !=== FOR ISOTOPES: Depending on the selected isotopes family 30 31 PUBLIC :: isotope !--- Selected isotopes database (argument of getKey) 31 32 PUBLIC :: isoKeys, isoName, isoZone, isoPhas !--- Isotopes keys & names, tagging zones names, phases 32 PUBLIC :: niso, ntiso, nzone, nphas!--- Number of " "33 PUBLIC :: niso, ntiso, nzone, nphas!--- Number of " " 33 34 PUBLIC :: itZonIso !--- Index "it" in "isoName(1:niso)" = f(tagging idx, isotope idx) 34 35 PUBLIC :: iqIsoPha !--- Index "iq" in "qx" = f(isotope idx, phase idx) … … 68 69 ! | name | Name (short) | tname | | 69 70 ! | keys | key/val pairs accessible with "getKey" routine | / | | 70 ! |gen0Name | Name of the 1st generation ancestor | / | |71 ! |gen0Name | Name of the 1st generation ancestor | / | | 71 72 ! | parent | Name of the parent | / | | 72 73 ! | longName | Long name (with adv. scheme suffix) for outputs | ttext | | 73 74 ! | type | Type (so far: tracer or tag) | / | tracer,tag | 74 75 ! | phase | Phases list ("g"as / "l"iquid / "s"olid | | [g|l|s|r|b] | 75 ! | | "r"(cloud) / "b"lowing) | / | |76 ! | | "r"(cloud) / "b"lowing) | / | | 76 77 ! | component | Name(s) of the merged/cumulated section(s) | / | coma-separated names | 77 78 ! | iGeneration | Generation (>=1) | / | | … … 105 106 106 107 !=== INDICES FOR WATER 107 108 !$OMP THREADPRIVATE(ivap, iliq, isol)109 110 108 INTEGER, SAVE :: ivap, iliq, isol 109 !$OMP THREADPRIVATE(ivap, iliq, isol) 110 111 !===DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 111 112 INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O) 112 113 nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O) … … 119 120 !=== VARIABLES FOR INCA 120 121 INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: & 121 122 conv_flg, pbl_flg !--- Convection / boundary layer activation (nbtr) 122 123 !$OMP THREADPRIVATE(conv_flg, pbl_flg) 123 124 … … 132 133 SUBROUTINE init_infotrac_phy 133 134 USE lmdz_ioipsl_getin_p, ONLY: getin_p 135 USE lmdz_phys_para, ONLY: is_master, is_omp_master 134 136 USE lmdz_reprobus_wrappers, ONLY: Init_chem_rep_trac 135 137 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_STRATAER, CPPKEY_REPROBUS … … 192 194 193 195 CALL getin_p('type_trac', type_trac) 194 195 lerr = strParse(type_trac, '|', types_trac, n = nt) 196 IF (nt > 1) THEN 197 IF (nt > 2) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1) 198 IF (nt == 2) type_trac = types_trac(2) 199 ENDIF 196 CALL msg('type_trac = "' // TRIM(type_trac) // '"', modname, is_master) 197 IF(strCount(type_trac, '|', nt)) CALL abort_physic(modname, 'Could''nt parse the "type_trac" string with delimiter "|"', 1) 198 IF(nt >= 3) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1) 199 IF(strParse(type_trac, '|', types_trac, n = nt)) CALL abort_physic(modname, "couldn't parse " // '"type_trac"', 1) 200 IF(nt == 2) type_trac = types_trac(2) ! TO BE DELETED SOON 200 201 201 202 CALL msg('type_trac = "' // TRIM(type_trac) // '"', modname) … … 203 204 204 205 !############################################################################################################################## 205 IF(lInit ) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac ####206 IF(lInit .AND. is_master) THEN !=== SKIPED IF ALREADY DONE 206 207 !############################################################################################################################## 207 208 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION … … 236 237 !############################################################################################################################## 237 238 238 nqCO2 = COUNT([type_trac == 'inco', type_trac == 'co2i']) 239 239 240 240 241 !============================================================================================================================== … … 245 246 IF(texp /= 'lmdz') texp = 'lmdz|' // TRIM(texp) 246 247 247 248 IF(testTracersFiles(modname, texp, fType, lInit)) CALL abort_physic(modname, 'problem with tracers file(s)', 1) 249 250 ttp = type_trac; IF(fType /= 1) ttp = texp 248 IF(testTracersFiles(modname, texp, fType, lInit.AND.is_master)) CALL abort_physic(modname, 'problem with tracers file(s)', 1) 249 250 ttp = type_trac; IF(fType /= 1) ttp = texp!--------------------------------------------------------------------------------------------------------------------------- 251 IF(fType == 0) CALL abort_physic(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.', 1) 252 !--------------------------------------------------------------------------------------------------------------------------- 253 IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) & !=== FOUND OLD STYLE INCA "traceur.def" 254 CALL abort_physic(modname, 'retro-compatibility with old-style INCA traceur.def files has been disabled.', 1) 255 !--------------------------------------------------------------------------------------------------------------------------- 251 256 252 257 !############################################################################################################################## 253 258 IF(lInit) THEN 254 259 IF(readTracersFiles(ttp, lRepr = type_trac=='repr')) CALL abort_physic(modname, 'problem with tracers file(s)', 1) 255 ELSE 256 CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname) 257 END IF 258 !############################################################################################################################## 259 260 !============================================================================================================================== 261 ! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc. 262 !============================================================================================================================== 263 !--------------------------------------------------------------------------------------------------------------------------- 264 IF(fType == 0) CALL abort_physic(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracersfile.', 1) 265 !--------------------------------------------------------------------------------------------------------------------------- 266 IF(fType == 1 .AND. ANY(['inca', 'inco']==type_trac) .AND. lInit) THEN !=== FOUND OLD STYLE INCA "traceur.def" 267 !--------------------------------------------------------------------------------------------------------------------------- 268 IF (CPPKEY_INCA) THEN 269 nqo = SIZE(tracers) - nqCO2 270 CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA 271 nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac 272 nqtrue = nbtr + nqo !--- Total number of "true" tracers 273 IF(ALL([2, 3] /= nqo)) CALL abort_physic(modname, 'Only 2 or 3 water phases allowed ; found nqo=' // TRIM(int2str(nqo)), 1) 274 ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA)) 275 ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA)) 276 CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca) 277 ALLOCATE(ttr(nqtrue)) 278 ttr(1:nqo + nqCO2) = tracers 279 ttr(1:nqo)%component = 'lmdz' 280 ttr(1 + nqo:nqCO2 + nqo)%component = 'co2i' 281 ttr(1 + nqo + nqCO2:nqtrue)%component = 'inca' 282 ttr(1 + nqo:nqtrue)%name = [('CO2 ', iq = 1, nqCO2), solsym_inca] 283 ttr(1 + nqo + nqCO2:nqtrue)%parent = tran0 284 ttr(1 + nqo + nqCO2:nqtrue)%phase = 'g' 285 lerr = getKey('hadv', had, ky = tracers(:)%keys) 286 lerr = getKey('vadv', vad, ky = tracers(:)%keys) 287 hadv(1:nqo + nqCO2) = had(:); hadv(1 + nqo + nqCO2:nqtrue) = hadv_inca 288 vadv(1:nqo + nqCO2) = vad(:); vadv(1 + nqo + nqCO2:nqtrue) = vadv_inca 289 CALL MOVE_ALLOC(FROM = ttr, TO = tracers) 290 DO iq = 1, nqtrue 291 t1 => tracers(iq) 292 CALL addKey('name', t1%name, t1%keys) 293 CALL addKey('component', t1%component, t1%keys) 294 CALL addKey('parent', t1%parent, t1%keys) 295 CALL addKey('phase', t1%phase, t1%keys) 296 END DO 297 IF(setGeneration(tracers)) CALL abort_physic(modname, 'See below', 1) !- SET FIELDS %iGeneration, %gen0Name 298 DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) 299 END IF 300 !--------------------------------------------------------------------------------------------------------------------------- 301 ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) 302 !--------------------------------------------------------------------------------------------------------------------------- 303 nqtrue = SIZE(tracers) !--- "true" tracers 304 nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases 305 nbtr = nqtrue-COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O') !--- Passed to phytrac 306 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 307 IF (CPPKEY_INCA) THEN 308 nqINCA = COUNT(tracers(:)%component == 'inca') 309 END IF 310 IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "hadv"', 1) 311 IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "vadv"', 1) 312 !--------------------------------------------------------------------------------------------------------------------------- 260 END IF 261 CALL msg('No tracers description file(s) reading needed: already done', modname, .NOT.lInit.AND.is_master) 262 !############################################################################################################################## 263 264 !============================================================================================================================== 265 ! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc. 266 !============================================================================================================================== 267 nqtrue = SIZE(tracers) !--- "true" tracers 268 nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases 269 nbtr = nqtrue - COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O') !--- Passed to phytrac 270 nqCO2 = COUNT([type_trac == 'inco', type_trac == 'co2i']) 271 IF (CPPKEY_INCA) THEN 272 nqINCA = COUNT(tracers(:)%component == 'inca') 313 273 END IF 314 274 !--------------------------------------------------------------------------------------------------------------------------- … … 326 286 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). 327 287 !============================================================================================================================== 288 IF(getKey('hadv', hadv, ky = tracers(:)%keys)) CALL abort_physic(modname, 'missing key "hadv"', 1) 289 IF(getKey('vadv', vadv, ky = tracers(:)%keys)) CALL abort_physic(modname, 'missing key "vadv"', 1) 290 328 291 DO iq = 1, nqtrue 329 292 IF(hadv(iq)<20 .OR. (ANY(hadv(iq)==[20, 30]) .AND. hadv(iq)==vadv(iq))) CYCLE … … 360 323 t1%longName = t1%name; IF(iad > 0) t1%longName = TRIM(t1%name) // descrq(iad) 361 324 t1%isAdvected = iad >= 0 362 t1%isInPhysics = delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O325 t1%isInPhysics = delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O 363 326 ttr(iq) = t1 364 327 … … 370 333 ttr(jq + 1:jq + nm) = t1 371 334 ttr(jq + 1:jq + nm)%name = [(TRIM(t1%name) // '-' // TRIM(suff(im)), im = 1, nm) ] 372 ttr(jq +1:jq+nm)%gen0Name = [ (TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ]335 ttr(jq + 1:jq + nm)%gen0Name = [ (TRIM(t1%name) // '-' // TRIM(suff(im)), im = 1, nm) ] 373 336 ttr(jq + 1:jq + nm)%parent = [(TRIM(t1%parent) // '-' // TRIM(suff(im)), im = 1, nm) ] 374 337 ttr(jq + 1:jq + nm)%longName = [(TRIM(t1%longName) // '-' // TRIM(suff(im)), im = 1, nm) ] 375 ttr(jq + 1:jq + nm)%isAdvected = [(.FALSE., im =1, nm) ]376 ttr(jq+1:jq+nm)%isInPhysics = [ (.FALSE., im = 1, nm) ]338 ttr(jq + 1:jq + nm)%isAdvected = [(.FALSE., im = 1, nm) ] 339 ttr(jq + 1:jq + nm)%isInPhysics = [ (.FALSE., im = 1, nm) ] 377 340 jq = jq + nm 378 341 END DO … … 404 367 !--- Convection / boundary layer activation for all tracers 405 368 IF(.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 406 IF(.NOT.ALLOCATED( 369 IF(.NOT.ALLOCATED(pbl_flg)) ALLOCATE(pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1 407 370 408 371 !--- Note: nqtottr can differ from nbtr when nmom/=0 … … 412 375 413 376 !=== DISPLAY THE RESULTS 377 IF(.NOT.is_master) RETURN 414 378 CALL msg('nqo = ' // TRIM(int2str(nqo)), modname) 415 379 CALL msg('nbtr = ' // TRIM(int2str(nbtr)), modname) … … 423 387 END IF 424 388 t => tracers 425 CALL msg('Information stored in ' //TRIM(modname)//' :', modname)389 CALL msg('Information stored in ' // TRIM(modname) // ' :', modname) 426 390 IF(dispTable('isssssssssiiiiiiii', ['iq ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', & 427 391 'isPh', 'isAd', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], & 428 392 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, & 429 393 bool2str(t%isInPhysics), bool2str(t%isAdvected)), & 430 394 cat([(iq, iq = 1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, & 431 395 t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax = maxTableWidth, nHead = 2, sub = modname)) & 432 396 CALL abort_physic(modname, "problem with the tracers table content", 1) 433 IF(niso > 0) THEN 434 CALL msg('Where, for isotopes family "' // TRIM(isotope%parent) // '":', modname) 435 CALL msg(' isoKeys%name = ' // strStack(isoKeys%name), modname) 436 CALL msg(' isoName = ' // strStack(isoName), modname) 437 CALL msg(' isoZone = ' // strStack(isoZone), modname) 438 CALL msg(' isoPhas = ' // TRIM(isoPhas), modname) 439 ELSE 440 CALL msg('No isotopes identified.', modname) 441 END IF 397 CALL msg('No isotopes identified.', modname, nbIso == 0) 398 IF(nbIso == 0) RETURN 399 CALL msg('For isotopes family "H2O":', modname) 400 CALL msg(' isoKeys%name = ' // strStack(isoKeys%name), modname) 401 CALL msg(' isoName = ' // strStack(isoName), modname) 402 CALL msg(' isoZone = ' // strStack(isoZone), modname) 403 CALL msg(' isoPhas = ' // TRIM(isoPhas), modname) 404 442 405 443 406 #ifdef ISOVERIF … … 463 426 END IF 464 427 END IF 465 CALL msg('end', modname)466 428 467 429 END SUBROUTINE init_infotrac_phy
Note: See TracChangeset
for help on using the changeset viewer.