Changeset 5190 for LMDZ6/trunk/libf/phylmd/infotrac_phy.F90
- Timestamp:
- Sep 15, 2024, 10:38:32 AM (8 weeks ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/infotrac_phy.F90
r5184 r5190 3 3 MODULE infotrac_phy 4 4 5 USE strings_mod, ONLY: msg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount, strIdx 6 USE readTracFiles_mod, ONLY: readTracersFiles, maxTableWidth, tisot=>isot_type, addPhase, addKey, iH2O, & 7 indexUpdate, keys_type, testTracersFiles, processIsotopes, trac=>tracers, delPhase, getKey, tran0 8 USE readTracFiles_mod, ONLY: new2oldH2O 9 5 USE strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx 6 USE readTracFiles_mod, 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 10 9 IMPLICIT NONE 11 10 … … 17 16 PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr !--- Main dimensions 18 17 PUBLIC :: conv_flg, pbl_flg !--- Convection & boundary layer activation keys 19 PUBLIC :: new2oldH2O !--- For backwards compatibility in phyetat0 20 PUBLIC :: addPhase, delPhase !--- Add/remove the phase from the name of a tracer 21 #if defined CPP_StratAer || defined REPROBUS 18 #ifdef CPP_StratAer 22 19 PUBLIC :: nbtr_bin, nbtr_sulgas !--- Number of aerosols bins and sulfur gases for StratAer model 23 20 PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat 24 21 #endif 25 22 23 !=== FOR WATER 24 PUBLIC :: ivap, iliq, isol 26 25 !=== FOR ISOTOPES: General 27 26 PUBLIC :: isot_type, nbIso !--- Derived type, full isotopes families database + nb of families 28 PUBLIC :: isoSelect, ixIso , isoFamilies !--- Isotopes families selection tool + selected index + list27 PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index 29 28 !=== FOR ISOTOPES: Specific to water 30 PUBLIC :: iH2O !--- Value of "ixIso" for "H2O" isotopes class 31 PUBLIC :: ivap, iliq, isol 29 PUBLIC :: iH2O !--- H2O isotopes class index 32 30 !=== FOR ISOTOPES: Depending on the selected isotopes family 33 PUBLIC :: isotope !--- Selected isotopes database (argument of getKey) 34 PUBLIC :: isoKeys, isoName, isoZone, isoPhas !--- Isotopes keys & names, tagging zones names, phases 35 PUBLIC :: niso, ntiso, nzone, nphas !--- Number of " " 36 PUBLIC :: itZonIso !--- index "it" in "isoName(1:niso)" = f(tagging idx, isotope idx) 37 PUBLIC :: iqIsoPha !--- index "iq" in "qx" = f(isotope idx, phase idx) 38 PUBLIC :: iqWIsoPha !--- Same as iqIsoPha but with normal water phases 31 PUBLIC :: isotope, isoKeys !--- Selected isotopes database + associated keys (cf. getKey) 32 PUBLIC :: isoName, isoZone, isoPhas !--- Isotopes and tagging zones names, phases 33 PUBLIC :: niso, nzone, nphas, ntiso !--- " " numbers + isotopes & tagging tracers number 34 PUBLIC :: itZonIso !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx) 35 PUBLIC :: iqIsoPha !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases 36 PUBLIC :: iqWIsoPha !--- Same as iqIsoPha but with normal water phases 37 39 38 PUBLIC :: isoCheck !--- Run isotopes checking routines 40 39 !=== FOR BOTH TRACERS AND ISOTOPES … … 44 43 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 45 44 ! | water in different | water tagging | water isotopes | other tracers | additional tracers moments | 46 ! | phases: H2O_[gls rb]| isotopes | | | for higher order schemes |45 ! | phases: H2O_[gls] | isotopes | | | for higher order schemes | 47 46 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 48 47 ! | | | | | | … … 58 57 ! |-----------------------------------------------------------------------------------------------------------| 59 58 ! NOTES FOR THIS TABLE: 60 ! * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)% name== 'H2O'),59 ! * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'), 61 60 ! since water is so far the sole tracers family, except passive CO2, removed from the main tracers table. 62 61 ! * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas". 63 62 ! * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any. 64 ! * If you deal with an isotopes family other than "H2O" ("Sulf" in the example), a good practice is to keep65 ! track of the isotopes class (of its index) before switching to it at the beginning of the dedicated code:66 ! - first time (use selection by name and compute the corresponding index iSulf) :67 ! i0=ixIso; IF(.NOT.isoSelect('Sulf')) CALL abort_physic("Can't select isotopes class", modname, 1); iS=ixIso68 ! - next times (use selection by index - "iS" has been computed at first call):69 ! i0=ixIso; IF(.NOT.isoSelect(iS)) CALL abort_physic("Can't select isotopes class", modname, 1)70 ! and to switch back to the original category when you're done with "Sulf":71 ! IF(.NOT.isoSelect(i0)) CALL abort_physic("Can't select isotopes class", modname, 1)72 ! to restore the original isotopes category (before dealing with "Sulf" (most of the time "H2O").73 63 ! 74 64 !=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot) … … 78 68 ! |-------------+------------------------------------------------------+-------------+------------------------+ 79 69 ! | name | Name (short) | tname | | 80 ! | keys | key/val pairs accessible with "getKey" routine | / | |81 70 ! | gen0Name | Name of the 1st generation ancestor | / | | 82 71 ! | parent | Name of the parent | / | | 83 72 ! | longName | Long name (with adv. scheme suffix) for outputs | ttext | | 84 73 ! | type | Type (so far: tracer or tag) | / | tracer,tag | 85 ! | phase | Phases list ("g"as / "l"iquid / "s"olid | | [g|l|s|r|b] | 86 ! | | "r"(cloud) / "b"lowing) | / | | 74 ! | phase | Phases list ("g"as / "l"iquid / "s"olid) | / | [g][l][s] | 87 75 ! | component | Name(s) of the merged/cumulated section(s) | / | coma-separated names | 88 76 ! | iGeneration | Generation (>=1) | / | | … … 91 79 ! | nqDescen | Number of the descendants (all generations) | nqdesc | 1:nqtot | 92 80 ! | nqChildren | Number of childs (1st generation only) | nqfils | 1:nqtot | 93 ! | isAdvected | Advected tracers flag (.TRUE. if iadv >= 0) | / | nqtrue .TRUE. values | 94 ! | isInPhysics | Tracers not extracted from the main table in physics | / | nqtottr .TRUE. values | 81 ! | keys | key/val pairs accessible with "getKey" routine | / | | 82 ! | isAdvected | advected tracers flag (.TRUE. if iadv >= 0) | / | nqtrue .TRUE. values | 83 ! | isInPhysics | tracers not extracted from the main table in physics | / | nqtottr .TRUE. values | 95 84 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 96 85 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | … … 104 93 ! | entry | length | Meaning | Former name | Possible values | 105 94 ! |-----------------+--------------------------------------------------+--------------------+-----------------+ 106 ! | name | Name of the isotopes class (family)| | |95 ! | parent | Parent tracer (isotopes family name) | | | 107 96 ! | keys | niso | Isotopes keys/values pairs list + number | | | 108 97 ! | trac | ntiso | Isotopes + tagging tracers list + number | / | ntraciso | | 109 98 ! | zone | nzone | Geographic tagging zones list + number | / | ntraceurs_zone | | 110 ! | phase | nphas | Phases list + number | | [g |l|s|r|b] 1:5|99 ! | phase | nphas | Phases list + number | | [g][l][s], 1:3 | 111 100 ! | iqIsoPha | Index in "qx" = f(name(1:ntiso)),phas) | iqiso | 1:nqtot | 112 ! | iqWIsoPha | Index in "qx" = f(name(1:ntiso+nqo)),phas) | ?| 1:nqtot |101 ! | iqWIsoPha | Index in "qx" = f(name(1:ntiso)),phas) | iqiso | 1:nqtot | 113 102 ! | itZonIso | Index in "trac(1:ntiso)"= f(zone, name(1:niso)) | index_trac | 1:ntiso | 114 103 ! +-----------------+--------------------------------------------------+--------------------+-----------------+ 115 104 116 !------------------------------------------------------------------------------------------------------------------------------117 TYPE :: trac_type !=== TYPE FOR A SINGLE TRACER NAMED "name"118 CHARACTER(LEN=maxlen) :: name = '' !--- Name of the tracer119 TYPE(keys_type) :: keys !--- <key>=<val> pairs vector (general container)120 CHARACTER(LEN=maxlen) :: gen0Name = '' !--- First generation ancestor name121 CHARACTER(LEN=maxlen) :: parent = '' !--- Parent name122 CHARACTER(LEN=maxlen) :: longName = '' !--- Long name (with advection scheme suffix)123 CHARACTER(LEN=maxlen) :: type = 'tracer' !--- Type (so far: 'tracer' / 'tag')124 CHARACTER(LEN=maxlen) :: phase = 'g' !--- Phase ('g'as / 'l'iquid / 's'olid)125 CHARACTER(LEN=maxlen) :: component = '' !--- Coma-separated list of components (Ex: lmdz,inca)126 INTEGER :: iGeneration = -1 !--- Generation number (>=0)127 INTEGER :: iqParent = 0 !--- Parent index128 INTEGER, ALLOCATABLE :: iqDescen(:) !--- Descendants index (in growing generation order)129 INTEGER :: nqDescen = 0 !--- Number of descendants (all generations)130 INTEGER :: nqChildren = 0 !--- Number of children (first generation)131 LOGICAL :: isAdvected = .FALSE. !--- "true" tracers: iadv > 0. COUNT(isAdvected )=nqtrue132 LOGICAL :: isInPhysics = .TRUE. !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr133 INTEGER :: iso_iGroup = 0 !--- Isotopes group index in isotopes(:)134 INTEGER :: iso_iName = 0 !--- Isotope name index in isotopes(iso_iGroup)%trac(:)135 INTEGER :: iso_iZone = 0 !--- Isotope zone index in isotopes(iso_iGroup)%zone(:)136 INTEGER :: iso_iPhase = 0 !--- Isotope phase index in isotopes(iso_iGroup)%phase137 END TYPE trac_type138 !------------------------------------------------------------------------------------------------------------------------------139 TYPE :: isot_type !=== TYPE FOR THE ISOTOPES FAMILY DESCENDING ON TRACER "name"140 CHARACTER(LEN=maxlen) :: name !--- Isotopes family name (ex: H2O)141 TYPE(keys_type), ALLOCATABLE :: keys(:) !--- Isotopes keys/values pairs list (length: niso)142 LOGICAL :: check=.FALSE. !--- Flag for checking routines triggering143 CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:) !--- Isotopes + tagging tracers list (length: ntiso)144 CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:) !--- Geographic tagging zones names list (length: nzone)145 CHARACTER(LEN=maxlen) :: phase = 'g' !--- Phases list: [g|l|s|r|b] (length: nphas)146 INTEGER :: niso = 0 !--- Number of isotopes, excluding tagging tracers147 INTEGER :: ntiso = 0 !--- Number of isotopes, including tagging tracers148 INTEGER :: nzone = 0 !--- Number of geographic tagging zones149 INTEGER :: nphas = 0 !--- Number of phases150 INTEGER, ALLOCATABLE :: iqIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f( name(1:ntiso) ,phas)151 INTEGER, ALLOCATABLE :: iqWIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f([H2O,name(1:ntiso)],phas)152 INTEGER, ALLOCATABLE :: itZonIso(:,:) !--- Idx in "trac(1:ntiso)" = f(zone,name(1:niso))153 END TYPE isot_type154 !------------------------------------------------------------------------------------------------------------------------------155 INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect156 !------------------------------------------------------------------------------------------------------------------------------157 158 !=== INDICES FOR WATER159 INTEGER, SAVE :: ivap, iliq, isol160 !$OMP THREADPRIVATE(ivap, iliq, isol)161 162 105 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 163 INTEGER, SAVE :: nqtot, &!--- Tracers nb in dynamics (incl. higher moments + H2O)164 nbtr, &!--- Tracers nb in physics (excl. higher moments + H2O)165 nqo, &!--- Number of water phases106 INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O) 107 nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O) 108 nqo, & !--- Number of water phases 166 109 nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?) 167 110 nqCO2 !--- Number of tracers of CO2 (ThL) … … 169 112 !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac) 170 113 171 !=== NUMBER AND LIST OF DEFINED ISOTOPES FAMILIES 172 INTEGER, SAVE :: nbIso !--- Number of defined isotopes classes 173 CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: isoFamilies(:) !--- Generation 0 tracer name for each isotopes family (nbIso) 174 !$OMP THREADPRIVATE(isoFamilies) 175 176 !=== QUANTITIES RELATED TO THE CURRENTLY SELECTED ISOTOPES CLASS (USUALLY H2O) 177 TYPE(isot_type), SAVE, POINTER :: isotope !--- Selected isotopes database (=isotopes(ixIso)) 178 TYPE(keys_type), SAVE, POINTER :: isoKeys(:) !--- Database to get isotopes keys using "getKey" (niso) 179 CHARACTER(LEN=maxlen), SAVE, POINTER :: isoName(:), & !--- Isotopes list including tagging tracers, no phase (ntiso) 180 isoZone(:), & !--- Geographic tagging zones list (nzone) 181 isoPhas !--- Used phases names ([g|l|s|r|b]) (nphas) 182 INTEGER, SAVE, POINTER :: itZonIso(:,:), & !--- Idx "it" in isoName(1:niso) = f(tagging idx, isotope idx) 183 iqIsoPha(:,:), & !--- Idx "iq" in qx = f(isotope idx, phase idx) 184 iqWIsoPha(:,:) !--- Idx "iq" in qx = f([parent trac,isotope idx], phase idx) 185 INTEGER, SAVE :: ixIso, & !--- Idx in "isoFamilies" of currently selectd class 186 niso, & !--- Number of isotopes 187 ntiso, & !--- Number of isotopes + tagging tracers 188 nzone, & !--- Number of tagging zones 189 nphas !--- Number of phases 190 LOGICAL, SAVE :: isoCheck !--- Isotopes checking routines triggering flag 191 !$OMP THREADPRIVATE(isotope, isoKeys, isoName, isoZone, isoPhas, itZonIso, iqIsoPha, iqWIsoPha, niso, ntiso, nzone, nphas, isoCheck) 114 !=== INDICES OF WATER 115 INTEGER, SAVE :: ivap,iliq,isol ! Indices for vap, liq and ice 116 !$OMP THREADPRIVATE(ivap,iliq,isol) 192 117 193 118 !=== VARIABLES FOR INCA 194 INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: &195 conv_flg, pbl_flg !--- Convection / boundary layer activation(nbtr)119 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr) 120 pbl_flg(:) !--- Boundary layer activation ; needed for INCA (nbtr) 196 121 !$OMP THREADPRIVATE(conv_flg, pbl_flg) 197 122 198 !=== TRACERS/ISOTOPES DESCRIPTORS: EFFECTIVE STORAGE (LOCAL DERIVED TYPES) 199 TYPE(trac_type), SAVE, ALLOCATABLE, TARGET :: tracers(:) 200 TYPE(isot_type), SAVE, ALLOCATABLE, TARGET :: isotopes(:) 201 !$OMP THREADPRIVATE(tracers, isotopes) 202 203 #if defined CPP_StratAer || defined REPROBUS 123 #ifdef CPP_StratAer 204 124 !=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB) 205 125 INTEGER, SAVE :: nbtr_bin, nbtr_sulgas !--- number of aerosols bins and sulfur gases for StratAer model … … 213 133 SUBROUTINE init_infotrac_phy 214 134 USE ioipsl_getin_p_mod, ONLY: getin_p 215 USE mod_phys_lmdz_para, ONLY: is_master, is_omp_master216 135 #ifdef REPROBUS 217 136 USE CHEM_REP, ONLY: Init_chem_rep_trac … … 242 161 !------------------------------------------------------------------------------------------------------------------------------ 243 162 ! Local variables 244 INTEGER, ALLOCATABLE :: hadv(:), vadv(:) , itmp(:)!--- Horizontal/vertical transport scheme number163 INTEGER, ALLOCATABLE :: hadv(:), vadv(:) !--- Horizontal/vertical transport scheme number 245 164 #ifdef INCA 246 165 INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA … … 254 173 CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather) 255 174 CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags 256 CHARACTER(LEN=maxlen) :: msg1, texp, ttp , ky !--- Stringsfor messages and expanded tracers type175 CHARACTER(LEN=maxlen) :: msg1, texp, ttp !--- String for messages and expanded tracers type 257 176 INTEGER :: fType !--- Tracers description file type ; 0: none 258 177 !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def" 259 178 INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments) 260 179 INTEGER :: iad !--- Advection scheme number 261 INTEGER :: iq, jq, it, nt, im, nm !--- Indexes and temporary variables 262 LOGICAL :: lInit 263 TYPE(keys_type), ALLOCATABLE, TARGET :: tra(:) !--- Tracers descriptor as in readTracFiles_mod 264 TYPE(tisot), ALLOCATABLE :: iso(:) !--- Isotopes descriptor as in readTracFiles_mod 180 INTEGER :: iq, jq, nt, im, nm, k !--- Indexes and temporary variables 181 LOGICAL :: lerr, lInit 265 182 TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:) 266 TYPE(trac_type), POINTER :: t (:), t1267 TYPE(keys_type), POINTER :: k(:)268 CHARACTER(LEN=maxlen), ALLOCATABLE :: types_trac(:) !--- Keywords for tracers type(s), parsed version183 TYPE(trac_type), POINTER :: t1, t(:) 184 CHARACTER(LEN=maxlen), ALLOCATABLE :: types_trac(:) !--- Keyword for tracers type(s), parsed version 185 269 186 CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac_phy" 270 187 !------------------------------------------------------------------------------------------------------------------------------ … … 278 195 279 196 CALL getin_p('type_trac',type_trac) 280 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname, is_master) 281 IF(strCount(type_trac, '|', nt)) CALL abort_physic(modname, 'Could''nt parse the "type_trac" string with delimiter "|"', 1) 282 IF(nt >= 3) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1) 283 IF(strParse(type_trac, '|', types_trac, n=nt)) CALL abort_physic(modname, "couldn't parse "//'"type_trac"', 1) 284 IF(nt == 2) type_trac = types_trac(2) ! TO BE DELETED SOON 285 286 lInit = .NOT.ALLOCATED(trac) 287 288 !############################################################################################################################## 289 IF(lInit .AND. is_master) THEN !=== SKIPED IF ALREADY DONE 197 198 lerr=strParse(type_trac, '|', types_trac, n=nt) 199 IF (nt .GT. 1) THEN 200 IF (nt .GT. 2) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1) 201 IF (nt .EQ. 2) type_trac=types_trac(2) 202 ENDIF 203 204 205 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) 206 lInit = .NOT.ALLOCATED(tracers) 207 208 !############################################################################################################################## 209 IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### 290 210 !############################################################################################################################## 291 211 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION … … 320 240 !############################################################################################################################## 321 241 322 !============================================================================================================================== 323 ! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT ; TRANSFER THE NEEDED QUANTITIES TO LOCAL "tracers". 324 !============================================================================================================================== 325 texp = type_trac !=== EXPANDED (WITH "|" SEPARATOR) "type_trac" 242 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 243 244 !============================================================================================================================== 245 ! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid) 246 !============================================================================================================================== 247 texp = type_trac !=== EXPANDED VERSION OF "type_trac", WITH "|" SEPARATOR 326 248 IF(texp == 'inco') texp = 'co2i|inca' 327 249 IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp) 328 IF(testTracersFiles(modname, texp, fType, lInit.AND.is_master)) CALL abort_physic(modname, 'problem with tracers file(s)',1) 250 251 !=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE 252 IF(testTracersFiles(modname, texp, fType, lInit)) CALL abort_physic(modname, 'problem with tracers file(s)',1) 253 329 254 ttp = type_trac; IF(fType /= 1) ttp = texp 330 !--------------------------------------------------------------------------------------------------------------------------- 331 IF(fType == 0) CALL abort_physic(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1) 332 !--------------------------------------------------------------------------------------------------------------------------- 333 IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) & !=== FOUND OLD STYLE INCA "traceur.def" 334 CALL abort_physic(modname, 'retro-compatibility with old-style INCA traceur.def files has been disabled.', 1) 335 !--------------------------------------------------------------------------------------------------------------------------- 336 337 !############################################################################################################################## 338 IF(lInit .AND. is_omp_master) THEN 339 IF(readTracersFiles(ttp, tra, type_trac == 'repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1) 255 256 !############################################################################################################################## 257 IF(lInit) THEN 258 IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1) 340 259 ELSE 341 tra = trac 342 END IF 343 CALL msg('No tracers description file(s) reading needed: already done', modname, .NOT.lInit.AND.is_master) 344 !############################################################################################################################## 345 346 !--- POPULATE SOME EXPLICIT (ACCESSIBLE THROUGH "%") KEYS OF THE LOCAL TRACERS DESCRIPTION DERIVED TYPE 347 ! To be defined: iqParent, iq/nqDescen, nqChildren (in indexUpdate), longName, iso_i*, isAdvected, isInPhysics (later) 348 ALLOCATE(tracers(SIZE(tra))) 349 DO iq = 1, SIZE(tra); t1 => tracers(iq) 350 t1%keys = tra(iq) 351 msg1 = '" for tracer nr. '//TRIM(int2str(iq)) 352 ky='name '; IF(getKey(ky, t1%name, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1) 353 msg1 = '" for "'//TRIM(t1%name)//'"' 354 ky='gen0Name '; IF(getKey(ky, t1%gen0Name, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1) 355 ky='parent '; IF(getKey(ky, t1%parent, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1) 356 ky='type '; IF(getKey(ky, t1%type, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1) 357 ky='phase '; IF(getKey(ky, t1%phase, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1) 358 ky='component '; IF(getKey(ky, t1%component, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1) 359 ky='iGeneration'; IF(getKey(ky, t1%iGeneration, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1) 360 END DO 361 362 !============================================================================================================================== 363 ! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc. 364 !============================================================================================================================== 365 nqtrue = SIZE(tracers) !--- "true" tracers 366 nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases 367 nbtr = nqtrue-COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O') !--- Passed to phytrac 368 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 260 CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname) 261 END IF 262 !############################################################################################################################## 263 264 !--------------------------------------------------------------------------------------------------------------------------- 265 IF(fType == 0) CALL abort_physic(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1) 266 !--------------------------------------------------------------------------------------------------------------------------- 267 IF(fType == 1 .AND. ANY(['inca','inco']==type_trac) .AND. lInit) THEN !=== FOUND OLD STYLE INCA "traceur.def" 268 !--------------------------------------------------------------------------------------------------------------------------- 369 269 #ifdef INCA 370 nqINCA = COUNT(tracers(:)%component == 'inca') 371 #endif 270 nqo = SIZE(tracers) - nqCO2 271 CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA 272 nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac 273 nqtrue = nbtr + nqo !--- Total number of "true" tracers 274 IF(ALL([2,3] /= nqo)) CALL abort_physic(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1) 275 ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA)) 276 ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA)) 277 CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca) 278 ALLOCATE(ttr(nqtrue)) 279 ttr(1:nqo+nqCO2) = tracers 280 ttr(1 : nqo )%component = 'lmdz' 281 ttr(1+nqo:nqCO2+nqo )%component = 'co2i' 282 ttr(1+nqo+nqCO2:nqtrue)%component = 'inca' 283 ttr(1+nqo :nqtrue)%name = [('CO2 ', k=1, nqCO2), solsym_inca] 284 ttr(1+nqo+nqCO2:nqtrue)%parent = tran0 285 ttr(1+nqo+nqCO2:nqtrue)%phase = 'g' 286 lerr = getKey('hadv', had, ky=tracers(:)%keys) 287 lerr = getKey('vadv', vad, ky=tracers(:)%keys) 288 hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca 289 vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca 290 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 291 DO iq = 1, nqtrue 292 t1 => tracers(iq) 293 CALL addKey('name', t1%name, t1%keys) 294 CALL addKey('component', t1%component, t1%keys) 295 CALL addKey('parent', t1%parent, t1%keys) 296 CALL addKey('phase', t1%phase, t1%keys) 297 END DO 298 IF(setGeneration(tracers)) CALL abort_physic(modname,'See below',1) !- SET FIELDS %iGeneration, %gen0Name 299 DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) 300 #endif 301 !--------------------------------------------------------------------------------------------------------------------------- 302 ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) 303 !--------------------------------------------------------------------------------------------------------------------------- 304 nqo = COUNT(delPhase(tracers(:)%name) == 'H2O' & 305 .AND. tracers(:)%component == 'lmdz') !--- Number of water phases 306 nqtrue = SIZE(tracers) !--- Total number of "true" tracers 307 nbtr = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' & 308 .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac 309 #ifdef INCA 310 nqINCA = COUNT(tracers(:)%component == 'inca') 311 #endif 312 lerr = getKey('hadv', hadv, ky=tracers(:)%keys) 313 lerr = getKey('vadv', vadv, ky=tracers(:)%keys) 314 !--------------------------------------------------------------------------------------------------------------------------- 315 END IF 316 !--------------------------------------------------------------------------------------------------------------------------- 317 318 !--- Transfert the number of tracers to Reprobus 372 319 #ifdef REPROBUS 373 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) !--- Transfert the number of tracers to Reprobus 374 #endif 320 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) 321 #endif 322 323 !############################################################################################################################## 324 IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### 325 !############################################################################################################################## 375 326 376 327 !============================================================================================================================== 377 328 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). 378 329 !============================================================================================================================== 379 IF(getKey('hadv', hadv, ky=tra)) CALL abort_physic(modname, 'missing key "hadv"', 1)380 IF(getKey('vadv', vadv, ky=tra)) CALL abort_physic(modname, 'missing key "vadv"', 1)381 330 DO iq = 1, nqtrue 382 331 IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE … … 399 348 !============================================================================================================================== 400 349 ALLOCATE(ttr(nqtot)) 401 jq = nqtrue+1 350 jq = nqtrue+1; tracers(:)%iadv = -1 402 351 DO iq = 1, nqtrue 403 352 t1 => tracers(iq) … … 410 359 IF(iad == -1) CALL abort_physic(modname, msg1, 1) 411 360 412 !--- SET FIELDS longName, isAdvected,isInPhysics361 !--- SET FIELDS %longName, %isAdvected, %isInPhysics 413 362 t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad) 414 363 t1%isAdvected = iad >= 0 415 t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O 364 t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' & 365 .OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD... 416 366 ttr(iq) = t1 417 367 … … 422 372 IF(nm == 0) CYCLE !--- No higher moments 423 373 ttr(jq+1:jq+nm) = t1 424 ttr(jq+1:jq+nm)%name = [ (TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ] 425 ttr(jq+1:jq+nm)%gen0Name = [ (TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ] 426 ttr(jq+1:jq+nm)%parent = [ (TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ] 427 ttr(jq+1:jq+nm)%longName = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] 428 ttr(jq+1:jq+nm)%isAdvected = [ (.FALSE., im=1, nm) ] 429 ttr(jq+1:jq+nm)%isInPhysics = [ (.FALSE., im=1, nm) ] 374 ttr(jq+1:jq+nm)%name = [(TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ] 375 ttr(jq+1:jq+nm)%parent = [(TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ] 376 ttr(jq+1:jq+nm)%longName = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] 377 ttr(jq+1:jq+nm)%isAdvected = [(.FALSE., im=1, nm) ] 430 378 jq = jq + nm 431 379 END DO … … 433 381 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 434 382 435 !--- SET FIELDS iqParent, iqDescen, nqDescen, nqChildren 436 IF(indexUpdate(tracers%keys)) CALL abort_physic(modname, 'problem with tracers indices update', 1) 437 k => tracers(:)%keys 438 DO iq = 1, SIZE(tracers); t1 => tracers(iq); msg1 = '" for "'//TRIM(t1%name)//'"' 439 ky='iqParent '; IF(getKey(ky, t1%iqParent, iq, k)) CALL abort_physic(modname, 'missing key "'//TRIM(ky)//TRIM(msg1), 1) 440 ky='iqDescen '; IF(getKey(ky, t1%iqDescen, iq, k)) CALL abort_physic(modname, 'missing key "'//TRIM(ky)//TRIM(msg1), 1) 441 ky='nqDescen '; IF(getKey(ky, t1%nqDescen, iq, k)) CALL abort_physic(modname, 'missing key "'//TRIM(ky)//TRIM(msg1), 1) 442 ky='nqChildren'; IF(getKey(ky, t1%nqChildren, iq, k)) CALL abort_physic(modname, 'missing key "'//TRIM(ky)//TRIM(msg1), 1) 443 END DO 444 445 !=== DETERMINE ISOTOPES RELATED PARAMETERS ; DEFINE THE EXPLICIT KEYS iso_i* 446 IF(processIsotopes(tracers%keys, iso)) CALL abort_physic(modname, 'problem while processing isotopes parameters', 1) 447 448 !--- POPULATE SOME EXPLICIT (ACCESSIBLE THROUGH "%") KEYS OF THE LOCAL ISOTOPES DESCRIPTION DERIVED TYPE 449 nbIso = SIZE(iso) 450 ALLOCATE(isotopes(nbIso)) 451 IF(nbIso /= 0) THEN 452 k => tracers(:)%keys 453 IF(getKey('iso_iGroup', itmp, ky=k)) CALL abort_physic(modname, 'missing key "iso_iGroup"', 1); tracers%iso_iGroup = itmp 454 IF(getKey('iso_iName', itmp, ky=k)) CALL abort_physic(modname, 'missing key "iso_iName"', 1); tracers%iso_iName = itmp 455 IF(getKey('iso_iZone', itmp, ky=k)) CALL abort_physic(modname, 'missing key "iso_iZone"', 1); tracers%iso_iZone = itmp 456 IF(getKey('iso_iPhas', itmp, ky=k)) CALL abort_physic(modname, 'missing key "iso_iPhas"', 1); tracers%iso_iPhase = itmp 457 isotopes(:)%name = iso(:)%name !--- Isotopes family name (ex: H2O) 458 isotopes(:)%phase = iso(:)%phase !--- Phases list: [g][l][s] (length: nphas) 459 isotopes(:)%niso = iso(:)%niso !--- Number of isotopes, excluding tagging tracers 460 isotopes(:)%ntiso = iso(:)%ntiso !--- Number of isotopes, including tagging tracers 461 isotopes(:)%nzone = iso(:)%nzone !--- Number of geographic tagging zones 462 isotopes(:)%nphas = iso(:)%nphas !--- Number of phases 463 isotopes(:)%check = .FALSE. !--- Flag for checking routines triggering 464 CALL getin_p('ok_iso_verif', isotopes(:)%check) 465 DO it = 1, nbIso 466 isotopes(it)%keys = iso(it)%keys !--- Isotopes keys/values pairs list (length: niso) 467 isotopes(it)%trac = iso(it)%trac !--- Isotopes + tagging tracers list (length: ntiso) 468 isotopes(it)%zone = iso(it)%zone !--- Geographic tagging zones names list (length: nzone) 469 isotopes(it)%iqIsoPha = iso(it)%iqIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas) 470 isotopes(it)%iqWIsoPha= iso(it)%iqWIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f([trPrnt,name(1:ntiso)],phas) 471 isotopes(it)%itZonIso = iso(it)%itZonIso(:,:) !--- Idx in "tracers(1:ntiso)" = f( zone,name(1:niso)) 472 END DO 473 IF(isoSelect(1, .TRUE.)) CALL abort_physic(modname, "Can't select the first isotopes family", 1) 474 IF(.NOT.isoSelect('H2O', .TRUE.)) iH2O = ixIso 475 END IF 476 isoFamilies = isotopes(:)%name 477 383 !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen 384 IF(indexUpdate(tracers)) CALL abort_gcm(modname, 'problem when processing isotopes parameters', 1) 385 386 !############################################################################################################################## 387 END IF 388 !############################################################################################################################## 389 390 !############################################################################################################################## 391 IF(.NOT.lInit) THEN 392 !############################################################################################################################## 393 nqtot = SIZE(tracers) 394 !############################################################################################################################## 395 ELSE 396 !############################################################################################################################## 397 398 !=== READ PHYSICAL PARAMETERS FOR ISOTOPES 399 niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE. 400 IF(processIsotopes()) CALL abort_physic(modname, 'Problem when processing isotopes parameters', 1) 401 402 !############################################################################################################################## 403 END IF 404 !############################################################################################################################## 478 405 !--- Convection / boundary layer activation for all tracers 479 IF (.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1480 IF (.NOT.ALLOCATED(pbl_flg)) ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1406 IF (.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 407 IF (.NOT.ALLOCATED(pbl_flg)) ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1 481 408 482 409 !--- Note: nqtottr can differ from nbtr when nmom/=0 … … 486 413 487 414 !=== DISPLAY THE RESULTS 488 IF(.NOT.is_master) RETURN489 415 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 490 416 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) … … 498 424 #endif 499 425 t => tracers 500 CALL msg('Information stored in '//TRIM(modname)//': ', modname) 501 IF(dispTable('isssssssssiiiiiiii', ['iq ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', & 502 'isPh', 'isAd', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], & 503 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, & 504 bool2str(t%isInPhysics), bool2str(t%isAdvected)), & 426 CALL msg('Information stored in infotrac_phy :', modname) 427 IF(dispTable('issssssssiiiiiiii', ['iq ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', & 428 'isPh', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], & 429 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),& 505 430 cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, & 506 431 t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) & 507 432 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 442 443 #ifdef ISOVERIF 444 CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname) 445 #endif 508 446 #ifdef CPP_StratAer 509 447 IF (type_trac == 'coag') THEN … … 525 463 END IF 526 464 #endif 527 CALL msg('No isotopes identified.', modname, nbIso == 0) 528 IF(nbIso == 0) RETURN 529 DO it = 1, nbIso 530 IF(isoSelect(it, .TRUE.)) CALL abort_physic(modname, 'Problem when selecting isotopes class', 1) 531 CALL msg('For isotopes family "'//TRIM(isoFamilies(it))//'":', modname) 532 CALL msg(' isoName = '//strStack(isotope%trac), modname) 533 CALL msg(' isoZone = '//strStack(isotope%zone), modname) 534 CALL msg(' isoPhas = '// TRIM(isotope%phase), modname) 535 END DO 536 IF(isoSelect('H2O', .TRUE.)) THEN 537 IF(isoSelect(1, .TRUE.)) CALL abort_physic(modname, 'Problem when selecting isotopes class', 1) 538 ELSE 539 iH2O = ixIso 540 END IF 541 IF(ALLOCATED(isotope%keys(ixIso)%key)) & 542 CALL msg(' isoKeys('//TRIM(int2str(ixIso))//') = '//TRIM(strStack(isotope%keys(ixIso)%key)), modname) 543 #ifdef ISOVERIF 544 CALL msg('iso_iName(H2O) = '//TRIM(strStack(int2str(PACK(tracers%iso_iName, MASK=tracers%iso_iGroup==iH2O)))),modname) 545 #endif 465 CALL msg('end', modname) 546 466 547 467 END SUBROUTINE init_infotrac_phy 548 468 549 !==============================================================================================================================550 LOGICAL FUNCTION isoSelectByName(iClass, lVerbose) RESULT(lerr)551 IMPLICIT NONE552 CHARACTER(LEN=*), INTENT(IN) :: iClass553 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose554 INTEGER :: iIso555 LOGICAL :: lV556 lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose557 iIso = strIdx(isotopes(:)%name, iClass)558 lerr = iIso == 0559 IF(lerr) THEN560 niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck=.FALSE.561 CALL msg('no isotope family named "'//TRIM(iClass)//'"', ll=lV)562 RETURN563 END IF564 lerr = isoSelectByIndex(iIso, lV)565 END FUNCTION isoSelectByName566 !==============================================================================================================================567 LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)568 IMPLICIT NONE569 INTEGER, INTENT(IN) :: iIso570 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose571 LOGICAL :: lV572 lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose573 lerr = .FALSE.574 IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK575 lerr = iIso<=0 .OR. iIso>SIZE(isotopes)576 CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '&577 //TRIM(int2str(SIZE(isotopes)))//'"', ll = lerr .AND. lV)578 IF(lerr) RETURN579 ixIso = iIso !--- Update currently selected family index580 isotope => isotopes(ixIso) !--- Select corresponding component581 isoKeys => isotope%keys; niso = isotope%niso582 isoName => isotope%trac; ntiso = isotope%ntiso583 isoZone => isotope%zone; nzone = isotope%nzone584 isoPhas => isotope%phase; nphas = isotope%nphas585 itZonIso => isotope%itZonIso; isoCheck = isotope%check586 iqIsoPha => isotope%iqIsoPha587 iqWIsoPha=> isotope%iqWIsoPha588 END FUNCTION isoSelectByIndex589 !==============================================================================================================================590 591 469 END MODULE infotrac_phy
Note: See TracChangeset
for help on using the changeset viewer.