Changeset 4063
- Timestamp:
- Jan 25, 2022, 1:01:52 AM (3 years ago)
- Location:
- LMDZ6/trunk/libf
- Files:
-
- 8 edited
-
dyn3d/dynetat0.f90 (modified) (1 diff)
-
dyn3d/dynredem.F90 (modified) (2 diffs)
-
dyn3d_common/infotrac.F90 (modified) (2 diffs)
-
dyn3dmem/dynetat0_loc.F90 (modified) (1 diff)
-
dyn3dmem/dynredem_loc.F90 (modified) (2 diffs)
-
misc/readTracFiles_mod.f90 (modified) (27 diffs)
-
misc/strings_mod.F90 (modified) (5 diffs)
-
misc/trac_types_mod.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3d/dynetat0.f90
r4052 r4063 7 7 !------------------------------------------------------------------------------- 8 8 USE infotrac, ONLY: nqtot, tracers, iqiso, iso_indnum, tnat, alpha_ideal, & 9 ok_isotopes, maxlen 9 ok_isotopes 10 USE strings_mod, ONLY: maxlen 10 11 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_INQ_VARID, NF90_NoErr, & 11 12 NF90_CLOSE, NF90_GET_VAR -
LMDZ6/trunk/libf/dyn3d/dynredem.F90
r4050 r4063 7 7 USE IOIPSL 8 8 #endif 9 USE infotrac, ONLY: nqtot, tracers, maxlen 9 USE strings_mod, ONLY: maxlen 10 USE infotrac, ONLY: nqtot, tracers 10 11 USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL, & 11 12 NF90_CLOSE, NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER, & … … 166 167 ! Purpose: Write the NetCDF restart file (append). 167 168 !------------------------------------------------------------------------------- 168 USE infotrac, ONLY: nqtot, tracers, type_trac, maxlen 169 USE strings_mod, ONLY: maxlen 170 USE infotrac, ONLY: nqtot, tracers, type_trac 169 171 USE control_mod 170 172 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID, & -
LMDZ6/trunk/libf/dyn3d_common/infotrac.F90
r4057 r4063 3 3 MODULE infotrac 4 4 5 USE readTracFiles_mod, ONLY: trac_type, isot_type, maxlen, ancestor, delPhase 6 7 ! nqtot : total number of tracers and higher order of moment, water vapor and liquid included 8 INTEGER, SAVE :: nqtot 9 !CR: on ajoute le nombre de traceurs de l eau 10 INTEGER, SAVE :: nqo 11 12 ! nbtr : number of tracers not including higher order of moment or water vapor or liquid 13 ! number of tracers used in the physics 14 INTEGER, SAVE :: nbtr 15 16 ! Nombre de traceurs passes a phytrac 17 INTEGER, SAVE :: nqtottr 18 19 ! ThL: nb traceurs CO2 20 INTEGER, SAVE :: nqCO2 21 22 ! DC: derived types containing informations about tracers and isotopes 23 TYPE(trac_type), TARGET, SAVE, ALLOCATABLE :: tracers(:) !=== TRACERS DESCRIPTORS VECTOR 24 TYPE(isot_type), TARGET, SAVE, ALLOCATABLE :: isotopes(:) !=== ISOTOPES PARAMETERS VECTOR 25 26 REAL :: qperemin,masseqmin,ratiomin ! MVals et CRisi 27 PARAMETER (qperemin=1e-30,masseqmin=1e-18,ratiomin=1e-16) ! MVals 28 29 ! conv_flg(it)=0 : convection desactivated for tracer number it 30 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: conv_flg 31 ! pbl_flg(it)=0 : boundary layer diffusion desactivaded for tracer number it 32 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: pbl_flg 33 34 CHARACTER(len=4),SAVE :: type_trac 35 CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym 5 USE strings_mod, ONLY: msg, find, strIdx, strFind, strParse, dispTable, int2str, reduceExpr, & 6 fmsg, test, strTail, strHead, strStack, strReduce, maxlen, testFile, cat 7 USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, addPhase, phases_sep, nphases, ancestor, & 8 isot_type, readIsotopesFile, delPhase, old_phases, getKey_init, tran0, & 9 keys_type, initIsotopes, indexUpdate, known_phases, getKey, setGeneration 10 11 IMPLICIT NONE 12 13 PRIVATE 14 15 !=== FOR TRACERS: 16 PUBLIC :: infotrac_init !--- Initialization of the tracers 17 PUBLIC :: tracers, type_trac !--- Full tracers database, tracers type keyword 18 PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr !--- Main dimensions 19 PUBLIC :: solsym, conv_flg, pbl_flg !--- Tracers names + convection & boundary layer activation keys 20 21 !=== FOR ISOTOPES: General 22 PUBLIC :: isotopes, nbIso !--- Derived type, full isotopes families database + nb of families 23 PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index 24 PUBLIC :: min_qParent, min_qMass, min_ratio !--- Min. values for various isotopic quantities 25 !=== FOR ISOTOPES: Specific to water 26 PUBLIC :: iH2O, tnat, alpha_ideal !--- H2O isotopes index, natural abundance, fractionning coeff. 27 !=== FOR ISOTOPES: Depending on the selected isotopes family 28 PUBLIC :: isotope, isoKeys !--- Selected isotopes database + associated keys (cf. getKey) 29 PUBLIC :: isoName, isoZone, isoPhas !--- Isotopes and tagging zones names, phases 30 PUBLIC :: niso, nzone, nphas, ntiso !--- " " numbers + isotopes & tagging tracers number 31 PUBLIC :: iZonIso, iTraPha !--- 2D index tables to get "iq" index 32 PUBLIC :: isoCheck !--- Run isotopes checking routines 33 !=== FOR BOTH TRACERS AND ISOTOPES 34 PUBLIC :: getKey !--- Get a key from "tracers" or "isotope" 35 36 PUBLIC :: ntraciso, ntraceurs_zone, iqiso 37 PUBLIC :: ok_isotopes, ok_iso_verif, ok_isotrac, ok_init_iso, use_iso 38 PUBLIC :: index_trac, iso_indnum, indnum_fn_num, niso_possibles 39 PUBLIC :: qperemin, masseqmin, ratiomin 40 41 INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect 42 43 !=== CONVENTIONS FOR TRACERS NUMBERS: 44 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 45 ! | water in different | water tagging | water isotopes | other tracers | additional tracers moments | 46 ! | phases: H2O_[gls] | isotopes | | | for higher order schemes | 47 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 48 ! | | | | | | 49 ! |<-- nqo -->|<-- nqo*niso* nzone -->|<-- nqo*niso -->|<-- nbtr -->|<-- (nmom) -->| 50 ! | | | | 51 ! | |<-- nqo*niso*(nzone+1) = nqo*ntiso -->|<-- nqtottr = nbtr + nmom -->| 52 ! | = nqtot - nqo*(ntiso+1) | 53 ! | | 54 ! |<-- nqtrue = nbtr + nqo*(ntiso+1) -->| | 55 ! | | 56 ! |<-- nqtot = nqtrue + nmom -->| 57 ! | | 58 ! |-----------------------------------------------------------------------------------------------------------| 59 ! NOTES FOR THIS TABLE: 60 ! * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'), 61 ! since water is so far the sole tracers family, except passive CO2, removed from the main tracers table. 62 ! * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas". 63 ! * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any. 64 ! 65 !=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot) 66 ! Each entry is accessible using "%" sign. 67 ! |-------------+------------------------------------------------------+-------------+------------------------+ 68 ! | entry | Meaning | Former name | Possible values | 69 ! |-------------+------------------------------------------------------+-------------+------------------------+ 70 ! | name | Name (short) | tname | | 71 ! | gen0Name | Name of the 1st generation ancestor | / | | 72 ! | parent | Name of the parent | / | | 73 ! | longName | Long name (with adv. scheme suffix) for outputs | ttext | | 74 ! | type | Type (so far: tracer or tag) | / | tracer,tag | 75 ! | phase | Phases list ("g"as / "l"iquid / "s"olid) | / | [g][l][s] | 76 ! | component | Name(s) of the merged/cumulated section(s) | / | coma-separated names | 77 ! | iadv | Advection scheme number | iadv | 1-20,30 exc. 3-9,15,19 | 78 ! | iGeneration | Generation (>=1) | / | | 79 ! | isAdvected | advected tracers flag (.TRUE. if iadv > 0) | / | nqtrue .TRUE. values | 80 ! | isH2Ofamily | H2O tracer/isotope/tagging tracer | / | nqtottr .TRUE. values | 81 ! | iqParent | Index of the parent tracer | iqpere | 1:nqtot | 82 ! | iqDescen | Indexes of the childs (all generations) | iqfils | 1:nqtot | 83 ! | nqDescen | Number of the descendants (all generations) | nqdesc | 1:nqtot | 84 ! | nqChilds | Number of childs (1st generation only) | nqfils | 1:nqtot | 85 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 86 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | 87 ! | iso_iZone | Isotope zone index in isotopes(iso_iGroup)%zone(:) | zone_num | 1:nzone | 88 ! | iso_iPhas | Isotope phase index in isotopes(iso_iGroup)%phas(:) | phase_num | 1:nphas | 89 ! | keys | key/val pairs accessible with "getKey" routine | / | | 90 ! +-------------+------------------------------------------------------+-------------+------------------------+ 91 ! 92 !=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES) 93 ! Each entry is accessible using "%" sign. 94 ! |-----------------+--------------------------------------------------+----------------+-----------------+ 95 ! | entry | length | Meaning | Former name | Possible values | 96 ! |-----------------+--------------------------------------------------+----------------+-----------------+ 97 ! | parent | Parent tracer (isotopes family name) | | | 98 ! | keys | niso | Isotopes keys/values pairs list + number | | | 99 ! | trac | ntiso | Isotopes + tagging tracers list + number | | | 100 ! | zone | nzone | Geographic tagging zones list + number | | | 101 ! | phase | nphas | Phases list + number | | [g][l][s], 1:3 | 102 ! | niso | Number of isotopes, excluding tagging tracers | | | 103 ! | ntiso | Number of isotopes, including tagging tracers | ntraciso | | 104 ! | nzone | Number of geographic tagging zones | ntraceurs_zone | | 105 ! | nphas | Number of phases | | | 106 ! | iTraPha | Index in "trac(1:niso)" = f(name(1:ntiso)),phas) | iqiso | 1:niso | 107 ! | iZonIso | Index in "trac(1:ntiso)" = f(zone, name(1:niso)) | index_trac | 1:nzone | 108 ! |-----------------+--------------------------------------------------+----------------+-----------------+ 109 110 REAL, PARAMETER :: min_qParent = 1.e-30, min_qMass = 1.e-18, min_ratio = 1.e-16 ! MVals et CRisi 111 112 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 113 INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O) 114 nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O) 115 nqo, & !--- Number of water phases 116 nbIso, & !--- Number of available isotopes family 117 nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?) 118 nqCO2 !--- Number of tracers of CO2 (ThL) 119 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type 120 121 !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES 122 TYPE(trac_type), TARGET, SAVE, ALLOCATABLE :: tracers(:) !=== TRACERS DESCRIPTORS VECTOR 123 TYPE(isot_type), TARGET, SAVE, ALLOCATABLE :: isotopes(:) !=== ISOTOPES PARAMETERS VECTOR 124 125 !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes" 126 TYPE(isot_type), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR 127 INTEGER, SAVE :: ixIso, iH2O !--- Index of the selected isotopes family and H2O family 128 LOGICAL, SAVE :: isoCheck !--- Flag to trigger the checking routines 129 TYPE(keys_type), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName) 130 CHARACTER(LEN=maxlen), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY 131 isoZone(:), & !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY 132 isoPhas !--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY 133 INTEGER, TARGET, SAVE :: niso, nzone, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES 134 nphas, ntiso !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS 135 INTEGER, SAVE, POINTER :: iZonIso(:,:) !--- INDEX IN "isoTrac" AS f(tagging zone, isotope) 136 INTEGER, SAVE, POINTER :: iTraPha(:,:) !--- INDEX IN "isoTrac" AS f(isotopic tracer, phase) 137 INTEGER, ALLOCATABLE, SAVE :: index_trac(:,:) ! numero ixt en fn izone, indnum entre 1 et niso 138 INTEGER, ALLOCATABLE, SAVE :: iqiso(:,:) ! donne indice iq en fn de (ixt,phase) 139 140 !--- Aliases for older names 141 INTEGER, POINTER, SAVE :: ntraciso, ntraceurs_zone 142 REAL, POINTER, SAVE :: qperemin, masseqmin, ratiomin 36 143 37 144 ! CRisi: cas particulier des isotopes 38 LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso 39 INTEGER :: niso_possibles 40 PARAMETER ( niso_possibles=5) 41 REAL, DIMENSION (niso_possibles),SAVE :: tnat,alpha_ideal 42 LOGICAL, DIMENSION(niso_possibles),SAVE :: use_iso 43 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqiso ! donne indice iq en fn de (ixt,phase) 44 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_indnum ! donne numero iso entre 1 et niso effectif en fn de nqtot 45 INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numero d isotope entre 1 et niso_possibles 46 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: index_trac ! numero ixt en fn izone, indnum entre 1 et niso 47 INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso 145 INTEGER, PARAMETER :: niso_possibles = 5 146 LOGICAL, SAVE :: ok_isotopes, ok_iso_verif, ok_isotrac, ok_init_iso 147 LOGICAL, SAVE, ALLOCATABLE :: use_iso(:) 148 INTEGER, SAVE, ALLOCATABLE :: iso_indnum(:) !--- Gives 1<=idx<=niso_possibles as function(1<=iq <=nqtot) 149 INTEGER, SAVE, ALLOCATABLE :: indnum_fn_num(:) !--- Gives 1<=idx<=niso as function(1<=idx<=niso_possibles) 150 151 !=== VARIABLES FOR ISOTOPES INITIALIZATION AND FOR INCA 152 REAL, SAVE, ALLOCATABLE :: tnat(:), & !--- Natural relative abundance of water isotope (niso) 153 alpha_ideal(:) !--- Ideal fractionning coefficient (for initial state) (niso) 154 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr) 155 pbl_flg(:) !--- Boundary layer activation ; needed for INCA (nbtr) 156 CHARACTER(LEN=8), SAVE, ALLOCATABLE :: solsym(:) !--- Names from INCA (nbtr) 157 LOGICAL, PARAMETER :: lOldCode = .TRUE. 48 158 49 159 CONTAINS 50 160 51 52 161 SUBROUTINE infotrac_init 162 USE control_mod, ONLY: planet_type, config_inca 53 163 #ifdef REPROBUS 54 USE CHEM_REP, ONLY: Init_chem_rep_trac55 #endif 56 57 !======================================================================= 164 USE CHEM_REP, ONLY: Init_chem_rep_trac 165 #endif 166 IMPLICIT NONE 167 !============================================================================================================================== 58 168 ! 59 169 ! Auteur: P. Le Van /L. Fairhead/F.Hourdin 60 170 ! ------- 61 ! Modif special traceur F.Forget 05/94 62 ! Modif M-A Filiberti 02/02 lecture de traceur.def 171 ! 172 ! Modifications: 173 ! -------------- 174 ! 05/94: F.Forget Modif special traceur 175 ! 02/02: M-A Filiberti Lecture de traceur.def 176 ! 01/22: D. Cugnet Nouveaux tracer.def et tracer_*.def + encapsulation (types tr et iso) 63 177 ! 64 178 ! Objet: … … 66 180 ! GCM LMD nouvelle grille 67 181 ! 68 !======================================================================= 182 !============================================================================================================================== 69 183 ! ... modification de l'integration de q ( 26/04/94 ) .... 70 !----------------------------------------------------------------------- 71 ! Declarations 72 73 INCLUDE "dimensions.h"74 INCLUDE "iniprint.h" 75 184 !------------------------------------------------------------------------------------------------------------------------------ 185 ! Declarations: 186 INCLUDE "dimensions.h" 187 INCLUDE "iniprint.h" 188 189 !------------------------------------------------------------------------------------------------------------------------------ 76 190 ! Local variables 77 INTEGER, ALLOCATABLE, DIMENSION(:) :: hadv ! index of horizontal trasport schema 78 INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv ! index of vertical trasport schema 79 80 INTEGER, ALLOCATABLE, DIMENSION(:) :: hadv_inca ! index of horizontal trasport schema 81 INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv_inca ! index of vertical trasport schema 82 83 INTEGER, ALLOCATABLE, DIMENSION(:) :: conv_flg_inca 84 INTEGER, ALLOCATABLE, DIMENSION(:) :: pbl_flg_inca 85 CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: solsym_inca 86 87 CHARACTER(len=maxlen), ALLOCATABLE, DIMENSION(:) :: tnom_0 ! tracer short name 88 CHARACTER(len=maxlen), ALLOCATABLE, DIMENSION(:) :: tnom_transp ! transporting fluid short name: CRisi 89 CHARACTER(len=3), DIMENSION(30) :: descrq 90 CHARACTER(len=1), DIMENSION(3) :: txts 91 CHARACTER(len=2), DIMENSION(9) :: txtp 92 CHARACTER(len=maxlen) :: str1,str2 93 94 INTEGER :: nqtrue ! number of tracers read from tracer.def, without higer order of moment 95 INTEGER :: iq, new_iq, iiq, jq, ierr,itr, iadv 96 INTEGER :: ifils,ipere ! CRisi 97 LOGICAL :: continu,nouveau_traceurdef 98 INTEGER :: IOstatus ! gestion de la retrocompatibilite de traceur.def 99 CHARACTER(len=maxlen) :: tchaine, msg1 100 INTEGER, ALLOCATABLE :: iqfils(:,:) 101 INTEGER :: nqINCA 102 103 character(len=*),parameter :: modname="infotrac_init" 104 105 !----------------------------------------------------------------------- 191 INTEGER, ALLOCATABLE :: & 192 hadv(:), had(:), hadv_inca(:), conv_flg_inca(:), & !--- Horizontal/vertical transport scheme number 193 vadv(:), vad(:), vadv_inca(:), pbl_flg_inca(:) !--- + specific variables for INCA 194 CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA 195 CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather) 196 CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags 197 CHARACTER(LEN=maxlen) :: oldH2O, newH2O !--- Old and new water names 198 CHARACTER(LEN=maxlen) :: msg1, msg2 !--- Strings for messages 199 CHARACTER(LEN=maxlen), ALLOCATABLE :: str(:) !--- Temporary storage 200 INTEGER :: fType !--- Tracers description file type ; 0: none 201 !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def" 202 INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments) 203 INTEGER :: iad !--- Advection scheme number 204 INTEGER :: ic, ip, np, iq, jq, it, nt, im, nm, ix, iz, nz !--- Indexes and temporary variables 205 LOGICAL :: lerr, ll 206 CHARACTER(LEN=1) :: p 207 TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:) 208 TYPE(trac_type), POINTER :: t1, tp, t(:) 209 TYPE(isot_type), POINTER :: iso 210 211 CHARACTER(LEN=maxlen), ALLOCATABLE :: tnom_0(:), tnom_transp(:) !--- Tracer short name + transporting fluid name 212 CHARACTER(LEN=maxlen) :: tchaine 213 INTEGER :: ierr, nqINCA 214 LOGICAL :: lINCA 215 216 CHARACTER(LEN=*), PARAMETER :: modname="infotrac_init" 217 !------------------------------------------------------------------------------------------------------------------------------ 106 218 ! Initialization : 219 !------------------------------------------------------------------------------------------------------------------------------ 220 suff = ['x ','y ','z ','xx','xy','xz','yy','yz','zz'] 221 descrq( 1: 2) = ['LMV','BAK'] 222 descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH',' ','PPM','PPS','PPP',' ','SLP'] 223 descrq(30) = 'PRA' 224 225 CALL msg('type_trac='//TRIM(type_trac), modname) 226 IF(lOldCode) THEN 227 str = [type_trac]; nt = 1 228 ELSE 229 IF(strParse(type_trac, ',', str, n=nt)) CALL abort_gcm(modname,'can''t parse "type_trac = '//TRIM(type_trac)//'"',1) 230 END IF 231 232 !--------------------------------------------------------------------------------------------------------------------------- 233 DO it = 1, nt !--- nt>1=> "type_trac": coma-separated keywords list 234 !--------------------------------------------------------------------------------------------------------------------------- 235 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION 236 msg1 = 'For type_trac = "'//TRIM(str(it))//'":' 237 SELECT CASE(type_trac) 238 CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model, config_inca='//config_inca, modname) 239 CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname) 240 CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname) 241 CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname) 242 CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname) 243 CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname) 244 CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(str(it))//' not possible yet.',1) 245 END SELECT 246 247 !--- COHERENCE TEST BETWEEN "type_trac" AND "config_inca" 248 IF(ANY(['inca', 'inco'] == str(it)) .AND. ALL(['aero', 'aeNP', 'chem'] /= config_inca)) & 249 CALL abort_gcm(modname, 'Incoherence between type_trac and config_inca. Please modify "run.def"',1) 250 251 !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS 252 SELECT CASE(str(it)) 253 CASE('inca','inco') 254 #ifndef INCA 255 CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1) 256 #endif 257 CASE('repr') 258 #ifndef REPROBUS 259 CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) 260 #endif 261 CASE('coag') 262 #ifndef CPP_StratAer 263 CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) 264 #endif 265 END SELECT 266 267 !--- DISABLE "config_inca" OPTION FOR A RUN WITHOUT "INCA" IF IT DIFFERS FROM "none" 268 IF(fmsg('Setting config_inca="none" as you do not couple with INCA model', & 269 modname, ALL(['inca', 'inco'] /= str(it)) .AND. config_inca /= 'none')) config_inca = 'none' 270 271 !--------------------------------------------------------------------------------------------------------------------------- 272 END DO 273 !--------------------------------------------------------------------------------------------------------------------------- 274 275 nqCO2 = 0; IF(ANY(str == 'inco')) nqCO2 = 1 276 277 !============================================================================================================================== 278 ! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid) 279 !============================================================================================================================== 280 281 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 282 IF(lOldCode) THEN 283 !------------------------------------------------------------------------------------------------------------------------------ 284 !--- Determine nqtrue and (INCA only) nqo, nbtr 285 OPEN(90, FILE='traceur.def', FORM='formatted', STATUS='old', IOSTAT=ierr) 286 IF(ierr /= 0) CALL abort_gcm(modname, 'file "traceur.def" not found !', 1) 287 CALL msg('File "traceur.def" successfully opened.', modname) 288 lINCA = ANY(['inca','inco'] == type_trac) 289 290 IF(lINCA) THEN 291 #ifdef INCA 292 READ(90,*) nqo 293 IF(nqCO2==1 .AND. nqo==4) nqo = 3 294 CALL Init_chem_inca_trac(nqINCA) 295 nbtr = nqINCA + nqCO2 296 nqtrue = nbtr + nqo 297 IF(ALL([2,3] /= nqo) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1) 298 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 299 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) 300 CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname) 301 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 302 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) 303 ALLOCATE(hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA)) 304 ALLOCATE(vadv_inca(nqINCA), pbl_flg_inca(nqINCA)) 305 CALL init_transport(hadv_inca, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) 306 ! DC passive CO2 tracer is at position 1: H2O was removed ; nqCO2/=0 in "inco" case only 307 conv_flg = [( 1, ic=1, nqCO2),conv_flg_inca] 308 pbl_flg = [( 1, ic=1, nqCO2), pbl_flg_inca] 309 solsym = [('CO2 ', ic=1, nqCO2) solsym_inca] 310 DEALLOCATE(conv_flg_inca, pbl_flg_inca, solsym_inca) 311 #endif 312 ELSE 313 READ(90,*) nqtrue 314 END IF 315 316 IF (planet_type=="earth" .AND. nqtrue < 2) & 317 CALL abort_gcm('infotrac_init', 'Not enough tracers: nqtrue='//TRIM(int2str(nqtrue))//', 2 tracers is the minimum', 1) 318 319 !--- Allocate variables depending on nqtrue 320 ALLOCATE(hadv(nqtrue), vadv(nqtrue), tnom_0(nqtrue), tnom_transp(nqtrue), tracers(nqtrue)) 321 322 !--- Continue to read tracer.def 323 it = 0 324 DO iq = 1, nqtrue 325 #ifdef INCA 326 IF(iq > nqo+nqCO2) THEN 327 it = it+1 328 hadv (iq) = hadv_inca (it) 329 vadv (iq) = vadv_inca (it) 330 tnom_0(iq) = solsym_inca(it) 331 tnom_transp(iq) = 'air' 332 CYCLE 333 END IF 334 #endif 335 CALL msg('237: iq='//TRIM(int2str(iq)), modname) 336 READ(90,'(I2,X,I2,X,A)',IOSTAT=ierr) hadv(iq),vadv(iq),tchaine 337 WRITE(msg1,'("iq, hadv(iq), vadv(iq) = ",i0,2(", ",i0))')iq, hadv(iq), vadv(iq) 338 CALL msg(msg1, modname) 339 CALL msg('tchaine = "'//TRIM(tchaine)//'"', modname) 340 CALL msg('infotrac 238: IOstatus='//TRIM(int2str(ierr)), modname) 341 IF(ierr/=0) CALL abort_gcm('infotrac_init', 'Pb dans la lecture de traceur.def', 1) 342 jq = INDEX(tchaine(1:LEN_TRIM(tchaine)),' ') 343 CALL msg("Ancienne version de traceur.def: traceurs d'air uniquement", modname, iq==1 .AND. jq==0) 344 CALL msg("Nouvelle version de traceur.def", modname, iq==1 .AND. jq/=0) 345 IF(jq /= 0) THEN !--- Space in the string chain => new format 346 tnom_0 (iq) = tchaine(1:jq-1) 347 tnom_transp(iq) = tchaine(jq+1:) 348 ELSE 349 tnom_0 (iq) = tchaine 350 tnom_transp(iq) = 'air' 351 END IF 352 CALL msg( 'tnom_0(iq)=<'//TRIM(tnom_0(iq)) //'>', modname) 353 CALL msg('tnom_transp(iq)=<'//TRIM(tnom_transp(iq))//'>', modname) 354 END DO 355 356 CLOSE(90) 357 358 #ifndef INCA 359 conv_flg = [(1, ic=1, nbtr)] !--- Convection activated for all tracers 360 pbl_flg = [(1, ic=1, nbtr)] !--- Boundary layer activated for all tracers 361 ALLOCATE(solsym(nbtr)) 362 CALL msg('Valeur de traceur.def :', modname) 363 CALL msg('nombre total de traceurs '//TRIM(int2str(nqtrue)), modname) 364 DO iq = 1, nqtrue 365 CALL msg(strStack([int2str(hadv(iq)), int2str(vadv(iq)), tnom_0(iq), tnom_transp(iq)]), modname) 366 END DO 367 IF(planet_type /= 'earth') nqo = 0 !--- Same number of tracers in dynamics and physics 368 IF(planet_type == 'earth') nqo = COUNT(delPhase(tnom_0) == 'H2O') !--- for all planets except for Earth 369 nbtr = nqtrue - nqo 370 #endif 371 372 !--- SET FIELDS %name, %parent, %phase, %component 373 tracers(:)%name = tnom_0 374 tracers(:)%parent = tnom_transp 375 tracers(:)%phase = 'g' 376 tracers(:)%component = type_trac 377 DO ip = 1, nphases 378 p = old_phases(ip:ip) 379 iq = strIdx(tracers(:)%name, 'H2O'//p) 380 IF(iq /= 0) CYCLE 381 tracers(iq)%phase = p 382 IF(lINCA) tracers(iq)%component = 'lmdz' 383 END DO 384 IF(lINCA) tracers(1+nqo:nqCO2+nqo)%component = 'co2i' 385 CALL setGeneration(tracers) !--- SET FIELDS %iGeneration, %gen0Name 386 387 ! manque "type" 388 389 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 390 ELSE 391 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 392 IF(readTracersFiles(type_trac, fType, tracers)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 393 IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1) 394 !--------------------------------------------------------------------------------------------------------------------------- 395 IF(fType == 1) THEN !=== FOUND AN OLD STYLE "traceur.def" 396 !--------------------------------------------------------------------------------------------------------------------------- 397 #ifdef INCA 398 nqo = SIZE(tracers) 399 IF(nqCO2==1 .AND. nqo==4) nqo = 3 !--- Force nqo to 3 (ThL) 400 CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA 401 nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac 402 nqtrue = nbtr + nqo !--- Total number of "true" tracers 403 IF(ALL([2,3] /= nqo) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1) 404 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 405 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) 406 CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname) 407 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 408 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) 409 ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA)) 410 ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA)) 411 CALL init_transport(hadv_inca, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) 412 ! DC passive CO2 tracer is at position 1: H2O was removed ; nqCO2/=0 in "inco" case only 413 conv_flg = [( 1, k=1, nqCO2), conv_flg_inca] 414 pbl_flg = [( 1, k=1, nqCO2), pbl_flg_inca] 415 solsym = [('CO2 ', k=1, nqCO2) solsym_inca] 416 DEALLOCATE(conv_flg_inca, pbl_flg_inca, solsym_inca) 417 ALLOCATE(ttr(nqtrue)) 418 ttr(1:nqo+nqCO2) = tracers 419 ttr(1 : nqo )%component = 'lmdz' 420 ttr(1+nqo:nqCO2+nqo )%component = 'co2i' 421 ttr(1+nqo+nqCO2:nqtrue)%component = 'inca' 422 ttr(1+nqo :nqtrue)%name = solsym 423 ttr(1+nqo+nqCO2:nqtrue)%parent = tran0 424 ttr(1+nqo+nqCO2:nqtrue)%phase = 'g' 425 lerr = getKey('hadv', had, ky=ttr(:)%keys); hadv(:) = [had, hadv_inca] 426 lerr = getKey('vadv', vad, ky=ttr(:)%keys); vadv(:) = [vad, vadv_inca] 427 DEALLOCATE(had, hadv_inca, vad, vadv_inca) 428 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 429 CALL setGeneration(tracers) !--- SET FIELDS %iGeneration, %gen0Name 430 #else 431 nqo = COUNT(delPhase(tracers(:)%name) == 'H2O') !--- Number of water phases 432 nqtrue = SIZE(tracers) !--- Total number of "true" tracers 433 nbtr = nqtrue - nqo !--- Number of tracers passed to phytrac 434 lerr = getKey('hadv', hadv, ky=tracers(:)%keys) 435 lerr = getKey('vadv', vadv, ky=tracers(:)%keys) 436 #endif 437 !--------------------------------------------------------------------------------------------------------------------------- 438 ELSE !=== FOUND NEW STYLE TRACERS CONFIGURATION FILE(S) 439 !--------------------------------------------------------------------------------------------------------------------------- 440 nqo = COUNT(delPhase(tracers(:)%name) == 'H2O') !--- Number of water phases 441 nqtrue = SIZE(tracers) !--- Total number of "true" tracers 442 nbtr = nqtrue - nqo !--- Number of tracers passed to phytrac 443 lerr = getKey('hadv', hadv, ky=tracers(:)%keys) 444 lerr = getKey('vadv', vadv, ky=tracers(:)%keys) 445 ALLOCATE(solsym(nbtr)) 446 conv_flg = [(1, it=1, nbtr)] 447 pbl_flg = [(1, it=1, nbtr)] 448 !--------------------------------------------------------------------------------------------------------------------------- 449 END IF 450 !--------------------------------------------------------------------------------------------------------------------------- 451 END IF 452 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 453 454 CALL getKey_init(tracers) 455 456 !--- Transfert the number of tracers to Reprobus 457 #ifdef REPROBUS 458 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) 459 #endif 460 461 !============================================================================================================================== 462 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). 463 !============================================================================================================================== 464 DO iq = 1, nqtrue 465 IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE 466 WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available' 467 CALL abort_gcm(modname, TRIM(msg1), 1) 468 END DO 469 nqtot = COUNT( hadv< 20 .AND. vadv< 20 ) & !--- No additional tracer 470 + 4*COUNT( hadv==20 .AND. vadv==20 ) & !--- 3 additional tracers 471 + 10*COUNT( hadv==30 .AND. vadv==30 ) !--- 9 additional tracers 472 473 !--- More tracers due to the choice of advection scheme => assign total number of tracers 474 IF( nqtot /= nqtrue ) THEN 475 CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers') 476 CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue))) 477 CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot))) 478 END IF 479 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 480 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) 481 CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname) 482 CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) 483 484 !============================================================================================================================== 485 ! 3) Determine the advection scheme choice for water and tracers "iadv" and the fields long name, isAdvected. 486 ! iadv = 1 "LMDZ-specific humidity transport" (for H2O vapour) LMV 487 ! iadv = 2 backward (for H2O liquid) BAK 488 ! iadv = 14 Van-Leer + specific humidity, modified by Francis Codron VLH 489 ! iadv = 10 Van-Leer (chosen for vapour and liquid water) VL1 490 ! iadv = 11 Van-Leer for hadv and PPM version (Monotonic) for vadv VLP 491 ! iadv = 12 Frederic Hourdin I FH1 492 ! iadv = 13 Frederic Hourdin II FH2 493 ! iadv = 16 Monotonic PPM (Collela & Woodward 1984) PPM 494 ! iadv = 17 Semi-monotonic PPM (overshoots allowed) PPS 495 ! iadv = 18 Definite positive PPM (overshoots and undershoots allowed) PPP 496 ! iadv = 20 Slopes SLP 497 ! iadv = 30 Prather PRA 107 498 ! 108 txts=(/'x','y','z'/) 109 txtp=(/'x ','y ','z ','xx','xy','xz','yy','yz','zz'/) 110 111 descrq(14)='VLH' 112 descrq(10)='VL1' 113 descrq(11)='VLP' 114 descrq(12)='FH1' 115 descrq(13)='FH2' 116 descrq(16)='PPM' 117 descrq(17)='PPS' 118 descrq(18)='PPP' 119 descrq(20)='SLP' 120 descrq(30)='PRA' 121 122 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION 123 WRITE(lunout,*)'type_trac='//TRIM(type_trac) 124 msg1 = 'For type_trac = "'//TRIM(type_trac)//'":' 125 SELECT CASE(type_trac) 126 CASE('inca'); WRITE(lunout,*)TRIM(msg1)//' coupling with INCA chemistry model, config_inca='//config_inca 127 CASE('inco'); WRITE(lunout,*)TRIM(msg1)//' coupling jointly with INCA and CO2 cycle' 128 CASE('repr'); WRITE(lunout,*)TRIM(msg1)//' coupling with REPROBUS chemistry model' 129 CASE('co2i'); WRITE(lunout,*)TRIM(msg1)//' you have chosen to run with CO2 cycle' 130 CASE('coag'); WRITE(lunout,*)TRIM(msg1)//' tracers are treated for COAGULATION tests' 131 CASE('lmdz'); WRITE(lunout,*)TRIM(msg1)//' tracers are treated in LMDZ only' 132 CASE DEFAULT 133 CALL abort_gcm(modname,'type_trac='//TRIM(type_trac)//' not possible yet.',1) 134 END SELECT 135 136 !--- COHERENCE TEST BETWEEN "type_trac", "config_inca" AND PREPROCESSING KEYS 137 SELECT CASE(type_trac) 138 CASE('inca','inco'); IF(ALL(['aero', 'aeNP', 'chem']/=config_inca)) & 139 CALL abort_gcm(modname, 'Incoherence between type_trac and config_inca. Please modify "run.def"',1) 140 #ifndef INCA 141 CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code',1) 142 #endif 143 CASE('repr') 144 #ifndef REPROBUS 145 CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code',1) 146 #endif 147 CASE('coag') 148 #ifndef CPP_StratAer 149 CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code',1) 150 #endif 151 END SELECT 152 153 !--- Disable "config_inca" option for a run without INCA if it differs from "none" 154 IF (ALL(['inca', 'inco', 'none'] /= config_inca)) THEN 155 WRITE(lunout,*)'setting config_inca="none" as you do not couple with INCA model' 156 config_inca = 'none' 157 END IF 158 159 !----------------------------------------------------------------------- 160 ! 161 ! 1) Get the true number of tracers + water vapor/liquid 162 ! Here true tracers (nqtrue) means declared tracers (only first order) 163 ! 164 !----------------------------------------------------------------------- 165 OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr) 166 IF(ierr.EQ.0) THEN 167 WRITE(lunout,*) trim(modname),': Open traceur.def : ok' 168 ELSE 169 WRITE(lunout,*) trim(modname),': Failed opening traceur.def' 170 CALL abort_gcm(modname,"file traceur.def not found!",1) 171 ENDIF 172 nqCO2 = 0; IF(type_trac == 'inco') nqCO2 = 1 173 SELECT CASE(type_trac) 174 CASE('lmdz','repr','coag','co2i'); READ(90,*) nqtrue 175 CASE('inca','inco'); READ(90,*) nqo 176 ! The traceur.def file is used to define the number "nqo" of water phases 177 ! present in the simulation. Default : nqo = 2. 178 IF (nqo == 4 .AND. type_trac=='inco') nqo = 3 179 IF(ALL([2,3] /= nqo)) THEN 180 WRITE(lunout,*) trim(modname),': nqo=',nqo, ' is not allowed. Only 2 or 3 water phases allowed' 181 CALL abort_gcm('infotrac_init','Bad number of water phases',1) 182 END IF 183 ! nbtr has been read from INCA by init_const_lmdz() in gcm.F 184 #ifdef INCA 185 CALL Init_chem_inca_trac(nqINCA) 499 ! In array q(ij,l,iq) : iq = 1/2[/3] for vapour/liquid[/ice] water 500 ! And optionaly: iq = 3[4],nqtot for other tracers 501 !============================================================================================================================== 502 ALLOCATE(ttr(nqtot)) 503 jq = nqtrue+1; tracers(:)%iadv = -1 504 DO iq = 1, nqtrue 505 t1 => tracers(iq) 506 507 !--- VERIFY THE CHOICE OF ADVECTION SCHEME 508 iad = -1 509 IF(hadv(iq) == vadv(iq) ) iad = hadv(iq) 510 IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11 511 WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq) 512 IF(iad == -1) CALL abort_gcm(modname, msg1, 1) 513 514 !--- SET FIELDS %longName, %iadv, %isAdvected, %isH2Ofamily 515 t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad) 516 t1%iadv = iad 517 t1%isAdvected = iad > 0 518 t1%isH2Ofamily= delPhase(t1%gen0Name) == 'H2O' 519 ttr(iq) = t1 520 521 !--- DEFINE THE HIGHER ORDER TRACERS, IF ANY 522 nm = 0 523 IF(iad == 20) nm = 3 !--- 2nd order scheme 524 IF(iad == 30) nm = 9 !--- 3rd order scheme 525 ttr(jq+1:jq+nm) = t1 526 ttr(jq+1:jq+nm)%name = [(TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ] 527 ttr(jq+1:jq+nm)%parent = [(TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ] 528 ttr(jq+1:jq+nm)%longName = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] 529 ttr(jq+1:jq+nm)%iadv = [(-iad, im=1, nm) ] 530 ttr(jq+1:jq+nm)%isAdvected = [(.FALSE., im=1, nm) ] 531 jq = jq + nm 532 END DO 533 DEALLOCATE(hadv, vadv) 534 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 535 536 !--- SET FIELDS %iqParent, %nqChilds, %iGeneration, %iqDescen, %nqDescen 537 CALL indexUpdate(tracers) 538 539 CALL msg('Information stored in infotrac :', modname) 540 CALL msg('iadv name long_name :', modname) 541 542 !=== TEST ADVECTION SCHEME 543 DO iq=1,nqtot ; t1 => tracers(iq); iad = t1%iadv 544 545 !--- ONLY TESTED VALUES FOR TRACERS FOR NOW: iadv = 14, 10 (and 0 for non-transported tracers) 546 IF(ALL([10,14,0] /= iad)) & 547 CALL abort_gcm(modname, 'Not tested for iadv='//TRIM(int2str(iad))//' ; 10 or 14 only are allowed !', 1) 548 549 !--- ONLY TESTED VALUES FOR PARENTS HAVING CHILDS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1) 550 IF(ALL([10,14] /= iad) .AND. t1%iGeneration == 1 .AND. ANY(tracers(:)%iGeneration > 1)) & 551 CALL abort_gcm(modname, 'iadv='//TRIM(int2str(iad))//' not implemented for parents ; 10 or 14 only are allowed !', 1) 552 553 !--- ONLY TESTED VALUES FOR CHILDS FOR NOW: iadv = 10 (CHILDS: TRACERS OF GENERATION GREATER THAN 1) 554 IF(fmsg('WARNING ! iadv='//TRIM(int2str(iad))//' not implemented for childs. Setting iadv=10 for "'//TRIM(t1%name)//'"',& 555 modname, iad /= 10 .AND. t1%iGeneration > 1)) t1%iadv = 10 556 557 !--- ONLY VALID SCHEME NUMBER FOR WATER VAPOUR: iadv = 14 558 ll = t1%name /= addPhase('H2O','g'); IF(lOldCode) ll = t1%name /= 'H2Ov' 559 IF(fmsg('WARNING ! iadv=14 is valid for water vapour only. Setting iadv=10 for "'//TRIM(t1%name)//'".', & 560 modname, iad == 14 .AND. ll)) t1%iadv = 10 561 END DO 562 563 IF(lOldCode) THEN 564 565 CALL infotrac_setHeredity !--- SET FIELDS %iqParent, %nqChilds, %iGeneration, %gen0Name, %iqDescen, %nqDescen 566 CALL infotrac_isoinit(tnom_0, nqtrue) !--- SET FIELDS %type, %iso_iName, %iso_iZone, %iso_iPhase 567 CALL getKey_init(tracers, isotopes) 568 IF(isoSelect('H2O')) RETURN !--- Select water isotopes ; finished if no water isotopes 569 iH2O = ixIso !--- Keep track of water family index 570 571 !--- Remove the isotopic tracers from the tracers list passed to phytrac 572 nbtr = nbtr -nqo* ntiso !--- ISOTOPIC TAGGING TRACERS ARE NOT PASSED TO THE PHYSICS 573 nqtottr = nqtot-nqo*(1+ntiso) !--- NO H2O-FAMILY TRACER IS PASSED TO THE PHYSICS 574 CALL msg('702: nbtr, ntiso='//strStack(int2str([nbtr, ntiso])), modname) 575 CALL msg('704: nqtottr, nqtot, nqo = '//strStack(int2str([nqtottr, nqtot, nqo])), modname) 576 ! Rq: nqtottr n'est pas forcement egal a nbtr dans le cas ou nmom/=0 577 IF(COUNT(tracers%iso_iName == 0 .AND. delPhase(tracers(:)%name)/='H2O') /= nqtottr) & 578 CALL abort_gcm('infotrac_init', 'pb dans le calcul de nqtottr', 1) 579 580 !--- Finalize : 581 DEALLOCATE(tnom_0, hadv, vadv, tnom_transp) 582 583 ELSE 584 585 CALL initIsotopes(tracers, isotopes) 586 nbIso = SIZE(isotopes); IF(nbIso==0) RETURN !--- No isotopes: finished. 587 588 !=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE SPECIFIC TO WATER ISOTOPES 589 ! DONE HERE, AND NOT ONLY IN "infotrac_phy", BECAUSE SOME PHYSICAL PARAMS ARE NEEDED FOR RESTARTS (tnat, alpha_ideal) 590 CALL getKey_init(tracers, isotopes) 591 IF(isoSelect('H2O')) RETURN !--- Select water isotopes ; finished if no water isotopes 592 iH2O = ixIso !--- Keep track of water family index 593 IF(getKey('tnat' , tnat, isoName(1:niso))) CALL abort_gcm(modname, 'can''t read "tnat"', 1) 594 IF(getKey('alpha', alpha_ideal, isoName(1:niso))) CALL abort_gcm(modname, 'can''t read "alpha_ideal"', 1) 595 596 !=== ENSURE THE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES 597 DO ix = 1, nbIso 598 iso => isotopes(ix) 599 !--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases 600 DO it = 1, iso%ntiso 601 np = SUM([(COUNT(tracers(:)%name == addPhase(iso%trac(it), iso%phase(ip:ip))), ip=1, iso%nphas)]) 602 IF(np == iso%nphas) CYCLE 603 WRITE(msg1,'("Found ",i0," phases for ",s," instead of ",i0)')np, iso%trac(it), iso%nphas 604 CALL abort_gcm(modname, msg1, 1) 605 END DO 606 DO it = 1, iso%niso 607 nz = SUM([(COUNT(iso%trac == iso%trac(it)//'_'//iso%zone(iz)), iz=1, iso%nzone)]) 608 IF(nz == iso%nzone) CYCLE 609 WRITE(msg1,'("Found ",i0," tagging zones for ",s," instead of ",i0)')nz, iso%trac(it), iso%nzone 610 CALL abort_gcm(modname, msg1, 1) 611 END DO 612 END DO 613 nqtottr = COUNT(tracers%iso_iName == 0) 614 615 END IF 616 617 !=== DISPLAY THE RESULTING LIST 618 t => tracers 619 CALL msg('Information stored in infotrac :') 620 IF(dispTable('issssiii', ['iq ', 'name ', 'longName', 'gen0Name', 'parent ', 'iadv ', 'iqParent', 'iGenerat'], & 621 cat(t%name, t%longName, t%gen0Name, t%parent), cat([(iq, iq=1, nqtot)], t%iadv, t%iqParent, t%iGeneration))) & 622 CALL abort_gcm(modname, "problem with the tracers table content", 1) 623 624 !--- Some aliases to be removed later 625 ntraciso => iso%ntiso 626 ntraceurs_zone => iso%nzone 627 qperemin = min_qParent 628 masseqmin = min_qMass 629 ratiomin = min_ratio 630 CALL msg('end', modname) 631 632 END SUBROUTINE infotrac_init 633 634 635 636 SUBROUTINE infotrac_setHeredity 637 !--- Purpose: Set fields %iqParent, %nqChilds, %iGeneration, %iqDescen, %nqDescen (old method) 638 USE strings_mod, ONLY: strIdx 639 INTEGER :: iq, ipere, ifils 640 INTEGER, ALLOCATABLE :: iqfils(:,:) 641 CHARACTER(LEN=maxlen) :: msg1, modname='infotrac_init' 642 INCLUDE "iniprint.h" 643 644 !=== SET FIELDS %iqParent, %nqChilds 645 ALLOCATE(iqfils(nqtot,nqtot)); iqfils(:,:) = 0 646 647 DO iq = 1, nqtot 648 msg1 = 'Tracer nr. '//TRIM(int2str(iq))//', called "'//TRIM(tracers(iq)%name)//'" is ' 649 650 !--- IS IT A GENERATION 0 TRACER ? IF SO, tracers(iq)%iqParent KEEPS ITS DEFAULT VALUE (0) 651 IF(fmsg(TRIM(msg1)//' a parent', modname, tracers(iq)%parent == tran0)) CYCLE 652 653 !--- TRACERS OF GENERATION > 0 ; FIND ITS PARENT INDEX 654 ipere = strIdx(tracers(:)%name, tracers(iq)%parent) 655 IF(ipere == 0) CALL abort_gcm('infotrac_init', TRIM(msg1)//' an orphan', 1) 656 IF(iq == ipere) CALL abort_gcm('infotrac_init', TRIM(msg1)//' its own parent',1) 657 658 CALL msg(TRIM(msg1)//' the child of '//TRIM(tracers(ipere)%name), modname) 659 tracers(iq)%iqParent = ipere 660 tracers(ipere)%nqChilds = tracers(ipere)%nqChilds+1 661 iqfils(tracers(ipere)%nqChilds,ipere) = iq 662 END DO 663 CALL msg('nqGen0 = '//int2str(COUNT(tracers(:)%parent == 'air')), modname) 664 CALL msg('nqChilds = '//strStack(int2str(tracers(:)%nqChilds)), modname) 665 CALL msg('iqParent = '//strStack(int2str(tracers(:)%iqParent)), modname) 666 WRITE(lunout,*)TRIM(modname)//': iqfils = ',iqfils 667 668 !=== SET FIELDS %iGeneration, %iqDescen, %nqDescen 669 tracers(:)%iGeneration = 0 670 DO iq = 1, nqtot 671 ifils = iq 672 DO WHILE(tracers(ifils)%iqParent > 0) 673 ipere = tracers(ifils)%iqParent 674 tracers(ipere)%nqDescen = tracers(ipere)%nqDescen+1 675 tracers(iq)%iGeneration = tracers(iq)%iGeneration+1 676 iqfils(tracers(ipere)%nqDescen,ipere) = iq 677 ifils = ipere 678 END DO 679 msg1 = 'Tracer nr. '//TRIM(int2str(iq))//', called "'//TRIM(tracers(iq)%name)//'" is ' 680 CALL msg(TRIM(msg1)//' of generation '//TRIM(int2str(tracers(iq)%iGeneration)), modname) 681 END DO 682 DO iq=1,nqtot 683 tracers(iq)%iqDescen = iqfils(1:tracers(iq)%nqDescen,iq) 684 END DO 685 686 CALL msg('nqDescen = '//TRIM(strStack(int2str(tracers(:)%nqDescen))), modname) 687 CALL msg('nqDescen_tot = ' //TRIM(int2str(SUM(tracers(:)%nqDescen))), modname) 688 WRITE(lunout,*)TRIM(modname)//': iqfils = ',iqfils 689 690 END SUBROUTINE infotrac_setHeredity 691 692 693 694 SUBROUTINE infotrac_isoinit(tnom_0, nqtrue) 695 696 #ifdef CPP_IOIPSL 697 USE IOIPSL 186 698 #else 187 nqINCA=0 188 #endif 189 nbtr=nqINCA+nqCO2 190 nqtrue=nbtr+nqo 191 WRITE(lunout,*) trim(modname),': nqo = ',nqo 192 WRITE(lunout,*) trim(modname),': nbtr = ',nbtr 193 WRITE(lunout,*) trim(modname),': nqtrue = ',nqtrue 194 WRITE(lunout,*) trim(modname),': nqCO2 = ',nqCO2 195 WRITE(lunout,*) trim(modname),': nqINCA = ',nqINCA 196 ALLOCATE(hadv_inca(nqINCA), vadv_inca(nqINCA), conv_flg_inca(nqINCA), pbl_flg_inca(nqINCA), solsym_inca(nqINCA)) 197 END SELECT 198 !>jyg 199 200 IF ((planet_type=="earth").and.(nqtrue < 2)) THEN 201 WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowed. 2 tracers is the minimum' 202 CALL abort_gcm('infotrac_init','Not enough tracers',1) 203 ENDIF 204 205 !jyg< 206 207 ! 208 ! Allocate variables depending on nqtrue 209 ! 210 ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue),tnom_transp(nqtrue)) 211 212 213 !----------------------------------------------------------------------- 214 ! 2) Choix des schemas d'advection pour l'eau et les traceurs 215 ! 216 ! iadv = 1 schema transport type "humidite specifique LMD" 217 ! iadv = 2 schema amont 218 ! iadv = 14 schema Van-leer + humidite specifique 219 ! Modif F.Codron 220 ! iadv = 10 schema Van-leer (retenu pour l'eau vapeur et liquide) 221 ! iadv = 11 schema Van-Leer pour hadv et version PPM (Monotone) pour vadv 222 ! iadv = 12 schema Frederic Hourdin I 223 ! iadv = 13 schema Frederic Hourdin II 224 ! iadv = 16 schema PPM Monotone(Collela & Woodward 1984) 225 ! iadv = 17 schema PPM Semi Monotone (overshoots autorises) 226 ! iadv = 18 schema PPM Positif Defini (overshoots undershoots autorises) 227 ! iadv = 20 schema Slopes 228 ! iadv = 30 schema Prather 229 ! 230 ! Dans le tableau q(ij,l,iq) : iq = 1 pour l'eau vapeur 231 ! iq = 2 pour l'eau liquide 232 ! Et eventuellement iq = 3,nqtot pour les autres traceurs 233 ! 234 ! iadv(1): choix pour l'eau vap. et iadv(2) : choix pour l'eau liq. 235 !------------------------------------------------------------------------ 236 ! 237 ! Get choice of advection schema from file tracer.def or from INCA 238 !--------------------------------------------------------------------- 239 IF (ANY(['lmdz', 'repr', 'coag', 'co2i'] == type_trac)) THEN 240 241 ! Continue to read tracer.def 242 DO iq=1,nqtrue 243 244 write(*,*) 'infotrac 237: iq=',iq 245 ! CRisi: ajout du nom du fluide transporteur 246 ! mais rester retro compatible 247 READ(90,'(I2,X,I2,X,A)',IOSTAT=IOstatus) hadv(iq),vadv(iq),tchaine 248 write(lunout,*) 'iq,hadv(iq),vadv(iq)=',iq,hadv(iq),vadv(iq) 249 write(lunout,*) 'tchaine=',trim(tchaine) 250 write(*,*) 'infotrac 238: IOstatus=',IOstatus 251 if (IOstatus.ne.0) CALL abort_gcm('infotrac_init','Pb dans la lecture de traceur.def',1) 252 ! Y-a-t-il 1 ou 2 noms de traceurs separes par un espace ? 253 iiq = INDEX(tchaine(1:LEN_TRIM(tchaine)),' ') 254 nouveau_traceurdef=iiq/=0 255 write(*,*) 'iiq,nouveau_traceurdef=',iiq,nouveau_traceurdef 256 if (nouveau_traceurdef) then 257 IF(iq==1) write(lunout,*) "Nouvelle version de traceur.def" 258 tnom_0 (iq) = tchaine(1:iiq-1) 259 tnom_transp(iq) = tchaine(iiq+1:) 260 else 261 IF(iq==1) write(lunout,*) "Nouvelle version de traceur.def: traceurs d'air uniquement" 262 tnom_0 (iq) = tchaine 263 tnom_transp(iq) = 'air' 264 endif 265 write(lunout,*) 'tnom_0(iq)=<',trim(tnom_0(iq)),'>' 266 write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>' 267 ENDDO!DO iq=1,nqtrue 268 269 CLOSE(90) 270 271 WRITE(lunout,*) trim(modname),': Valeur de traceur.def :' 272 WRITE(lunout,*) trim(modname),': nombre total de traceurs ',nqtrue 273 DO iq=1,nqtrue 274 WRITE(lunout,*) hadv(iq),vadv(iq),' ',trim(tnom_0(iq)),' ',trim(tnom_transp(iq)) 275 END DO 276 277 IF ( planet_type=='earth') THEN 278 !CR: nombre de traceurs de l eau 279 nqo=2; IF (tnom_0(3) == 'H2Oi') nqo=3 280 ! For Earth, water vapour & liquid tracers are not in the physics 281 nbtr=nqtrue-nqo 282 ELSE 283 ! Other planets (for now); we have the same number of tracers 284 ! in the dynamics than in the physics 285 nbtr=nqtrue 286 ENDIF 287 288 ENDIF 289 !jyg< 290 ! 291 292 ! Transfert number of tracers to Reprobus 293 #ifdef REPROBUS 294 IF (type_trac == 'repr') CALL Init_chem_rep_trac(nbtr,nqo,tnom_0) 295 #endif 296 ! 297 ! Allocate variables depending on nbtr 298 ! 299 ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr)) 300 conv_flg(:) = 1 ! convection activated for all tracers 301 pbl_flg(:) = 1 ! boundary layer activated for all tracers 302 303 IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN ! config_inca='aero' ou 'chem' 304 !>jyg 305 ! le module de chimie fournit les noms des traceurs et les schemas d'advection associes. 306 ! excepte pour ceux lus dans traceur.def 307 308 #ifdef INCA 309 CALL init_transport(hadv_inca, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) 310 ! DC passive CO2 tracer is at index 1: H2O was removed ; nqCO2/=0 in "inco" case only 311 conv_flg(1:nqCO2) = 1; conv_flg(1+nqCO2:nbtr) = conv_flg_inca 312 pbl_flg(1:nqCO2) = 1; pbl_flg(1+nqCO2:nbtr) = pbl_flg_inca 313 solsym(1:nqCO2) = 'CO2'; solsym(1+nqCO2:nbtr) = solsym_inca 314 #endif 315 316 itr = 0 317 DO iq = 1, nqtot 318 IF(iq > nqo+nqCO2) THEN 319 itr = itr+1 320 hadv (iq) = hadv_inca (itr) 321 vadv (iq) = vadv_inca (itr) 322 tnom_0(iq) = solsym_inca(itr) 323 tnom_transp(iq) = 'air' 324 CYCLE 325 END IF 326 write(*,*) 'infotrac 237: iq=',iq 327 ! CRisi: ajout du nom du fluide transporteur en restant retro-compatible 328 READ(90,'(I2,X,I2,X,A)',IOSTAT=IOstatus) hadv(iq),vadv(iq),tchaine 329 write(lunout,*) 'iq,hadv(iq),vadv(iq)=',iq,hadv(iq),vadv(iq) 330 write(lunout,*) 'tchaine=',trim(tchaine) 331 write(*,*) 'infotrac 238: IOstatus=',IOstatus 332 if (IOstatus.ne.0) CALL abort_gcm('infotrac_init','Pb dans la lecture de traceur.def',1) 333 ! Y-a-t-il 1 ou 2 noms de traceurs separes par un espace ? 334 iiq = INDEX(tchaine(1:LEN_TRIM(tchaine)),' ') 335 nouveau_traceurdef=iiq/=0 336 write(*,*) 'iiq,nouveau_traceurdef=',iiq,nouveau_traceurdef 337 if (nouveau_traceurdef) then 338 IF(iq==1) write(lunout,*) "Nouvelle version de traceur.def" 339 tnom_0 (iq) = tchaine(1:iiq-1) 340 tnom_transp(iq) = tchaine(iiq+1:) 341 else 342 IF(iq==1) write(lunout,*) "Nouvelle version de traceur.def: traceurs d'air uniquement" 343 tnom_0 (iq) = tchaine 344 tnom_transp(iq) = 'air' 345 endif 346 write(lunout,*) 'tnom_0(iq)=<',trim(tnom_0(iq)),'>' 347 write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>' 348 END DO 349 CLOSE(90) 350 ENDIF ! (type_trac == 'inca' or 'inco') 351 352 !----------------------------------------------------------------------- 353 ! 354 ! 3) Verify if advection schema 20 or 30 choosen 355 ! Calculate total number of tracers needed: nqtot 356 ! Allocate variables depending on total number of tracers 357 !----------------------------------------------------------------------- 358 new_iq=0 359 DO iq=1,nqtrue 360 ! Add tracers for certain advection schema 361 IF (hadv(iq)<20 .AND. vadv(iq)<20 ) THEN 362 new_iq=new_iq+1 ! no tracers added 363 ELSE IF (hadv(iq)==20 .AND. vadv(iq)==20 ) THEN 364 new_iq=new_iq+4 ! 3 tracers added 365 ELSE IF (hadv(iq)==30 .AND. vadv(iq)==30 ) THEN 366 new_iq=new_iq+10 ! 9 tracers added 367 ELSE 368 WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq) 369 CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1) 370 ENDIF 371 END DO 372 373 IF (new_iq /= nqtrue) THEN 374 ! The choice of advection schema imposes more tracers 375 ! Assigne total number of tracers 376 nqtot = new_iq 377 378 WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers' 379 WRITE(lunout,*) 'makes it necessary to add tracers' 380 WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers' 381 WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed' 382 383 ELSE 384 ! The true number of tracers is also the total number 385 nqtot = nqtrue 386 ENDIF 387 388 ! 389 ! Allocate variables with total number of tracers, nqtot 390 ! 391 ALLOCATE(tracers(nqtot)) 392 393 !----------------------------------------------------------------------- 394 ! 395 ! 4) Determine iadv, long and short name 396 ! 397 !----------------------------------------------------------------------- 398 new_iq=0 399 DO iq=1,nqtrue 400 new_iq=new_iq+1 401 402 ! Verify choice of advection schema 403 IF (hadv(iq)==vadv(iq)) THEN 404 tracers(new_iq)%iadv=hadv(iq) 405 ELSE IF (hadv(iq)==10 .AND. vadv(iq)==16) THEN 406 tracers(new_iq)%iadv=11 407 ELSE 408 WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq) 409 410 CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1) 411 ENDIF 412 413 str1=tnom_0(iq) 414 tracers(new_iq)%name = TRIM(tnom_0(iq)) 415 tracers(new_iq)%parent = TRIM(tnom_transp(iq)) 416 IF (tracers(new_iq)%iadv==0) THEN 417 tracers(new_iq)%longName=trim(str1) 418 ELSE 419 tracers(new_iq)%longName=trim(tnom_0(iq))//descrq(tracers(new_iq)%iadv) 420 ENDIF 421 422 ! schemas tenant compte des moments d'ordre superieur 423 str2=TRIM(tracers(new_iq)%longName) 424 IF (tracers(new_iq)%iadv==20) THEN 425 DO jq=1,3 426 new_iq=new_iq+1 427 tracers(new_iq)%iadv=-20 428 tracers(new_iq)%longName=trim(str2)//txts(jq) 429 tracers(new_iq)%name=trim(str1)//txts(jq) 430 END DO 431 ELSE IF (tracers(new_iq)%iadv==30) THEN 432 DO jq=1,9 433 new_iq=new_iq+1 434 tracers(new_iq)%iadv=-30 435 tracers(new_iq)%longName=trim(str2)//txtp(jq) 436 tracers(new_iq)%name=trim(str1)//txtp(jq) 437 END DO 438 ENDIF 439 END DO 440 441 WRITE(lunout,*) trim(modname),': Information stored in infotrac :' 442 WRITE(lunout,*) trim(modname),': iadv name long_name :' 443 444 DO iq=1,nqtot 445 WRITE(lunout,*) tracers(iq)%iadv,' ',trim(tracers(iq)%name),' ',trim(tracers(iq)%longName) 446 END DO 447 448 ! 449 ! Test for advection schema. 450 ! This version of LMDZ only garantees iadv=10 and iadv=14 (14 only for water vapour) . 451 ! 452 DO iq=1,nqtot 453 iadv=tracers(iq)%iadv 454 IF (ALL([10, 14, 0]/=iadv)) THEN 455 WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv,' is not tested in this version of LMDZ' 456 CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1) 457 ELSE IF (iadv==14 .AND. iq/=1) THEN 458 WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv,' is not tested in this version of LMDZ' 459 CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1) 460 ENDIF 461 END DO 462 463 464 ! CRisi: quels sont les traceurs fils et les traceurs peres. 465 ! initialiser tous les tableaux d'indices lies aux traceurs familiaux 466 ! + verifier que tous les peres sont ecrits en premieres positions 467 ALLOCATE(iqfils(nqtot,nqtot)) 468 iqfils(:,:)=0 469 tracers(:)%iqParent=0 470 DO iq=1,nqtot 471 if (tnom_transp(iq) == 'air') then 472 ! ceci est un traceur pere 473 WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un pere' 474 tracers(iq)%iqParent=0 475 else !if (tnom_transp(iq) == 'air') then 476 ! ceci est un fils. Qui est son pere? 477 WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un fils' 478 continu=.true. 479 ipere=1 480 do while (continu) 481 if (tnom_transp(iq) == tnom_0(ipere)) then 482 ! Son pere est ipere 483 WRITE(lunout,*) 'Le traceur',iq,'appele ', & 484 & trim(tnom_0(iq)),' est le fils de ',ipere,'appele ',trim(tnom_0(ipere)) 485 if (iq.eq.ipere) then 486 CALL abort_gcm('infotrac_init','Un fils est son propre pere',1) 487 endif 488 tracers(ipere)%nqChilds = tracers(ipere)%nqChilds+1 489 iqfils(tracers(ipere)%nqChilds,ipere)=iq 490 tracers(iq)%iqParent=ipere 491 continu=.false. 492 else !if (tnom_transp(iq) == tnom_0(ipere)) then 493 ipere=ipere+1 494 if (ipere.gt.nqtot) then 495 WRITE(lunout,*) 'Le traceur',iq,'appele ', & 496 & trim(tnom_0(iq)),', est orphelin.' 497 CALL abort_gcm('infotrac_init','Un traceur est orphelin',1) 498 endif !if (ipere.gt.nqtot) then 499 endif !if (tnom_transp(iq) == tnom_0(ipere)) then 500 enddo !do while (continu) 501 endif !if (tnom_transp(iq) == 'air') then 502 enddo !DO iq=1,nqtot 503 WRITE(lunout,*) 'infotrac: nqGen0=',COUNT(tracers(:)%parent == 'air') 504 WRITE(lunout,*) 'nqChilds=',tracers(:)%nqChilds 505 WRITE(lunout,*) 'iqParent=',tracers(:)%iqParent 506 WRITE(lunout,*) 'iqfils=',iqfils 507 508 ! Calculer le nombre de descendants a partir de iqfils et de nbfils 509 DO iq=1,nqtot 510 tracers(iq)%iGeneration=0 511 continu=.true. 512 ifils=iq 513 do while (continu) 514 ipere=tracers(ifils)%iqParent 515 if (ipere.gt.0) then 516 tracers(ipere)%nqDescen = tracers(ipere)%nqDescen+1 517 iqfils(tracers(ipere)%nqDescen,ipere)=iq 518 ifils=ipere 519 tracers(iq)%iGeneration=tracers(iq)%iGeneration+1 520 else !if (ipere.gt.0) then 521 continu=.false. 522 endif !if (ipere.gt.0) then 523 enddo !do while (continu) 524 WRITE(lunout,*) 'Le traceur ',iq,', appele ',trim(tnom_0(iq)), & 525 ' est un traceur de generation: ',tracers(iq)%iGeneration 526 enddo !DO iq=1,nqtot 527 DO iq=1,nqtot 528 ALLOCATE(tracers(iq)%iqDescen(tracers(iq)%nqDescen)) 529 tracers(iq)%iqDescen(:) = iqfils(1:tracers(iq)%nqDescen,iq) 530 END DO 531 532 WRITE(lunout,*) 'infotrac: nqDescen=',tracers(:)%nqDescen 533 WRITE(lunout,*) 'iqfils=',iqfils 534 WRITE(lunout,*) 'nqDescen_tot=',SUM(tracers(:)%nqDescen) 535 536 ! Interdire autres schemas que 10 pour les traceurs fils, et autres schemas 537 ! que 10 et 14 si des peres ont des fils 538 do iq=1,nqtot 539 if (tracers(iq)%iqParent > 0) then 540 ! ce traceur a un pere qui n'est pas l'air 541 ! Seul le schema 10 est autorise 542 iadv=tracers(iq)%iadv 543 if (iadv/=10) then 544 WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv,' is not implemented for sons' 545 CALL abort_gcm('infotrac_init','Sons should be advected by scheme 10',1) 546 endif 547 ! Le traceur pere ne peut etre advecte que par schema 10 ou 14: 548 IF (ALL([10,14]/=tracers(tracers(iq)%iqParent)%iadv)) THEN 549 WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv,' is not implemented for fathers' 550 CALL abort_gcm('infotrac_init','Fathers should be advected by scheme 10 ou 14',1) 551 endif 552 endif 553 enddo !do iq=1,nqtot 554 tracers(:)%gen0Name = ancestor(tracers) !--- Name of the first generation ancestor 555 tracers(:)%isAdvected = tracers(:)%iadv > 0 556 ! tracers(:)%isH2Ofamily = delPhase(tracers(:)%gen0Name) == 'H2O' 557 tracers(:)%isH2Ofamily = [(tracers(iq)%gen0Name(1:3) == 'H2O', iq=1, nqtot)] 558 559 ! detecter quels sont les traceurs isotopiques parmi des traceurs 560 call infotrac_isoinit(tnom_0,nqtrue) 561 562 ! if (ntraciso.gt.0) then 563 ! le 18 sep 2020: on enleve la condition ntraciso.gt.0 car nqtottr doit etre 564 ! connu meme si il n'y a pas d'isotopes! 565 write(lunout,*) 'infotrac 702: nbtr,ntraciso=',nbtr,ntraciso 566 ! retrancher les traceurs isotopiques de la liste des traceurs qui passent dans 567 ! phytrac 568 nbtr=nbtr-nqo*ntraciso 569 570 ! faire un tableau d'indice des traceurs qui passeront dans phytrac 571 nqtottr=nqtot-nqo*(1+ntraciso) 572 write(lunout,*) 'infotrac 704: nqtottr,nqtot,nqo=',nqtottr,nqtot,nqo 573 ! Rq: nqtottr n'est pas forcement egal a nbtr dans le cas ou new_iq /= nqtrue 574 ! if (COUNT(tracers(:)%iso_iName == 0) /= nqtottr) & 575 ! CALL abort_gcm('infotrac_init','pb dans le calcul de nqtottr',1) 576 ! endif !if (ntraciso.gt.0) then 577 578 !----------------------------------------------------------------------- 579 ! Finalize : 580 ! 581 DEALLOCATE(tnom_0, hadv, vadv,tnom_transp) 582 583 WRITE(lunout,*) 'infotrac init fin' 584 585 END SUBROUTINE infotrac_init 586 587 SUBROUTINE infotrac_isoinit(tnom_0,nqtrue) 588 589 #ifdef CPP_IOIPSL 590 use IOIPSL 591 #else 592 ! if not using IOIPSL, we still need to use (a local version of) getin 593 use ioipsl_getincom 594 #endif 595 implicit none 699 USE ioipsl_getincom 700 #endif 701 IMPLICIT NONE 702 INTEGER, INTENT(IN) :: nqtrue 703 CHARACTER(LEN=*), INTENT(IN) :: tnom_0(nqtrue) 704 CHARACTER(LEN=3) :: tnom_iso(niso_possibles) 705 INTEGER, ALLOCATABLE :: nb_iso(:,:), nb_traciso(:,:) 706 INTEGER :: ii, ip, iq, it, iz, ixt, n, nb_isoind, nzone_prec 707 TYPE(isot_type), POINTER :: i 708 TYPE(trac_type), POINTER :: t(:) 709 CHARACTER(LEN=1) :: p 710 CHARACTER(LEN=maxlen) :: tnom_trac 711 CHARACTER(LEN=maxlen), ALLOCATABLE :: str(:) 712 INCLUDE "iniprint.h" 713 714 tnom_iso = ['eau', 'HDO', 'O18', 'O17', 'HTO'] 715 ALLOCATE(nb_iso (niso_possibles,nqo)) 716 ALLOCATE(nb_traciso (niso_possibles,nqo)) 717 ALLOCATE(use_iso (niso_possibles)) 718 ALLOCATE(indnum_fn_num(niso_possibles)) 719 ALLOCATE(iso_indnum(nqtot)) 720 721 iso_indnum (:) = 0 722 use_iso (:) = .FALSE. 723 indnum_fn_num(:) = 0 724 nb_iso (:,:) = 0 725 nb_traciso (:,:) = 0 726 727 DO iq=1, nqtot 728 IF(delPhase(tracers(iq)%name) == 'H2O' .OR. .NOT.tracers(iq)%isAdvected) CYCLE 729 outer:DO ip = 1, nqo 730 nb_isoind = 0 731 DO ixt= 1,niso_possibles 732 tnom_trac = 'H2O'//old_phases(ip:ip)//'_'//TRIM(tnom_iso(ixt)) 733 IF (tracers(iq)%name == tnom_trac) THEN 734 nb_iso(ixt,ip) = nb_iso(ixt,ip)+1 735 nb_isoind = nb_isoind+1 736 tracers(iq)%type = 'tracer' 737 tracers(iq)%iso_iGroup = 1 738 tracers(iq)%iso_iName = ixt 739 iso_indnum(iq) = nb_isoind 740 indnum_fn_num(ixt) = iso_indnum(iq) 741 tracers(iq)%iso_iPhase = ip 742 EXIT outer 743 ELSE IF(tracers(iq)%iqParent> 0) THEN 744 IF(tracers(tracers(iq)%iqParent)%name == tnom_trac) THEN 745 nb_traciso(ixt,ip) = nb_traciso(ixt,ip)+1 746 iso_indnum(iq) = indnum_fn_num(ixt) 747 tracers(iq)%type = 'tag' 748 tracers(iq)%iso_iGroup = 1 749 tracers(iq)%iso_iName = ixt 750 tracers(iq)%iso_iZone = nb_traciso(ixt,ip) 751 tracers(iq)%iso_iPhase = ip 752 EXIT outer 753 END IF 754 END IF 755 END DO 756 END DO outer 757 END DO 758 759 niso = 0; nzone_prec = nb_traciso(1,1) 760 DO ixt = 1, niso_possibles 761 IF(nb_iso(ixt,1) == 0) CYCLE 762 IF(nb_iso(ixt,1) /= 1) CALL abort_gcm('infotrac_init', 'Isotopes are not well defined in traceur.def', 1) 763 764 ! on verifie que toutes les phases ont le meme nombre d'isotopes 765 IF(ANY(nb_iso(ixt,:) /= 1)) CALL abort_gcm('infotrac_init', 'Phases must have same number of isotopes', 1) 766 767 niso = niso+1 768 use_iso(ixt) = .TRUE. 769 nzone = nb_traciso(ixt,1) 770 771 ! on verifie que toutes les phases ont le meme nombre de traceurs d'isotopes 772 IF(ANY(nb_traciso(ixt,2:nqo) /= nzone)) CALL abort_gcm('infotrac_init','Phases must have same number of tracers',1) 773 774 ! on verifie que tous les isotopes ont le meme nombre de traceurs d'isotopes 775 IF(nzone /= nzone_prec) CALL abort_gcm('infotrac_init','Isotope tracers are not well defined in traceur.def',1) 776 nzone_prec = nzone 777 END DO 778 779 ! dimensions et flags isotopiques: 780 ntiso = niso*(nzone+1) 781 ok_isotopes = niso > 0 782 ok_isotrac = nzone > 0 596 783 597 ! inputs 598 INTEGER,INTENT(IN) :: nqtrue 599 CHARACTER(len=*),INTENT(IN) :: tnom_0(nqtrue) 600 601 ! locals 602 CHARACTER(len=3), DIMENSION(niso_possibles) :: tnom_iso 603 INTEGER, ALLOCATABLE,DIMENSION(:,:) :: nb_iso,nb_traciso 604 INTEGER, ALLOCATABLE,DIMENSION(:) :: nb_isoind 605 INTEGER :: ntraceurs_zone_prec,iq,phase,ixt,iiso,izone 606 CHARACTER(len=maxlen) :: tnom_trac 607 INCLUDE "iniprint.h" 608 609 tnom_iso=(/'eau','HDO','O18','O17','HTO'/) 610 611 ALLOCATE(nb_iso(niso_possibles,nqo)) 612 ALLOCATE(nb_isoind(nqo)) 613 ALLOCATE(nb_traciso(niso_possibles,nqo)) 614 ALLOCATE(iso_indnum(nqtot)) 615 616 iso_indnum(:)=0 617 indnum_fn_num(:)=0 618 use_iso(:)=.false. 619 nb_iso(:,:)=0 620 nb_isoind(:)=0 621 nb_traciso(:,:)=0 622 niso=0 623 ntraceurs_zone=0 624 ntraceurs_zone_prec=0 625 ntraciso=0 626 627 do iq=nqo+1,nqtot 628 ! write(lunout,*) 'infotrac 569: iq,tnom_0(iq)=',iq,tnom_0(iq) 629 do phase=1,nqo 630 do ixt= 1,niso_possibles 631 tnom_trac=trim(tnom_0(phase))//'_' 632 tnom_trac=trim(tnom_trac)//trim(tnom_iso(ixt)) 633 ! write(*,*) 'phase,ixt,tnom_trac=',phase,ixt,tnom_trac 634 IF (tnom_0(iq) == tnom_trac) then 635 ! write(lunout,*) 'Ce traceur est un isotope' 636 nb_iso(ixt,phase)=nb_iso(ixt,phase)+1 637 nb_isoind(phase)=nb_isoind(phase)+1 638 tracers(iq)%iso_iName=ixt 639 iso_indnum(iq)=nb_isoind(phase) 640 indnum_fn_num(ixt)=iso_indnum(iq) 641 tracers(iq)%iso_iPhase=phase 642 goto 20 643 else if ( tracers(iq)%iqParent> 0) then 644 if (tnom_0(tracers(iq)%iqParent) == tnom_trac) then 645 ! write(lunout,*) 'Ce traceur est le fils d''un isotope' 646 ! c'est un traceur d'isotope 647 nb_traciso(ixt,phase)=nb_traciso(ixt,phase)+1 648 tracers(iq)%iso_iName=ixt 649 iso_indnum(iq)=indnum_fn_num(ixt) 650 tracers(iq)%iso_iZone=nb_traciso(ixt,phase) 651 tracers(iq)%iso_iPhase=phase 652 goto 20 653 endif !if (tnom_0(tracers(iq)%iqParent) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then 654 endif !IF (tnom_0(iq) == trim(tnom_0(phase))//trim(tnom_iso(ixt))) then 655 enddo !do ixt= niso_possibles 656 enddo !do phase=1,nqo 657 20 continue 658 enddo !do iq=1,nqtot 659 660 do ixt= 1,niso_possibles 661 662 if (nb_iso(ixt,1).eq.1) then 663 ! on verifie que toutes les phases ont le meme nombre de 664 ! traceurs 665 do phase=2,nqo 666 if (nb_iso(ixt,phase).ne.nb_iso(ixt,1)) then 667 ! write(lunout,*) 'ixt,phase,nb_iso=',ixt,phase,nb_iso(ixt,phase) 668 CALL abort_gcm('infotrac_init','Phases must have same number of isotopes',1) 669 endif 670 enddo !do phase=2,nqo 671 672 niso=niso+1 673 use_iso(ixt)=.true. 674 ntraceurs_zone=nb_traciso(ixt,1) 675 676 ! on verifie que toutes les phases ont le meme nombre de 677 ! traceurs 678 do phase=2,nqo 679 if (nb_traciso(ixt,phase).ne.ntraceurs_zone) then 680 write(lunout,*) 'ixt,phase,nb_traciso=',ixt,phase,nb_traciso(ixt,phase) 681 write(lunout,*) 'ntraceurs_zone=',ntraceurs_zone 682 CALL abort_gcm('infotrac_init','Phases must have same number of tracers',1) 683 endif 684 enddo !do phase=2,nqo 685 ! on verifie que tous les isotopes ont le meme nombre de 686 ! traceurs 687 if (ntraceurs_zone_prec.gt.0) then 688 if (ntraceurs_zone.eq.ntraceurs_zone_prec) then 689 ntraceurs_zone_prec=ntraceurs_zone 690 else !if (ntraceurs_zone.eq.ntraceurs_zone_prec) then 691 write(*,*) 'ntraceurs_zone_prec,ntraceurs_zone=',ntraceurs_zone_prec,ntraceurs_zone 692 CALL abort_gcm('infotrac_init', & 693 &'Isotope tracers are not well defined in traceur.def',1) 694 endif !if (ntraceurs_zone.eq.ntraceurs_zone_prec) then 695 endif !if (ntraceurs_zone_prec.gt.0) then 696 697 else if (nb_iso(ixt,1).ne.0) then 698 WRITE(lunout,*) 'nqo,ixt=',nqo,ixt 699 WRITE(lunout,*) 'nb_iso(ixt,1)=',nb_iso(ixt,1) 700 CALL abort_gcm('infotrac_init','Isotopes are not well defined in traceur.def',1) 701 endif !if (nb_iso(ixt,1).eq.1) then 702 enddo ! do ixt= niso_possibles 703 704 ! dimensions isotopique: 705 ntraciso=niso*(ntraceurs_zone+1) 706 ! WRITE(lunout,*) 'niso=',niso 707 ! WRITE(lunout,*) 'ntraceurs_zone,ntraciso=',ntraceurs_zone,ntraciso 708 709 ! flags isotopiques: 710 ok_isotopes = niso > 0 711 ! WRITE(lunout,*) 'ok_isotopes=',ok_isotopes 712 713 if (ok_isotopes) then 714 ok_iso_verif=.false. 715 call getin('ok_iso_verif',ok_iso_verif) 716 ok_init_iso=.false. 717 call getin('ok_init_iso',ok_init_iso) 718 tnat=(/1.0,155.76e-6,2005.2e-6,0.004/100.,0.0/) 719 alpha_ideal=(/1.0,1.01,1.006,1.003,1.0/) 720 endif !if (ok_isotopes) then 721 ! WRITE(lunout,*) 'ok_iso_verif=',ok_iso_verif 722 ! WRITE(lunout,*) 'ok_init_iso=',ok_init_iso 723 724 if (ntraceurs_zone.gt.0) then 725 ok_isotrac=.true. 726 else 727 ok_isotrac=.false. 728 endif 729 ! WRITE(lunout,*) 'ok_isotrac=',ok_isotrac 730 731 ! remplissage du tableau iqiso(ntraciso,phase) 732 ALLOCATE(iqiso(ntraciso,nqo)) 733 iqiso(:,:)=0 734 do iq=1,nqtot 735 if (tracers(iq)%iso_iName > 0) then 736 ixt=iso_indnum(iq)+tracers(iq)%iso_iZone*niso 737 iqiso(ixt,tracers(iq)%iso_iPhase)=iq 738 endif 739 enddo 740 ! WRITE(lunout,*) 'iqiso=',iqiso 741 742 ! replissage du tableau index_trac(ntraceurs_zone,niso) 743 ALLOCATE(index_trac(ntraceurs_zone,niso)) 744 if (ok_isotrac) then 745 do iiso=1,niso 746 do izone=1,ntraceurs_zone 747 index_trac(izone,iiso)=iiso+izone*niso 748 enddo 749 enddo 750 else !if (ok_isotrac) then 751 index_trac(:,:)=0.0 752 endif !if (ok_isotrac) then 753 ! write(lunout,*) 'index_trac=',index_trac 754 755 ! Finalize : 756 DEALLOCATE(nb_iso) 757 758 END SUBROUTINE infotrac_isoinit 784 IF(ok_isotopes) THEN 785 ok_iso_verif = .FALSE.; CALL getin('ok_iso_verif', ok_iso_verif) 786 ok_init_iso = .FALSE.; CALL getin('ok_init_iso', ok_init_iso) 787 END IF 788 tnat = [1.0, 155.76e-6, 2005.2e-6, 0.004/100., 0.0] 789 alpha_ideal = [1.0, 1.01, 1.006, 1.003, 1.0] 790 ! END IF 791 792 ! remplissage du tableau iqiso(ntiso,phase) 793 ALLOCATE(iqiso(ntiso,nqo)) 794 iqiso(:,:)=0 795 DO iq = 1, nqtot 796 IF(tracers(iq)%iso_iName <= 0) CYCLE 797 ixt = iso_indnum(iq) + tracers(iq)%iso_iZone*niso 798 iqiso(ixt, tracers(iq)%iso_iPhase) = iq 799 END DO 800 801 ! remplissage du tableau index_trac(nzone,niso) 802 ALLOCATE(index_trac(nzone, niso)) 803 IF(ok_isotrac) then 804 DO ii = 1, niso; index_trac(:, ii) = ii + niso*[(iz, iz=1, nzone)]; END DO 805 ELSE 806 index_trac(:,:)=0.0 807 END IF 808 809 ALLOCATE(isotopes(1)) !--- Only water 810 nbIso = 1 811 i => isotopes(1) 812 t => tracers 813 str = PACK(delPhase(t%name), MASK = t%type=='tracer' .AND. delPhase(t%parent) == 'H2O' .AND. t%phase == 'g') 814 i%parent = 'H2O' 815 i%niso = SIZE(str) 816 i%nzone = nzone 817 i%nphas = nqo 818 FORALL(it = 1:i%niso) i%keys(it)%name = str(it) 819 i%zone = PACK(strTail(t%name,'_',.TRUE.), MASK = t%type=='tag' .AND. delPhase(t%gen0Name)=='H2O' .AND. t%iGeneration==3) 820 CALL strReduce(i%zone) 821 i%phase = strStack([(known_phases(ip:ip), ip=1, nphases)], MASK=[(strIdx(t%name,addPhase('H2O',known_phases(ip:ip)))/=0)]) 822 i%iTraPha = RESHAPE([((strIdx(t(:)%name,addPhase(i%trac(it),i%phase(ip:ip))) ,it=1,i%ntiso),ip=1,i%nphas)],[i%ntiso,i%nphas]) 823 i%iZonIso = RESHAPE([((strIdx(i%trac,TRIM(i%trac(it))//'_'//TRIM(i%zone(iz))),iz=1,i%nzone),it=1,i%niso )],[i%nzone,i%niso ]) 824 DO it=1,ntiso 825 WRITE(lunout,'(a,i0,a)')TRIM('infotrac_init')//': iqiso (',it,',:) = '//strStack(int2str(iqiso(it,:))) 826 WRITE(lunout,'(a,i0,a)')TRIM('infotrac_init')//': iTraPha(',it,',:) = '//strStack(int2str(i%iTraPha(it,:))) 827 END DO 828 DO iz=1,nzone 829 WRITE(lunout,'(a,i0,a)')TRIM('infotrac_init')//': index_trac(',iz,',:) = '//strStack(int2str(index_trac(iz,:))) 830 WRITE(lunout,'(a,i0,a)')TRIM('infotrac_init')//': iZonIso (',iz,',:) = '//strStack(int2str(i%iZonIso(iz,:))) 831 END DO 832 833 ! Finalize : 834 DEALLOCATE(nb_iso) 835 836 END SUBROUTINE infotrac_isoinit 837 838 839 !============================================================================================================================== 840 !=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED 841 ! Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call). 842 !============================================================================================================================== 843 LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr) 844 IMPLICIT NONE 845 CHARACTER(LEN=*), INTENT(IN) :: iName 846 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose 847 INTEGER :: iIso 848 LOGICAL :: lV 849 lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose 850 iIso = strIdx(isotopes(:)%parent, iName) 851 lerr = iIso == 0 852 CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lerr .AND. lV) 853 IF(lerr) RETURN 854 lerr = isoSelectByIndex(iIso, lV) 855 END FUNCTION isoSelectByName 856 !============================================================================================================================== 857 LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr) 858 IMPLICIT NONE 859 INTEGER, INTENT(IN) :: iIso 860 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose 861 LOGICAL :: lv 862 lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose 863 lerr = .FALSE. 864 IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK 865 lerr = iIso<=0 .OR. iIso>nbIso 866 CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '//TRIM(int2str(nbIso))//'"',& 867 ll=lerr .AND. lV) 868 IF(lerr) RETURN 869 ixIso = iIso !--- Update currently selected family index 870 isotope => isotopes(ixIso) !--- Select corresponding component 871 isoKeys => isotope%keys; niso = isotope%niso 872 isoName => isotope%trac; ntiso = isotope%ntiso 873 isoZone => isotope%zone; nzone = isotope%nzone 874 isoPhas => isotope%phase; nphas = isotope%nphas 875 iZonIso => isotope%iZonIso; isoCheck = isotope%check 876 iTraPha => isotope%iTraPha 877 END FUNCTION isoSelectByIndex 878 !============================================================================================================================== 759 879 760 880 END MODULE infotrac -
LMDZ6/trunk/libf/dyn3dmem/dynetat0_loc.F90
r4052 r4063 7 7 !------------------------------------------------------------------------------- 8 8 USE parallel_lmdz 9 USE infotrac, ONLY: nqtot, tracers, iqiso, iso_indnum, tnat, alpha_ideal, ok_isotopes, maxlen 9 USE strings_mod, ONLY: maxlen 10 USE infotrac, ONLY: nqtot, tracers, iqiso, iso_indnum, tnat, alpha_ideal, ok_isotopes 10 11 USE netcdf, ONLY: NF90_OPEN, NF90_INQUIRE_DIMENSION, NF90_INQ_VARID, & 11 12 NF90_NOWRITE, NF90_CLOSE, NF90_INQUIRE_VARIABLE, NF90_GET_VAR, NF90_NoErr -
LMDZ6/trunk/libf/dyn3dmem/dynredem_loc.F90
r4050 r4063 9 9 USE parallel_lmdz 10 10 USE mod_hallo 11 USE infotrac, ONLY: nqtot, tracers, maxlen 11 USE strings_mod, ONLY: maxlen 12 USE infotrac, ONLY: nqtot, tracers 12 13 USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL, & 13 14 NF90_CLOSE, NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER, & … … 174 175 USE parallel_lmdz 175 176 USE mod_hallo 176 USE infotrac, ONLY: nqtot, tracers, type_trac, maxlen 177 USE strings_mod, ONLY: maxlen 178 USE infotrac, ONLY: nqtot, tracers, type_trac 177 179 USE control_mod 178 180 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID, & -
LMDZ6/trunk/libf/misc/readTracFiles_mod.f90
r4046 r4063 1 1 MODULE readTracFiles_mod 2 2 3 USE strings_mod, ONLY:msg, testFile, strFind, strStack, strReduce, strHead, strCount, find, maxlen, fmsg, &4 removeComment, cat, checkList, strIdx, strParse, strReplace, strTail, reduceExpr, test, get_in, dispTable5 USE trac_types_mod, ONLY 3 USE strings_mod, ONLY: msg, testFile, strFind, strStack, strReduce, strHead, strCount, find, maxlen, fmsg, & 4 removeComment, cat, checkList, strIdx, strParse, strReplace, strTail, reduceExpr, test, get_in, dispTable 5 USE trac_types_mod, ONLY: trac_type, isot_type, keys_type 6 6 7 7 IMPLICIT NONE … … 9 9 PRIVATE 10 10 11 PUBLIC :: initIsotopes, maxlen, trac_type, isot_type 12 PUBLIC :: readTracersFiles, aliasTracer, tracersSubset, indexUpdate!--- TOOLS ASSOCIATED TO TRACERS DESCRIPTORS11 PUBLIC :: initIsotopes, maxlen, trac_type, isot_type, keys_type 12 PUBLIC :: readTracersFiles, indexUpdate, setGeneration !--- TOOLS ASSOCIATED TO TRACERS DESCRIPTORS 13 13 PUBLIC :: readIsotopesFile !--- TOOLS ASSOCIATED TO ISOTOPES DESCRIPTORS 14 14 PUBLIC :: getKey_init, getKey, setDirectKeys !--- GET/SET KEYS FROM/TO tracers & isotopes … … 45 45 CHARACTER(LEN=maxlen), SAVE :: phases_names(nphases) & !--- Known phases names 46 46 = ['gaseous', 'liquid ', 'solid '] 47 CHARACTER(LEN=1), SAVE :: phases_sep = '_'!--- Phase separator48 LOGICAL, SAVE :: tracs_merge = .TRUE.!--- Merge/stack tracers lists49 LOGICAL, SAVE :: lSortByGen = .TRUE.!--- Sort by growing generation47 CHARACTER(LEN=1), SAVE :: phases_sep = '_' !--- Phase separator 48 LOGICAL, SAVE :: tracs_merge = .TRUE. !--- Merge/stack tracers lists 49 LOGICAL, SAVE :: lSortByGen = .TRUE. !--- Sort by growing generation 50 50 51 51 !=== LOCAL COPIES OF THE TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey (INITIALIZED IN getKey_init) … … 76 76 ! * The "keys" component (of type keys_type) is in principle enough to store everything we could need. 77 77 ! But some variables are stored as direct-access keys to make the code more readable and because they are used often. 78 ! * Most of the direct-access keys are set in this module, but some are not (l nam, iadv and itr for example).78 ! * Most of the direct-access keys are set in this module, but some are not (longName, iadv, isAdvected for now). 79 79 ! * Some of the direct-access keys must be updated (using the routine "setDirectKeys") is a subset of "tracers(:)" 80 ! is extracted: the indexes are no longer valid for a subset (examples: tracers(:)%iqParent or tracers(:)%ichld).80 ! is extracted: the indexes are no longer valid for a subset (examples: iqParent, iqDescen). 81 81 ! * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys". 82 82 !============================================================================================================================== … … 87 87 TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tracs(:) 88 88 CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), sections(:), trac_files(:) 89 CHARACTER(LEN=maxlen) :: str, fname, mesg 90 INTEGER :: is, nsec, ierr, it, ntrac, ns, ip 89 CHARACTER(LEN=maxlen) :: str, fname, mesg, oldH2O, newH2O 90 INTEGER :: is, nsec, ierr, it, ntrac, ns, ip, ix 91 91 LOGICAL, ALLOCATABLE :: ll(:), lGen3(:) 92 92 !------------------------------------------------------------------------------------------------------------------------------ … … 111 111 END IF 112 112 113 !--- CHECK WHETHER type_trac AND FILE TYPE ARE COMPATIBLE 114 IF(test(fmsg('No multiple sections for the old format "traceur.def"', ll = SIZE(sections)>1 .AND. fType==1), lerr)) RETURN 115 113 116 !--- TELLS WHAT WAS IS ABOUT TO BE USED 114 117 IF (fmsg('No adequate tracers description file(s) found ; default values will be used', modname, fType==0)) RETURN … … 118 121 119 122 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 120 IF(fType==1) THEN !=== OLD FORMAT "traceur.def" 121 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 122 !--- OPEN THE "traceur.def" FILE 123 OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', IOSTAT=ierr) 124 125 !--- GET THE TRACERS NUMBER 126 READ(90,'(i3)',IOSTAT=ierr)ntrac !--- Number of lines/tracers 127 IF(test(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, ierr /= 0), lerr)) RETURN 128 129 !--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>] 130 ALLOCATE(tracs(ntrac)) 131 DO it=1,ntrac !=== READ RAW DATA: loop on the line/tracer number 132 READ(90,'(a)',IOSTAT=ierr) str 133 IF(test(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, ierr>0), lerr)) RETURN 134 IF(test(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, ierr<0), lerr)) RETURN 135 ll = strParse(str, ' ', s, n=ns) 136 tracs(it)%keys%key = ['hadv', 'vadv'] 137 tracs(it)%keys%val = s(1:2) 138 CALL msg('This file is for air tracers only', modname, ns == 3 .AND. it == 1) 139 CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1) 140 tracs(it)%name = TRIM(s(3)) !--- Name of the tracer 141 tracs(it)%phase = known_phases(1:1) !--- Phase (default: "g" for gazeous) 123 SELECT CASE(fType) !--- Set %name, %genOName, %parent, %type, %phase, %component, %iGeneration, %keys 124 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 125 CASE(1) !=== OLD FORMAT "traceur.def" 126 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 127 !--- OPEN THE "traceur.def" FILE 128 OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', IOSTAT=ierr) 129 130 !--- GET THE TRACERS NUMBER 131 READ(90,'(i3)',IOSTAT=ierr)ntrac !--- Number of lines/tracers 132 IF(test(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, ierr /= 0), lerr)) RETURN 133 134 !--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>] 135 ALLOCATE(tracs(ntrac)) 136 DO it=1,ntrac !=== READ RAW DATA: loop on the line/tracer number 137 READ(90,'(a)',IOSTAT=ierr) str 138 IF(test(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, ierr>0), lerr)) RETURN 139 IF(test(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, ierr<0), lerr)) RETURN 140 ll = strParse(str, ' ', s, n=ns) 141 CALL msg('This file is for air tracers only', modname, ns == 3 .AND. it == 1) 142 CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1) 143 tracs(it)%name = TRIM(s(3)) !--- Set %name: name of the tracer 144 tracs(it)%parent = tran0 !--- Set %parent: transporting fluid 145 IF(ns == 4) tracs(it)%parent = s(4) !--- default: 'air' or defined in the file 146 tracs(it)%phase = known_phases(1:1) !--- Set %phase: tracer phase (default: "g"azeous) 147 tracs(it)%component = TRIM(type_trac) !--- Set %component: model component name 148 tracs(it)%keys%key = ['hadv', 'vadv'] !--- Set %keys%key 149 tracs(it)%keys%val = s(1:2) !--- Set %keys%val 150 END DO 151 CLOSE(90) 142 152 DO ip = 1, nphases !--- Deal with old water names 143 IF(s(3) /= 'H2O'//old_phases(ip:ip)) CYCLE 144 tracs(it)%phase = known_phases(ip:ip); tracs(it)%name = 'H2O'//phases_sep//TRIM(tracs(it)%phase) 153 oldH2O = 'H2O'//old_phases(ip:ip) 154 newH2O = 'H2O'//phases_sep//known_phases(ip:ip) 155 ix = strIdx(tracs(:)%name, oldH2O) 156 IF(ix == 0) CYCLE 157 tracs(ix)%name = newH2O !--- Set %name: name of the tracer 158 WHERE(tracs(:)%parent == oldH2O) tracs(:)%parent = newH2O !--- Set %parent: transporting fluid 159 tracs(ix)%phase = known_phases(ip:ip) !--- Set %phase: tracer phase 145 160 END DO 146 tracs(it)%parent = tran0 !--- Default transporting fluid: Air 147 IF(ns == 4) tracs(it)%parent = s(4) !--- Transporting fluid name 148 END DO 149 CLOSE(90) 150 151 lGen3 = tracs%iGeneration==3 152 CALL setGeneration(tracs) !--- Determine tracs(:)%iGeneration values 153 IF(test(checkTracers(tracs, fname,fname),lerr)) RETURN !--- Detect orphans and check phases 154 IF(test(checkUnique (tracs,lGen3,fname,fname),lerr)) RETURN !--- Detect repeated tracers 155 CALL sortTracers (tracs) !--- Sort the tracers 156 CALL setDirectKeys(tracs) !--- Set the directly accessible keys 157 tracs(:)%keys%name = tracs(:)%name !--- Copy tracers names in keys components 158 RETURN 159 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 161 CALL setGeneration(tracs) !--- Set %iGeneration and %gen0Name 162 WHERE(tracs%iGeneration == 3) tracs%type = 'tag' !--- Set %type: 'tracer' or 'tag' 163 IF(test(checkTracers(tracs, fname, fname), lerr)) RETURN !--- Detect orphans and check phases 164 IF(test(checkUnique (tracs, fname, fname), lerr)) RETURN !--- Detect repeated tracers 165 CALL sortTracers (tracs) !--- Sort the tracers 166 tracs(:)%keys%name = tracs(:)%name !--- Copy tracers names in keys components 167 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 168 CASE(2); IF(test(feedDBase(["tracer.def"],[type_trac]), lerr)) RETURN !=== SINGLE FILE, COMA-SEPARATED SECTIONS LIST 169 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 170 CASE(3); IF(test(feedDBase( trac_files , sections ), lerr)) RETURN !=== MULTIPLE FILES, ONE SECTION EACH FILE 171 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 172 END SELECT 173 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 174 175 IF(ANY([2,3] == fType) .AND. nsec > 1) THEN 176 IF(tracs_merge) THEN 177 CALL msg('The multiple required sections will be MERGED.', modname) 178 IF(test(mergeTracers(dBase, tracs), lerr)) RETURN 179 ELSE 180 CALL msg('The multiple required sections will be CUMULATED.', modname) 181 IF(test(cumulTracers(dBase, tracs), lerr)) RETURN 182 END IF 183 WHERE(tracs%gen0Name(1:3) == 'H2O') tracs%isH2Ofamily=.TRUE. !--- Set %isH2Ofamily: belongs to H2O family 184 CALL setDirectKeys(tracs) !--- Set %iqParent, %iqDescen, %nqDescen, %nqChilds 160 185 END IF 161 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++162 163 !=== USING NEW FORMAT TRACERS DESCRIPTION FILES WITH POSSIBLY SEVERAL SECTIONS164 CALL msg('The multiple required sections will be MERGED.', modname, nsec > 1 .AND. tracs_merge)165 CALL msg('The multiple required sections will be CUMULATED.', modname, nsec > 1 .AND. .NOT.tracs_merge)166 167 !=== FEED THE DATABASE WITH THE RAW CONTENT OF THE FILE168 SELECT CASE(fType)169 CASE(2); lerr = feedDBase(["tracer.def"],[type_trac]) !--- Single file, coma-separated sections list170 CASE(3); lerr = feedDBase(trac_files, sections ) !--- Multiple files, one section name each file171 END SELECT172 IF(lerr) RETURN173 IF( tracs_merge) lerr = mergeTracers(dBase, tracs) !--- MERGE THE COMPONENTS OF THE DATABASE174 IF(.NOT.tracs_merge) lerr = cumulTracers(dBase, tracs) !--- CUMULATE THE COMPONENTS OF THE DATABASE175 IF(lerr) RETURN176 CALL setDirectKeys(tracs) !--- Set the directly accessible keys177 186 178 187 END FUNCTION readTracersFiles … … 201 210 ll = strCount(snames, ',', ndb) !--- Number of sections for each file 202 211 ALLOCATE(ixf(SUM(ndb))) 203 DO i=1, SIZE(fnames) 212 DO i=1, SIZE(fnames) !--- Set %name, %keys 204 213 IF(test(readSections(fnames(i), snames(i), 'default'), lerr)) RETURN 205 214 ixf(1+SUM(ndb(1:i-1)):SUM(ndb(1:i))) = i !--- File index for each section of the expanded list … … 208 217 DO idb=1,SIZE(dBase) !--- LOOP ON THE LOADED SECTIONS 209 218 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 210 fnm = fnames(ixf(idb)); snm = dBase(idb)%name 211 IF(test(expandSection(dBase(idb)%trac, snm, fnm),lerr)) RETURN !--- EXPAND NAMES AND PARENTS LISTS 212 CALL setGeneration (dBase(idb)%trac) !--- DETERMINE GENERATION NUMBER 213 IF(test(checkTracers (dBase(idb)%trac, snm, fnm),lerr)) RETURN !--- CHECK ORPHANS AND PHASES 214 lTg = dBase(idb)%trac(:)%type == 'tag' !--- Flag for tagging tracers 215 IF(test(checkUnique (dBase(idb)%trac,lTg,snm,fnm),lerr)) RETURN !--- CHECK TRACERS UNIQUENESS 216 CALL expandPhases (dBase(idb)%trac) !--- EXPAND THE PHASES 219 fnm = fnames(ixf(idb)); snm = dBase(idb)%name !--- FILE AND SECTION NAMES 220 IF(test(expandSection(dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- EXPAND NAMES ; set %parent, %type, %component 221 CALL setGeneration (dBase(idb)%trac) !--- set %iGeneration, %genOName 222 IF(test(checkTracers (dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- CHECK ORPHANS AND PHASES 223 IF(test(checkUnique (dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- CHECK TRACERS UNIQUENESS 224 CALL expandPhases (dBase(idb)%trac) !--- EXPAND PHASES ; set %phase 217 225 CALL sortTracers (dBase(idb)%trac) !--- SORT TRACERS 218 226 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ … … 283 291 ll = strParse(str,' ', keys = s, vals = v, n = n) !--- Parse <key>=<val> pairs 284 292 tt = dBase(ndb)%trac(:) 285 tmp%name = s(1); tmp% component=secn; tmp%keys = keys_type(s(1), s(2:n), v(2:n))293 tmp%name = s(1); tmp%keys = keys_type(s(1), s(2:n), v(2:n)) !--- Set %name and %keys 286 294 dBase(ndb)%trac = [tt(:), tmp] 287 295 DEALLOCATE(tt) 288 ! dBase(ndb)%trac = [dBase(ndb)%trac(:), tra(name=s(1), comp=secn,keys=keys_type(s(1), s(2:n), v(2:n)))]296 ! dBase(ndb)%trac = [dBase(ndb)%trac(:), tra(name=s(1), keys=keys_type(s(1), s(2:n), v(2:n)))] 289 297 END IF 290 298 END DO … … 421 429 !------------------------------------------------------------------------------------------------------------------------------ 422 430 ! Purpose: Determine, for each tracer of "tr(:)": 423 ! * the generation number 424 ! * the first generation ancestor name 425 !------------------------------------------------------------------------------------------------------------------------------ 426 ! Arguments: 427 TYPE(trac_type), INTENT(INOUT) :: tr(:) !--- Tracer derived type vector 428 !------------------------------------------------------------------------------------------------------------------------------ 429 ! Local variables: 430 INTEGER :: iq, nq, ig 431 ! * %iGeneration: the generation number 432 ! * %gen0Name: the generation 0 ancestor name 433 !------------------------------------------------------------------------------------------------------------------------------ 434 TYPE(trac_type), INTENT(INOUT) :: tr(:) !--- Tracer derived type vector 435 INTEGER :: iq, nq, ig 431 436 LOGICAL, ALLOCATABLE :: lg(:) 432 437 CHARACTER(LEN=maxlen), ALLOCATABLE :: prn(:) 433 438 !------------------------------------------------------------------------------------------------------------------------------ 434 tr(:)%iGeneration = 0 !--- error if 0439 tr(:)%iGeneration = -1 !--- error if -1 435 440 nq = SIZE(tr, DIM=1) !--- Number of tracers lines 436 441 lg = tr(:)%parent == tran0 !--- First generation tracers flag 437 WHERE(lg) tr(:)%iGeneration = 1!--- First generation tracers442 WHERE(lg) tr(:)%iGeneration = 0 !--- First generation tracers 438 443 439 444 !=== Determine generation for each tracer 440 ig= 0; prn = [tran0]445 ig=-1; prn = [tran0] 441 446 DO !--- Update current generation flag 442 IF(ig/= 0) prn = PACK( tr(:)%name, MASK=tr(:)%iGeneration == ig)447 IF(ig/=-1) prn = PACK( tr(:)%name, MASK=tr(:)%iGeneration == ig) 443 448 lg(:) = [(ANY(prn(:) == tr(iq)%parent), iq=1, nq)] !--- Current generation tracers flag 444 449 IF( ALL( .NOT. lg ) ) EXIT !--- Empty current generation … … 470 475 471 476 !=== CHECK FOR ORPHAN TRACERS 472 IF(test(checkList(tr%name, tr%iGeneration== 0, mesg, 'tracers', 'orphan'), lerr)) RETURN477 IF(test(checkList(tr%name, tr%iGeneration==-1, mesg, 'tracers', 'orphan'), lerr)) RETURN 473 478 474 479 !=== CHECK PHASES 475 DO iq=1,nq; IF(tr(iq)%iGeneration/= 1) CYCLE !--- Generation 1only is checked480 DO iq=1,nq; IF(tr(iq)%iGeneration/=0) CYCLE !--- Generation O only is checked 476 481 pha = fgetKey(iq, 'phases', tr(:)%keys, 'g') !--- Phases 477 482 np = LEN_TRIM(pha); bp(iq)=' ' … … 479 484 IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tr(iq)%name)//': '//TRIM(bp(iq)) 480 485 END DO 481 lerr = checkList(bp, tr%iGeneration== 1.AND. bp/='', mesg, 'tracers phases', 'unknown')486 lerr = checkList(bp, tr%iGeneration==0 .AND. bp/='', mesg, 'tracers phases', 'unknown') 482 487 END FUNCTION checkTracers 483 488 !============================================================================================================================== 484 489 485 490 !============================================================================================================================== 486 LOGICAL FUNCTION checkUnique(tr, lTag,sname, fname) RESULT(lerr)491 LOGICAL FUNCTION checkUnique(tr, sname, fname) RESULT(lerr) 487 492 !------------------------------------------------------------------------------------------------------------------------------ 488 493 ! Purpose: Make sure that tracers are not repeated. 489 494 !------------------------------------------------------------------------------------------------------------------------------ 490 495 TYPE(trac_type), INTENT(IN) :: tr(:) !--- Tracer derived type vector 491 LOGICAL, INTENT(IN) :: lTag(:) !--- Tagging tracer flag492 496 CHARACTER(LEN=*), INTENT(IN) :: sname !--- Section name 493 497 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname !--- File name … … 502 506 nq=SIZE(tr,DIM=1); lerr=.FALSE. !--- Number of lines ; error flag 503 507 tdup(:) = '' 504 DO iq=1,nq; IF( lTag(iq)) CYCLE!--- Tags can be repeated508 DO iq=1,nq; IF(tr(iq)%type == 'tag') CYCLE !--- Tags can be repeated 505 509 tnam = TRIM(tr(iq)%name) 506 510 ll = tr(:)%name==TRIM(tnam) !--- Mask for current tracer name … … 585 589 !------------------------------------------------------------------------------------------------------------------------------ 586 590 ! Purpose: Sort tracers: 591 ! * Put water at first places, in the "known_phases" order. 587 592 ! * lGrowGen == T: in ascending generations numbers. 588 593 ! * lGrowGen == F: tracer + its childs sorted by growing generation, one after the other. 594 ! TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END 589 595 !------------------------------------------------------------------------------------------------------------------------------ 590 596 TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:) !--- Tracer derived type vector 591 INTEGER :: ig, ng, iq, jq, n, ix(SIZE(tr)), k597 INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k 592 598 INTEGER, ALLOCATABLE :: iy(:), iz(:) 593 599 !------------------------------------------------------------------------------------------------------------------------------ 600 nq = SIZE(tr) 601 iy = [(k, k=1, nq)] 602 DO ip = nphases, 1, -1 603 iq = strIdx(tracers(:)%name, 'H2O'//phases_sep//known_phases(ip:ip)) 604 IF(iq/=0) iy = [iq, iy(1:iq-1), iy(iq:nq)] 605 END DO 606 tr = tr(iy) !--- Water displaces at first positions 594 607 iq = 1 595 608 IF(lSortByGen) THEN 596 609 ng = MAXVAL(tr(:)%iGeneration, MASK=.TRUE., DIM=1) !--- Number of generations 597 610 DO ig = 0, ng !--- Loop on generations 598 iy = PACK([(k, k=1, SIZE(tr))], MASK=tr(:)%iGeneration==ig)!--- Generation ig tracers indexes611 iy = PACK([(k, k=1, nq)], MASK=tr(:)%iGeneration==ig) !--- Generation ig tracers indexes 599 612 n = SIZE(iy) 600 613 ix(iq:iq+n-1) = iy !--- Stack growing generations idxs … … 602 615 END DO 603 616 ELSE 604 DO jq = 1, SIZE(tr,DIM=1)!--- Loop on first generation tracers617 DO jq = 1, nq !--- Loop on first generation tracers 605 618 IF(tr(jq)%iGeneration /= 1) CYCLE !--- Skip generations >= 1 606 619 ix(iq) = jq !--- First generation ancestor index first … … 727 740 SUBROUTINE setDirectKeys(tr) 728 741 TYPE(trac_type), INTENT(INOUT) :: tr(:) 729 CALL indexUpdate(tr) !--- Update iqParent and iqDescen indexes vectors 742 743 !--- Update %iqParent, %iqDescen, %nqDescen, %nqChilds 744 CALL indexUpdate(tr) 745 746 !--- Extract some direct-access keys 730 747 ! DO iq = 1, SIZE(tr) 731 ! tr(iq)%keys%<key> = getKey_prv(it, "<key>", tr%keys, tran0 ) !--- For additional keys748 ! tr(iq)%keys%<key> = getKey_prv(it, "<key>", tr%keys, <default_value> ) 732 749 ! END DO 733 750 END SUBROUTINE setDirectKeys … … 829 846 !=== NOTES: ==== 830 847 !=== * Most of the "isot" components have been defined in the calling routine (initIsotopes): ==== 831 !=== p rnt, nzon, zone(:), niso, keys(:)%name, nitr, trac(:), npha, phas, iTraPha(:,:), iZonPhi(:,:)====848 !=== parent, nzone, zone(:), niso, keys(:)%name, ntiso, trac(:), nphas, phas, iTraPha(:,:), iZonPhi(:,:) ==== 832 849 !=== * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes ==== 833 850 !=== * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values ==== … … 939 956 s%zone = PACK(strTail(t(:)%name,'_',lFirst=.TRUE.), MASK = ll) !--- Tagging zones names for isotopes category "iname" 940 957 CALL strReduce(s%zone) 941 s%nzon = SIZE(s%zone)!--- Tagging zones number for isotopes category "iname"958 s%nzone = SIZE(s%zone) !--- Tagging zones number for isotopes category "iname" 942 959 943 960 !=== Geographic tracers of the isotopes childs of tracer "iname" (same for each phase of "iname") … … 945 962 str = PACK(delPhase(t(:)%name), MASK=ll) 946 963 CALL strReduce(str) 947 s%n itr = s%niso + SIZE(str)!--- Number of isotopes + their geographic tracers [ntraciso]948 ALLOCATE(s%trac(s%n itr))964 s%ntiso = s%niso + SIZE(str) !--- Number of isotopes + their geographic tracers [ntraciso] 965 ALLOCATE(s%trac(s%ntiso)) 949 966 FORALL(it = 1:s%niso) s%trac(it) = s%keys(it)%name 950 FORALL(it = s%niso+1:s%n itr) s%trac(it) = str(it-s%niso)967 FORALL(it = s%niso+1:s%ntiso) s%trac(it) = str(it-s%niso) 951 968 952 969 !=== Phases for tracer "iname" 953 970 s%phase = '' 954 971 DO ip = 1, nphases; ph = known_phases(ip:ip); IF(strIdx(t%name,addPhase(iname, ph)) /= 0) s%phase = TRIM(s%phase)//ph; END DO 955 s%npha = LEN_TRIM(s%phase)!--- Equal to "nqo" for water972 s%nphas = LEN_TRIM(s%phase) !--- Equal to "nqo" for water 956 973 957 974 !=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot) … … 968 985 !=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list 969 986 ! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN 970 s%iTraPha = RESHAPE( [( (strIdx(t(:)%name, addPhase(s%trac(it),s%phase(ip:ip))), it=1, s%n itr), ip=1, s%npha)], &971 [s%n itr, s%npha] )972 973 !=== Table used to get ix (index in tagging tracers isotopes list, size n itr) from the zone and isotope indexes974 s%iZonIso = RESHAPE( [( (strIdx(s%trac(:), TRIM(s%trac(it))//'_'//TRIM(s%zone(iz))), iz=1, s%nzon ), it=1, s%niso)], &975 [s%nzon , s%niso] )987 s%iTraPha = RESHAPE( [( (strIdx(t(:)%name, addPhase(s%trac(it),s%phase(ip:ip))), it=1, s%ntiso), ip=1, s%nphas)], & 988 [s%ntiso, s%nphas] ) 989 990 !=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes 991 s%iZonIso = RESHAPE( [( (strIdx(s%trac(:), TRIM(s%trac(it))//'_'//TRIM(s%zone(iz))), iz=1, s%nzone), it=1, s%niso )], & 992 [s%nzone, s%niso] ) 976 993 END DO 977 994 … … 1240 1257 out = s 1241 1258 IF(s == '') RETURN !--- Empty string: nothing to do 1259 1260 !--- Special case: old phases for water, no phases separator 1261 IF(ANY([('H2O'//old_phases(ix:ix), ix=1, nphases)] == s)) THEN; out='H2O'; RETURN; END IF 1262 1242 1263 !--- Index of found phase in "known_phases" 1243 1264 ix = MAXLOC( [(i, i=1,nphases)], MASK=[( INDEX(s, phases_sep//known_phases(i:i))/=0, i=1, nphases)], DIM=1 ) … … 1252 1273 END FUNCTION delPhase 1253 1274 !------------------------------------------------------------------------------------------------------------------------------ 1254 CHARACTER(LEN=maxlen) FUNCTION addPhase_1(s,pha) RESULT(out) 1255 CHARACTER(LEN=*), INTENT(IN) :: s 1256 CHARACTER(LEN=1), INTENT(IN) :: pha 1275 CHARACTER(LEN=maxlen) FUNCTION addPhase_1(s,pha,ph_sep) RESULT(out) 1276 CHARACTER(LEN=*), INTENT(IN) :: s 1277 CHARACTER(LEN=1), INTENT(IN) :: pha 1278 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: ph_sep 1279 CHARACTER(LEN=1) :: psep 1257 1280 INTEGER :: l, i 1258 1281 out = s 1259 1282 IF(s == '') RETURN !--- Empty string: nothing to do 1283 psep = phases_sep; IF(PRESENT(ph_sep)) psep = ph_sep 1260 1284 i = INDEX(s, '_') !--- /=0 for <var>_<tag> tracers names 1261 1285 l = LEN_TRIM(s) 1262 IF(i == 0) out = TRIM(s)// phases_sep//pha !--- <var> => return <var><sep><pha>1263 IF(i /= 0) out = s(1:i-1)// phases_sep//pha//'_'//s(i+1:l) !--- <var>_<tag> => return <var><sep><pha>_<tag>1286 IF(i == 0) out = TRIM(s)//TRIM(psep)//pha !--- <var> => return <var><sep><pha> 1287 IF(i /= 0) out = s(1:i-1)//TRIM(psep)//pha//'_'//s(i+1:l) !--- <var>_<tag> => return <var><sep><pha>_<tag> 1264 1288 END FUNCTION addPhase_1 1265 1289 !------------------------------------------------------------------------------------------------------------------------------ 1266 FUNCTION addPhase_m(s,pha) RESULT(out) 1267 CHARACTER(LEN=*), INTENT(IN) :: s(:) 1268 CHARACTER(LEN=1), INTENT(IN) :: pha 1269 CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:) 1290 FUNCTION addPhase_m(s,pha,ph_sep) RESULT(out) 1291 CHARACTER(LEN=*), INTENT(IN) :: s(:) 1292 CHARACTER(LEN=1), INTENT(IN) :: pha 1293 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: ph_sep 1294 CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:) 1295 CHARACTER(LEN=1) :: psep 1270 1296 INTEGER :: k 1271 out = [( addPhase_1(s(k), pha), k=1, SIZE(s) )] 1297 psep = phases_sep; IF(PRESENT(ph_sep)) psep = ph_sep 1298 out = [( addPhase_1(s(k), pha, psep), k=1, SIZE(s) )] 1272 1299 END FUNCTION addPhase_m 1273 1300 !------------------------------------------------------------------------------------------------------------------------------ … … 1282 1309 INTEGER, OPTIONAL, INTENT(IN) :: igen 1283 1310 INTEGER :: ig, ix 1284 ig = 1; IF(PRESENT(igen)) ig = igen1311 ig = 0; IF(PRESENT(igen)) ig = igen 1285 1312 ix = idxAncestor_1(t, tname, ig) 1286 1313 out = ''; IF(ix /= 0) out = t(ix)%name … … 1294 1321 INTEGER, ALLOCATABLE :: ix(:) 1295 1322 INTEGER :: ig 1296 ig = 1; IF(PRESENT(igen)) ig = igen1323 ig = 0; IF(PRESENT(igen)) ig = igen 1297 1324 IF( PRESENT(tname)) ix = idxAncestor_m(t, tname, ig) 1298 1325 IF(.NOT.PRESENT(tname)) ix = idxAncestor_m(t, t(:)%name, ig) … … 1307 1334 !============================================================================================================================== 1308 1335 INTEGER FUNCTION idxAncestor_1(t, tname, igen) RESULT(out) 1309 ! Return the name of the generation "igen" ancestor of "tname"1336 ! Return the name of the generation "igen" (>=0) ancestor of "tname" 1310 1337 TYPE(trac_type), INTENT(IN) :: t(:) 1311 1338 CHARACTER(LEN=*), INTENT(IN) :: tname 1312 1339 INTEGER, OPTIONAL, INTENT(IN) :: igen 1313 1340 INTEGER :: ig 1314 ig = 1; IF(PRESENT(igen)) ig = igen1341 ig = 0; IF(PRESENT(igen)) ig = igen 1315 1342 out = strIdx(t(:)%name, tname) 1316 IF(out == 0) RETURN1317 IF(t(out)%iGeneration <= ig) RETURN 1343 IF(out == 0) RETURN !--- Tracer not found 1344 IF(t(out)%iGeneration <= ig) RETURN !--- Tracer has a lower generation number than asked generation 'igen" 1318 1345 DO WHILE(t(out)%iGeneration > ig); out = strIdx(t(:)%name, t(out)%parent); END DO 1319 1346 END FUNCTION idxAncestor_1 … … 1325 1352 INTEGER, OPTIONAL, INTENT(IN) :: igen 1326 1353 INTEGER :: ig, ix 1327 ig = 1; IF(PRESENT(igen)) ig = igen1354 ig = 0; IF(PRESENT(igen)) ig = igen 1328 1355 IF( PRESENT(tname)) out = [(idxAncestor_1(t, tname(ix), ig), ix=1, SIZE(tname))] 1329 1356 IF(.NOT.PRESENT(tname)) out = [(idxAncestor_1(t, t(ix)%name, ig), ix=1, SIZE(t))] -
LMDZ6/trunk/libf/misc/strings_mod.F90
r4047 r4063 106 106 INTEGER, OPTIONAL, INTENT(IN) :: unit 107 107 INTEGER :: unt 108 IF(PRESENT(ll)) THEN; IF( ll) RETURN; END IF108 IF(PRESENT(ll)) THEN; IF(.NOT.ll) RETURN; END IF 109 109 unt = lunout; IF(PRESENT(unit)) unt = unit 110 110 IF(PRESENT(modname)) THEN … … 124 124 CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:) 125 125 INTEGER :: unt, nmx, k 126 LOGICAL :: l err127 l err = .TRUE.; IF(PRESENT(ll)) lerr= ll128 unt = lunout 129 nmx = 128; 126 LOGICAL :: l 127 l = .TRUE.; IF(PRESENT(ll)) l = ll 128 unt = lunout; IF(PRESENT(unit)) unt = unit 129 nmx = 128; IF(PRESENT(nmax)) nmx = nmax 130 130 s = strStackm(str, ', ', nmx) 131 131 IF(PRESENT(modname)) THEN 132 DO k=1,SIZE(s); CALL msg_1(s(k), modname, l err, unt); END DO132 DO k=1,SIZE(s); CALL msg_1(s(k), modname, l, unt); END DO 133 133 ELSE 134 DO k=1,SIZE(s); CALL msg_1(s(k), ll=l err, unit=unt); END DO134 DO k=1,SIZE(s); CALL msg_1(s(k), ll=l, unit=unt); END DO 135 135 END IF 136 136 END SUBROUTINE msg_m 137 137 !============================================================================================================================== 138 LOGICAL FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l err)138 LOGICAL FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l) 139 139 CHARACTER(LEN=*), INTENT(IN) :: str 140 140 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname … … 142 142 INTEGER, OPTIONAL, INTENT(IN) :: unit 143 143 INTEGER :: unt 144 l err = .TRUE.; IF(PRESENT(ll)) lerr= ll145 unt = lunout 144 l = .TRUE.; IF(PRESENT(ll)) l = ll 145 unt = lunout; IF(PRESENT(unit)) unt = unit 146 146 IF(PRESENT(modname)) THEN 147 CALL msg_1(str, modname, l err, unt)147 CALL msg_1(str, modname, l, unt) 148 148 ELSE 149 CALL msg_1(str, ll=l err, unit=unt)149 CALL msg_1(str, ll=l, unit=unt) 150 150 END IF 151 151 END FUNCTION fmsg_1 152 152 !============================================================================================================================== 153 LOGICAL FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l err)153 LOGICAL FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l) 154 154 CHARACTER(LEN=*), INTENT(IN) :: str(:) 155 155 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname … … 158 158 INTEGER, OPTIONAL, INTENT(IN) :: nmax 159 159 INTEGER :: unt, nmx 160 l err = .TRUE.; IF(PRESENT(ll)) lerr= ll161 unt = lunout 162 nmx = 128; 160 l = .TRUE.; IF(PRESENT(ll)) l = ll 161 unt = lunout; IF(PRESENT(unit)) unt = unit 162 nmx = 128; IF(PRESENT(nmax)) nmx = nmax 163 163 IF(PRESENT(modname)) THEN 164 CALL msg_m(str, modname, l err, unt, nmx)164 CALL msg_m(str, modname, l, unt, nmx) 165 165 ELSE 166 CALL msg_m(str, ll=l err, unit=unt, nmax=nmx)166 CALL msg_m(str, ll=l, unit=unt, nmax=nmx) 167 167 END IF 168 168 END FUNCTION fmsg_m … … 267 267 !=== Concatenates the strings "str(:)" with separator "sep" into a single string using a separator (',' by default). ========== 268 268 !============================================================================================================================== 269 FUNCTION strStack(str, sep ) RESULT(out)269 FUNCTION strStack(str, sep, mask) RESULT(out) 270 270 CHARACTER(LEN=:), ALLOCATABLE :: out 271 271 CHARACTER(LEN=*), INTENT(IN) :: str(:) 272 272 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep 273 LOGICAL, OPTIONAL, INTENT(IN) :: mask(:) 273 274 CHARACTER(LEN=:), ALLOCATABLE :: s 274 INTEGER :: is 275 INTEGER :: is, i0 275 276 IF(SIZE(str) == 0) THEN; out = ''; RETURN; END IF 276 277 ALLOCATE(s, SOURCE=', '); IF(PRESENT(sep)) s=sep 277 out = str(1); DO is=2,SIZE(str, DIM=1); out = TRIM(out)//s//TRIM(str(is)); END DO 278 IF(PRESENT(mask)) THEN 279 IF(ALL(.NOT.mask)) THEN; out = ''; RETURN; END IF 280 i0 = 0; DO WHILE(.NOT.mask(i0+1)); i0 = i0+1; END DO 281 out = str(i0); DO is=i0+1,SIZE(str, DIM=1); IF(.NOT.mask(is)) CYCLE; out = TRIM(out)//s//TRIM(str(is)); END DO 282 ELSE 283 out = str(1); DO is=2,SIZE(str, DIM=1); out = TRIM(out)//s//TRIM(str(is)); END DO 284 END IF 278 285 END FUNCTION strStack 279 286 !============================================================================================================================== -
LMDZ6/trunk/libf/misc/trac_types_mod.F90
r4046 r4063 22 22 CHARACTER(LEN=maxlen) :: component !--- Coma-separated list of components (Ex: lmdz,inca) 23 23 INTEGER :: iadv = 10 !--- Advection scheme used 24 INTEGER :: iGeneration = 1 !--- Generation number (>=1)24 INTEGER :: iGeneration = -1 !--- Generation number (>=0) 25 25 LOGICAL :: isAdvected = .FALSE. !--- "true" tracers: iadv > 0 . COUNT( isAdvected) =nqtrue 26 26 LOGICAL :: isH2Ofamily = .FALSE. !--- H2O tracers/isotopes/tags. COUNT(.NOT.isH2Ofamily)=nqtottr … … 40 40 LOGICAL :: check=.FALSE. !--- Triggering of the checking routines 41 41 TYPE(keys_type), ALLOCATABLE :: keys(:) !--- Isotopes keys/values pairs list (length: niso) 42 CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:) !--- Isotopes + tagging tracers list (length: n itr)43 CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:) !--- Geographic tagging zones names list (length: nzon )44 CHARACTER(LEN=maxlen) :: phase = 'g' !--- Phases list: [g][l][s] (length: npha )45 INTEGER :: niso = 0!--- Number of isotopes, excluding tagging tracers46 INTEGER :: nzon = 0!--- Number of geographic tagging zones47 INTEGER :: n itr = 0!--- Number of isotopes, including tagging tracers48 INTEGER :: npha = 0!--- Number phases49 INTEGER, ALLOCATABLE :: iTraPha(:,:) !--- Idx in "trac(1:niso)" = f(name(1:n itr)),phas)42 CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:) !--- Isotopes + tagging tracers list (length: ntiso) 43 CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:) !--- Geographic tagging zones names list (length: nzone) 44 CHARACTER(LEN=maxlen) :: phase = 'g' !--- Phases list: [g][l][s] (length: nphas) 45 INTEGER :: niso = 0 !--- Number of isotopes, excluding tagging tracers 46 INTEGER :: nzone = 0 !--- Number of geographic tagging zones 47 INTEGER :: ntiso = 0 !--- Number of isotopes, including tagging tracers 48 INTEGER :: nphas = 0 !--- Number phases 49 INTEGER, ALLOCATABLE :: iTraPha(:,:) !--- Idx in "trac(1:niso)" = f(name(1:ntiso)),phas) 50 50 !--- "iTraPha" former name: "iqiso" 51 INTEGER, ALLOCATABLE :: iZonIso(:,:) !--- Idx in "trac(1:n itr)" = f(zone, name(1:niso))51 INTEGER, ALLOCATABLE :: iZonIso(:,:) !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso)) 52 52 !--- "iZonIso" former name: "index_trac" 53 53 END TYPE isot_type
Note: See TracChangeset
for help on using the changeset viewer.
