Changeset 4368 for LMDZ6/branches/Ocean_skin/libf/phylmd/infotrac_phy.F90
- Timestamp:
- Dec 6, 2022, 12:01:16 AM (22 months ago)
- Location:
- LMDZ6/branches/Ocean_skin
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/infotrac_phy.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Ocean_skin
- Property svn:mergeinfo changed
-
LMDZ6/branches/Ocean_skin/libf/phylmd/infotrac_phy.F90
r4013 r4368 1 2 ! $Id: $ 3 1 !$Id: infotrac.F90 4301 2022-10-20 11:57:21Z dcugnet $ 2 ! 4 3 MODULE infotrac_phy 5 4 6 ! Infotrac for physics; for now contains the same information as infotrac for 7 ! the dynamics (could be further cleaned) and is initialized using values 8 ! provided by the dynamics 9 10 ! nqtot : total number of tracers and higher order of moment, water vapor and liquid included 11 INTEGER, SAVE :: nqtot 12 !$OMP THREADPRIVATE(nqtot) 13 14 !CR: on ajoute le nombre de traceurs de l eau 15 INTEGER, SAVE :: nqo 16 !$OMP THREADPRIVATE(nqo) 17 18 ! nbtr : number of tracers not including higher order of moment or water vapor or liquid 19 ! number of tracers used in the physics 20 INTEGER, SAVE :: nbtr 21 !$OMP THREADPRIVATE(nbtr) 22 23 INTEGER, SAVE :: nqtottr 24 !$OMP THREADPRIVATE(nqtottr) 25 26 ! ThL : number of CO2 tracers ModThL 27 INTEGER, SAVE :: nqCO2 28 !$OMP THREADPRIVATE(nqCO2) 29 5 USE strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx 6 USE readTracFiles_mod, ONLY: trac_type, nphas, readTracersFiles, tracers, setGeneration, itZonIso, nbIso, tran0, delPhase, & 7 getKey, isot_type, nzone, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, ntiso, ixIso, addPhase, & 8 indexUpdate, isoSelect, niso, testTracersFiles, isoPhas, isoZone, isoName, isoKeys, iH2O, isoCheck 9 IMPLICIT NONE 10 11 PRIVATE 12 13 !=== FOR TRACERS: 14 PUBLIC :: init_infotrac_phy !--- Initialization of the tracers 15 PUBLIC :: tracers, type_trac, types_trac !--- Full tracers database, tracers type keyword 16 PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr !--- Main dimensions 17 PUBLIC :: conv_flg, pbl_flg !--- Convection & boundary layer activation keys 30 18 #ifdef CPP_StratAer 31 ! nbtr_bin: number of aerosol bins for StratAer model 32 ! nbtr_sulgas: number of sulfur gases for StratAer model 33 INTEGER, SAVE :: nbtr_bin, nbtr_sulgas 34 !$OMP THREADPRIVATE(nbtr_bin,nbtr_sulgas) 35 INTEGER, SAVE :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat 36 !$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat) 37 #endif 38 39 ! CRisi: nb traceurs pères= directement advectés par l'air 40 INTEGER, SAVE :: nqperes 41 !$OMP THREADPRIVATE(nqperes) 42 43 ! Name variables 44 INTEGER,PARAMETER :: tname_lenmax=128 45 CHARACTER(len=tname_lenmax), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics 46 CHARACTER(len=tname_lenmax+3), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics 47 !$OMP THREADPRIVATE(tname,ttext) 48 49 !! iadv : index of trasport schema for each tracer 50 ! INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iadv 51 52 ! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the 53 ! dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code. 54 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: niadv ! equivalent dyn / physique 55 !$OMP THREADPRIVATE(niadv) 56 57 ! CRisi: tableaux de fils 58 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nqfils 59 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les générations 60 INTEGER, SAVE :: nqdesc_tot 61 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqfils 62 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iqpere 63 !$OMP THREADPRIVATE(nqfils,nqdesc,nqdesc_tot,iqfils,iqpere) 64 65 ! conv_flg(it)=0 : convection desactivated for tracer number it 66 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: conv_flg 67 !$OMP THREADPRIVATE(conv_flg) 68 69 ! pbl_flg(it)=0 : boundary layer diffusion desactivaded for tracer number it 70 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: pbl_flg 71 !$OMP THREADPRIVATE(pbl_flg) 72 73 CHARACTER(len=4),SAVE :: type_trac 74 !$OMP THREADPRIVATE(type_trac) 75 CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym 76 !$OMP THREADPRIVATE(solsym) 77 78 ! CRisi: cas particulier des isotopes 79 LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso 80 !$OMP THREADPRIVATE(ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso) 81 INTEGER :: niso_possibles 82 PARAMETER ( niso_possibles=5) 83 real, DIMENSION (niso_possibles),SAVE :: tnat,alpha_ideal 84 !$OMP THREADPRIVATE(tnat,alpha_ideal) 85 LOGICAL, DIMENSION(niso_possibles),SAVE :: use_iso 86 !$OMP THREADPRIVATE(use_iso) 87 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqiso ! donne indice iq en fn de (ixt,phase) 88 !$OMP THREADPRIVATE(iqiso) 89 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot 90 !$OMP THREADPRIVATE(iso_num) 91 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot 92 !$OMP THREADPRIVATE(iso_indnum) 93 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: zone_num ! donne numéro de la zone de tracage en fn de nqtot 94 !$OMP THREADPRIVATE(zone_num) 95 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: phase_num ! donne numéro de la zone de tracage en fn de nqtot 96 !$OMP THREADPRIVATE(phase_num) 97 INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numéro d isotope entre 1 et niso_possibles 98 !$OMP THREADPRIVATE(indnum_fn_num) 99 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: index_trac ! numéro ixt en fn izone, indnum entre 1 et niso 100 !$OMP THREADPRIVATE(index_trac) 101 INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso 102 !$OMP THREADPRIVATE(niso,ntraceurs_zone,ntraciso) 103 104 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: itr_indice ! numéro iq entre 1 et nqtot qui correspond au traceur itr entre 1 et nqtottr 105 !$OMP THREADPRIVATE(itr_indice) 106 19 PUBLIC :: nbtr_bin, nbtr_sulgas !--- Number of aerosols bins and sulfur gases for StratAer model 20 PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat 21 #endif 22 23 !=== FOR ISOTOPES: General 24 PUBLIC :: isot_type, nbIso !--- Derived type, full isotopes families database + nb of families 25 PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index 26 !=== FOR ISOTOPES: Specific to water 27 PUBLIC :: iH2O !--- H2O isotopes index 28 !=== FOR ISOTOPES: Depending on the selected isotopes family 29 PUBLIC :: isotope, isoKeys !--- Selected isotopes database + associated keys (cf. getKey) 30 PUBLIC :: isoName, isoZone, isoPhas !--- Isotopes and tagging zones names, phases 31 PUBLIC :: niso, nzone, nphas, ntiso !--- " " numbers + isotopes & tagging tracers number 32 PUBLIC :: itZonIso !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx) 33 PUBLIC :: iqIsoPha !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases 34 PUBLIC :: isoCheck !--- Run isotopes checking routines 35 !=== FOR BOTH TRACERS AND ISOTOPES 36 PUBLIC :: getKey !--- Get a key from "tracers" or "isotope" 37 38 !=== CONVENTIONS FOR TRACERS NUMBERS: 39 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 40 ! | water in different | water tagging | water isotopes | other tracers | additional tracers moments | 41 ! | phases: H2O_[gls] | isotopes | | | for higher order schemes | 42 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 43 ! | | | | | | 44 ! |<-- nqo -->|<-- nqo*niso* nzone -->|<-- nqo*niso -->|<-- nbtr -->|<-- (nmom) -->| 45 ! | | | | 46 ! | |<-- nqo*niso*(nzone+1) = nqo*ntiso -->|<-- nqtottr = nbtr + nmom -->| 47 ! | = nqtot - nqo*(ntiso+1) | 48 ! | | 49 ! |<-- nqtrue = nbtr + nqo*(ntiso+1) -->| | 50 ! | | 51 ! |<-- nqtot = nqtrue + nmom -->| 52 ! | | 53 ! |-----------------------------------------------------------------------------------------------------------| 54 ! NOTES FOR THIS TABLE: 55 ! * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'), 56 ! since water is so far the sole tracers family, except passive CO2, removed from the main tracers table. 57 ! * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas". 58 ! * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any. 59 ! 60 !=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot) 61 ! Each entry is accessible using "%" sign. 62 ! |-------------+------------------------------------------------------+-------------+------------------------+ 63 ! | entry | Meaning | Former name | Possible values | 64 ! |-------------+------------------------------------------------------+-------------+------------------------+ 65 ! | name | Name (short) | tname | | 66 ! | gen0Name | Name of the 1st generation ancestor | / | | 67 ! | parent | Name of the parent | / | | 68 ! | longName | Long name (with adv. scheme suffix) for outputs | ttext | | 69 ! | type | Type (so far: tracer or tag) | / | tracer,tag | 70 ! | phase | Phases list ("g"as / "l"iquid / "s"olid) | / | [g][l][s] | 71 ! | component | Name(s) of the merged/cumulated section(s) | / | coma-separated names | 72 ! | iGeneration | Generation (>=1) | / | | 73 ! | isInPhysics | tracers not extracted from the main table in physics | / | nqtottr .TRUE. values | 74 ! | iqParent | Index of the parent tracer | iqpere | 1:nqtot | 75 ! | iqDescen | Indexes of the childs (all generations) | iqfils | 1:nqtot | 76 ! | nqDescen | Number of the descendants (all generations) | nqdesc | 1:nqtot | 77 ! | nqChildren | Number of childs (1st generation only) | nqfils | 1:nqtot | 78 ! | keys | key/val pairs accessible with "getKey" routine | / | | 79 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 80 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | 81 ! | iso_iZone | Isotope zone index in isotopes(iso_iGroup)%zone(:) | zone_num | 1:nzone | 82 ! | iso_iPhas | Isotope phase index in isotopes(iso_iGroup)%phas(:) | phase_num | 1:nphas | 83 ! +-------------+------------------------------------------------------+-------------+------------------------+ 84 ! 85 !=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES) 86 ! Each entry is accessible using "%" sign. 87 ! |-----------------+--------------------------------------------------+--------------------+-----------------+ 88 ! | entry | length | Meaning | Former name | Possible values | 89 ! |-----------------+--------------------------------------------------+--------------------+-----------------+ 90 ! | parent | Parent tracer (isotopes family name) | | | 91 ! | keys | niso | Isotopes keys/values pairs list + number | | | 92 ! | trac | ntiso | Isotopes + tagging tracers list + number | / | ntraciso | | 93 ! | zone | nzone | Geographic tagging zones list + number | / | ntraceurs_zone | | 94 ! | phase | nphas | Phases list + number | | [g][l][s], 1:3 | 95 ! | iqIsoPha | Index in "qx" = f(name(1:ntiso)),phas) | iqiso | 1:nqtot | 96 ! | itZonIso | Index in "trac(1:ntiso)"= f(zone, name(1:niso)) | index_trac | 1:ntiso | 97 ! +-----------------+--------------------------------------------------+--------------------+-----------------+ 98 99 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 100 INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O) 101 nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O) 102 nqo, & !--- Number of water phases 103 nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?) 104 nqCO2 !--- Number of tracers of CO2 (ThL) 105 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s) 106 CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: types_trac(:) !--- Keyword for tracers type(s), parsed version 107 !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac, types_trac) 108 109 !=== VARIABLES FOR INCA 110 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr) 111 pbl_flg(:) !--- Boundary layer activation ; needed for INCA (nbtr) 112 !$OMP THREADPRIVATE(conv_flg, pbl_flg) 113 114 #ifdef CPP_StratAer 115 !=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB) 116 INTEGER, SAVE :: nbtr_bin, nbtr_sulgas !--- number of aerosols bins and sulfur gases for StratAer model 117 !$OMP THREADPRIVATE(nbtr_bin, nbtr_sulgas) 118 INTEGER, SAVE :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat 119 !$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat) 120 #endif 121 107 122 CONTAINS 108 123 109 SUBROUTINE init_infotrac_phy(nqtot_,nqo_,nbtr_,nqtottr_,nqCO2_,tname_,ttext_,type_trac_,& 110 niadv_,conv_flg_,pbl_flg_,solsym_,& 111 nqfils_,nqdesc_,nqdesc_tot_,iqfils_,iqpere_,& 112 ok_isotopes_,ok_iso_verif_,ok_isotrac_,& 113 ok_init_iso_,niso_possibles_,tnat_,& 114 alpha_ideal_,use_iso_,iqiso_,iso_num_,& 115 iso_indnum_,zone_num_,phase_num_,& 116 indnum_fn_num_,index_trac_,& 117 niso_,ntraceurs_zone_,ntraciso_,itr_indice_& 124 SUBROUTINE init_infotrac_phy 125 USE ioipsl_getin_p_mod, ONLY: getin_p 126 #ifdef REPROBUS 127 USE CHEM_REP, ONLY: Init_chem_rep_trac 128 #endif 129 IMPLICIT NONE 130 !============================================================================================================================== 131 ! 132 ! Auteur: P. Le Van /L. Fairhead/F.Hourdin 133 ! ------- 134 ! 135 ! Modifications: 136 ! -------------- 137 ! 05/94: F.Forget Modif special traceur 138 ! 02/02: M-A Filiberti Lecture de traceur.def 139 ! 01/22: D. Cugnet Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type) 140 ! 141 ! Objet: 142 ! ------ 143 ! GCM LMD nouvelle grille 144 ! 145 !============================================================================================================================== 146 ! ... modification de l'integration de q ( 26/04/94 ) .... 147 !------------------------------------------------------------------------------------------------------------------------------ 148 ! Declarations: 149 INCLUDE "dimensions.h" 150 INCLUDE "iniprint.h" 151 152 !------------------------------------------------------------------------------------------------------------------------------ 153 ! Local variables 154 INTEGER, ALLOCATABLE :: hadv(:), vadv(:) !--- Horizontal/vertical transport scheme number 155 #ifdef INCA 156 INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA 157 vad (:), vadv_inca(:), pbl_flg_inca(:) 158 CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA 159 INTEGER :: nqINCA 160 #endif 118 161 #ifdef CPP_StratAer 119 ,nbtr_bin_,nbtr_sulgas_& 120 ,id_OCS_strat_,id_SO2_strat_,id_H2SO4_strat_,id_BIN01_strat_& 121 #endif 122 ) 123 124 ! transfer information on tracers from dynamics to physics 125 USE print_control_mod, ONLY: prt_level, lunout 126 IMPLICIT NONE 127 128 INTEGER,INTENT(IN) :: nqtot_ 129 INTEGER,INTENT(IN) :: nqo_ 130 INTEGER,INTENT(IN) :: nbtr_ 131 INTEGER,INTENT(IN) :: nqtottr_ 132 INTEGER,INTENT(IN) :: nqCO2_ 162 CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:) 163 #endif 164 CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather) 165 CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags 166 CHARACTER(LEN=maxlen) :: msg1 !--- String for messages 167 INTEGER :: fType !--- Tracers description file type ; 0: none 168 !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def" 169 INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments) 170 INTEGER :: iad !--- Advection scheme number 171 INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k !--- Indexes and temporary variables 172 LOGICAL :: lerr, ll, lRepr, lInit 173 CHARACTER(LEN=1) :: p 174 TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:) 175 TYPE(trac_type), POINTER :: t1, t(:) 176 INTEGER :: ierr 177 178 CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac_phy" 179 !------------------------------------------------------------------------------------------------------------------------------ 180 ! Initialization : 181 !------------------------------------------------------------------------------------------------------------------------------ 182 suff = ['x ','y ','z ','xx','xy','xz','yy','yz','zz'] 183 descrq( 1: 2) = ['LMV','BAK'] 184 descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH',' ','PPM','PPS','PPP',' ','SLP'] 185 descrq(30) = 'PRA' 186 187 CALL getin_p('type_trac',type_trac) 188 CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname) 189 IF(strParse(type_trac, '|', types_trac, n=nt)) CALL abort_gcm(modname,'can''t parse "type_trac = '//TRIM(type_trac)//'"',1) 190 lInit = .NOT.ALLOCATED(tracers) 191 192 !############################################################################################################################## 193 IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### 194 !############################################################################################################################## 195 !--------------------------------------------------------------------------------------------------------------------------- 196 DO it = 1, nt !--- nt>1=> "type_trac": coma-separated keywords list 197 !--------------------------------------------------------------------------------------------------------------------------- 198 !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION 199 msg1 = 'For type_trac = "'//TRIM(types_trac(it))//'":' 200 SELECT CASE(types_trac(it)) 201 CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model', modname) 202 CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname) 203 CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname) 204 CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname) 205 CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname) 206 CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname) 207 CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(types_trac(it))//' not possible yet.',1) 208 END SELECT 209 210 !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS 211 SELECT CASE(types_trac(it)) 212 CASE('inca', 'inco') 213 #ifndef INCA 214 CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1) 215 #endif 216 CASE('repr') 217 #ifndef REPROBUS 218 CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1) 219 #endif 220 CASE('coag') 221 #ifndef CPP_StratAer 222 CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1) 223 #endif 224 END SELECT 225 226 !--------------------------------------------------------------------------------------------------------------------------- 227 END DO 228 !--------------------------------------------------------------------------------------------------------------------------- 229 230 !############################################################################################################################## 231 END IF 232 !############################################################################################################################## 233 234 nqCO2 = COUNT( [ANY(types_trac == 'inco') .OR. (ANY(types_trac == 'co2i') .AND. ANY(types_trac == 'inca'))] ) 235 236 !============================================================================================================================== 237 ! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid) 238 !============================================================================================================================== 239 lRepr = ANY(types_trac(:) == 'repr') 240 !############################################################################################################################## 241 IF(lInit) THEN 242 IF(readTracersFiles(type_trac, fType, lRepr)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 243 ELSE 244 CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname) 245 IF(testTracersFiles(modname, type_trac, fType, .FALSE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 246 END IF 247 !############################################################################################################################## 248 249 !--------------------------------------------------------------------------------------------------------------------------- 250 IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1) 251 !--------------------------------------------------------------------------------------------------------------------------- 252 IF(fType == 1 .AND. ANY(['inca','inco']==type_trac) .AND. lInit) THEN !=== OLD STYLE INCA "traceur.def" (single type_trac) 253 !--------------------------------------------------------------------------------------------------------------------------- 254 #ifdef INCA 255 nqo = SIZE(tracers) - nqCO2 256 CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA 257 nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac 258 nqtrue = nbtr + nqo !--- Total number of "true" tracers 259 IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1) 260 ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA)) 261 ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA)) 262 CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca) 263 ALLOCATE(ttr(nqtrue)) 264 ttr(1:nqo+nqCO2) = tracers 265 ttr(1 : nqo )%component = 'lmdz' 266 ttr(1+nqo:nqCO2+nqo )%component = 'co2i' 267 ttr(1+nqo+nqCO2:nqtrue)%component = 'inca' 268 ttr(1+nqo :nqtrue)%name = [('CO2 ', k=1, nqCO2), solsym_inca] 269 ttr(1+nqo+nqCO2:nqtrue)%parent = tran0 270 ttr(1+nqo+nqCO2:nqtrue)%phase = 'g' 271 lerr = getKey('hadv', had, ky=tracers(:)%keys) 272 lerr = getKey('vadv', vad, ky=tracers(:)%keys) 273 hadv(1:nqo) = had(:); hadv(nqo+1:nqtrue) = hadv_inca 274 vadv(1:nqo) = vad(:); vadv(nqo+1:nqtrue) = vadv_inca 275 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 276 CALL setGeneration(tracers) !--- SET FIELDS %iGeneration, %gen0Name 277 DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) 278 #endif 279 !--------------------------------------------------------------------------------------------------------------------------- 280 ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) 281 !--------------------------------------------------------------------------------------------------------------------------- 282 nqo = COUNT(delPhase(tracers(:)%name) == 'H2O' & 283 .AND. tracers(:)%component == 'lmdz') !--- Number of water phases 284 nqtrue = SIZE(tracers) !--- Total number of "true" tracers 285 nbtr = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' & 286 .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac 287 #ifdef INCA 288 nqINCA = COUNT(tracers(:)%component == 'inca') 289 #endif 290 lerr = getKey('hadv', hadv, ky=tracers(:)%keys) 291 lerr = getKey('vadv', vadv, ky=tracers(:)%keys) 292 !--------------------------------------------------------------------------------------------------------------------------- 293 END IF 294 !--------------------------------------------------------------------------------------------------------------------------- 295 296 !--- Transfert the number of tracers to Reprobus 297 #ifdef REPROBUS 298 CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) 299 #endif 300 301 !############################################################################################################################## 302 IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac #### 303 !############################################################################################################################## 304 305 !============================================================================================================================== 306 ! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen). 307 !============================================================================================================================== 308 DO iq = 1, nqtrue 309 IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE 310 WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available' 311 CALL abort_gcm(modname, TRIM(msg1), 1) 312 END DO 313 nqtot = COUNT( hadv< 20 .AND. vadv< 20 ) & !--- No additional tracer 314 + 4*COUNT( hadv==20 .AND. vadv==20 ) & !--- 3 additional tracers 315 + 10*COUNT( hadv==30 .AND. vadv==30 ) !--- 9 additional tracers 316 317 !--- More tracers due to the choice of advection scheme => assign total number of tracers 318 IF( nqtot /= nqtrue ) THEN 319 CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers') 320 CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue))) 321 CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot))) 322 END IF 323 324 !============================================================================================================================== 325 ! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names and nqtot. 326 !============================================================================================================================== 327 ALLOCATE(ttr(nqtot)) 328 jq = nqtrue+1; tracers(:)%iadv = -1 329 DO iq = 1, nqtrue 330 t1 => tracers(iq) 331 332 !--- VERIFY THE CHOICE OF ADVECTION SCHEME 333 iad = -1 334 IF(hadv(iq) == vadv(iq) ) iad = hadv(iq) 335 IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11 336 WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq) 337 IF(iad == -1) CALL abort_gcm(modname, msg1, 1) 338 339 !--- SET FIELDS %longName, %isInPhysics 340 t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad) 341 t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' & 342 .OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD... 343 ttr(iq) = t1 344 345 !--- DEFINE THE HIGHER ORDER TRACERS, IF ANY 346 nm = 0 347 IF(iad == 20) nm = 3 !--- 2nd order scheme 348 IF(iad == 30) nm = 9 !--- 3rd order scheme 349 IF(nm == 0) CYCLE !--- No higher moments 350 ttr(jq+1:jq+nm) = t1 351 ttr(jq+1:jq+nm)%name = [(TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ] 352 ttr(jq+1:jq+nm)%parent = [(TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ] 353 ttr(jq+1:jq+nm)%longName = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ] 354 jq = jq + nm 355 END DO 356 DEALLOCATE(hadv, vadv) 357 CALL MOVE_ALLOC(FROM=ttr, TO=tracers) 358 359 !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen 360 CALL indexUpdate(tracers) 361 362 !############################################################################################################################## 363 END IF 364 !############################################################################################################################## 365 366 !############################################################################################################################## 367 IF(.NOT.lInit) THEN 368 !############################################################################################################################## 369 nqtot = SIZE(tracers) 370 !############################################################################################################################## 371 ELSE 372 !############################################################################################################################## 373 374 !=== READ PHYSICAL PARAMETERS FOR ISOTOPES 375 niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE. 376 IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1) 377 378 !############################################################################################################################## 379 END IF 380 !############################################################################################################################## 381 !--- Convection / boundary layer activation for all tracers 382 ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1 383 ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1 384 385 !--- Note: nqtottr can differ from nbtr when nmom/=0 386 nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz') 387 IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) & 388 CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1) 389 390 !=== DISPLAY THE RESULTS 391 ! IF(prt_level > 1) THEN 392 CALL msg('nqo = '//TRIM(int2str(nqo)), modname) 393 CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname) 394 CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname) 395 CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) 396 CALL msg('niso = '//TRIM(int2str(niso)), modname) 397 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) 398 #ifdef INCA 399 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 400 CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname) 401 #endif 402 ! END IF 403 t => tracers 404 CALL msg('Information stored in infotrac_phy :', modname) 405 IF(dispTable('issssssssiiiiiiii', & 406 ['iq ', 'name ', 'lName ', 'gen0N ', 'parent', 'type ', 'phase ', 'compon', 'isPhy ', & 407 'iGen ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'], & 408 cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),& 409 cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, & 410 t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) & 411 CALL abort_gcm(modname, "problem with the tracers table content", 1) 412 IF(niso > 0) THEN 413 CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname) 414 CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname) 415 CALL msg(' isoName = '//strStack(isoName), modname) 416 CALL msg(' isoZone = '//strStack(isoZone), modname) 417 CALL msg(' isoPhas = '//TRIM(isoPhas), modname) 418 ELSE 419 CALL msg('No isotopes identified.', modname) 420 END IF 421 422 #ifdef ISOVERIF 423 CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname) 424 #endif 133 425 #ifdef CPP_StratAer 134 INTEGER,INTENT(IN) :: nbtr_bin_ 135 INTEGER,INTENT(IN) :: nbtr_sulgas_ 136 INTEGER,INTENT(IN) :: id_OCS_strat_ 137 INTEGER,INTENT(IN) :: id_SO2_strat_ 138 INTEGER,INTENT(IN) :: id_H2SO4_strat_ 139 INTEGER,INTENT(IN) :: id_BIN01_strat_ 140 #endif 141 CHARACTER(len=*),INTENT(IN) :: tname_(nqtot_) ! tracer short name for restart and diagnostics 142 CHARACTER(len=*),INTENT(IN) :: ttext_(nqtot_) ! tracer long name for diagnostics 143 CHARACTER(len=*),INTENT(IN) :: type_trac_ 144 INTEGER,INTENT(IN) :: niadv_ (nqtot_) ! equivalent dyn / physique 145 INTEGER,INTENT(IN) :: conv_flg_(nbtr_) 146 INTEGER,INTENT(IN) :: pbl_flg_(nbtr_) 147 CHARACTER(len=*),INTENT(IN) :: solsym_(nbtr_) 148 ! Isotopes: 149 INTEGER,INTENT(IN) :: nqfils_(nqtot_) 150 INTEGER,INTENT(IN) :: nqdesc_(nqtot_) 151 INTEGER,INTENT(IN) :: nqdesc_tot_ 152 INTEGER,INTENT(IN) :: iqfils_(nqtot_,nqtot_) 153 INTEGER,INTENT(IN) :: iqpere_(nqtot_) 154 LOGICAL,INTENT(IN) :: ok_isotopes_ 155 LOGICAL,INTENT(IN) :: ok_iso_verif_ 156 LOGICAL,INTENT(IN) :: ok_isotrac_ 157 LOGICAL,INTENT(IN) :: ok_init_iso_ 158 INTEGER,INTENT(IN) :: niso_possibles_ 159 REAL,INTENT(IN) :: tnat_(niso_possibles_) 160 REAL,INTENT(IN) :: alpha_ideal_(niso_possibles_) 161 LOGICAL,INTENT(IN) :: use_iso_(niso_possibles_) 162 INTEGER,INTENT(IN) :: iqiso_(ntraciso_,nqo_) 163 INTEGER,INTENT(IN) :: iso_num_(nqtot_) 164 INTEGER,INTENT(IN) :: iso_indnum_(nqtot_) 165 INTEGER,INTENT(IN) :: zone_num_(nqtot_) 166 INTEGER,INTENT(IN) :: phase_num_(nqtot_) 167 INTEGER,INTENT(IN) :: indnum_fn_num_(niso_possibles_) 168 INTEGER,INTENT(IN) :: index_trac_(ntraceurs_zone_,niso_) 169 INTEGER,INTENT(IN) :: niso_ 170 INTEGER,INTENT(IN) :: ntraceurs_zone_ 171 INTEGER,INTENT(IN) :: ntraciso_ 172 INTEGER,INTENT(IN) :: itr_indice_(nqtottr_) 173 174 CHARACTER(LEN=30) :: modname="init_infotrac_phy" 175 176 nqtot=nqtot_ 177 nqo=nqo_ 178 nbtr=nbtr_ 179 nqCO2=nqCO2_ 180 nqtottr=nqtottr_ 181 #ifdef CPP_StratAer 182 nbtr_bin=nbtr_bin_ 183 nbtr_sulgas=nbtr_sulgas_ 184 id_OCS_strat=id_OCS_strat_ 185 id_SO2_strat=id_SO2_strat_ 186 id_H2SO4_strat=id_H2SO4_strat_ 187 id_BIN01_strat=id_BIN01_strat_ 188 #endif 189 ALLOCATE(tname(nqtot)) 190 tname(:) = tname_(:) 191 ALLOCATE(ttext(nqtot)) 192 ttext(:) = ttext_(:) 193 type_trac = type_trac_ 194 ALLOCATE(niadv(nqtot)) 195 niadv(:)=niadv_(:) 196 ALLOCATE(conv_flg(nbtr)) 197 conv_flg(:)=conv_flg_(:) 198 ALLOCATE(pbl_flg(nbtr)) 199 pbl_flg(:)=pbl_flg_(:) 200 ALLOCATE(solsym(nbtr)) 201 solsym(:)=solsym_(:) 202 203 IF(prt_level.ge.1) THEN 204 write(lunout,*) TRIM(modname)//": nqtot,nqo,nbtr,nqCO2",nqtot,nqo,nbtr,nqCO2 205 ENDIF 206 207 ! Isotopes: 208 209 ! First check that the "niso_possibles" has the correct value 210 IF (niso_possibles.ne.niso_possibles_) THEN 211 CALL abort_physic(modname,& 212 "wrong value for parameter niso_possibles in infotrac_phy",1) 213 ENDIF 214 215 ok_isotopes=ok_isotopes_ 216 ok_iso_verif=ok_iso_verif_ 217 ok_isotrac=ok_isotrac_ 218 ok_init_iso=ok_init_iso_ 219 220 niso=niso_ 221 ntraceurs_zone=ntraceurs_zone_ 222 ntraciso=ntraciso_ 223 224 IF (ok_isotopes) THEN 225 ALLOCATE(nqfils(nqtot)) 226 nqfils(:)=nqfils_(:) 227 ALLOCATE(nqdesc(nqtot)) 228 nqdesc(:)=nqdesc_(:) 229 nqdesc_tot=nqdesc_tot_ 230 ALLOCATE(iqfils(nqtot,nqtot)) 231 iqfils(:,:)=iqfils_(:,:) 232 ALLOCATE(iqpere(nqtot)) 233 iqpere(:)=iqpere_(:) 234 235 tnat(:)=tnat_(:) 236 alpha_ideal(:)=alpha_ideal_(:) 237 use_iso(:)=use_iso_(:) 238 239 ALLOCATE(iqiso(ntraciso,nqo)) 240 iqiso(:,:)=iqiso_(:,:) 241 ALLOCATE(iso_num(nqtot)) 242 iso_num(:)=iso_num_(:) 243 ALLOCATE(iso_indnum(nqtot)) 244 iso_indnum(:)=iso_indnum_(:) 245 ALLOCATE(zone_num(nqtot)) 246 zone_num(:)=zone_num_(:) 247 ALLOCATE(phase_num(nqtot)) 248 phase_num(:)=phase_num_(:) 249 250 indnum_fn_num(:)=indnum_fn_num_(:) 251 252 ALLOCATE(index_trac(ntraceurs_zone,niso)) 253 index_trac(:,:)=index_trac_(:,:) 254 255 ALLOCATE(itr_indice(nqtottr)) 256 itr_indice(:)=itr_indice_(:) 257 ENDIF ! of IF(ok_isotopes) 258 259 END SUBROUTINE init_infotrac_phy 426 IF (ANY(types_trac == 'coag')) THEN 427 nbtr_bin = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)]) 428 nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)]) 429 tnames = PACK(tracers(:)%name, MASK=tracers(:)%isInPhysics) 430 id_BIN01_strat = strIdx(tnames, 'BIN01' ) 431 id_OCS_strat = strIdx(tnames, 'GASOCS' ) 432 id_SO2_strat = strIdx(tnames, 'GASSO2' ) 433 id_H2SO4_strat = strIdx(tnames, 'GASH2SO4') 434 id_TEST_strat = strIdx(tnames, 'GASTEST' ) 435 CALL msg('nbtr_bin ='//TRIM(int2str(nbtr_bin )), modname) 436 CALL msg('nbtr_sulgas ='//TRIM(int2str(nbtr_sulgas )), modname) 437 CALL msg('id_BIN01_strat ='//TRIM(int2str(id_BIN01_strat)), modname) 438 CALL msg('id_OCS_strat ='//TRIM(int2str(id_OCS_strat )), modname) 439 CALL msg('id_SO2_strat ='//TRIM(int2str(id_SO2_strat )), modname) 440 CALL msg('id_H2SO4_strat ='//TRIM(int2str(id_H2SO4_strat)), modname) 441 CALL msg('id_TEST_strat ='//TRIM(int2str(id_TEST_strat )), modname) 442 END IF 443 #endif 444 CALL msg('end', modname) 445 446 END SUBROUTINE init_infotrac_phy 260 447 261 448 END MODULE infotrac_phy
Note: See TracChangeset
for help on using the changeset viewer.
