Changeset 5230
- Timestamp:
- Sep 25, 2024, 1:15:00 PM (3 months ago)
- Location:
- LMDZ6/branches/Amaury_dev
- Files:
-
- 3 edited
- 1 moved
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 -
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 -
LMDZ6/branches/Amaury_dev/libf/phylmd/phys_local_var_mod.F90
r5224 r5230 414 414 REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: h1_diag 415 415 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: xtrunoff_diag 416 !$OMP THREADPRIVATE(h1_diag v,xtrunoff_diag)416 !$OMP THREADPRIVATE(h1_diag,xtrunoff_diag) 417 417 REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zxfxtcalving 418 418 !$OMP THREADPRIVATE(zxfxtcalving)
Note: See TracChangeset
for help on using the changeset viewer.