Changeset 4482 for LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/infotrac.F90
- Timestamp:
- Mar 29, 2023, 3:14:27 PM (15 months ago)
- Location:
- LMDZ6/branches/LMDZ_ECRad
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/LMDZ_ECRad
- Property svn:mergeinfo changed
-
LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/infotrac.F90
r4203 r4482 3 3 MODULE infotrac 4 4 5 USE strings_mod, ONLY: msg, find, strIdx, strFind, strParse, dispTable, int2str, reduceExpr, & 6 cat, fmsg, test, strTail, strHead, strStack, strReduce, bool2str, maxlen, testFile 7 USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, addPhase, indexUpdate, nphases, ancestor, & 8 isot_type, old2newName, delPhase, getKey_init, tran0, & 9 keys_type, initIsotopes, getPhase, known_phases, getKey, setGeneration, & 10 maxTableWidth 5 USE strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse 6 USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, & 7 delPhase, niso, getKey, isot_type, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, & 8 addPhase, iH2O, nbIso, isoSelect, testTracersFiles, isoKeys, indexUpdate, isoCheck, nzone, ntiso, isoName, & 9 addKey 11 10 IMPLICIT NONE 12 11 … … 14 13 15 14 !=== FOR TRACERS: 16 PUBLIC :: in fotrac_init!--- Initialization of the tracers17 PUBLIC :: tracers, type_trac , types_trac!--- Full tracers database, tracers type keyword15 PUBLIC :: init_infotrac !--- Initialization of the tracers 16 PUBLIC :: tracers, type_trac !--- Full tracers database, tracers type keyword 18 17 PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr !--- Main dimensions 19 18 PUBLIC :: conv_flg, pbl_flg !--- Convection & boundary layer activation keys 20 19 21 20 !=== FOR ISOTOPES: General 22 PUBLIC :: isot opes,nbIso !--- Derived type, full isotopes families database + nb of families21 PUBLIC :: isot_type, nbIso !--- Derived type, full isotopes families database + nb of families 23 22 PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index 24 23 !=== FOR ISOTOPES: Specific to water 25 PUBLIC :: iH2O , tnat, alpha_ideal !--- H2O isotopes index, natural abundance, fractionning coeff.24 PUBLIC :: iH2O !--- H2O isotopes class index 26 25 PUBLIC :: min_qParent, min_qMass, min_ratio !--- Min. values for various isotopic quantities 27 26 !=== FOR ISOTOPES: Depending on the selected isotopes family … … 34 33 !=== FOR BOTH TRACERS AND ISOTOPES 35 34 PUBLIC :: getKey !--- Get a key from "tracers" or "isotope" 36 37 INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect38 35 39 36 !=== CONVENTIONS FOR TRACERS NUMBERS: … … 71 68 ! | phase | Phases list ("g"as / "l"iquid / "s"olid) | / | [g][l][s] | 72 69 ! | component | Name(s) of the merged/cumulated section(s) | / | coma-separated names | 73 ! | iadv | Advection scheme number | iadv | 1-20,30 exc. 3-9,15,19 |74 70 ! | iGeneration | Generation (>=1) | / | | 75 ! | isAdvected | advected tracers flag (.TRUE. if iadv >= 0) | / | nqtrue .TRUE. values |76 ! | isInPhysics | tracers not extracted from the main table in physics | / | nqtottr .TRUE. values |77 71 ! | iqParent | Index of the parent tracer | iqpere | 1:nqtot | 78 72 ! | iqDescen | Indexes of the childs (all generations) | iqfils | 1:nqtot | 79 73 ! | nqDescen | Number of the descendants (all generations) | nqdesc | 1:nqtot | 80 ! | nqChilds | Number of childs (1st generation only) | nqfils | 1:nqtot | 74 ! | nqChildren | Number of childs (1st generation only) | nqfils | 1:nqtot | 75 ! | keys | key/val pairs accessible with "getKey" routine | / | | 76 ! | iadv | Advection scheme number | iadv | 1,2,10-20(exc.15,19),30| 77 ! | isAdvected | advected tracers flag (.TRUE. if iadv >= 0) | / | nqtrue .TRUE. values | 78 ! | isInPhysics | tracers not extracted from the main table in physics | / | nqtottr .TRUE. values | 81 79 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 82 80 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | 83 81 ! | iso_iZone | Isotope zone index in isotopes(iso_iGroup)%zone(:) | zone_num | 1:nzone | 84 82 ! | iso_iPhas | Isotope phase index in isotopes(iso_iGroup)%phas(:) | phase_num | 1:nphas | 85 ! | keys | key/val pairs accessible with "getKey" routine | / | |86 83 ! +-------------+------------------------------------------------------+-------------+------------------------+ 87 84 ! … … 103 100 104 101 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 105 INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O) 106 nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O) 107 nqo, & !--- Number of water phases 108 nbIso, & !--- Number of available isotopes family 109 nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?) 110 nqCO2 !--- Number of tracers of CO2 (ThL) 111 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s) 112 CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: types_trac(:) !--- Keyword for tracers type(s), parsed version 113 114 !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES 115 TYPE(trac_type), TARGET, SAVE, ALLOCATABLE :: tracers(:) !=== TRACERS DESCRIPTORS VECTOR 116 TYPE(isot_type), TARGET, SAVE, ALLOCATABLE :: isotopes(:) !=== ISOTOPES PARAMETERS VECTOR 117 118 !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes" 119 TYPE(isot_type), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR 120 INTEGER, SAVE :: ixIso, iH2O !--- Index of the selected isotopes family and H2O family 121 LOGICAL, SAVE :: isoCheck !--- Flag to trigger the checking routines 122 TYPE(keys_type), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName) 123 CHARACTER(LEN=maxlen), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY 124 isoZone(:), & !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY 125 isoPhas !--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY 126 INTEGER, SAVE :: niso, nzone, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES 127 nphas, ntiso !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS 128 INTEGER, SAVE, POINTER ::itZonIso(:,:), & !--- INDEX IN "isoTrac" AS f(tagging zone idx, isotope idx) 129 iqIsoPha(:,:) !--- INDEX IN "qx" AS f(isotopic tracer idx, phase idx) 130 131 !=== VARIABLES FOR ISOTOPES INITIALIZATION AND FOR INCA 132 REAL, SAVE, ALLOCATABLE :: tnat(:), & !--- Natural relative abundance of water isotope (niso) 133 alpha_ideal(:) !--- Ideal fractionning coefficient (for initial state) (niso) 134 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr) 135 pbl_flg(:) !--- Boundary layer activation ; needed for INCA (nbtr) 102 INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O) 103 nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O) 104 nqo, & !--- Number of water phases 105 nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?) 106 nqCO2 !--- Number of tracers of CO2 (ThL) 107 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type 108 109 !=== VARIABLES FOR INCA 110 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr) 111 pbl_flg(:) !--- Boundary layer activation ; needed for INCA (nbtr) 136 112 137 113 CONTAINS 138 114 139 SUBROUTINE in fotrac_init140 USE control_mod, ONLY: planet_type , config_inca115 SUBROUTINE init_infotrac 116 USE control_mod, ONLY: planet_type 141 117 #ifdef REPROBUS 142 118 USE CHEM_REP, ONLY: Init_chem_rep_trac … … 176 152 CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather) 177 153 CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags 178 CHARACTER(LEN=maxlen) :: msg1 !--- String for messages154 CHARACTER(LEN=maxlen) :: msg1, texp, ttp !--- Strings for messages and expanded tracers type 179 155 INTEGER :: fType !--- Tracers description file type ; 0: none 180 156 !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def" 181 157 INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments) 182 158 INTEGER :: iad !--- Advection scheme number 183 INTEGER :: ic, i p, np, iq, jq, it, nt, im, nm, ix, iz, nz, k!--- Indexes and temporary variables159 INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k !--- Indexes and temporary variables 184 160 LOGICAL :: lerr, ll 185 161 CHARACTER(LEN=1) :: p 186 162 TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:) 187 163 TYPE(trac_type), POINTER :: t1, t(:) 188 TYPE(isot_type), POINTER :: iso189 190 CHARACTER(LEN=maxlen), ALLOCATABLE :: tnom_0(:), tnom_transp(:) !--- Tracer short name + transporting fluid name191 CHARACTER(LEN=maxlen) :: tchaine192 164 INTEGER :: ierr 193 165 194 CHARACTER(LEN=*), PARAMETER :: modname="in fotrac_init"166 CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac" 195 167 !------------------------------------------------------------------------------------------------------------------------------ 196 168 ! Initialization : … … 202 174 203 175 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) 204 IF(strParse(type_trac, '|', types_trac, n=nt)) CALL abort_gcm(modname,'can''t parse "type_trac = '//TRIM(type_trac)//'"',1) 205 206 !--------------------------------------------------------------------------------------------------------------------------- 207 DO it = 1, nt !--- nt>1=> "type_trac": coma-separated keywords list 208 !--------------------------------------------------------------------------------------------------------------------------- 209 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION 210 msg1 = 'For type_trac = "'//TRIM(types_trac(it))//'":' 211 SELECT CASE(types_trac(it)) 212 CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model, config_inca='//config_inca, modname) 213 CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname) 214 CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname) 215 CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname) 216 CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname) 217 CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname) 218 CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(types_trac(it))//' not possible yet.',1) 219 END SELECT 220 221 !--- COHERENCE TEST BETWEEN "type_trac" AND "config_inca" 222 IF(ANY(['inca', 'inco'] == types_trac(it)) .AND. ALL(['aero', 'aeNP', 'chem'] /= config_inca)) & 223 CALL abort_gcm(modname, 'Incoherence between type_trac and config_inca. Please modify "run.def"',1) 224 225 !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS 226 SELECT CASE(types_trac(it)) 227 CASE('inca', 'inco') 176 177 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION 178 msg1 = 'For type_trac = "'//TRIM(type_trac)//'":' 179 SELECT CASE(type_trac) 180 CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model', modname) 181 CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname) 182 CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname) 183 CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname) 184 CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname) 185 CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname) 186 CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(type_trac)//' not possible yet.',1) 187 END SELECT 188 189 !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS 190 SELECT CASE(type_trac) 191 CASE('inca', 'inco') 228 192 #ifndef INCA 229 230 #endif 231 193 CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1) 194 #endif 195 CASE('repr') 232 196 #ifndef REPROBUS 233 234 #endif 235 197 CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) 198 #endif 199 CASE('coag') 236 200 #ifndef CPP_StratAer 237 CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) 238 #endif 239 END SELECT 240 241 !--------------------------------------------------------------------------------------------------------------------------- 242 END DO 243 !--------------------------------------------------------------------------------------------------------------------------- 244 245 !--- DISABLE "config_inca" OPTION FOR A RUN WITHOUT "INCA" IF IT DIFFERS FROM "none" 246 IF(fmsg('Setting config_inca="none" as you do not couple with INCA model', & 247 modname, ALL(types_trac /= 'inca') .AND. ALL(types_trac /= 'inco') .AND. config_inca /= 'none')) config_inca = 'none' 248 249 nqCO2 = 0; IF(ANY(types_trac == 'inco')) nqCO2 = 1 201 CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) 202 #endif 203 END SELECT 204 205 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 250 206 251 207 !============================================================================================================================== 252 208 ! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid) 253 209 !============================================================================================================================== 254 IF(readTracersFiles(type_trac, fType, tracers)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 210 texp = type_trac !=== EXPANDED VERSION OF "type_trac", WITH "|" SEPARATOR 211 IF(texp == 'inco') texp = 'co2i|inca' 212 IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp) 213 214 !=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE 215 IF(testTracersFiles(modname, texp, fType, .TRUE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 216 ttp = type_trac; IF(fType /= 1) ttp = texp 217 218 IF(readTracersFiles(ttp, type_trac == 'repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 219 !--------------------------------------------------------------------------------------------------------------------------- 255 220 IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1) 256 221 !--------------------------------------------------------------------------------------------------------------------------- 257 IF(fType == 1 .AND. ANY(['inca','inco'] == type_trac)) THEN !=== FOUND OLD STYLE INCA "traceur.def" (single type_trac)222 IF(fType == 1 .AND. ANY(['inca','inco']==type_trac)) THEN !=== FOUND OLD STYLE INCA "traceur.def" 258 223 !--------------------------------------------------------------------------------------------------------------------------- 259 224 #ifdef INCA 260 nqo = SIZE(tracers) 261 IF(nqCO2==1 .AND. nqo==4) nqo = 3 !--- Force nqo to 3 (ThL) 225 nqo = SIZE(tracers) - nqCO2 262 226 CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA 263 227 nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac … … 268 232 CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca) 269 233 ALLOCATE(ttr(nqtrue)) 270 ttr(1:nqo+nqCO2) 271 ttr(1 : nqo )%component 272 ttr(1+nqo:nqCO2+nqo )%component 273 ttr(1+nqo+nqCO2:nqtrue)%component 274 ttr(1+nqo :nqtrue)%name 275 ttr(1+nqo+nqCO2:nqtrue)%parent 276 ttr(1+nqo+nqCO2:nqtrue)%phase 234 ttr(1:nqo+nqCO2) = tracers 235 ttr(1 : nqo )%component = 'lmdz' 236 ttr(1+nqo:nqCO2+nqo )%component = 'co2i' 237 ttr(1+nqo+nqCO2:nqtrue)%component = 'inca' 238 ttr(1+nqo :nqtrue)%name = [('CO2 ', k=1, nqCO2), solsym_inca] 239 ttr(1+nqo+nqCO2:nqtrue)%parent = tran0 240 ttr(1+nqo+nqCO2:nqtrue)%phase = 'g' 277 241 lerr = getKey('hadv', had, ky=tracers(:)%keys) 278 242 lerr = getKey('vadv', vad, ky=tracers(:)%keys) 279 hadv(1:nqo ) = had(:); hadv(nqo+1:nqtrue) = hadv_inca280 vadv(1:nqo ) = vad(:); vadv(nqo+1:nqtrue) = vadv_inca243 hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca 244 vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca 281 245 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 282 CALL setGeneration(tracers) !--- SET FIELDS %iGeneration, %gen0Name 246 DO iq = 1, nqtrue 247 t1 => tracers(iq) 248 CALL addKey('name', t1%name, t1%keys) 249 CALL addKey('component', t1%component, t1%keys) 250 CALL addKey('parent', t1%parent, t1%keys) 251 CALL addKey('phase', t1%phase, t1%keys) 252 END DO 253 IF(setGeneration(tracers)) CALL abort_gcm(modname,'See above',1) !- SET FIELDS %iGeneration, %gen0Name 283 254 DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) 284 255 #endif 285 256 !--------------------------------------------------------------------------------------------------------------------------- 286 ELSE !=== FOUND NEW STYLE TRACERS CONFIGURATION FILE(S)257 ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) 287 258 !--------------------------------------------------------------------------------------------------------------------------- 288 259 nqo = COUNT(delPhase(tracers(:)%name) == 'H2O' & … … 300 271 !--------------------------------------------------------------------------------------------------------------------------- 301 272 302 CALL getKey_init(tracers) 303 273 #ifdef REPROBUS 304 274 !--- Transfert the number of tracers to Reprobus 305 #ifdef REPROBUS306 275 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) 307 #endif 308 276 277 #endif 309 278 !============================================================================================================================== 310 279 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). … … 380 349 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 381 350 382 !--- SET FIELDS %iqParent, %nqChild s, %iGeneration, %iqDescen, %nqDescen351 !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen 383 352 CALL indexUpdate(tracers) 384 353 … … 404 373 END DO 405 374 406 niso = 0; nzone=0; nphas=nqo; ntiso = 0; isoCheck=.FALSE. 407 IF(initIsotopes(tracers, isotopes)) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1) 408 nbIso = SIZE(isotopes) 409 nqtottr = nqtot - COUNT(tracers%gen0Name == 'H2O' .AND. tracers%component == 'lmdz') 410 IF(nbIso/=0) THEN !--- ISOTOPES FOUND 411 412 !=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE SPECIFIC TO WATER ISOTOPES 413 ! DONE HERE, AND NOT ONLY IN "infotrac_phy", BECAUSE SOME PHYSICAL PARAMS ARE NEEDED FOR RESTARTS (tnat, alpha_ideal) 414 CALL getKey_init(tracers, isotopes) 415 IF(isoSelect('H2O')) RETURN !--- Select water isotopes ; finished if no water isotopes 416 iH2O = ixIso !--- Keep track of water family index 417 IF(getKey('tnat' , tnat, isoName(1:niso))) CALL abort_gcm(modname, 'can''t read "tnat"', 1) 418 IF(getKey('alpha', alpha_ideal, isoName(1:niso))) CALL abort_gcm(modname, 'can''t read "alpha_ideal"', 1) 419 420 !=== MAKE SURE THE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES 421 DO ix = 1, nbIso 422 iso => isotopes(ix) 423 !--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases 424 DO it = 1, iso%ntiso 425 np = SUM([(COUNT(tracers(:)%name == addPhase(iso%trac(it), iso%phase(ip:ip))), ip=1, iso%nphas)]) 426 IF(np == iso%nphas) CYCLE 427 WRITE(msg1,'("Found ",i0," phases for ",a," instead of ",i0)')np, TRIM(iso%trac(it)), iso%nphas 428 CALL abort_gcm(modname, msg1, 1) 429 END DO 430 DO it = 1, iso%niso 431 nz = SUM([(COUNT(iso%trac == TRIM(iso%trac(it))//'_'//iso%zone(iz)), iz=1, iso%nzone)]) 432 IF(nz == iso%nzone) CYCLE 433 WRITE(msg1,'("Found ",i0," tagging zones for ",a," instead of ",i0)')nz, TRIM(iso%trac(it)), iso%nzone 434 CALL abort_gcm(modname, msg1, 1) 435 END DO 436 END DO 437 END IF 375 !=== READ PHYSICAL PARAMETERS FOR ISOTOPES ; DONE HERE BECAUSE dynetat0 AND iniacademic NEED "tnat" AND "alpha_ideal" 376 niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE. 377 IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1) 438 378 439 379 !--- Convection / boundary layer activation for all tracers … … 442 382 443 383 !--- Note: nqtottr can differ from nbtr when nmom/=0 444 ! IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) & 445 ! CALL abort_gcm('infotrac_init', 'pb dans le calcul de nqtottr', 1) 384 nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz') 385 IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) & 386 CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1) 446 387 447 388 !=== DISPLAY THE RESULTS … … 459 400 CALL msg('Information stored in infotrac :', modname) 460 401 IF(dispTable('isssssssssiiiiiiiii', & 461 ['iq ', 'name ', 'lName ', 'gen0N ', 'parent', 'type ', 'phase ', 'compon', 'is Adv ', 'isPhy', &402 ['iq ', 'name ', 'lName ', 'gen0N ', 'parent', 'type ', 'phase ', 'compon', 'isPhy ', 'isAdv ', & 462 403 'iadv ', 'iGen ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'], & 463 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%is Advected),&464 bool2str(t%is InPhysics)),&465 cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChild s, t%iso_iGroup,&404 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics), & 405 bool2str(t%isAdvected)), & 406 cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, & 466 407 t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) & 467 408 CALL abort_gcm(modname, "problem with the tracers table content", 1) 468 409 IF(niso > 0) THEN 469 410 CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname) 470 CALL msg(' isoKeys = '//strStack(isoKeys%name), modname)411 CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname) 471 412 CALL msg(' isoName = '//strStack(isoName), modname) 472 413 CALL msg(' isoZone = '//strStack(isoZone), modname) … … 477 418 CALL msg('end', modname) 478 419 479 END SUBROUTINE infotrac_init 480 481 482 !============================================================================================================================== 483 !=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED 484 ! Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call). 485 !============================================================================================================================== 486 LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr) 487 IMPLICIT NONE 488 CHARACTER(LEN=*), INTENT(IN) :: iName 489 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose 490 INTEGER :: iIso 491 LOGICAL :: lV 492 lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose 493 iIso = strIdx(isotopes(:)%parent, iName) 494 lerr = iIso == 0 495 IF(lerr) THEN 496 niso = 0; ntiso = 0; nzone=0; nphas=nqo; isoCheck=.FALSE. 497 CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV) 498 RETURN 499 END IF 500 lerr = isoSelectByIndex(iIso, lV) 501 END FUNCTION isoSelectByName 502 !============================================================================================================================== 503 LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr) 504 IMPLICIT NONE 505 INTEGER, INTENT(IN) :: iIso 506 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose 507 LOGICAL :: lv 508 lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose 509 lerr = .FALSE. 510 IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK 511 lerr = iIso<=0 .OR. iIso>nbIso 512 CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '//TRIM(int2str(nbIso))//'"',& 513 ll=lerr .AND. lV) 514 IF(lerr) RETURN 515 ixIso = iIso !--- Update currently selected family index 516 isotope => isotopes(ixIso) !--- Select corresponding component 517 isoKeys => isotope%keys; niso = isotope%niso 518 isoName => isotope%trac; ntiso = isotope%ntiso 519 isoZone => isotope%zone; nzone = isotope%nzone 520 isoPhas => isotope%phase; nphas = isotope%nphas 521 itZonIso => isotope%itZonIso; isoCheck = isotope%check 522 iqIsoPha => isotope%iqIsoPha 523 END FUNCTION isoSelectByIndex 524 !============================================================================================================================== 420 END SUBROUTINE init_infotrac 525 421 526 422 END MODULE infotrac
Note: See TracChangeset
for help on using the changeset viewer.