Changeset 3891 for LMDZ6/branches/LMDZ-tracers/libf/phylmd/infotrac_phy.F90
- Timestamp:
- May 11, 2021, 2:10:34 PM (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/LMDZ-tracers/libf/phylmd/infotrac_phy.F90
r3852 r3891 3 3 USE strings_mod, ONLY: msg, fmsg, test, strIdx, int2str 4 4 5 USE readTracFiles_mod, ONLY: getKey_init, getKey, indexUpdate 5 USE readTracFiles_mod, ONLY: getKey_init, getKey, indexUpdate, delPhase 6 6 7 7 USE trac_types_mod, ONLY: tra, iso, kys … … 75 75 ! | type | Type (so far: tracer or tag) | / | tracer,tag | 76 76 ! | phas | Phases list ("g"as / "l"iquid / "s"olid) | / | [g][l][s] | 77 ! | comp | Name(s) of the merged/cumulated section(s) | / | coma-separated names | 77 78 ! | iadv | Advection scheme number | iadv | 1-20,30 exc. 3-9,15,19 | 78 79 ! | igen | Generation (>=1) | / | | … … 108 109 nbIso !--- Number of available isotopes family 109 110 CHARACTER(LEN=256), SAVE :: type_trac !--- Keyword for tracers type 111 !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nbIso, type_trac) 110 112 111 113 !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES … … 115 117 116 118 !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes" 117 TYPE(iso), SAVE, POINTER :: isotope!--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR118 INTEGER, SAVE :: ixIso, iH2O!--- Index of the selected isotopes family and H2O family119 LOGICAL, SAVE , POINTER :: isoCheck!--- Flag to trigger the checking routines120 TYPE(kys), SAVE, POINTER :: isoKeys(:)!--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)121 CHARACTER(LEN=256), SAVE, POINTER :: isoName(:),& !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY122 isoZone(:),& !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY123 isoPhas!--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY124 INTEGER, SAVE :: niso, nzon, npha,& !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES125 nitr !--- NUMBER OFISOTOPES + ISOTOPIC TAGGING TRACERS126 INTEGER, SAVE, POINTER :: iZonIso(:,:)!--- INDEX IN "isoTrac" AS f(tagging zone, isotope)127 INTEGER, SAVE, POINTER :: iTraPha(:,:) !===INDEX IN "isoTrac" AS f(isotopic tracer, phase)119 TYPE(iso), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR 120 INTEGER, SAVE :: ixIso, iH2O !--- Index of the selected isotopes family and H2O family 121 LOGICAL, SAVE :: isoCheck !--- Flag to trigger the checking routines 122 TYPE(kys), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName) 123 CHARACTER(LEN=256), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY 124 isoZone(:), & !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY 125 isoPhas !--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY 126 INTEGER, SAVE :: niso, nzon, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES 127 npha, nitr !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS 128 INTEGER, SAVE, POINTER :: iZonIso(:,:) !--- INDEX IN "isoTrac" AS f(tagging zone, isotope) 129 INTEGER, SAVE, POINTER :: iTraPha(:,:) !--- INDEX IN "isoTrac" AS f(isotopic tracer, phase) 128 130 !$OMP THREADPRIVATE(isotope, ixIso,iH2O, isoCheck, isoKeys, isoName,isoZone,isoPhas, niso,nzon,npha,nitr, iZonIso,iTraPha) 129 131 … … 132 134 alpha_ideal(:) !--- Ideal fractionning coefficient (for initial state) (niso) 133 135 INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr) 134 pbl_flg(:) !---Boundary layer activation ; needed for INCA (nbtr)135 INTEGER, SAVE, ALLOCATABLE :: niadv(:), &136 itr_indice(:) !--- Indexes of the tracers passed to phytrac (nqtottr)137 CHARACTER(LEN= 256),SAVE, ALLOCATABLE :: solsym(:) !--- Names from INCA (nbtr)138 !OMP THREADPRIVATE(tnat, alpha_ideal, conv_flg, pbl_flg, niadv, itr_indice, solsym)136 pbl_flg(:), & !--- Boundary layer activation ; needed for INCA (nbtr) 137 itr_indice(:), & !--- Indexes of the tracers passed to phytrac (nqtottr) 138 niadv(:) !--- Indexes of true tracers (<=nqtot, such that iadv(idx)>0) 139 CHARACTER(LEN=8), SAVE, ALLOCATABLE :: solsym(:) !--- Names from INCA (nbtr) 140 !OMP THREADPRIVATE(tnat, alpha_ideal, conv_flg, pbl_flg, itr_indice, niadv, solsym) 139 141 140 142 #ifdef CPP_StratAer … … 163 165 solsym = solsym_ 164 166 nqtot = SIZE(tracers_) 167 nqo = COUNT(delPhase(tracers%name)=='H2O' .AND. tracers%igen==1) 165 168 nbtr = nbtr_ 166 169 niadv = niadv_ … … 169 172 conv_flg = conv_flg_ 170 173 174 CALL msg('nqtot = '//TRIM(int2str(nqtot))) 175 CALL msg('nbtr = '//TRIM(int2str(nbtr))) 176 CALL msg('nqo = '//TRIM(int2str(nqo))) 177 171 178 !=== Specific to water 172 179 CALL getKey_init(tracers, isotopes) 173 180 IF(.NOT.isoSelect('H2O')) THEN 174 181 iH2O = ixIso 175 lerr = getKey('tnat' ,tnat, isoName) 176 lerr = getKey('alpha',alpha_ideal, isoName) 177 nqo = isotope%npha 182 lerr = getKey('tnat' ,tnat, isoName(1:isotope%niso)) 183 lerr = getKey('alpha',alpha_ideal, isoName(1:isotope%niso)) 178 184 END IF 179 IF(prt_level > 1) WRITE(lunout,*) TRIM(modname)//": nqtot, nqo, nbtr = ",nqtot, nqo, nbtr180 185 itr_indice = PACK(tracers(:)%itr, MASK = tracers(:)%itr/=0) 181 print*,'66' 182 183 !? conv_flg, pbl_flg, solsym 184 !? isoInit 186 !? CDC isoInit => A VOIR !! 185 187 186 188 #ifdef CPP_StratAer … … 196 198 CASE('GASSO2'); id_SO2_strat = iq - nqo; CALL msg('id_SO2_strat =', id_SO2_strat) 197 199 CASE('GASH2SO4'); id_H2SO4_strat = iq - nqo; CALL msg('id_H2SO4_strat=', id_H2SO4_strat) 198 CASE('GASTEST'); id_TEST_strat = iq - nqo; CALL msg('id_TEST_strat =', id_TEST_strat)200 CASE('GASTEST'); id_TEST_strat = iq - nqo; CALL msg('id_TEST_strat =', id_TEST_strat) 199 201 END SELECT 200 202 END DO … … 209 211 !============================================================================================================================== 210 212 !=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED 211 ! Singe generic "isoSelect" routine, using the predefined parent index (fast version) or its name (first time). 212 !============================================================================================================================== 213 LOGICAL FUNCTION isoSelectByName(iName) RESULT(lerr) 214 CHARACTER(LEN=*), INTENT(IN) :: iName 213 ! Singe generic "isoSelect" routine, using the predefined parent index (fast version) or its name (first call). 214 !============================================================================================================================== 215 LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr) 216 IMPLICIT NONE 217 CHARACTER(LEN=*), INTENT(IN) :: iName 218 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose 215 219 INTEGER :: iIso 220 LOGICAL :: lV 221 lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose 216 222 iIso = strIdx(isotopes(:)%prnt, iName) 217 IF(test(fmsg(iIso == 0,'no isotope family named "'//TRIM(iName)//'"'),lerr)) RETURN 218 IF(isoSelectByIndex(iIso)) RETURN 223 lerr = iIso == 0 224 CALL msg(lerr .AND. lV, 'no isotope family named "'//TRIM(iName)//'"') 225 IF(lerr) RETURN 226 lerr = isoSelectByIndex(iIso) 219 227 END FUNCTION isoSelectByName 220 228 !============================================================================================================================== 221 LOGICAL FUNCTION isoSelectByIndex(iIso) RESULT(lerr) 222 INTEGER, INTENT(IN) :: iIso 229 LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr) 230 IMPLICIT NONE 231 INTEGER, INTENT(IN) :: iIso 232 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose 233 LOGICAL :: lv 234 lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose 223 235 lerr = .FALSE. 224 236 IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK 225 IF(test(fmsg(iIso<=0 .OR. iIso>=nbIso,'Inconsistent isotopes family index '//TRIM(int2str(iIso))),lerr)) RETURN 237 lerr = iIso<=0 .OR. iIso>nbIso 238 CALL msg(lerr .AND. lV, 'Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= ' & 239 //TRIM(int2str(nbIso))//'"') 240 IF(lerr) RETURN 226 241 ixIso = iIso !--- Update currently selected family index 227 242 isotope => isotopes(ixIso) !--- Select corresponding component 228 !--- VARIOUS ALIASES 229 isoKeys => isotope%keys; niso = isotope%niso 230 isoName => isotope%trac; nitr = isotope%nitr; isoCheck => isotope%check 231 isoZone => isotope%zone; nzon = isotope%nzon; iZonIso => isotope%iZonIso 232 isoPhas => isotope%phas; npha = isotope%npha; iTraPha => isotope%iTraPha 243 isoKeys => isotope%keys; niso = isotope%niso 244 isoName => isotope%trac; nitr = isotope%nitr 245 isoZone => isotope%zone; nzon = isotope%nzon 246 isoPhas => isotope%phas; npha = isotope%npha 247 iZonIso => isotope%iZonIso; isoCheck = isotope%check 248 iTraPha => isotope%iTraPha 233 249 END FUNCTION isoSelectByIndex 234 250 !==============================================================================================================================
Note: See TracChangeset
for help on using the changeset viewer.