Changeset 4171 for LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/infotrac_phy.F90
- Timestamp:
- Jun 17, 2022, 4:24:49 PM (2 years ago)
- Location:
- LMDZ6/branches/LMDZ-ECRAD
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/infotrac_phy.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/LMDZ-ECRAD
- Property svn:mergeinfo changed
-
LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/infotrac_phy.F90
r3677 r4171 4 4 MODULE infotrac_phy 5 5 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) 6 USE strings_mod, ONLY: msg, maxlen, strStack, strHead, strParse, strIdx, int2str 7 USE readTracFiles_mod, ONLY: trac_type, isot_type, keys_type, delPhase, getKey, tnom_iso => newH2OIso 8 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 18 19 !=== FOR ISOTOPES: General 20 PUBLIC :: isotopes, nbIso !--- Derived type, full isotopes families database + nb of families 21 PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index 22 !=== FOR ISOTOPES: Specific to water 23 PUBLIC :: iH2O !--- H2O isotopes index 24 !=== FOR ISOTOPES: Depending on the selected isotopes family 25 PUBLIC :: isotope, isoKeys !--- Selected isotopes database + associated keys (cf. getKey) 26 PUBLIC :: isoName, isoZone, isoPhas !--- Isotopes and tagging zones names, phases 27 PUBLIC :: niso, nzone, nphas, ntiso !--- " " numbers + isotopes & tagging tracers number 28 PUBLIC :: itZonIso !--- iq = function(tagging zone idx, isotope idx) 29 PUBLIC :: iqIsoPha !--- idx of tagging tracer in iName = function(isotope idx, phase idx) 30 PUBLIC :: isoCheck !--- Run isotopes checking routines 31 !=== FOR BOTH TRACERS AND ISOTOPES 32 PUBLIC :: getKey !--- Get a key from "tracers" or "isotope" 33 34 INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect 35 36 !=== CONVENTIONS FOR TRACERS NUMBERS: 37 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 38 ! | water in different | water tagging | water isotopes | other tracers | additional tracers moments | 39 ! | phases: H2O_[gls] | isotopes | | | for higher order schemes | 40 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 41 ! | | | | | | 42 ! |<-- nqo -->|<-- nqo*niso* nzone -->|<-- nqo*niso -->|<-- nbtr -->|<-- (nmom) -->| 43 ! | | | | 44 ! | |<-- nqo*niso*(nzone+1) = nqo*ntiso -->|<-- nqtottr = nbtr + nmom -->| 45 ! | = nqtot - nqo*(ntiso+1) | 46 ! | | 47 ! |<-- nqtrue = nbtr + nqo*(ntiso+1) -->| | 48 ! | | 49 ! |<-- nqtot = nqtrue + nmom -->| 50 ! | | 51 ! |-----------------------------------------------------------------------------------------------------------| 52 ! NOTES FOR THIS TABLE: 53 ! * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'), 54 ! since water is so far the sole tracers family, except passive CO2, removed from the main tracers table. 55 ! * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas". 56 ! * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any. 57 ! 58 !=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot) 59 ! Each entry is accessible using "%" sign. 60 ! |-------------+------------------------------------------------------+-------------+------------------------+ 61 ! | entry | Meaning | Former name | Possible values | 62 ! |-------------+------------------------------------------------------+-------------+------------------------+ 63 ! | name | Name (short) | tname | | 64 ! | gen0Name | Name of the 1st generation ancestor | / | | 65 ! | parent | Name of the parent | / | | 66 ! | longName | Long name (with adv. scheme suffix) for outputs | ttext | | 67 ! | type | Type (so far: tracer or tag) | / | tracer,tag | 68 ! | phase | Phases list ("g"as / "l"iquid / "s"olid) | / | [g][l][s] | 69 ! | component | Name(s) of the merged/cumulated section(s) | / | coma-separated names | 70 ! | iadv | Advection scheme number | iadv | 1-20,30 exc. 3-9,15,19 | 71 ! | iGeneration | Generation (>=1) | / | | 72 ! | isAdvected | advected tracers flag (.TRUE. if iadv >= 0) | / | nqtrue .TRUE. values | 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 ! | nqChilds | Number of childs (1st generation only) | nqfils | 1:nqtot | 78 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 79 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | 80 ! | iso_iZone | Isotope zone index in isotopes(iso_iGroup)%zone(:) | zone_num | 1:nzone | 81 ! | iso_iPhas | Isotope phase index in isotopes(iso_iGroup)%phas(:) | phase_num | 1:nphas | 82 ! | keys | key/val pairs accessible with "getKey" routine | / | | 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 nbIso, & !--- Number of available isotopes family 104 nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?) 105 nqCO2 !--- Number of tracers of CO2 (ThL) 106 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type 107 CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: types_trac(:) !--- Keyword for tracers type 108 109 !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nbIso, nqtottr, nqCO2, type_trac, types_trac) 110 111 !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES 112 TYPE(trac_type), TARGET, SAVE, ALLOCATABLE :: tracers(:) !=== TRACERS DESCRIPTORS VECTOR 113 TYPE(isot_type), TARGET, SAVE, ALLOCATABLE :: isotopes(:) !=== ISOTOPES PARAMETERS VECTOR 114 !$OMP THREADPRIVATE(tracers, isotopes) 115 116 !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes" 117 TYPE(isot_type), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR 118 INTEGER, SAVE :: ixIso, iH2O !--- Index of the selected isotopes family and H2O family 119 LOGICAL, SAVE :: isoCheck !--- Flag to trigger the checking routines 120 TYPE(keys_type), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName) 121 CHARACTER(LEN=maxlen), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY 122 isoZone(:), & !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY 123 isoPhas !--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY 124 INTEGER, SAVE :: niso, nzone, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES 125 nphas, ntiso !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS 126 INTEGER, SAVE, POINTER ::itZonIso(:,:), & !--- INDEX IN "isoTrac" AS f(tagging zone idx, isotope idx) 127 iqIsoPha(:,:) !--- INDEX IN "qx" AS f(isotopic tracer idx, phase idx) 128 !$OMP THREADPRIVATE(isotope, ixIso,iH2O, isoCheck, isoKeys, isoName,isoZone,isoPhas, niso,nzone,nphas,ntiso, itZonIso,iqIsoPha) 129 130 !=== VARIABLES FOR ISOTOPES INITIALIZATION AND FOR INCA 131 INTEGER, SAVE, ALLOCATABLE ::conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr) 132 pbl_flg(:) !--- Boundary layer activation ; needed for INCA (nbtr) 133 !$OMP THREADPRIVATE(conv_flg, pbl_flg) 22 134 23 135 #ifdef CPP_StratAer 24 ! nbtr_bin: number of aerosol bins for StratAer model 25 ! nbtr_sulgas: number of sulfur gases for StratAer model 26 INTEGER, SAVE :: nbtr_bin, nbtr_sulgas 27 !$OMP THREADPRIVATE(nbtr_bin,nbtr_sulgas) 28 INTEGER, SAVE :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat 29 !$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat) 30 #endif 31 32 ! CRisi: nb traceurs pères= directement advectés par l'air 33 INTEGER, SAVE :: nqperes 34 !$OMP THREADPRIVATE(nqperes) 35 36 ! Name variables 37 CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics 38 CHARACTER(len=23), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics 39 !$OMP THREADPRIVATE(tname,ttext) 40 41 !! iadv : index of trasport schema for each tracer 42 ! INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iadv 43 44 ! niadv : vector keeping the coorspondance between all tracers(nqtot) treated in the 45 ! dynamic part of the code and the tracers (nbtr+2) used in the physics part of the code. 46 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: niadv ! equivalent dyn / physique 47 !$OMP THREADPRIVATE(niadv) 48 49 ! CRisi: tableaux de fils 50 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nqfils 51 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les générations 52 INTEGER, SAVE :: nqdesc_tot 53 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqfils 54 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iqpere 55 !$OMP THREADPRIVATE(nqfils,nqdesc,nqdesc_tot,iqfils,iqpere) 56 57 ! conv_flg(it)=0 : convection desactivated for tracer number it 58 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: conv_flg 59 !$OMP THREADPRIVATE(conv_flg) 60 61 ! pbl_flg(it)=0 : boundary layer diffusion desactivaded for tracer number it 62 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: pbl_flg 63 !$OMP THREADPRIVATE(pbl_flg) 64 65 CHARACTER(len=4),SAVE :: type_trac 66 !$OMP THREADPRIVATE(type_trac) 67 CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym 68 !$OMP THREADPRIVATE(solsym) 69 70 ! CRisi: cas particulier des isotopes 71 LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso 72 !$OMP THREADPRIVATE(ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso) 73 INTEGER :: niso_possibles 74 PARAMETER ( niso_possibles=5) 75 real, DIMENSION (niso_possibles),SAVE :: tnat,alpha_ideal 76 !$OMP THREADPRIVATE(tnat,alpha_ideal) 77 LOGICAL, DIMENSION(niso_possibles),SAVE :: use_iso 78 !$OMP THREADPRIVATE(use_iso) 79 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqiso ! donne indice iq en fn de (ixt,phase) 80 !$OMP THREADPRIVATE(iqiso) 81 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot 82 !$OMP THREADPRIVATE(iso_num) 83 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot 84 !$OMP THREADPRIVATE(iso_indnum) 85 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: zone_num ! donne numéro de la zone de tracage en fn de nqtot 86 !$OMP THREADPRIVATE(zone_num) 87 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: phase_num ! donne numéro de la zone de tracage en fn de nqtot 88 !$OMP THREADPRIVATE(phase_num) 89 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 90 !$OMP THREADPRIVATE(indnum_fn_num) 91 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: index_trac ! numéro ixt en fn izone, indnum entre 1 et niso 92 !$OMP THREADPRIVATE(index_trac) 93 INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso 94 !$OMP THREADPRIVATE(niso,ntraceurs_zone,ntraciso) 95 136 !=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB) 137 INTEGER, SAVE :: nbtr_bin, nbtr_sulgas !--- number of aerosols bins and sulfur gases for StratAer model 138 !$OMP THREADPRIVATE(nbtr_bin, nbtr_sulgas) 139 INTEGER, SAVE :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat 140 !$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat) 141 #endif 142 96 143 CONTAINS 97 144 98 SUBROUTINE init_infotrac_phy(nqtot_,nqo_,nbtr_,tname_,ttext_,type_trac_,& 99 niadv_,conv_flg_,pbl_flg_,solsym_,& 100 nqfils_,nqdesc_,nqdesc_tot_,iqfils_,iqpere_,& 101 ok_isotopes_,ok_iso_verif_,ok_isotrac_,& 102 ok_init_iso_,niso_possibles_,tnat_,& 103 alpha_ideal_,use_iso_,iqiso_,iso_num_,& 104 iso_indnum_,zone_num_,phase_num_,& 105 indnum_fn_num_,index_trac_,& 106 niso_,ntraceurs_zone_,ntraciso_& 145 SUBROUTINE init_infotrac_phy(type_trac_, tracers_, isotopes_, nqtottr_, nqCO2_, pbl_flg_, conv_flg_) 146 147 USE print_control_mod, ONLY: prt_level, lunout 148 149 IMPLICIT NONE 150 CHARACTER(LEN=*),INTENT(IN) :: type_trac_ 151 TYPE(trac_type), INTENT(IN) :: tracers_(:) 152 TYPE(isot_type), INTENT(IN) :: isotopes_(:) 153 INTEGER, INTENT(IN) :: nqtottr_ 154 INTEGER, INTENT(IN) :: nqCO2_ 155 INTEGER, INTENT(IN) :: conv_flg_(:) 156 INTEGER, INTENT(IN) :: pbl_flg_(:) 157 158 INTEGER :: iq, ixt 107 159 #ifdef CPP_StratAer 108 ,nbtr_bin_,nbtr_sulgas_& 109 ,id_OCS_strat_,id_SO2_strat_,id_H2SO4_strat_,id_BIN01_strat_& 110 #endif 111 ) 112 113 ! transfer information on tracers from dynamics to physics 114 USE print_control_mod, ONLY: prt_level, lunout 115 IMPLICIT NONE 116 117 INTEGER,INTENT(IN) :: nqtot_ 118 INTEGER,INTENT(IN) :: nqo_ 119 INTEGER,INTENT(IN) :: nbtr_ 160 CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:) 161 #endif 162 CHARACTER(LEN=maxlen) :: modname="init_infotrac_phy" 163 164 type_trac = type_trac_ 165 IF(strParse(type_trac, '|', types_trac)) CALL abort_gcm(modname,'can''t parse "type_trac = '//TRIM(type_trac)//'"',1) 166 tracers = tracers_ 167 isotopes = isotopes_ 168 nqtottr = nqtottr_ 169 nqCO2 = nqCO2_ 170 pbl_flg = pbl_flg_ 171 conv_flg = conv_flg_ 172 nqtot = SIZE(tracers_) 173 nqo = COUNT(delPhase(tracers%name)=='H2O' .AND. tracers%iGeneration==0 .AND. tracers%component=='lmdz') 174 nbtr = SIZE(conv_flg) 175 nbIso = SIZE(isotopes_) 176 177 !=== Determine selected isotopes class related quantities: 178 ! ixIso, isotope, niso,isoKeys, ntiso,isoName, nzone,isoZone, nphas,isoPhas, itZonIso, iqIsoPha, isoCheck 179 IF(.NOT.isoSelect('H2O')) iH2O = ixIso 180 IF(prt_level > 1) THEN 181 CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) 182 CALL msg('nbtr = '//TRIM(int2str(nbtr )), modname) 183 CALL msg('nqo = '//TRIM(int2str(nqo )), modname) 184 CALL msg('niso = '//TRIM(int2str(niso )), modname) 185 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) 186 CALL msg('nqtottr = '//TRIM(int2str(nqtottr)), modname) 187 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 188 END IF 189 120 190 #ifdef CPP_StratAer 121 INTEGER,INTENT(IN) :: nbtr_bin_ 122 INTEGER,INTENT(IN) :: nbtr_sulgas_ 123 INTEGER,INTENT(IN) :: id_OCS_strat_ 124 INTEGER,INTENT(IN) :: id_SO2_strat_ 125 INTEGER,INTENT(IN) :: id_H2SO4_strat_ 126 INTEGER,INTENT(IN) :: id_BIN01_strat_ 127 #endif 128 CHARACTER(len=20),INTENT(IN) :: tname_(nqtot_) ! tracer short name for restart and diagnostics 129 CHARACTER(len=23),INTENT(IN) :: ttext_(nqtot_) ! tracer long name for diagnostics 130 CHARACTER(len=4),INTENT(IN) :: type_trac_ 131 INTEGER,INTENT(IN) :: niadv_ (nqtot_) ! equivalent dyn / physique 132 INTEGER,INTENT(IN) :: conv_flg_(nbtr_) 133 INTEGER,INTENT(IN) :: pbl_flg_(nbtr_) 134 CHARACTER(len=8),INTENT(IN) :: solsym_(nbtr_) 135 ! Isotopes: 136 INTEGER,INTENT(IN) :: nqfils_(nqtot_) 137 INTEGER,INTENT(IN) :: nqdesc_(nqtot_) 138 INTEGER,INTENT(IN) :: nqdesc_tot_ 139 INTEGER,INTENT(IN) :: iqfils_(nqtot_,nqtot_) 140 INTEGER,INTENT(IN) :: iqpere_(nqtot_) 141 LOGICAL,INTENT(IN) :: ok_isotopes_ 142 LOGICAL,INTENT(IN) :: ok_iso_verif_ 143 LOGICAL,INTENT(IN) :: ok_isotrac_ 144 LOGICAL,INTENT(IN) :: ok_init_iso_ 145 INTEGER,INTENT(IN) :: niso_possibles_ 146 REAL,INTENT(IN) :: tnat_(niso_possibles_) 147 REAL,INTENT(IN) :: alpha_ideal_(niso_possibles_) 148 LOGICAL,INTENT(IN) :: use_iso_(niso_possibles_) 149 INTEGER,INTENT(IN) :: iqiso_(ntraciso_,nqo_) 150 INTEGER,INTENT(IN) :: iso_num_(nqtot_) 151 INTEGER,INTENT(IN) :: iso_indnum_(nqtot_) 152 INTEGER,INTENT(IN) :: zone_num_(nqtot_) 153 INTEGER,INTENT(IN) :: phase_num_(nqtot_) 154 INTEGER,INTENT(IN) :: indnum_fn_num_(niso_possibles_) 155 INTEGER,INTENT(IN) :: index_trac_(ntraceurs_zone_,niso_) 156 INTEGER,INTENT(IN) :: niso_ 157 INTEGER,INTENT(IN) :: ntraceurs_zone_ 158 INTEGER,INTENT(IN) :: ntraciso_ 159 160 CHARACTER(LEN=30) :: modname="init_infotrac_phy" 161 162 nqtot=nqtot_ 163 nqo=nqo_ 164 nbtr=nbtr_ 165 #ifdef CPP_StratAer 166 nbtr_bin=nbtr_bin_ 167 nbtr_sulgas=nbtr_sulgas_ 168 id_OCS_strat=id_OCS_strat_ 169 id_SO2_strat=id_SO2_strat_ 170 id_H2SO4_strat=id_H2SO4_strat_ 171 id_BIN01_strat=id_BIN01_strat_ 172 #endif 173 ALLOCATE(tname(nqtot)) 174 tname(:) = tname_(:) 175 ALLOCATE(ttext(nqtot)) 176 ttext(:) = ttext_(:) 177 type_trac = type_trac_ 178 ALLOCATE(niadv(nqtot)) 179 niadv(:)=niadv_(:) 180 ALLOCATE(conv_flg(nbtr)) 181 conv_flg(:)=conv_flg_(:) 182 ALLOCATE(pbl_flg(nbtr)) 183 pbl_flg(:)=pbl_flg_(:) 184 ALLOCATE(solsym(nbtr)) 185 solsym(:)=solsym_(:) 186 187 IF(prt_level.ge.1) THEN 188 write(lunout,*) TRIM(modname)//": nqtot,nqo,nbtr",nqtot,nqo,nbtr 189 ENDIF 190 191 ! Isotopes: 192 193 ! First check that the "niso_possibles" has the correct value 194 IF (niso_possibles.ne.niso_possibles_) THEN 195 CALL abort_physic(modname,& 196 "wrong value for parameter niso_possibles in infotrac_phy",1) 197 ENDIF 198 199 ok_isotopes=ok_isotopes_ 200 ok_iso_verif=ok_iso_verif_ 201 ok_isotrac=ok_isotrac_ 202 ok_init_iso=ok_init_iso_ 203 204 niso=niso_ 205 ntraceurs_zone=ntraceurs_zone_ 206 ntraciso=ntraciso_ 207 208 IF (ok_isotopes) THEN 209 ALLOCATE(nqfils(nqtot)) 210 nqfils(:)=nqfils_(:) 211 ALLOCATE(nqdesc(nqtot)) 212 nqdesc(:)=nqdesc_(:) 213 nqdesc_tot=nqdesc_tot_ 214 ALLOCATE(iqfils(nqtot,nqtot)) 215 iqfils(:,:)=iqfils_(:,:) 216 ALLOCATE(iqpere(nqtot)) 217 iqpere(:)=iqpere_(:) 218 219 tnat(:)=tnat_(:) 220 alpha_ideal(:)=alpha_ideal_(:) 221 use_iso(:)=use_iso_(:) 222 223 ALLOCATE(iqiso(ntraciso,nqo)) 224 iqiso(:,:)=iqiso_(:,:) 225 ALLOCATE(iso_num(nqtot)) 226 iso_num(:)=iso_num_(:) 227 ALLOCATE(iso_indnum(nqtot)) 228 iso_indnum(:)=iso_indnum_(:) 229 ALLOCATE(zone_num(nqtot)) 230 zone_num(:)=zone_num_(:) 231 ALLOCATE(phase_num(nqtot)) 232 phase_num(:)=phase_num_(:) 233 234 indnum_fn_num(:)=indnum_fn_num_(:) 235 236 ALLOCATE(index_trac(ntraceurs_zone,niso)) 237 index_trac(:,:)=index_trac_(:,:) 238 ENDIF ! of IF(ok_isotopes) 239 240 END SUBROUTINE init_infotrac_phy 191 IF (ANY(types_trac == 'coag')) THEN 192 nbtr_bin = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)]) 193 nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)]) 194 tnames = PACK(tracers(:)%name, MASK=tracers(:)%isInPhysics) 195 id_BIN01_strat = strIdx(tnames, 'BIN01' ) 196 id_OCS_strat = strIdx(tnames, 'GASOSC' ) 197 id_SO2_strat = strIdx(tnames, 'GASSO2' ) 198 id_H2SO4_strat = strIdx(tnames, 'GASH2SO4') 199 id_TEST_strat = strIdx(tnames, 'GASTEST' ) 200 CALL msg('nbtr_bin ='//TRIM(int2str(nbtr_bin )), modname) 201 CALL msg('nbtr_sulgas ='//TRIM(int2str(nbtr_sulgas )), modname) 202 CALL msg('id_BIN01_strat ='//TRIM(int2str(id_BIN01_strat)), modname) 203 CALL msg('id_OCS_strat ='//TRIM(int2str(id_OCS_strat )), modname) 204 CALL msg('id_SO2_strat ='//TRIM(int2str(id_SO2_strat )), modname) 205 CALL msg('id_H2SO4_strat ='//TRIM(int2str(id_H2SO4_strat)), modname) 206 CALL msg('id_TEST_strat ='//TRIM(int2str(id_TEST_strat )), modname) 207 END IF 208 #endif 209 #ifdef ISOVERIF 210 CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname) 211 #endif 212 213 END SUBROUTINE init_infotrac_phy 214 215 216 !============================================================================================================================== 217 !=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED 218 ! Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call). 219 !============================================================================================================================== 220 LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr) 221 IMPLICIT NONE 222 CHARACTER(LEN=*), INTENT(IN) :: iName 223 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose 224 INTEGER :: iIso 225 LOGICAL :: lV 226 lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose 227 iIso = strIdx(isotopes(:)%parent, iName) 228 lerr = iIso == 0 229 IF(lerr) THEN 230 niso = 0; ntiso = 0; nzone=0; nphas=nqo; isoCheck=.FALSE. 231 CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV) 232 RETURN 233 END IF 234 lerr = isoSelectByIndex(iIso, lV) 235 END FUNCTION isoSelectByName 236 !============================================================================================================================== 237 LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr) 238 IMPLICIT NONE 239 INTEGER, INTENT(IN) :: iIso 240 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose 241 LOGICAL :: lv 242 lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose 243 lerr = .FALSE. 244 IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK 245 lerr = iIso<=0 .OR. iIso>nbIso 246 CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '//TRIM(int2str(nbIso))//'"',& 247 ll=lerr .AND. lV) 248 IF(lerr) RETURN 249 ixIso = iIso !--- Update currently selected family index 250 isotope => isotopes(ixIso) !--- Select corresponding component 251 isoKeys => isotope%keys; niso = isotope%niso 252 isoName => isotope%trac; ntiso = isotope%ntiso 253 isoZone => isotope%zone; nzone = isotope%nzone 254 isoPhas => isotope%phase; nphas = isotope%nphas 255 itZonIso => isotope%itZonIso; isoCheck = isotope%check 256 iqIsoPha => isotope%iqIsoPha 257 END FUNCTION isoSelectByIndex 258 !============================================================================================================================== 259 241 260 242 261 END MODULE infotrac_phy
Note: See TracChangeset
for help on using the changeset viewer.
