Changeset 4482 for LMDZ6/branches/LMDZ_ECRad/libf/phylmd/infotrac_phy.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/phylmd/infotrac_phy.F90
r4203 r4482 1 2 ! $Id: $ 3 1 !$Id: infotrac.F90 4301 2022-10-20 11:57:21Z dcugnet $ 2 ! 4 3 MODULE infotrac_phy 5 4 6 USE strings_mod, ONLY: msg, maxlen, strStack, strHead, strParse, strIdx, int2str 7 USE readTracFiles_mod, ONLY: trac_type, isot_type, keys_type, delPhase, getKey, tnom_iso => newH2OIso 8 5 USE strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx 6 USE readTracFiles_mod, ONLY: trac_type, nphas, readTracersFiles, tracers, setGeneration, itZonIso, nbIso, tran0, delPhase, & 7 getKey, isot_type, nzone, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, ntiso, ixIso, addPhase, & 8 indexUpdate, isoSelect, niso, testTracersFiles, isoPhas, isoZone, isoName, isoKeys, iH2O, isoCheck, addKey 9 9 IMPLICIT NONE 10 10 … … 13 13 !=== FOR TRACERS: 14 14 PUBLIC :: init_infotrac_phy !--- Initialization of the tracers 15 PUBLIC :: tracers, type_trac , types_trac!--- Full tracers database, tracers type keyword15 PUBLIC :: tracers, type_trac !--- Full tracers database, tracers type keyword 16 16 PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr !--- Main dimensions 17 17 PUBLIC :: conv_flg, pbl_flg !--- Convection & boundary layer activation keys 18 #ifdef CPP_StratAer 19 PUBLIC :: nbtr_bin, nbtr_sulgas !--- Number of aerosols bins and sulfur gases for StratAer model 20 PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat 21 #endif 18 22 19 23 !=== FOR ISOTOPES: General 20 PUBLIC :: isot opes,nbIso !--- Derived type, full isotopes families database + nb of families24 PUBLIC :: isot_type, nbIso !--- Derived type, full isotopes families database + nb of families 21 25 PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index 22 26 !=== FOR ISOTOPES: Specific to water … … 26 30 PUBLIC :: isoName, isoZone, isoPhas !--- Isotopes and tagging zones names, phases 27 31 PUBLIC :: niso, nzone, nphas, ntiso !--- " " numbers + isotopes & tagging tracers number 28 PUBLIC :: itZonIso !--- i q = function(tagging zoneidx, isotope idx)29 PUBLIC :: iqIsoPha !--- idx of tagging tracer in iName = function(isotope idx, phase idx)32 PUBLIC :: itZonIso !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx) 33 PUBLIC :: iqIsoPha !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases 30 34 PUBLIC :: isoCheck !--- Run isotopes checking routines 31 35 !=== FOR BOTH TRACERS AND ISOTOPES 32 36 PUBLIC :: getKey !--- Get a key from "tracers" or "isotope" 33 34 INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect35 37 36 38 !=== CONVENTIONS FOR TRACERS NUMBERS: … … 68 70 ! | phase | Phases list ("g"as / "l"iquid / "s"olid) | / | [g][l][s] | 69 71 ! | component | Name(s) of the merged/cumulated section(s) | / | coma-separated names | 70 ! | iadv | Advection scheme number | iadv | 1-20,30 exc. 3-9,15,19 |71 72 ! | iGeneration | Generation (>=1) | / | | 72 ! | isAdvected | advected tracers flag (.TRUE. if iadv >= 0) | / | nqtrue .TRUE. values |73 73 ! | isInPhysics | tracers not extracted from the main table in physics | / | nqtottr .TRUE. values | 74 74 ! | iqParent | Index of the parent tracer | iqpere | 1:nqtot | 75 75 ! | iqDescen | Indexes of the childs (all generations) | iqfils | 1:nqtot | 76 76 ! | nqDescen | Number of the descendants (all generations) | nqdesc | 1:nqtot | 77 ! | nqChilds | Number of childs (1st generation only) | nqfils | 1:nqtot | 77 ! | nqChildren | Number of childs (1st generation only) | nqfils | 1:nqtot | 78 ! | keys | key/val pairs accessible with "getKey" routine | / | | 78 79 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 79 80 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | 80 81 ! | iso_iZone | Isotope zone index in isotopes(iso_iGroup)%zone(:) | zone_num | 1:nzone | 81 82 ! | iso_iPhas | Isotope phase index in isotopes(iso_iGroup)%phas(:) | phase_num | 1:nphas | 82 ! | keys | key/val pairs accessible with "getKey" routine | / | |83 83 ! +-------------+------------------------------------------------------+-------------+------------------------+ 84 84 ! … … 98 98 99 99 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 100 INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O) 101 nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O) 102 nqo, & !--- Number of water phases 103 nbIso, & !--- Number of available isotopes family 104 nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?) 105 nqCO2 !--- Number of tracers of CO2 (ThL) 106 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type 107 CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: types_trac(:) !--- Keyword for tracers type 108 !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nbIso, nqtottr, nqCO2, type_trac, types_trac) 109 110 !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES 111 TYPE(trac_type), TARGET, SAVE, ALLOCATABLE :: tracers(:) !=== TRACERS DESCRIPTORS VECTOR 112 TYPE(isot_type), TARGET, SAVE, ALLOCATABLE :: isotopes(:) !=== ISOTOPES PARAMETERS VECTOR 113 !$OMP THREADPRIVATE(tracers, isotopes) 114 115 !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes" 116 TYPE(isot_type), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR 117 INTEGER, SAVE :: ixIso, iH2O !--- Index of the selected isotopes family and H2O family 118 LOGICAL, SAVE :: isoCheck !--- Flag to trigger the checking routines 119 TYPE(keys_type), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName) 120 CHARACTER(LEN=maxlen), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY 121 isoZone(:), & !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY 122 isoPhas !--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY 123 INTEGER, SAVE :: niso, nzone, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES 124 nphas, ntiso !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS 125 INTEGER, SAVE, POINTER ::itZonIso(:,:), & !--- INDEX IN "isoTrac" AS f(tagging zone idx, isotope idx) 126 iqIsoPha(:,:) !--- INDEX IN "qx" AS f(isotopic tracer idx, phase idx) 127 !$OMP THREADPRIVATE(isotope, ixIso,iH2O, isoCheck, isoKeys, isoName,isoZone,isoPhas, niso,nzone,nphas,ntiso, itZonIso,iqIsoPha) 128 129 !=== VARIABLES FOR ISOTOPES INITIALIZATION AND FOR INCA 130 INTEGER, SAVE, ALLOCATABLE ::conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr) 131 pbl_flg(:) !--- Boundary layer activation ; needed for INCA (nbtr) 100 INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O) 101 nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O) 102 nqo, & !--- Number of water phases 103 nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?) 104 nqCO2 !--- Number of tracers of CO2 (ThL) 105 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s) 106 !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac) 107 108 !=== VARIABLES FOR INCA 109 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr) 110 pbl_flg(:) !--- Boundary layer activation ; needed for INCA (nbtr) 132 111 !$OMP THREADPRIVATE(conv_flg, pbl_flg) 133 112 … … 142 121 CONTAINS 143 122 144 SUBROUTINE init_infotrac_phy(type_trac_, tracers_, isotopes_, nqtottr_, nqCO2_, pbl_flg_, conv_flg_) 145 146 USE print_control_mod, ONLY: prt_level, lunout 147 123 SUBROUTINE init_infotrac_phy 124 USE ioipsl_getin_p_mod, ONLY: getin_p 125 #ifdef REPROBUS 126 USE CHEM_REP, ONLY: Init_chem_rep_trac 127 #endif 148 128 IMPLICIT NONE 149 CHARACTER(LEN=*),INTENT(IN) :: type_trac_ 150 TYPE(trac_type), INTENT(IN) :: tracers_(:) 151 TYPE(isot_type), INTENT(IN) :: isotopes_(:) 152 INTEGER, INTENT(IN) :: nqtottr_ 153 INTEGER, INTENT(IN) :: nqCO2_ 154 INTEGER, INTENT(IN) :: conv_flg_(:) 155 INTEGER, INTENT(IN) :: pbl_flg_(:) 156 157 INTEGER :: iq, ixt 129 !============================================================================================================================== 130 ! 131 ! Auteur: P. Le Van /L. Fairhead/F.Hourdin 132 ! ------- 133 ! 134 ! Modifications: 135 ! -------------- 136 ! 05/94: F.Forget Modif special traceur 137 ! 02/02: M-A Filiberti Lecture de traceur.def 138 ! 01/22: D. Cugnet Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type) 139 ! 140 ! Objet: 141 ! ------ 142 ! GCM LMD nouvelle grille 143 ! 144 !============================================================================================================================== 145 ! ... modification de l'integration de q ( 26/04/94 ) .... 146 !------------------------------------------------------------------------------------------------------------------------------ 147 ! Declarations: 148 INCLUDE "dimensions.h" 149 INCLUDE "iniprint.h" 150 151 !------------------------------------------------------------------------------------------------------------------------------ 152 ! Local variables 153 INTEGER, ALLOCATABLE :: hadv(:), vadv(:) !--- Horizontal/vertical transport scheme number 154 #ifdef INCA 155 INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA 156 vad (:), vadv_inca(:), pbl_flg_inca(:) 157 CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA 158 INTEGER :: nqINCA 159 #endif 158 160 #ifdef CPP_StratAer 159 161 CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:) 160 162 #endif 161 CHARACTER(LEN=maxlen) :: modname="init_infotrac_phy" 162 163 type_trac = type_trac_ 164 IF(strParse(type_trac, '|', types_trac)) CALL abort_physic(modname,'can''t parse "type_trac = '//TRIM(type_trac)//'"',1) 165 tracers = tracers_ 166 isotopes = isotopes_ 167 nqtottr = nqtottr_ 168 nqCO2 = nqCO2_ 169 pbl_flg = pbl_flg_ 170 conv_flg = conv_flg_ 171 nqtot = SIZE(tracers_) 172 nqo = COUNT(delPhase(tracers%name)=='H2O' .AND. tracers%iGeneration==0 .AND. tracers%component=='lmdz') 173 nbtr = SIZE(conv_flg) 174 nbIso = SIZE(isotopes_) 175 176 !=== Determine selected isotopes class related quantities: 177 ! ixIso, isotope, niso,isoKeys, ntiso,isoName, nzone,isoZone, nphas,isoPhas, itZonIso, iqIsoPha, isoCheck 178 IF(.NOT.isoSelect('H2O')) iH2O = ixIso 179 IF(prt_level > 1) THEN 180 CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) 181 CALL msg('nbtr = '//TRIM(int2str(nbtr )), modname) 182 CALL msg('nqo = '//TRIM(int2str(nqo )), modname) 183 CALL msg('niso = '//TRIM(int2str(niso )), modname) 184 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) 185 CALL msg('nqtottr = '//TRIM(int2str(nqtottr)), modname) 186 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 187 END IF 188 163 CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather) 164 CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags 165 CHARACTER(LEN=maxlen) :: msg1, texp, ttp !--- String for messages and expanded tracers type 166 INTEGER :: fType !--- Tracers description file type ; 0: none 167 !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def" 168 INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments) 169 INTEGER :: iad !--- Advection scheme number 170 INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k !--- Indexes and temporary variables 171 LOGICAL :: lerr, ll, lInit 172 CHARACTER(LEN=1) :: p 173 TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:) 174 TYPE(trac_type), POINTER :: t1, t(:) 175 INTEGER :: ierr 176 177 CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac_phy" 178 !------------------------------------------------------------------------------------------------------------------------------ 179 ! Initialization : 180 !------------------------------------------------------------------------------------------------------------------------------ 181 suff = ['x ','y ','z ','xx','xy','xz','yy','yz','zz'] 182 descrq( 1:30) = ' ' 183 descrq( 1: 2) = ['LMV','BAK'] 184 descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH',' ','PPM','PPS','PPP',' ','SLP'] 185 descrq(30) = 'PRA' 186 187 CALL getin_p('type_trac',type_trac) 188 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) 189 lInit = .NOT.ALLOCATED(tracers) 190 191 !############################################################################################################################## 192 IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### 193 !############################################################################################################################## 194 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION 195 msg1 = 'For type_trac = "'//TRIM(type_trac)//'":' 196 SELECT CASE(type_trac) 197 CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model', modname) 198 CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname) 199 CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname) 200 CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname) 201 CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname) 202 CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname) 203 CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(type_trac)//' not possible yet.',1) 204 END SELECT 205 206 !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS 207 SELECT CASE(type_trac) 208 CASE('inca', 'inco') 209 #ifndef INCA 210 CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1) 211 #endif 212 CASE('repr') 213 #ifndef REPROBUS 214 CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) 215 #endif 216 CASE('coag') 217 #ifndef CPP_StratAer 218 CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) 219 #endif 220 END SELECT 221 !############################################################################################################################## 222 END IF 223 !############################################################################################################################## 224 225 nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] ) 226 227 !============================================================================================================================== 228 ! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid) 229 !============================================================================================================================== 230 texp = type_trac !=== EXPANDED VERSION OF "type_trac", WITH "|" SEPARATOR 231 IF(texp == 'inco') texp = 'co2i|inca' 232 IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp) 233 234 !=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE 235 IF(testTracersFiles(modname, texp, fType, lInit)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 236 ttp = type_trac; IF(fType /= 1) ttp = texp 237 238 !############################################################################################################################## 239 IF(lInit) THEN 240 IF(readTracersFiles(ttp, type_trac == 'repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 241 ELSE 242 CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname) 243 END IF 244 !############################################################################################################################## 245 246 !--------------------------------------------------------------------------------------------------------------------------- 247 IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1) 248 !--------------------------------------------------------------------------------------------------------------------------- 249 IF(fType == 1 .AND. ANY(['inca','inco']==type_trac) .AND. lInit) THEN !=== OLD STYLE INCA "traceur.def" (single type_trac) 250 !--------------------------------------------------------------------------------------------------------------------------- 251 #ifdef INCA 252 nqo = SIZE(tracers) - nqCO2 253 CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA 254 nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac 255 nqtrue = nbtr + nqo !--- Total number of "true" tracers 256 IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1) 257 ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA)) 258 ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA)) 259 CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca) 260 ALLOCATE(ttr(nqtrue)) 261 ttr(1:nqo+nqCO2) = tracers 262 ttr(1 : nqo )%component = 'lmdz' 263 ttr(1+nqo:nqCO2+nqo )%component = 'co2i' 264 ttr(1+nqo+nqCO2:nqtrue)%component = 'inca' 265 ttr(1+nqo :nqtrue)%name = [('CO2 ', k=1, nqCO2), solsym_inca] 266 ttr(1+nqo+nqCO2:nqtrue)%parent = tran0 267 ttr(1+nqo+nqCO2:nqtrue)%phase = 'g' 268 lerr = getKey('hadv', had, ky=tracers(:)%keys) 269 lerr = getKey('vadv', vad, ky=tracers(:)%keys) 270 hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca 271 vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca 272 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 273 DO iq = 1, nqtrue 274 t1 => tracers(iq) 275 CALL addKey('name', t1%name, t1%keys) 276 CALL addKey('component', t1%component, t1%keys) 277 CALL addKey('parent', t1%parent, t1%keys) 278 CALL addKey('phase', t1%phase, t1%keys) 279 END DO 280 IF(setGeneration(tracers)) CALL abort_gcm(modname,'See below',1) !- SET FIELDS %iGeneration, %gen0Name 281 DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) 282 #endif 283 !--------------------------------------------------------------------------------------------------------------------------- 284 ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) 285 !--------------------------------------------------------------------------------------------------------------------------- 286 nqo = COUNT(delPhase(tracers(:)%name) == 'H2O' & 287 .AND. tracers(:)%component == 'lmdz') !--- Number of water phases 288 nqtrue = SIZE(tracers) !--- Total number of "true" tracers 289 nbtr = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' & 290 .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac 291 #ifdef INCA 292 nqINCA = COUNT(tracers(:)%component == 'inca') 293 #endif 294 lerr = getKey('hadv', hadv, ky=tracers(:)%keys) 295 lerr = getKey('vadv', vadv, ky=tracers(:)%keys) 296 !--------------------------------------------------------------------------------------------------------------------------- 297 END IF 298 !--------------------------------------------------------------------------------------------------------------------------- 299 300 !--- Transfert the number of tracers to Reprobus 301 #ifdef REPROBUS 302 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) 303 #endif 304 305 !############################################################################################################################## 306 IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### 307 !############################################################################################################################## 308 309 !============================================================================================================================== 310 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). 311 !============================================================================================================================== 312 DO iq = 1, nqtrue 313 IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE 314 WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available' 315 CALL abort_gcm(modname, TRIM(msg1), 1) 316 END DO 317 nqtot = COUNT( hadv< 20 .AND. vadv< 20 ) & !--- No additional tracer 318 + 4*COUNT( hadv==20 .AND. vadv==20 ) & !--- 3 additional tracers 319 + 10*COUNT( hadv==30 .AND. vadv==30 ) !--- 9 additional tracers 320 321 !--- More tracers due to the choice of advection scheme => assign total number of tracers 322 IF( nqtot /= nqtrue ) THEN 323 CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers') 324 CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue))) 325 CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot))) 326 END IF 327 328 !============================================================================================================================== 329 ! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names and nqtot. 330 !============================================================================================================================== 331 ALLOCATE(ttr(nqtot)) 332 jq = nqtrue+1; tracers(:)%iadv = -1 333 DO iq = 1, nqtrue 334 t1 => tracers(iq) 335 336 !--- VERIFY THE CHOICE OF ADVECTION SCHEME 337 iad = -1 338 IF(hadv(iq) == vadv(iq) ) iad = hadv(iq) 339 IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11 340 WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq) 341 IF(iad == -1) CALL abort_gcm(modname, msg1, 1) 342 343 !--- SET FIELDS %longName, %isInPhysics 344 t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad) 345 t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' & 346 .OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD... 347 ttr(iq) = t1 348 349 !--- DEFINE THE HIGHER ORDER TRACERS, IF ANY 350 nm = 0 351 IF(iad == 20) nm = 3 !--- 2nd order scheme 352 IF(iad == 30) nm = 9 !--- 3rd order scheme 353 IF(nm == 0) CYCLE !--- No higher moments 354 ttr(jq+1:jq+nm) = t1 355 ttr(jq+1:jq+nm)%name = [(TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ] 356 ttr(jq+1:jq+nm)%parent = [(TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ] 357 ttr(jq+1:jq+nm)%longName = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] 358 jq = jq + nm 359 END DO 360 DEALLOCATE(hadv, vadv) 361 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 362 363 !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen 364 CALL indexUpdate(tracers) 365 366 !############################################################################################################################## 367 END IF 368 !############################################################################################################################## 369 370 !############################################################################################################################## 371 IF(.NOT.lInit) THEN 372 !############################################################################################################################## 373 nqtot = SIZE(tracers) 374 !############################################################################################################################## 375 ELSE 376 !############################################################################################################################## 377 378 !=== READ PHYSICAL PARAMETERS FOR ISOTOPES 379 niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE. 380 IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1) 381 382 !############################################################################################################################## 383 END IF 384 !############################################################################################################################## 385 !--- Convection / boundary layer activation for all tracers 386 ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 387 ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1 388 389 !--- Note: nqtottr can differ from nbtr when nmom/=0 390 nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz') 391 IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) & 392 CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1) 393 394 !=== DISPLAY THE RESULTS 395 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 396 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) 397 CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname) 398 CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) 399 CALL msg('niso = '//TRIM(int2str(niso)), modname) 400 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) 401 #ifdef INCA 402 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 403 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) 404 #endif 405 t => tracers 406 CALL msg('Information stored in infotrac_phy :', modname) 407 IF(dispTable('issssssssiiiiiiii', & 408 ['iq ', 'name ', 'lName ', 'gen0N ', 'parent', 'type ', 'phase ', 'compon', 'isPhy ', & 409 'iGen ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'], & 410 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),& 411 cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, & 412 t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) & 413 CALL abort_gcm(modname, "problem with the tracers table content", 1) 414 IF(niso > 0) THEN 415 CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname) 416 CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname) 417 CALL msg(' isoName = '//strStack(isoName), modname) 418 CALL msg(' isoZone = '//strStack(isoZone), modname) 419 CALL msg(' isoPhas = '//TRIM(isoPhas), modname) 420 ELSE 421 CALL msg('No isotopes identified.', modname) 422 END IF 423 424 #ifdef ISOVERIF 425 CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname) 426 #endif 189 427 #ifdef CPP_StratAer 190 IF ( ANY(types_trac == 'coag')) THEN428 IF (type_trac == 'coag') THEN 191 429 nbtr_bin = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)]) 192 430 nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)]) 193 431 tnames = PACK(tracers(:)%name, MASK=tracers(:)%isInPhysics) 194 432 id_BIN01_strat = strIdx(tnames, 'BIN01' ) 195 id_OCS_strat = strIdx(tnames, 'GASO SC' )433 id_OCS_strat = strIdx(tnames, 'GASOCS' ) 196 434 id_SO2_strat = strIdx(tnames, 'GASSO2' ) 197 435 id_H2SO4_strat = strIdx(tnames, 'GASH2SO4') … … 206 444 END IF 207 445 #endif 208 #ifdef ISOVERIF 209 CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname) 210 #endif 446 CALL msg('end', modname) 211 447 212 448 END SUBROUTINE init_infotrac_phy 213 449 214 215 !==============================================================================================================================216 !=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED217 ! Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).218 !==============================================================================================================================219 LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)220 IMPLICIT NONE221 CHARACTER(LEN=*), INTENT(IN) :: iName222 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose223 INTEGER :: iIso224 LOGICAL :: lV225 lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose226 iIso = strIdx(isotopes(:)%parent, iName)227 lerr = iIso == 0228 IF(lerr) THEN229 niso = 0; ntiso = 0; nzone=0; nphas=nqo; isoCheck=.FALSE.230 CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV)231 RETURN232 END IF233 lerr = isoSelectByIndex(iIso, lV)234 END FUNCTION isoSelectByName235 !==============================================================================================================================236 LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)237 IMPLICIT NONE238 INTEGER, INTENT(IN) :: iIso239 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose240 LOGICAL :: lv241 lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose242 lerr = .FALSE.243 IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK244 lerr = iIso<=0 .OR. iIso>nbIso245 CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '//TRIM(int2str(nbIso))//'"',&246 ll=lerr .AND. lV)247 IF(lerr) RETURN248 ixIso = iIso !--- Update currently selected family index249 isotope => isotopes(ixIso) !--- Select corresponding component250 isoKeys => isotope%keys; niso = isotope%niso251 isoName => isotope%trac; ntiso = isotope%ntiso252 isoZone => isotope%zone; nzone = isotope%nzone253 isoPhas => isotope%phase; nphas = isotope%nphas254 itZonIso => isotope%itZonIso; isoCheck = isotope%check255 iqIsoPha => isotope%iqIsoPha256 END FUNCTION isoSelectByIndex257 !==============================================================================================================================258 259 260 450 END MODULE infotrac_phy
Note: See TracChangeset
for help on using the changeset viewer.