Changeset 4120 for LMDZ6/trunk/libf/phylmd/infotrac_phy.F90
- Timestamp:
- Apr 5, 2022, 3:44:30 PM (2 years ago)
- File:
-
- 1 edited
-
LMDZ6/trunk/libf/phylmd/infotrac_phy.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/infotrac_phy.F90
r4071 r4120 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 USE readTracFiles_mod, ONLY: trac_type, maxlen, delPhase 11 12 ! nqtot : total number of tracers and higher order of moment, water vapor and liquid included 13 INTEGER, SAVE :: nqtot 14 !$OMP THREADPRIVATE(nqtot) 15 16 !CR: on ajoute le nombre de traceurs de l eau 17 INTEGER, SAVE :: nqo 18 !$OMP THREADPRIVATE(nqo) 19 20 ! nbtr : number of tracers not including higher order of moment or water vapor or liquid 21 ! number of tracers used in the physics 22 INTEGER, SAVE :: nbtr 23 !$OMP THREADPRIVATE(nbtr) 24 25 INTEGER, SAVE :: nqtottr 26 !$OMP THREADPRIVATE(nqtottr) 27 28 ! ThL : number of CO2 tracers ModThL 29 INTEGER, SAVE :: nqCO2 30 !$OMP THREADPRIVATE(nqCO2) 6 USE strings_mod, ONLY: msg, maxlen, strStack, strHead, 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 !--- Full tracers database, tracers type keyword 16 PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr !--- Main dimensions 17 PUBLIC :: conv_flg, pbl_flg, solsym !--- 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 :: iqTraPha !--- 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 PUBLIC :: ntraciso, ntraceurs_zone, indnum_fn_num, use_iso, index_trac, iqiso 35 PUBLIC :: niso_possibles, ok_isotrac, ok_isotopes, ok_iso_verif 36 37 INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect 38 39 !=== CONVENTIONS FOR TRACERS NUMBERS: 40 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 41 ! | water in different | water tagging | water isotopes | other tracers | additional tracers moments | 42 ! | phases: H2O_[gls] | isotopes | | | for higher order schemes | 43 ! |--------------------+-----------------------+-----------------+---------------+----------------------------| 44 ! | | | | | | 45 ! |<-- nqo -->|<-- nqo*niso* nzone -->|<-- nqo*niso -->|<-- nbtr -->|<-- (nmom) -->| 46 ! | | | | 47 ! | |<-- nqo*niso*(nzone+1) = nqo*ntiso -->|<-- nqtottr = nbtr + nmom -->| 48 ! | = nqtot - nqo*(ntiso+1) | 49 ! | | 50 ! |<-- nqtrue = nbtr + nqo*(ntiso+1) -->| | 51 ! | | 52 ! |<-- nqtot = nqtrue + nmom -->| 53 ! | | 54 ! |-----------------------------------------------------------------------------------------------------------| 55 ! NOTES FOR THIS TABLE: 56 ! * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'), 57 ! since water is so far the sole tracers family, except passive CO2, removed from the main tracers table. 58 ! * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas". 59 ! * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any. 60 ! 61 !=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot) 62 ! Each entry is accessible using "%" sign. 63 ! |-------------+------------------------------------------------------+-------------+------------------------+ 64 ! | entry | Meaning | Former name | Possible values | 65 ! |-------------+------------------------------------------------------+-------------+------------------------+ 66 ! | name | Name (short) | tname | | 67 ! | gen0Name | Name of the 1st generation ancestor | / | | 68 ! | parent | Name of the parent | / | | 69 ! | longName | Long name (with adv. scheme suffix) for outputs | ttext | | 70 ! | type | Type (so far: tracer or tag) | / | tracer,tag | 71 ! | phase | Phases list ("g"as / "l"iquid / "s"olid) | / | [g][l][s] | 72 ! | component | Name(s) of the merged/cumulated section(s) | / | coma-separated names | 73 ! | iadv | Advection scheme number | iadv | 1-20,30 exc. 3-9,15,19 | 74 ! | iGeneration | Generation (>=1) | / | | 75 ! | isAdvected | advected tracers flag (.TRUE. if iadv >= 0) | / | nqtrue .TRUE. values | 76 ! | isInPhysics | tracers not extracted from the main table in physics | / | nqtottr .TRUE. values | 77 ! | iqParent | Index of the parent tracer | iqpere | 1:nqtot | 78 ! | iqDescen | Indexes of the childs (all generations) | iqfils | 1:nqtot | 79 ! | nqDescen | Number of the descendants (all generations) | nqdesc | 1:nqtot | 80 ! | nqChilds | Number of childs (1st generation only) | nqfils | 1:nqtot | 81 ! | iso_iGroup | Isotopes group index in isotopes(:) | / | 1:nbIso | 82 ! | iso_iName | Isotope name index in isotopes(iso_iGroup)%trac(:) | iso_indnum | 1:niso | 83 ! | iso_iZone | Isotope zone index in isotopes(iso_iGroup)%zone(:) | zone_num | 1:nzone | 84 ! | iso_iPhas | Isotope phase index in isotopes(iso_iGroup)%phas(:) | phase_num | 1:nphas | 85 ! | keys | key/val pairs accessible with "getKey" routine | / | | 86 ! +-------------+------------------------------------------------------+-------------+------------------------+ 87 ! 88 !=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES) 89 ! Each entry is accessible using "%" sign. 90 ! |-----------------+--------------------------------------------------+--------------------+-----------------+ 91 ! | entry | length | Meaning | Former name | Possible values | 92 ! |-----------------+--------------------------------------------------+--------------------+-----------------+ 93 ! | parent | Parent tracer (isotopes family name) | | | 94 ! | keys | niso | Isotopes keys/values pairs list + number | | | 95 ! | trac | ntiso | Isotopes + tagging tracers list + number | / | ntraciso | | 96 ! | zone | nzone | Geographic tagging zones list + number | / | ntraceurs_zone | | 97 ! | phase | nphas | Phases list + number | | [g][l][s], 1:3 | 98 ! | iqTraPha | Index in "qx" = f(name(1:ntiso)),phas) | iqiso | 1:nqtot | 99 ! | itZonIso | Index in "trac(1:ntiso)"= f(zone, name(1:niso)) | index_trac | 1:ntiso | 100 ! +-----------------+--------------------------------------------------+--------------------+-----------------+ 101 102 !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES 103 INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O) 104 nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O) 105 nqo, & !--- Number of water phases 106 nbIso, & !--- Number of available isotopes family 107 nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?) 108 nqCO2 !--- Number of tracers of CO2 (ThL) 109 CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type 110 !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nbIso, nqtottr, nqCO2, type_trac) 111 112 !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES 113 TYPE(trac_type), TARGET, SAVE, ALLOCATABLE :: tracers(:) !=== TRACERS DESCRIPTORS VECTOR 114 TYPE(isot_type), TARGET, SAVE, ALLOCATABLE :: isotopes(:) !=== ISOTOPES PARAMETERS VECTOR 115 !$OMP THREADPRIVATE(tracers, isotopes) 116 117 !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes" 118 TYPE(isot_type), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR 119 INTEGER, SAVE :: ixIso, iH2O !--- Index of the selected isotopes family and H2O family 120 LOGICAL, SAVE, POINTER :: isoCheck !--- Flag to trigger the checking routines 121 TYPE(keys_type), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName) 122 CHARACTER(LEN=maxlen), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY 123 isoZone(:), & !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY 124 isoPhas !--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY 125 INTEGER, SAVE, POINTER :: niso, nzone, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES 126 nphas, ntiso, & !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS 127 itZonIso(:,:), & !--- INDEX IN "isoTrac" AS f(tagging zone idx, isotope idx) 128 iqTraPha(:,:) !--- INDEX IN "qx" AS f(isotopic tracer idx, phase idx) 129 !$OMP THREADPRIVATE(isotope, ixIso,iH2O, isoCheck, isoKeys, isoName,isoZone,isoPhas, niso,nzone,nphas,ntiso, itZonIso,iqTraPha) 130 131 !=== VARIABLES FOR ISOTOPES INITIALIZATION AND FOR INCA 132 INTEGER, SAVE, ALLOCATABLE ::conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr) 133 pbl_flg(:) !--- Boundary layer activation ; needed for INCA (nbtr) 134 CHARACTER(LEN=8), SAVE, ALLOCATABLE :: solsym(:) 135 !$OMP THREADPRIVATE(conv_flg, pbl_flg, solsym) 136 137 !--- Aliases for older names + quantities to be removed (will be replaced by:) 138 INTEGER, POINTER, SAVE :: ntraciso, ntraceurs_zone !--- -> ntiso, nzone 139 !$OMP THREADPRIVATE (ntraciso, ntraceurs_zone) 140 INTEGER, POINTER, SAVE :: index_trac(:,:), iqiso(:,:) !--- -> itZonIso, iqTraPha 141 !$OMP THREADPRIVATE (index_trac, iqiso) 142 INTEGER, SAVE :: niso_possibles !--- suppressed (use effective niso instead) 143 !$OMP THREADPRIVATE(niso_possibles) 144 LOGICAL, SAVE :: ok_isotopes, ok_iso_verif, ok_isotrac !--- -> niso>0, isoCheck, nzone>0 145 !$OMP THREADPRIVATE(ok_isotopes, ok_iso_verif, ok_isotrac) 146 LOGICAL, SAVE, ALLOCATABLE :: use_iso(:) !--- suppressed 147 !$OMP THREADPRIVATE (use_iso) 148 INTEGER, SAVE, ALLOCATABLE :: indnum_fn_num(:) 149 !$OMP THREADPRIVATE (indnum_fn_num) 31 150 32 151 #ifdef CPP_StratAer … … 38 157 #endif 39 158 40 ! Tracers parameters41 TYPE(trac_type), TARGET, ALLOCATABLE, SAVE :: tracers(:)42 !$OMP THREADPRIVATE(tracers)43 44 ! conv_flg(it)=0 : convection desactivated for tracer number it45 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: conv_flg46 !$OMP THREADPRIVATE(conv_flg)47 48 ! pbl_flg(it)=0 : boundary layer diffusion desactivaded for tracer number it49 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: pbl_flg50 !$OMP THREADPRIVATE(pbl_flg)51 52 CHARACTER(len=4),SAVE :: type_trac53 !$OMP THREADPRIVATE(type_trac)54 CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym55 !$OMP THREADPRIVATE(solsym)56 57 ! CRisi: cas particulier des isotopes58 LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso59 !$OMP THREADPRIVATE(ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso)60 INTEGER :: niso_possibles61 PARAMETER ( niso_possibles=5)62 real, DIMENSION (niso_possibles),SAVE :: tnat,alpha_ideal63 !$OMP THREADPRIVATE(tnat,alpha_ideal)64 LOGICAL, DIMENSION(niso_possibles),SAVE :: use_iso65 !$OMP THREADPRIVATE(use_iso)66 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: iqiso ! donne indice iq en fn de (ixt,phase)67 !$OMP THREADPRIVATE(iqiso)68 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot69 !$OMP THREADPRIVATE(iso_indnum)70 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_possibles71 !$OMP THREADPRIVATE(indnum_fn_num)72 INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE :: index_trac ! numéro ixt en fn izone, indnum entre 1 et niso73 !$OMP THREADPRIVATE(index_trac)74 INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso75 !$OMP THREADPRIVATE(niso,ntraceurs_zone,ntraciso)76 77 159 CONTAINS 78 160 79 SUBROUTINE init_infotrac_phy(nqtot_,nqo_,nbtr_,nqtottr_,nqCO2_,tracers_,type_trac_,& 80 conv_flg_,pbl_flg_,solsym_,& 81 ok_isotopes_,ok_iso_verif_,ok_isotrac_,& 82 ok_init_iso_,niso_possibles_,tnat_,& 83 alpha_ideal_,use_iso_,iqiso_,iso_indnum_,& 84 indnum_fn_num_,index_trac_,& 85 niso_,ntraceurs_zone_,ntraciso_) 86 87 ! transfer information on tracers from dynamics to physics 88 USE print_control_mod, ONLY: prt_level, lunout 89 IMPLICIT NONE 90 91 INTEGER,INTENT(IN) :: nqtot_ 92 INTEGER,INTENT(IN) :: nqo_ 93 INTEGER,INTENT(IN) :: nbtr_ 94 INTEGER,INTENT(IN) :: nqtottr_ 95 INTEGER,INTENT(IN) :: nqCO2_ 96 TYPE(trac_type), INTENT(IN) :: tracers_(nqtot_) ! tracers descriptors 97 CHARACTER(len=*),INTENT(IN) :: type_trac_ 98 INTEGER,INTENT(IN) :: conv_flg_(nbtr_) 99 INTEGER,INTENT(IN) :: pbl_flg_(nbtr_) 100 CHARACTER(len=*),INTENT(IN) :: solsym_(nbtr_) 101 ! Isotopes: 102 LOGICAL,INTENT(IN) :: ok_isotopes_ 103 LOGICAL,INTENT(IN) :: ok_iso_verif_ 104 LOGICAL,INTENT(IN) :: ok_isotrac_ 105 LOGICAL,INTENT(IN) :: ok_init_iso_ 106 INTEGER,INTENT(IN) :: niso_possibles_ 107 REAL,INTENT(IN) :: tnat_(niso_possibles_) 108 REAL,INTENT(IN) :: alpha_ideal_(niso_possibles_) 109 LOGICAL,INTENT(IN) :: use_iso_(niso_possibles_) 110 INTEGER,INTENT(IN) :: iqiso_(ntraciso_,nqo_) 111 INTEGER,INTENT(IN) :: iso_indnum_(nqtot_) 112 INTEGER,INTENT(IN) :: indnum_fn_num_(niso_possibles_) 113 INTEGER,INTENT(IN) :: index_trac_(ntraceurs_zone_,niso_) 114 INTEGER,INTENT(IN) :: niso_ 115 INTEGER,INTENT(IN) :: ntraceurs_zone_ 116 INTEGER,INTENT(IN) :: ntraciso_ 117 118 INTEGER :: iq, itr 119 CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:) 120 CHARACTER(LEN=maxlen) :: modname="init_infotrac_phy" 121 122 nqtot=nqtot_ 123 nqo=nqo_ 124 nbtr=nbtr_ 125 nqCO2=nqCO2_ 126 nqtottr=nqtottr_ 127 ALLOCATE(tracers(nqtot)); tracers(:) = tracers_(:) 161 SUBROUTINE init_infotrac_phy(type_trac_, tracers_, isotopes_, nqtottr_, nqCO2_, pbl_flg_, conv_flg_, solsym_) 162 163 USE print_control_mod, ONLY: prt_level, lunout 164 165 IMPLICIT NONE 166 CHARACTER(LEN=*),INTENT(IN) :: type_trac_ 167 TYPE(trac_type), INTENT(IN) :: tracers_(:) 168 TYPE(isot_type), INTENT(IN) :: isotopes_(:) 169 INTEGER, INTENT(IN) :: nqtottr_ 170 INTEGER, INTENT(IN) :: nqCO2_ 171 INTEGER, INTENT(IN) :: conv_flg_(:) 172 INTEGER, INTENT(IN) :: pbl_flg_(:) 173 CHARACTER(LEN=*),INTENT(IN) :: solsym_(:) 174 175 INTEGER :: iq, ixt 128 176 #ifdef CPP_StratAer 129 IF (type_trac == 'coag') THEN 177 CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:) 178 #endif 179 CHARACTER(LEN=maxlen) :: modname="init_infotrac_phy" 180 181 type_trac = type_trac_ 182 tracers = tracers_ 183 isotopes = isotopes_ 184 nqtottr = nqtottr_ 185 nqCO2 = nqCO2_ 186 pbl_flg = pbl_flg_ 187 conv_flg = conv_flg_ 188 solsym = solsym_ 189 nqtot = SIZE(tracers_) 190 nqo = COUNT(delPhase(tracers%name)=='H2O' .AND. tracers%iGeneration==0) 191 nbtr = SIZE(conv_flg) 192 nbIso = SIZE(isotopes_) 193 194 !=== Determine selected isotopes class related quantities: 195 ! ixIso, isotope, niso,isoKeys, ntiso,isoName, nzone,isoZone, nphas,isoPhas, itZonIso, iqTraPha, isoCheck 196 IF(.NOT.isoSelect('H2O')) iH2O = ixIso 197 IF(prt_level > 1) THEN 198 CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname) 199 CALL msg('nbtr = '//TRIM(int2str(nbtr )), modname) 200 CALL msg('nqo = '//TRIM(int2str(nqo )), modname) 201 CALL msg('niso = '//TRIM(int2str(niso )), modname) 202 CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname) 203 CALL msg('nqtottr = '//TRIM(int2str(nqtottr)), modname) 204 CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname) 205 END IF 206 207 #ifdef CPP_StratAer 208 IF (type_trac == 'coag') THEN 130 209 nbtr_bin = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)]) 131 210 nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)]) … … 136 215 id_H2SO4_strat = strIdx(tnames, 'GASH2SO4') 137 216 id_TEST_strat = strIdx(tnames, 'GASTEST' ) 138 WRITE(lunout,*)'nbtr_bin =', nbtr_bin 139 WRITE(lunout,*)'nbtr_sulgas =', nbtr_sulgas 140 WRITE(lunout,*)'id_BIN01_strat =', id_BIN01_strat 141 WRITE(lunout,*)'id_OCS_strat =', id_OCS_strat 142 WRITE(lunout,*)'id_SO2_strat =', id_SO2_strat 143 WRITE(lunout,*)'id_H2SO4_strat =', id_H2SO4_strat 144 WRITE(lunout,*)'id_TEST_strat =', id_TEST_strat 145 END IF 146 #endif 147 type_trac = type_trac_ 148 ALLOCATE(conv_flg(nbtr)) 149 conv_flg(:)=conv_flg_(:) 150 ALLOCATE(pbl_flg(nbtr)) 151 pbl_flg(:)=pbl_flg_(:) 152 ALLOCATE(solsym(nbtr)) 153 solsym(:)=solsym_(:) 154 155 IF(prt_level.ge.1) THEN 156 write(lunout,*) TRIM(modname)//": nqtot,nqo,nbtr,nqCO2",nqtot,nqo,nbtr,nqCO2 157 ENDIF 158 159 ! Isotopes: 160 161 ! First check that the "niso_possibles" has the correct value 162 IF (niso_possibles.ne.niso_possibles_) THEN 163 CALL abort_physic(modname,& 164 "wrong value for parameter niso_possibles in infotrac_phy",1) 165 ENDIF 166 167 ok_isotopes=ok_isotopes_ 168 ok_iso_verif=ok_iso_verif_ 169 ok_isotrac=ok_isotrac_ 170 ok_init_iso=ok_init_iso_ 171 172 niso=niso_ 173 ntraceurs_zone=ntraceurs_zone_ 174 ntraciso=ntraciso_ 175 176 IF (ok_isotopes) THEN 177 tnat(:)=tnat_(:) 178 alpha_ideal(:)=alpha_ideal_(:) 179 use_iso(:)=use_iso_(:) 180 181 ALLOCATE(iqiso(ntraciso,nqo)) 182 iqiso(:,:)=iqiso_(:,:) 183 ALLOCATE(iso_indnum(nqtot)) 184 iso_indnum(:)=iso_indnum_(:) 185 186 indnum_fn_num(:)=indnum_fn_num_(:) 187 188 ALLOCATE(index_trac(ntraceurs_zone,niso)) 189 index_trac(:,:)=index_trac_(:,:) 190 ENDIF ! of IF(ok_isotopes) 191 192 WRITE(*,*) 'infotrac_phy 207: nqtottr=',nqtottr 193 WRITE(*,*) 'ntraciso,niso=',ntraciso,niso 217 CALL msg('nbtr_bin ='//TRIM(int2str(nbtr_bin )), modname) 218 CALL msg('nbtr_sulgas ='//TRIM(int2str(nbtr_sulgas )), modname) 219 CALL msg('id_BIN01_strat ='//TRIM(int2str(id_BIN01_strat)), modname) 220 CALL msg('id_OCS_strat ='//TRIM(int2str(id_OCS_strat )), modname) 221 CALL msg('id_SO2_strat ='//TRIM(int2str(id_SO2_strat )), modname) 222 CALL msg('id_H2SO4_strat ='//TRIM(int2str(id_H2SO4_strat)), modname) 223 CALL msg('id_TEST_strat ='//TRIM(int2str(id_TEST_strat )), modname) 224 END IF 225 #endif 226 227 !--- Isotopic quantities (to be removed soon) 228 ntraciso => ntiso 229 ntraceurs_zone => nzone 230 iqiso => iqTraPha 231 index_trac => itZonIso 232 ok_isotopes = niso > 0 233 ok_isotrac = nzone > 0 234 ok_iso_verif = isoCheck 235 niso_possibles = SIZE(tnom_iso) 236 indnum_fn_num = [(strIdx(isotope%keys(:)%name, tnom_iso(ixt)), ixt=1, niso_possibles)] 237 use_iso = indnum_fn_num /= 0 194 238 #ifdef ISOVERIF 195 ! DC: the "1" will be replaced by iH2O (H2O isotopes group index) 196 WRITE(*,*) 'iso_iName=',PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==1) 197 #endif 198 199 END SUBROUTINE init_infotrac_phy 239 CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname) 240 #endif 241 242 END SUBROUTINE init_infotrac_phy 243 244 245 !============================================================================================================================== 246 !=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED 247 ! Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call). 248 !============================================================================================================================== 249 LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr) 250 IMPLICIT NONE 251 CHARACTER(LEN=*), INTENT(IN) :: iName 252 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose 253 INTEGER :: iIso 254 LOGICAL :: lV 255 lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose 256 iIso = strIdx(isotopes(:)%parent, iName) 257 lerr = iIso == 0 258 CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lerr .AND. lV) 259 IF(lerr) RETURN 260 lerr = isoSelectByIndex(iIso, lV) 261 END FUNCTION isoSelectByName 262 !============================================================================================================================== 263 LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr) 264 IMPLICIT NONE 265 INTEGER, INTENT(IN) :: iIso 266 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose 267 LOGICAL :: lv 268 lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose 269 lerr = .FALSE. 270 IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK 271 lerr = iIso<=0 .OR. iIso>nbIso 272 CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '//TRIM(int2str(nbIso))//'"',& 273 ll=lerr .AND. lV) 274 IF(lerr) RETURN 275 ixIso = iIso !--- Update currently selected family index 276 isotope => isotopes(ixIso) !--- Select corresponding component 277 isoKeys => isotope%keys; niso => isotope%niso 278 isoName => isotope%trac; ntiso => isotope%ntiso 279 isoZone => isotope%zone; nzone => isotope%nzone 280 isoPhas => isotope%phase; nphas => isotope%nphas 281 itZonIso => isotope%itZonIso; isoCheck => isotope%check 282 iqTraPha => isotope%iqTraPha 283 END FUNCTION isoSelectByIndex 284 !============================================================================================================================== 285 200 286 201 287 END MODULE infotrac_phy
Note: See TracChangeset
for help on using the changeset viewer.
