Changeset 4063 for LMDZ6/trunk/libf/dyn3d_common
- Timestamp:
- Jan 25, 2022, 1:01:52 AM (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.