- Timestamp:
- Sep 25, 2024, 1:15:00 PM (3 weeks ago)
- Location:
- LMDZ6/branches/Amaury_dev
- Files:
-
- 1 edited
- 1 moved
-
. (modified) (1 prop)
-
libf/dyn3d_common/lmdz_infotrac.F90 (moved) (moved from LMDZ6/branches/Amaury_dev/libf/dyn3d_common/lmdz_infotrac.f90) (12 diffs)
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/dyn3d_common/lmdz_infotrac.F90
r5229 r5230 1 1 MODULE lmdz_infotrac 2 2 3 USE lmdz_strings, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse 4 USE lmdz_readTracFiles, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, & 5 delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, & 6 addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate, iqWIsoPha, nbIso, ntiso, isoName, isoCheck 3 USE lmdz_strings, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount 4 USE lmdz_readTracFiles, ONLY: readTracersFiles, maxTableWidth, isot_type, addPhase, addKey, iH2O, & 5 indexUpdate, trac_type, testTracersFiles, processIsotopes, tracers, delPhase, getKey, tran0, & 6 isoKeys, isoName, isoZone, isoPhas, isoSelect, itZonIso, nbIso, isotope, & 7 niso, ntiso, nzone, nphas, iqIsoPha, ixIso, isoCheck 7 8 USE lmdz_readTracFiles, ONLY: new2oldH2O, newHNO3, oldHNO3 8 9 … … 28 29 PUBLIC :: isoKeys, isoName, isoZone, isoPhas !--- Isotopes keys & names, tagging zones names, phases 29 30 PUBLIC :: niso, ntiso, nzone, nphas !--- Number of " " 30 PUBLIC :: itZonIso !--- index "it" in "isoName(1:niso)" = f(tagging idx, isotope idx)31 PUBLIC :: iqIsoPha !--- index "iq" in "qx" = f(isotope idx, phase idx)31 PUBLIC :: itZonIso !--- Index "it" in "isoName(1:niso)" = f(tagging idx, isotope idx) 32 PUBLIC :: iqIsoPha !--- Index "iq" in "qx" = f(isotope idx, phase idx) 32 33 PUBLIC :: isoCheck !--- Run isotopes checking routines 33 34 !=== FOR BOTH TRACERS AND ISOTOPES … … 117 118 SUBROUTINE init_infotrac 118 119 USE control_mod, ONLY: planet_type 120 #ifdef CPP_PARA 121 USE parallel_lmdz, ONLY: is_master 122 #endif 119 123 USE lmdz_reprobus_wrappers, ONLY: init_chem_rep_trac 120 124 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_STRATAER, CPPKEY_REPROBUS … … 151 155 CHARACTER(LEN = 8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA 152 156 INTEGER :: nqINCA 153 CHARACTER(LEN = 2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather) 154 CHARACTER(LEN = 3) :: descrq(30) !--- Advection scheme description tags 155 CHARACTER(LEN = maxlen) :: msg1, texp, ttp !--- Strings for messages and expanded tracers type 157 #ifndef CPP_PARA 158 LOGICAL :: is_master = .TRUE. 159 #endif 160 CHARACTER(LEN = 2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather) 161 CHARACTER(LEN = 3) :: descrq(30) !--- Advection scheme description tags 162 CHARACTER(LEN = maxlen) :: msg1, texp, ttp, nam, val !--- Strings for messages and expanded tracers type 156 163 INTEGER :: fType !--- Tracers description file type ; 0: none 157 164 !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def" 158 165 INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments) 159 166 INTEGER :: iad !--- Advection scheme number 160 INTEGER :: iq, jq, nt, im, nm 167 INTEGER :: iq, jq, nt, im, nm, ig !--- Indexes and temporary variables 161 168 LOGICAL :: lerr, ll 162 169 TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:) … … 173 180 descrq(30) = 'PRA' 174 181 175 lerr = strParse(type_trac, '|', types_trac, n = nt)176 IF (nt > 1) THEN177 IF (nt > 2) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)178 IF (nt == 2) type_trac = types_trac(2)179 ENDIF182 CALL msg('type_trac = "' // TRIM(type_trac) // '"', modname, is_master) 183 IF(strCount(type_trac, '|', nt)) CALL abort_gcm(modname, 'Could''nt parse the "type_trac" string with delimiter "|"', 1) 184 IF(nt >= 3) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1) 185 IF(strParse(type_trac, '|', types_trac, n = nt)) CALL abort_gcm(modname, "couldn't parse " // '"type_trac"', 1) 186 IF(nt == 2) type_trac = types_trac(2) ! TO BE DELETED SOON 180 187 181 188 CALL msg('type_trac = "' // TRIM(type_trac) // '"', modname) 182 189 190 !############################################################################################################################## 191 IF(is_master) THEN !=== SKIPED IF ALREADY DONE 192 !############################################################################################################################## 183 193 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION 184 194 msg1 = 'For type_trac = "' // TRIM(type_trac) // '":' … … 209 219 END SELECT 210 220 211 nqCO2 = COUNT([type_trac == 'inco', type_trac == 'co2i']) 221 !############################################################################################################################## 222 END IF 223 !############################################################################################################################## 212 224 213 225 !============================================================================================================================== … … 219 231 IF(testTracersFiles(modname, texp, fType, .TRUE.)) CALL abort_gcm(modname, 'problem with tracers file(s)', 1) 220 232 ttp = type_trac; IF(fType /= 1) ttp = texp 221 IF(readTracersFiles(ttp, lRepr = type_trac=='repr')) CALL abort_gcm(modname, 'problem with tracers file(s)', 1) 233 !--------------------------------------------------------------------------------------------------------------------------- 234 IF(fType == 0) CALL abort_gcm(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1) 235 !--------------------------------------------------------------------------------------------------------------------------- 236 IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) & !=== FOUND OLD STYLE INCA "traceur.def" 237 CALL abort_gcm(modname, 'retro-compatibility with old-style INCA traceur.def files has been disabled.', 1) 238 !--------------------------------------------------------------------------------------------------------------------------- 239 240 IF(readTracersFiles(ttp, lRepr=type_trac == 'repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 222 241 !============================================================================================================================== 223 242 ! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc. 224 243 !============================================================================================================================== 225 226 !---------------------------------------------------------------------------------------------------------------------------227 IF(fType == 0) CALL abort_gcm(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.', 1)228 !---------------------------------------------------------------------------------------------------------------------------229 IF(fType == 1 .AND. ANY(['inca', 'inco']==type_trac)) THEN !=== FOUND OLD STYLE INCA "traceur.def"230 !---------------------------------------------------------------------------------------------------------------------------231 IF (CPPKEY_INCA) THEN232 nqo = SIZE(tracers) - nqCO2233 CALL init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA234 nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac235 nqtrue = nbtr + nqo !--- Total number of "true" tracers236 IF(ALL([2, 3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo=' // TRIM(int2str(nqo)), 1)237 ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))238 ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA))239 CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)240 ALLOCATE(ttr(nqtrue))241 ttr(1:nqo + nqCO2) = tracers242 ttr(1:nqo)%component = 'lmdz'243 ttr(1 + nqo:nqCO2 + nqo)%component = 'co2i'244 ttr(1 + nqo + nqCO2:nqtrue)%component = 'inca'245 ttr(1 + nqo:nqtrue)%name = [('CO2 ', iq = 1, nqCO2), solsym_inca]246 ttr(1 + nqo + nqCO2:nqtrue)%parent = tran0247 ttr(1 + nqo + nqCO2:nqtrue)%phase = 'g'248 lerr = getKey('hadv', had, ky = tracers(:)%keys)249 lerr = getKey('vadv', vad, ky = tracers(:)%keys)250 hadv(1:nqo + nqCO2) = had(:); hadv(1 + nqo + nqCO2:nqtrue) = hadv_inca251 vadv(1:nqo + nqCO2) = vad(:); vadv(1 + nqo + nqCO2:nqtrue) = vadv_inca252 CALL MOVE_ALLOC(FROM = ttr, TO = tracers)253 DO iq = 1, nqtrue254 t1 => tracers(iq)255 CALL addKey('name', t1%name, t1%keys)256 CALL addKey('component', t1%component, t1%keys)257 CALL addKey('parent', t1%parent, t1%keys)258 CALL addKey('phase', t1%phase, t1%keys)259 END DO260 IF(setGeneration(tracers)) CALL abort_gcm(modname, 'See above', 1) !- SET FIELDS %iGeneration, %gen0Name261 DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)262 !---------------------------------------------------------------------------------------------------------------------------263 END IF264 ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)265 !---------------------------------------------------------------------------------------------------------------------------266 244 nqtrue = SIZE(tracers) !--- "true" tracers 267 245 nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases … … 271 249 nqINCA = COUNT(tracers(:)%component == 'inca') 272 250 END IF 273 IF(getKey('hadv', hadv, ky = tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "hadv"', 1) 274 IF(getKey('vadv', vadv, ky = tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "vadv"', 1) 275 !--------------------------------------------------------------------------------------------------------------------------- 251 IF (CPPKEY_REPROBUS) THEN 252 CALL init_chem_rep_trac(nbtr, nqo, tracers(:)%name) !--- Transfert the number of tracers to Reprobus 276 253 END IF 277 !---------------------------------------------------------------------------------------------------------------------------278 279 IF (CPPKEY_REPROBUS) THEN280 CALL init_chem_rep_trac(nbtr, nqo, tracers(:)%name)281 END IF282 254 283 255 !============================================================================================================================== 284 256 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). 285 257 !============================================================================================================================== 258 IF(getKey('hadv', hadv, ky = tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "hadv"', 1) 259 IF(getKey('vadv', vadv, ky = tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "vadv"', 1) 286 260 DO iq = 1, nqtrue 287 261 IF(hadv(iq)<20 .OR. (ANY(hadv(iq)==[20, 30]) .AND. hadv(iq)==vadv(iq))) CYCLE … … 358 332 359 333 !=== TEST ADVECTION SCHEME 360 DO iq = 1, nqtot ; t1 => tracers(iq); iad = t1%iadv 334 DO iq = 1, nqtot ; t1 => tracers(iq) 335 iad = t1%iadv 336 ig = t1%iGeneration 337 nam = t1%name 338 val = 'iadv=' // TRIM(int2str(iad)) 361 339 362 340 !--- ONLY TESTED VALUES FOR TRACERS FOR NOW: iadv = 14, 10 (and 0 for non-transported tracers) 363 IF(ALL([10, 14, 0] /= iad)) & 364 CALL abort_gcm(modname, 'Not tested for iadv=' // TRIM(int2str(iad)) // ' ; 10 or 14 only are allowed !', 1) 365 366 !--- ONLY TESTED VALUES FOR PARENTS HAVING CHILDS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1) 367 IF(ALL([10, 14] /= iad) .AND. t1%iGeneration == 1 .AND. ANY(tracers(:)%iGeneration > 1)) & 368 CALL abort_gcm(modname, 'iadv=' // TRIM(int2str(iad)) // ' not implemented for parents ; 10 or 14 only are allowed !', 1) 369 370 !--- ONLY TESTED VALUES FOR CHILDS FOR NOW: iadv = 10 (CHILDS: TRACERS OF GENERATION GREATER THAN 1) 371 IF(fmsg('WARNING ! iadv=' // TRIM(int2str(iad)) // ' not implemented for childs. Setting iadv=10 for "' // TRIM(t1%name) // '"', & 372 modname, iad /= 10 .AND. t1%iGeneration > 1)) t1%iadv = 10 373 374 !--- ONLY VALID SCHEME NUMBER FOR WATER VAPOUR: iadv = 14 375 ll = t1%name /= addPhase('H2O', 'g') 376 IF(fmsg('WARNING ! iadv=14 is valid for water vapour only. Setting iadv=10 for "' // TRIM(t1%name) // '".', & 377 modname, iad == 14 .AND. ll)) t1%iadv = 10 341 IF(ALL([10, 14, 0] /= iad)) CALL abort_gcm(modname, TRIM(val) // ' has not been tested yet ; 10 or 14 only are allowed !', 1) 342 343 !--- ONLY TESTED VALUES SO FAR FOR PARENTS HAVING CHILDREN: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 0) 344 IF(ALL([10, 14] /= iad) .AND. ig == 0 .AND. ANY(tracers(:)%parent==nam)) & 345 CALL abort_gcm(modname, TRIM(val) // ' is not implemented for parents ; 10 or 14 only are allowed !', 1) 346 347 !--- ONLY TESTED VALUES SO FAR FOR DESCENDANTS (TRACERS OF GENERATION > 0): iadv = 10 ; WATER VAPOUR: iadv = 14 348 lerr = iad /= 10 .AND. ig > 0; IF(lerr) tracers(iq)%iadv = 10 349 CALL msg('WARNING! ' // TRIM(val) // ' not implemented for children. Setting iadv=10 for "' // TRIM(nam) // '"', modname, lerr) 350 lerr = iad == 14 .AND. nam /= addPhase('H2O', 'g'); IF(lerr) tracers(iq)%iadv = 10 351 CALL msg('WARNING! ' // TRIM(val) // ' is valid for water vapour only. Setting iadv=10 for "' // TRIM(nam) // '"', modname, lerr) 378 352 END DO 379 353 … … 383 357 384 358 !--- Convection / boundary layer activation for all tracers 385 ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1386 ALLOCATE(pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1359 IF(.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 360 IF(.NOT.ALLOCATED(pbl_flg)) ALLOCATE(pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1 387 361 388 362 !--- Note: nqtottr can differ from nbtr when nmom/=0 … … 392 366 393 367 !=== DISPLAY THE RESULTS 368 IF(.NOT.is_master) RETURN 394 369 CALL msg('nqo = ' // TRIM(int2str(nqo)), modname) 395 370 CALL msg('nbtr = ' // TRIM(int2str(nbtr)), modname) … … 410 385 t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax = maxTableWidth, nHead = 2, sub = modname)) & 411 386 CALL abort_gcm(modname, "problem with the tracers table content", 1) 412 IF(niso > 0) THEN 413 CALL msg('Where, for isotopes family "' // TRIM(isotope%parent) // '":', modname) 414 CALL msg(' isoKeys%name = ' // strStack(isoKeys%name), modname) 415 CALL msg(' isoName = ' // strStack(isoName), modname) 416 CALL msg(' isoZone = ' // strStack(isoZone), modname) 417 CALL msg(' isoPhas = ' // TRIM(isoPhas), modname) 418 ELSE 419 CALL msg('No isotopes identified.', modname) 420 END IF 421 CALL msg('end', modname) 387 CALL msg('No isotopes identified.', modname, nbIso == 0) 388 IF(nbIso == 0) RETURN 389 CALL msg('For isotopes family "H2O":', modname) 390 CALL msg(' isoKeys%name = ' // strStack(isoKeys%name), modname) 391 CALL msg(' isoName = ' // strStack(isoName), modname) 392 CALL msg(' isoZone = ' // strStack(isoZone), modname) 393 CALL msg(' isoPhas = ' // TRIM(isoPhas), modname) 422 394 423 395 END SUBROUTINE init_infotrac
Note: See TracChangeset
for help on using the changeset viewer.
