Changeset 4301 for LMDZ6/trunk
- Timestamp:
- Oct 20, 2022, 1:57:21 PM (2 years ago)
- Location:
- LMDZ6/trunk/libf
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3d/dynetat0.F90
r4270 r4301 10 10 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_INQ_VARID, & 11 11 NF90_CLOSE, NF90_GET_VAR, NF90_NoErr 12 USE readTracFiles_mod, ONLY: new2old Name12 USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3 13 13 USE control_mod, ONLY: planet_type 14 14 USE assert_eq_m, ONLY: assert_eq … … 42 42 INTEGER :: iq, fID, vID, idecal, iqParent, iName, iZone, iPhase 43 43 REAL :: time, tab_cntrl(length) !--- RUN PARAMS TABLE 44 LOGICAL :: l OldHNO3, ll44 LOGICAL :: lSkip, ll 45 45 !------------------------------------------------------------------------------- 46 46 modname="dynetat0" … … 130 130 ll=.FALSE. 131 131 #ifdef REPROBUS 132 !--- .TRUE. for old convention: HNO3 = g+l and HNO3_g = g (new convention: HNO3tot = g+l and HNO3 = g) 133 ll = NF90_INQ_VARID(fID, 'HNO3tot', vID) /= NF90_NoErr 132 ll = NF90_INQ_VARID(fID, 'HNO3tot', vID) /= NF90_NoErr !--- DETECT OLD REPRO start.nc FILE 134 133 #endif 135 134 DO iq=1,nqtot 136 135 var = tracers(iq)%name 137 oldVar = new2oldName(var) 138 lOldHNO3 = ll .AND. (var == 'HNO3' .OR. var == 'HNO3_g') 139 !-------------------------------------------------------------------------------------------------------------------------- 140 IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr .AND. .NOT.lOldHNO3) THEN !=== REGULAR CASE 136 oldVar = new2oldH2O(var) 137 lSkip = ll .AND. var == 'HNO3' !--- FORCE "HNO3_g" READING FOR "HNO3" 138 #ifdef REPROBUS 139 ix = strIdx(newHNO3, var); IF(ix /= 0) oldVar = oldHNO3(ix) !--- REPROBUS HNO3 exceptions 140 #endif 141 #ifdef INCA 142 IF(var == 'O3') oldVar = 'OX' !--- DEAL WITH INCA OZONE EXCEPTION 143 #endif 144 !-------------------------------------------------------------------------------------------------------------------------- 145 IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr .AND. .NOT.lSkip) THEN !=== REGULAR CASE: AVAILABLE VARIABLE 141 146 CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var) 142 147 !-------------------------------------------------------------------------------------------------------------------------- 143 ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == NF90_NoErr) THEN !=== OLDNAME148 ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == NF90_NoErr) THEN !=== TRY WITH ALTERNATE NAME 144 149 CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to <'//TRIM(oldVar)//'>', modname) 145 150 CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",oldVar) 146 151 !-------------------------------------------------------------------------------------------------------------------------- 147 #ifdef REPROBUS148 ELSE IF(NF90_INQ_VARID(fID, 'HNO3_g', vID) == NF90_NoErr .AND. lOldHNO3 .AND. var == 'HNO3' ) THEN149 CALL msg('Tracer <HNO3_g> is used for <HNO3> (old convention)', modname) !=== REPROBUS: HNO3_g INSTEAD OF HNO3150 CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var)151 ELSE IF(NF90_INQ_VARID(fID, 'HNO3', vID) == NF90_NoErr .AND. lOldHNO3 .AND. var == 'HNO3tot') THEN152 CALL msg('Tracer <HNO3> is used for <HNO3tot> (old convention)', modname) !=== REPROBUS: HNO3 INSTEAD OF HNO3tot153 CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var)154 #endif155 !--------------------------------------------------------------------------------------------------------------------------156 #ifdef INCA157 ELSE IF(NF90_INQ_VARID(fID, 'OX', vID) == NF90_NoErr .AND. var == 'O3') THEN !=== INCA: OX INSTEAD OF O3158 CALL msg('Tracer <O3> is missing => initialized to <OX>', modname)159 CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",'OX')160 !--------------------------------------------------------------------------------------------------------------------------161 #endif162 152 ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN !=== WATER ISOTOPES 163 153 iName = tracers(iq)%iso_iName -
LMDZ6/trunk/libf/dyn3d_common/infotrac.F90
r4193 r4301 5 5 USE strings_mod, ONLY: msg, find, strIdx, strFind, strParse, dispTable, int2str, reduceExpr, & 6 6 cat, fmsg, test, strTail, strHead, strStack, strReduce, bool2str, maxlen, testFile 7 USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, addPhase, indexUpdate, nphases, ancestor, & 8 isot_type, old2newName, delPhase, getKey_init, tran0, & 9 keys_type, initIsotopes, getPhase, known_phases, getKey, setGeneration, & 10 maxTableWidth 7 USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, indexUpdate, addPhase, getKey, maxTableWidth, keys_type, & 8 isot_type, setGeneration, initIsotopes, delPhase, getKey_init, ancestor, tran0 9 11 10 IMPLICIT NONE 12 11 … … 182 181 INTEGER :: iad !--- Advection scheme number 183 182 INTEGER :: ic, ip, np, iq, jq, it, nt, im, nm, ix, iz, nz, k !--- Indexes and temporary variables 184 LOGICAL :: lerr, ll 183 LOGICAL :: lerr, ll, lRepr 185 184 CHARACTER(LEN=1) :: p 186 185 TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:) 187 186 TYPE(trac_type), POINTER :: t1, t(:) 188 187 TYPE(isot_type), POINTER :: iso 189 190 CHARACTER(LEN=maxlen), ALLOCATABLE :: tnom_0(:), tnom_transp(:) !--- Tracer short name + transporting fluid name191 CHARACTER(LEN=maxlen) :: tchaine192 188 INTEGER :: ierr 193 189 … … 247 243 modname, ALL(types_trac /= 'inca') .AND. ALL(types_trac /= 'inco') .AND. config_inca /= 'none')) config_inca = 'none' 248 244 249 nqCO2 = 0; IF(ANY(types_trac == 'inco')) nqCO2 = 1245 nqCO2 = COUNT( [ANY(types_trac == 'inco') .OR. (ANY(types_trac == 'co2i') .AND. ANY(types_trac == 'inca'))] ) 250 246 251 247 !============================================================================================================================== 252 248 ! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid) 253 249 !============================================================================================================================== 254 IF(readTracersFiles(type_trac, fType, tracers)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 250 lRepr = ANY(types_trac(:) == 'repr') 251 IF(readTracersFiles(type_trac, fType, tracers, lRepr)) CALL abort_gcm(modname, 'problem with tracers file(s)',1) 252 !--------------------------------------------------------------------------------------------------------------------------- 255 253 IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1) 256 254 !--------------------------------------------------------------------------------------------------------------------------- … … 258 256 !--------------------------------------------------------------------------------------------------------------------------- 259 257 #ifdef INCA 260 nqo = SIZE(tracers) 261 IF(nqCO2==1 .AND. nqo==4) nqo = 3 !--- Force nqo to 3 (ThL) 258 nqo = SIZE(tracers) - nqCO2 262 259 CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA 263 260 nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac … … 284 281 #endif 285 282 !--------------------------------------------------------------------------------------------------------------------------- 286 ELSE !=== FOUND NEW STYLE TRACERS CONFIGURATION FILE(S)283 ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) 287 284 !--------------------------------------------------------------------------------------------------------------------------- 288 285 nqo = COUNT(delPhase(tracers(:)%name) == 'H2O' & … … 407 404 IF(initIsotopes(tracers, isotopes)) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1) 408 405 nbIso = SIZE(isotopes) 409 nqtottr = nqtot - COUNT( tracers%gen0Name== 'H2O' .AND. tracers%component == 'lmdz')406 nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz') 410 407 IF(nbIso/=0) THEN !--- ISOTOPES FOUND 411 408 … … 442 439 443 440 !--- Note: nqtottr can differ from nbtr when nmom/=0 444 !IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &445 !CALL abort_gcm('infotrac_init', 'pb dans le calcul de nqtottr', 1)441 IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) & 442 CALL abort_gcm('infotrac_init', 'pb dans le calcul de nqtottr', 1) 446 443 447 444 !=== DISPLAY THE RESULTS … … 486 483 LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr) 487 484 IMPLICIT NONE 488 CHARACTER(LEN=*), INTENT(IN) 485 CHARACTER(LEN=*), INTENT(IN) :: iName 489 486 LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose 490 487 INTEGER :: iIso -
LMDZ6/trunk/libf/dyn3dmem/dynetat0_loc.F90
r4270 r4301 8 8 USE parallel_lmdz 9 9 USE infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, tnat, alpha_ideal, iH2O 10 USE strings_mod, ONLY: maxlen, msg, strStack, real2str 10 USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str 11 11 USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_INQUIRE_DIMENSION, NF90_INQ_VARID, & 12 12 NF90_CLOSE, NF90_GET_VAR, NF90_INQUIRE_VARIABLE, NF90_NoErr 13 USE readTracFiles_mod, ONLY: new2old Name13 USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3 14 14 USE control_mod, ONLY: planet_type 15 15 USE assert_eq_m, ONLY: assert_eq … … 41 41 CHARACTER(LEN=maxlen) :: mesg, var, modname, oldVar 42 42 INTEGER, PARAMETER :: length=100 43 INTEGER :: iq, fID, vID, idecal, ierr, iqParent, iName, iZone, iPhase 43 INTEGER :: iq, fID, vID, idecal, ierr, iqParent, iName, iZone, iPhase, ix 44 44 REAL :: time, tab_cntrl(length) !--- RUN PARAMS TABLE 45 45 REAL, ALLOCATABLE :: vcov_glo(:,:),masse_glo(:,:), ps_glo(:) 46 46 REAL, ALLOCATABLE :: ucov_glo(:,:), q_glo(:,:), phis_glo(:) 47 47 REAL, ALLOCATABLE :: teta_glo(:,:) 48 LOGICAL :: l OldHNO3, ll48 LOGICAL :: lSkip, ll 49 49 !------------------------------------------------------------------------------- 50 50 modname="dynetat0_loc" … … 152 152 !--- Tracers 153 153 ALLOCATE(q_glo(ip1jmp1,llm)) 154 ll =.FALSE.154 ll = .FALSE. 155 155 #ifdef REPROBUS 156 !--- .TRUE. for old convention: HNO3 = g+l and HNO3_g = g (new convention: HNO3tot = g+l and HNO3 = g) 157 ll = NF90_INQ_VARID(fID, 'HNO3tot', vID) /= NF90_NoErr 156 ll = NF90_INQ_VARID(fID, 'HNO3tot', vID) /= NF90_NoErr !--- DETECT OLD REPRO start.nc FILE 158 157 #endif 159 158 DO iq=1,nqtot 160 159 var = tracers(iq)%name 161 oldVar = new2oldName(var) 162 lOldHNO3 = ll .AND. (var == 'HNO3' .OR. var == 'HNO3_g') 163 !-------------------------------------------------------------------------------------------------------------------------- 164 IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr .AND. .NOT.lOldHNO3) THEN !=== REGULAR CASE 160 oldVar = new2oldH2O(var) 161 lSkip = ll .AND. var == 'HNO3' !--- FORCE "HNO3_g" READING FOR "HNO3" 162 #ifdef REPROBUS 163 ix = strIdx(newHNO3, var); IF(ix /= 0) oldVar = oldHNO3(ix) !--- REPROBUS HNO3 exceptions 164 #endif 165 #ifdef INCA 166 IF(var == 'O3') oldVar = 'OX' !--- DEAL WITH INCA OZONE EXCEPTION 167 #endif 168 !-------------------------------------------------------------------------------------------------------------------------- 169 IF(NF90_INQ_VARID(fID, var, vID) == NF90_NoErr .AND. .NOT.lSkip) THEN !=== REGULAR CASE: AVAILABLE VARIABLE 165 170 CALL get_var2(var,q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:) 166 171 !-------------------------------------------------------------------------------------------------------------------------- 167 ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == NF90_NoErr) THEN !=== OLDNAME172 ELSE IF(NF90_INQ_VARID(fID, oldVar, vID) == NF90_NoErr) THEN !=== TRY WITH ALTERNATE NAME 168 173 CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to <'//TRIM(oldVar)//'>', modname) 169 174 CALL get_var2(oldVar, q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:) 170 !--------------------------------------------------------------------------------------------------------------------------171 #ifdef REPROBUS172 ELSE IF(lOldHNO3 .AND. var == 'HNO3') THEN !=== REPROBUS: HNO3_g INSTEAD OF HNO3173 CALL msg('Tracer <HNO3_g> is used for <HNO3> (old convention)', modname)174 CALL get_var2( 'HNO3_g', q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)175 ELSE IF(lOldHNO3 .AND. var == 'HNO3tot') THEN !=== REPROBUS: HNO3 INSTEAD OF HNO3tot176 CALL msg('Tracer <HNO3> is used for <HNO3tot> (old convention)', modname)177 CALL get_var2( 'HNO3', q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)178 #endif179 #ifdef INCA180 ELSE IF(NF90_INQ_VARID(fID, 'OX', vID) == NF90_NoErr .AND. var == 'O3') THEN !=== INCA: OX INSTEAD OF O3181 CALL msg('Tracer <O3> is missing => initialized to <OX>', modname)182 CALL get_var2( 'OX' , q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)183 #endif184 175 !-------------------------------------------------------------------------------------------------------------------------- 185 176 ELSE IF(tracers(iq)%iso_iGroup == iH2O .AND. niso > 0) THEN !=== WATER ISOTOPES … … 214 205 CHARACTER(LEN=*), INTENT(IN) :: str1, str2 215 206 CHARACTER(LEN=maxlen) :: s1, s2 216 IF(n1/=n2) THEN 217 s1='value of '//TRIM(str1)//' =' 218 s2=' read in starting file differs from parametrized '//TRIM(str2)//' =' 219 WRITE(mesg,'(10x,a,i4,2x,a,i4)')TRIM(ADJUSTL(s1)),n1,TRIM(ADJUSTL(s2)),n2 220 CALL ABORT_gcm(TRIM(modname),TRIM(mesg),1) 221 END IF 207 IF(n1/=n2) CALL abort_gcm(TRIM(modname), 'value of "'//TRIM(str1)//'" = '//TRIM(int2str(n1))// & 208 ' read in starting file differs from gcm value of "'//TRIM(str2)//'" = '//TRIM(int2str(n2)), 1) 222 209 END SUBROUTINE check_dim 223 210 -
LMDZ6/trunk/libf/misc/readTracFiles_mod.f90
r4263 r4301 1 1 MODULE readTracFiles_mod 2 2 3 USE strings_mod, ONLY: msg, testFile, strFind, strStack, strReduce, strHead, strCount, find, fmsg, reduceExpr, &4 removeComment, cat, checkList, str2int, strParse, strReplace, strTail, strIdx, maxlen, test, dispTable, get_in3 USE strings_mod, ONLY: msg, find, get_in, str2int, dispTable, testFile, strReduce, strFind, strStack, strHead, & 4 test, removeComment, cat, fmsg, maxlen, int2str, checkList, strParse, strReplace, strTail, strCount, strIdx, reduceExpr 5 5 USE trac_types_mod, ONLY: trac_type, isot_type, keys_type 6 6 … … 9 9 PRIVATE 10 10 11 PUBLIC :: initIsotopes, maxlen, trac_type, isot_type, keys_type 12 PUBLIC :: readTracersFiles, indexUpdate, setGeneration !--- TOOLS ASSOCIATED TO TRACERS DESCRIPTORS 13 PUBLIC :: readIsotopesFile !--- TOOLS ASSOCIATED TO ISOTOPES DESCRIPTORS 14 PUBLIC :: getKey_init, getKey, fGetKey, setDirectKeys !--- GET/SET KEYS FROM/TO tracers & isotopes 15 16 PUBLIC :: addPhase, new2oldName, getPhase, & !--- FUNCTIONS RELATED TO THE PHASES 17 delPhase, old2newName, getiPhase, & !--- + ASSOCIATED VARIABLES 18 known_phases, old_phases, phases_sep, phases_names, nphases 19 20 PUBLIC :: oldH2OIso, newH2OIso !--- NEEDED FOR BACKWARD COMPATIBILITY (OLD traceur.def) 11 PUBLIC :: maxlen !--- PARAMETER FOR CASUAL STRING LENGTH 12 PUBLIC :: trac_type, readTracersFiles, setGeneration, indexUpdate !--- TRACERS DESCRIPTION ASSOCIATED TOOLS 13 PUBLIC :: keys_type, getKey, fGetKey, setDirectKeys, getKey_init !--- TOOLS TO GET/SET KEYS FROM/TO tracers & isotopes 14 15 PUBLIC :: addPhase, getiPhase, old_phases, phases_sep, nphases, & !--- FUNCTIONS RELATED TO THE PHASES 16 delPhase, getPhase, known_phases, phases_names !--- + ASSOCIATED VARIABLES 17 18 PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def) 19 PUBLIC :: oldHNO3, newHNO3 !--- HNO3 REPRO BACKWARD COMPATIBILITY (OLD start.nc) 21 20 22 21 PUBLIC :: tran0, idxAncestor, ancestor !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS 22 23 !=== FOR ISOTOPES: GENERAL 24 PUBLIC :: isot_type, readIsotopesFile, initIsotopes !--- ISOTOPES DESCRIPTION TYPE + READING ROUTINE 25 23 26 PUBLIC :: maxTableWidth 24 27 !------------------------------------------------------------------------------------------------------------------------------ … … 29 32 !------------------------------------------------------------------------------------------------------------------------------ 30 33 INTERFACE getKey 31 MODULE PROCEDURE getKeyByName_s1, getKeyByName_i1, getKeyByName_r1, getKeyByName_sm, getKeyByName_im, getKeyByName_rm 34 MODULE PROCEDURE getKeyByName_s1, getKeyByName_i1, getKeyByName_r1, & 35 getKeyByName_sm, getKeyByName_im, getKeyByName_rm 32 36 END INTERFACE getKey 33 37 !------------------------------------------------------------------------------------------------------------------------------ 34 38 INTERFACE fGetKey; MODULE PROCEDURE fgetKeyByIndex_s1, fgetKeyByName_s1; END INTERFACE fGetKey 39 INTERFACE old2newH2O; MODULE PROCEDURE old2newH2O_1, old2newH2O_m; END INTERFACE old2newH2O 40 INTERFACE new2oldH2O; MODULE PROCEDURE new2oldH2O_1, new2oldH2O_m; END INTERFACE new2oldH2O 35 41 INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset 36 INTERFACE idxAncestor; MODULE PROCEDURE idxAncestor_1, idxAncestor_m; END INTERFACE idxAncestor37 INTERFACE ancestor; MODULE PROCEDURE ancestor_1, ancestor_m; END INTERFACE ancestor42 INTERFACE idxAncestor; MODULE PROCEDURE idxAncestor_1, idxAncestor_m; END INTERFACE idxAncestor 43 INTERFACE ancestor; MODULE PROCEDURE ancestor_1, ancestor_m; END INTERFACE ancestor 38 44 INTERFACE addPhase; MODULE PROCEDURE addPhase_s1, addPhase_sm, addPhase_i1, addPhase_im; END INTERFACE addPhase 39 INTERFACE old2newName; MODULE PROCEDURE old2newName_1, old2newName_m; END INTERFACE old2newName40 INTERFACE new2oldName; MODULE PROCEDURE new2oldName_1, new2oldName_m; END INTERFACE new2oldName41 45 !------------------------------------------------------------------------------------------------------------------------------ 42 46 … … 45 49 46 50 !--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN 47 CHARACTER(LEN=maxlen), SAVE :: tran0 = 'air' 48 CHARACTER(LEN=maxlen), PARAMETER :: old_phases = 'vlir' 49 CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsr' 50 INTEGER, PARAMETER :: nphases=LEN_TRIM(known_phases)!--- Number of phases51 CHARACTER(LEN=maxlen), SAVE :: phases_names(nphases) & 51 CHARACTER(LEN=maxlen), SAVE :: tran0 = 'air' !--- Default transporting fluid 52 CHARACTER(LEN=maxlen), PARAMETER :: old_phases = 'vlir' !--- Old phases for water (no separator) 53 CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsr' !--- Known phases initials 54 INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases) !--- Number of phases 55 CHARACTER(LEN=maxlen), SAVE :: phases_names(nphases) & !--- Known phases names 52 56 = ['gaseous', 'liquid ', 'solid ', 'cloud '] 53 CHARACTER(LEN=1), SAVE :: phases_sep = '_' !--- Phase separator 54 LOGICAL, SAVE :: tracs_merge = .TRUE. !--- Merge/stack tracers lists 55 LOGICAL, SAVE :: lSortByGen = .TRUE. !--- Sort by growing generation 56 57 !--- KEPT JUST TO MANAGE OLD WATER ISOTOPES NAMES 58 !--- Apart from that context, on limitaion on isotopes names (as long as they have a corresponding line in isotopes_params.def) 57 CHARACTER(LEN=1), SAVE :: phases_sep = '_' !--- Phase separator 58 LOGICAL, SAVE :: tracs_merge = .TRUE. !--- Merge/stack tracers lists 59 LOGICAL, SAVE :: lSortByGen = .TRUE. !--- Sort by growing generation 60 61 !--- CORRESPONDANCE BETWEEN OLD AND NEW WATER NAMES 59 62 CHARACTER(LEN=maxlen), SAVE :: oldH2OIso(5) = ['eau', 'HDO', 'O18', 'O17', 'HTO' ] 60 63 CHARACTER(LEN=maxlen), SAVE :: newH2OIso(5) = ['H2[16]O', 'H[2]HO ', 'H2[18]O', 'H2[17]O', 'H[3]HO '] 64 65 !--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES 66 CHARACTER(LEN=maxlen), SAVE :: oldHNO3(2) = ['HNO3_g ', 'HNO3 '] 67 CHARACTER(LEN=maxlen), SAVE :: newHNO3(2) = ['HNO3 ', 'HNO3tot'] 61 68 62 69 !=== LOCAL COPIES OF THE TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey (INITIALIZED IN getKey_init) … … 72 79 !============================================================================================================================== 73 80 !=== READ ONE OR SEVERAL TRACER FILES AND FILL A "tr" TRACERS DESCRIPTOR DERIVED TYPE. 74 !=== THE RETURN VALUE fType DEPENDS ON WHAT IS FOUND:81 !=== THE RETURNED VALUE fType DEPENDS ON WHAT IS FOUND: 75 82 !=== 0: NO ADEQUATE FILE FOUND ; DEFAULT VALUES MUST BE USED 76 83 !=== 1: AN "OLD STYLE" TRACERS FILE "traceur.def": … … 93 100 ! * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys". 94 101 !============================================================================================================================== 95 LOGICAL FUNCTION readTracersFiles(type_trac, fTyp e, tracs) RESULT(lerr)102 LOGICAL FUNCTION readTracersFiles(type_trac, fTyp, tracs, lRepr) RESULT(lerr) 96 103 !------------------------------------------------------------------------------------------------------------------------------ 97 104 CHARACTER(LEN=*), INTENT(IN) :: type_trac !--- List of components used 98 INTEGER, INTENT(OUT) :: fType!--- Type of input file found105 INTEGER, OPTIONAL, INTENT(OUT) :: fTyp !--- Type of input file found 99 106 TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tracs(:) 107 LOGICAL, OPTIONAL, INTENT(IN) :: lRepr 100 108 CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:), sections(:), trac_files(:) 101 CHARACTER(LEN=maxlen) :: str, fname, mesg 102 INTEGER :: is, nsec, ierr, it, ntrac, ns, ip, ix 109 CHARACTER(LEN=maxlen) :: str, fname, mesg, tname, pname, cname 110 INTEGER :: is, nsec, ierr, it, ntrac, ns, ip, ix, fType 103 111 LOGICAL, ALLOCATABLE :: ll(:), lGen3(:) 112 LOGICAL :: lRep 104 113 !------------------------------------------------------------------------------------------------------------------------------ 105 114 lerr = .FALSE. 106 115 modname = 'readTracersFiles' 107 116 IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0)) 117 lRep=0; IF(PRESENT(lRepr)) lRep = lRepr 108 118 109 119 !--- Required sections + corresponding files names (new style single section case) … … 119 129 IF(.NOT.testFile('tracer.def')) fType = 2 !--- NEW STYLE ; SINGLE FILE, SEVERAL SECTIONS 120 130 IF(ALL(ll)) fType = 3 !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED 131 IF(PRESENT(fTyp)) fTyp = fType 121 132 IF(ANY(ll) .AND. fType/=3) THEN !--- MISSING FILES 122 133 IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN … … 135 146 SELECT CASE(fType) !--- Set %name, %genOName, %parent, %type, %phase, %component, %iGeneration, %keys 136 147 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 137 CASE(1) 148 CASE(1) !=== OLD FORMAT "traceur.def" 138 149 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 139 150 !--- OPEN THE "traceur.def" FILE … … 153 164 CALL msg('This file is for air tracers only', modname, ns == 3 .AND. it == 1) 154 165 CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1) 155 tracs(it)%name = old2newName(s(3), ip) !--- Set %name: name of the tracer 156 tracs(it)%parent = tran0 !--- Default transporting fluid name 157 IF(ns == 4) tracs(it)%parent = old2newName(s(4)) !--- Set %parent: parent of the tracer 166 167 !=== NAME OF THE TRACER 168 tname = old2newH2O(s(3), ip) 169 ix = strIdx(oldHNO3, s(3)) 170 IF(ix /= 0 .AND. lRep) tname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY) 171 tracs(it)%name = tname !--- Set %name 172 tracs(it)%keys%name = tname !--- Copy tracers names in keys components 173 174 !=== NAME OF THE COMPONENT 175 cname = type_trac !--- Name of the model component 176 IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz' 177 tracs(it)%component = cname !--- Set %component 178 179 !=== NAME OF THE PARENT 180 pname = tran0 !--- Default name: default transporting fluid (air) 181 IF(ns == 4) THEN 182 pname = old2newH2O(s(4)) 183 ix = strIdx(oldHNO3, s(4)) 184 IF(ix /= 0 .AND. lRep) pname = newHNO3(ix) !--- Exception for HNO3 (REPROBUS ONLY) 185 END IF 186 tracs(it)%parent = pname !--- Set %parent 187 188 !=== PHASE AND ADVECTION SCHEMES NUMBERS 158 189 tracs(it)%phase = known_phases(ip:ip) !--- Set %phase: tracer phase (default: "g"azeous) 159 tracs(it)%component = TRIM(type_trac) !--- Set %component: model component name160 IF(ANY([(addPhase('H2O', ip), ip=1, nphases)] == tracs(it)%name)) tracs(it)%component = 'lmdz'161 190 tracs(it)%keys%key = ['hadv', 'vadv'] !--- Set %keys%key 162 191 tracs(it)%keys%val = s(1:2) !--- Set %keys%val … … 177 206 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 178 207 179 180 208 IF(ALL([2,3] /= fType)) RETURN 181 209 … … 189 217 IF(test(cumulTracers(dBase, tracs), lerr)) RETURN 190 218 END IF 191 WHERE(tracs%gen0Name(1:3) /= 'H2O') tracs%isInPhysics=.TRUE. !--- Set %isInPhysics: passed to physics192 219 CALL setDirectKeys(tracs) !--- Set %iqParent, %iqDescen, %nqDescen, %nqChilds 193 220 END FUNCTION readTracersFiles … … 557 584 CHARACTER(LEN=1) :: p 558 585 INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n 559 LOGICAL :: lT g, lEx586 LOGICAL :: lTag, lExt 560 587 !------------------------------------------------------------------------------------------------------------------------------ 561 588 nq = SIZE(tr, DIM=1) … … 571 598 it = 1 !--- Current "ttr(:)" index 572 599 DO iq = 1, nq !--- Loop on "tr(:)" indexes 573 lT g = tr(iq)%type=='tag'!--- Current tracer is a tag600 lTag = tr(iq)%type=='tag' !--- Current tracer is a tag 574 601 i0 = strFind(tr(:)%name, TRIM(tr(iq)%gen0Name), n) !--- Indexes of first generation ancestor copies 575 602 np = SUM([( LEN_TRIM(tr(i0(i))%phase),i=1,n )], 1) !--- Number of phases for current tracer tr(iq) 576 lEx = np>1!--- Phase suffix only required if phases number is > 1577 IF(lT g) lEx = lEx .AND. tr(iq)%iGeneration>0!--- No phase suffix for generation 0 tags603 lExt = np>1 !--- Phase suffix only required if phases number is > 1 604 IF(lTag) lExt = lExt .AND. tr(iq)%iGeneration>0 !--- No phase suffix for generation 0 tags 578 605 DO i=1,n !=== LOOP ON GENERATION 0 ANCESTORS 579 606 jq = i0(i) !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq) … … 583 610 p = pha(ip:ip) 584 611 trn = TRIM(tr(iq)%name); nam = trn !--- Tracer name (regular case) 585 IF(lT g) nam = TRIM(tr(iq)%parent)!--- Parent name (tagging case)586 IF(lEx ) nam = addPhase(nam, p )!--- Phase extension needed587 IF(lT g) nam = TRIM(nam)//'_'//TRIM(trn)!--- <parent>_<name> for tags612 IF(lTag) nam = TRIM(tr(iq)%parent) !--- Parent name (tagging case) 613 IF(lExt) nam = addPhase(nam, p ) !--- Phase extension needed 614 IF(lTag) nam = TRIM(nam)//'_'//TRIM(trn) !--- <parent>_<name> for tags 588 615 ttr(it) = tr(iq) !--- Same <key>=<val> pairs 589 616 ttr(it)%name = TRIM(nam) !--- Name with possibly phase suffix 590 617 ttr(it)%keys%name = TRIM(nam) !--- Name inside the keys decriptor 591 618 ttr(it)%phase = p !--- Single phase entry 592 IF(lEx .AND. tr(iq)%iGeneration>0) THEN619 IF(lExt .AND. tr(iq)%iGeneration>0) THEN 593 620 ttr(it)%parent = addPhase(ttr(it)%parent, p) 594 621 ttr(it)%gen0Name = addPhase(ttr(it)%gen0Name, p) … … 802 829 END FUNCTION dispTraSection 803 830 !============================================================================================================================== 804 !==============================================================================================================================805 831 806 832 … … 816 842 out => NULL(); IF(it /= 0) out => t(it) 817 843 END FUNCTION aliasTracer 818 ! ------------------------------------------------------------------------------------------------------------------------------844 !============================================================================================================================== 819 845 820 846 … … 837 863 CALL indexUpdate(out) 838 864 END FUNCTION trSubset_Name 839 ! ------------------------------------------------------------------------------------------------------------------------------865 !============================================================================================================================== 840 866 841 867 … … 850 876 CALL indexUpdate(out) 851 877 END FUNCTION trSubset_gen0Name 852 ! ------------------------------------------------------------------------------------------------------------------------------878 !============================================================================================================================== 853 879 854 880 … … 874 900 END DO 875 901 END SUBROUTINE indexUpdate 876 ! ------------------------------------------------------------------------------------------------------------------------------902 !============================================================================================================================== 877 903 878 904 … … 892 918 LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr) 893 919 CHARACTER(LEN=*), INTENT(IN) :: fnam !--- Input file name 894 TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:) !--- Isotopes descriptors (field "prnt" must be defined!)920 TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:) !--- Isotopes descriptors (field %parent must be defined!) 895 921 INTEGER :: ik, is, it, idb, nk0, i, iis 896 922 INTEGER :: nk, ns, nt, ndb, nb0, i0 … … 912 938 ndb = SIZE(dBase, DIM=1) !--- Current database size 913 939 DO idb = nb0, ndb 914 iis = idb-nb0+1940 iis = idb-nb0+1 915 941 916 942 !--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION … … 954 980 !============================================================================================================================== 955 981 982 956 983 !============================================================================================================================== 957 984 !=== IF ISOTOPES (2ND GENERATION TRACERS) ARE DETECTED: === … … 965 992 TYPE(isot_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: isot(:) 966 993 CHARACTER(LEN=maxlen), ALLOCATABLE :: p(:), str(:) !--- Temporary storage 967 CHARACTER(LEN=maxlen) :: i name994 CHARACTER(LEN=maxlen) :: iName 968 995 CHARACTER(LEN=1) :: ph !--- Phase 969 996 INTEGER :: nbIso, ic, ip, iq, it, iz … … 975 1002 t => trac 976 1003 977 p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1) !--- Parents of generation 1 isotopes 1004 !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES 1005 p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1) 978 1006 CALL strReduce(p, nbIso) 979 1007 ALLOCATE(isot(nbIso)) … … 1027 1055 !=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list 1028 1056 ! (including tagging tracers) is sorted this way: iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN 1029 i%iqIsoPha = RESHAPE( [( (strIdx(t%name, addPhase(i%trac(it),i%phase(ip:ip))), it=1, i%ntiso), ip=1, i%nphas)], &1057 i%iqIsoPha = RESHAPE( [( (strIdx(t%name, addPhase(i%trac(it),i%phase(ip:ip))), it=1, i%ntiso), ip=1, i%nphas)], & 1030 1058 [i%ntiso, i%nphas] ) 1031 1059 !=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes … … 1035 1063 1036 1064 !=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE 1037 ! DONE HERE, AND NOT ONLY IN "infotrac_phy", BECAUSE SOME PHYSICAL PARAMS ARE NEEDED FOR RESTARTS (tnat AND alpha_ideal)1038 1065 lerr = readIsotopesFile('isotopes_params.def',isot) 1039 1066 … … 1056 1083 prf = 'i'//REPEAT('s',nk+1) !--- Profile for table printing 1057 1084 ALLOCATE(ttl(nk+2), val(nt,nk+1)) 1058 ttl(1:2) = ['i q','name']; ttl(3:nk+2) = ides(ip)%keys(1)%key(:)!--- Titles line with keys names1085 ttl(1:2) = ['it ','name']; ttl(3:nk+2) = ides(ip)%keys(1)%key(:)!--- Titles line with keys names 1059 1086 val(:,1) = ides(ip)%keys(:)%name !--- Values table 1st column: isotopes names 1060 1087 DO ik = 1, nk … … 1072 1099 1073 1100 !============================================================================================================================== 1101 !=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS 1102 !============================================================================================================================== 1074 1103 SUBROUTINE addKey_1(key, val, ky, lOverWrite) 1075 !------------------------------------------------------------------------------------------------------------------------------1076 ! Purpose: Add the <key>=<val> pair in the "ky" keys descriptor.1077 !------------------------------------------------------------------------------------------------------------------------------1078 1104 CHARACTER(LEN=*), INTENT(IN) :: key, val 1079 1105 TYPE(keys_type), INTENT(INOUT) :: ky 1080 1106 LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite 1107 !------------------------------------------------------------------------------------------------------------------------------ 1081 1108 CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:) 1082 1109 INTEGER :: iky, nky 1083 1110 LOGICAL :: lo 1084 !------------------------------------------------------------------------------------------------------------------------------1085 1111 lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite 1086 1112 iky = strIdx(ky%key,key) … … 1094 1120 !============================================================================================================================== 1095 1121 SUBROUTINE addKey_m(key, val, ky, lOverWrite) 1096 !------------------------------------------------------------------------------------------------------------------------------1097 ! Purpose: Add the <key>=<val> pair in all the components of the "ky" keys descriptor.1098 !------------------------------------------------------------------------------------------------------------------------------1099 1122 CHARACTER(LEN=*), INTENT(IN) :: key, val 1100 1123 TYPE(keys_type), INTENT(INOUT) :: ky(:) 1101 1124 LOGICAL, OPTIONAL, INTENT(IN) :: lOverWrite 1125 !------------------------------------------------------------------------------------------------------------------------------ 1102 1126 INTEGER :: itr 1103 1127 LOGICAL :: lo 1104 !------------------------------------------------------------------------------------------------------------------------------1105 1128 lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite 1106 1129 DO itr = 1, SIZE(ky); CALL addKey_1(key, val, ky(itr), lo); END DO 1107 1130 END SUBROUTINE addKey_m 1108 1131 !============================================================================================================================== 1132 1133 1134 !============================================================================================================================== 1135 !=== OVERWRITE THE KEYS OF THE TRACER NAMED "tr0" WITH THE VALUES FOUND IN THE *.def FILES, IF ANY. =========================== 1136 !============================================================================================================================== 1109 1137 SUBROUTINE addKeysFromDef(t, tr0) 1110 !------------------------------------------------------------------------------------------------------------------------------1111 ! Purpose: The values of the keys of the tracer named "tr0" are overwritten by the values found in the *.def files, if any.1112 !------------------------------------------------------------------------------------------------------------------------------1113 1138 TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: t(:) 1114 1139 CHARACTER(LEN=*), INTENT(IN) :: tr0 1140 !------------------------------------------------------------------------------------------------------------------------------ 1115 1141 CHARACTER(LEN=maxlen) :: val 1116 1142 INTEGER :: ik, jd … … 1123 1149 END SUBROUTINE addKeysFromDef 1124 1150 !============================================================================================================================== 1151 1152 1153 !============================================================================================================================== 1154 !=== REMOVE THE KEYS NAMED "keyn(:)" FROM EITHER THE "itr"th OR ALL THE KEYS DESCRIPTORS OF "ky(:)" =========================== 1155 !============================================================================================================================== 1125 1156 SUBROUTINE delKey_1(itr, keyn, ky) 1126 !------------------------------------------------------------------------------------------------------------------------------1127 ! Purpose: Internal routine.1128 ! Remove <key>=<val> pairs in the "itr"th component of the "ky" keys descriptor.1129 !------------------------------------------------------------------------------------------------------------------------------1130 1157 INTEGER, INTENT(IN) :: itr 1131 1158 CHARACTER(LEN=*), INTENT(IN) :: keyn(:) 1132 1159 TYPE(trac_type), INTENT(INOUT) :: ky(:) 1160 !------------------------------------------------------------------------------------------------------------------------------ 1133 1161 CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:) 1134 1162 LOGICAL, ALLOCATABLE :: ll(:) 1135 1163 INTEGER :: iky 1136 !------------------------------------------------------------------------------------------------------------------------------1137 1164 IF(itr<=0 .OR. itr>SIZE(ky, DIM=1)) RETURN !--- Index is out of range 1138 1165 ll = [( ALL(keyn/=ky(itr)%keys%key(iky)), iky=1, SIZE(ky(itr)%keys%key) )] … … 1142 1169 !============================================================================================================================== 1143 1170 SUBROUTINE delKey(keyn, ky) 1144 !------------------------------------------------------------------------------------------------------------------------------1145 ! Purpose: Internal routine.1146 ! Remove <key>=<val> pairs in all the components of the "t" tracers descriptor.1147 !------------------------------------------------------------------------------------------------------------------------------1148 1171 CHARACTER(LEN=*), INTENT(IN) :: keyn(:) 1149 1172 TYPE(trac_type), INTENT(INOUT) :: ky(:) 1173 !------------------------------------------------------------------------------------------------------------------------------ 1150 1174 INTEGER :: iky 1151 !------------------------------------------------------------------------------------------------------------------------------1152 1175 DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky); END DO 1153 1176 END SUBROUTINE delKey … … 1156 1179 1157 1180 !============================================================================================================================== 1158 !=== PUBLIC ROUTINES: GET A KEY FROM A <key>=<val> LIST ; VECTORS, TRACER AND DATABASE VERSIONS =============================== 1159 !=== BEWARE !!! IF THE "ky" ARGUMENT IS NOT PRESENT, THEN THE VARIABLES "tracers" AND "isotopes" ARE USED. ==================== 1160 !=== THEY ARE LOCAL TO THIS MODULE, SO MUST MUST BE INITIALIZED FIRST USING the "getKey_init" ROUTINE ==================== 1181 !=== getKey ROUTINE INITIALIZATION (TO BE EMBEDDED SOMEWHERE) ================================================================ 1161 1182 !============================================================================================================================== 1162 1183 SUBROUTINE getKey_init(tracers_, isotopes_) … … 1166 1187 IF(PRESENT(isotopes_)) isotopes = isotopes_ 1167 1188 END SUBROUTINE getKey_init 1189 1190 1191 !============================================================================================================================== 1192 !================ GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RESULT IS THE RETURNED VALUE =================== 1168 1193 !============================================================================================================================== 1169 1194 CHARACTER(LEN=maxlen) FUNCTION fgetKeyByIndex_s1(itr, keyn, ky, def_val) RESULT(val) 1170 !------------------------------------------------------------------------------------------------------------------------------1171 ! Purpose: Internal function ; get a string formatted key value (returned argument) from its name and the tracer index.1172 !------------------------------------------------------------------------------------------------------------------------------1173 1195 INTEGER, INTENT(IN) :: itr 1174 1196 CHARACTER(LEN=*), INTENT(IN) :: keyn … … 1183 1205 !============================================================================================================================== 1184 1206 CHARACTER(LEN=maxlen) FUNCTION fgetKeyByName_s1(tname, keyn, ky, def_val, lerr) RESULT(val) 1185 !------------------------------------------------------------------------------------------------------------------------------1186 ! Purpose: Internal function ; get a string formatted key value (returned argument) from its name and the tracer name.1187 !------------------------------------------------------------------------------------------------------------------------------1188 1207 CHARACTER(LEN=*), INTENT(IN) :: tname, keyn 1189 1208 TYPE(keys_type), INTENT(IN) :: ky(:) … … 1200 1219 END FUNCTION fgetKeyByName_s1 1201 1220 !============================================================================================================================== 1221 1222 1223 !============================================================================================================================== 1224 !========== GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RETURNED VALUE IS THE ERROR CODE ============== 1225 !========== The key "keyn" is searched in: 1) "ky(:)%name" (if given) ============== 1226 !========== 2) "tracers(:)%name" ============== 1227 !========== 3) "isotope%keys(:)%name" ============== 1228 !========== for the tracer[s] "tname[(:)]" (if given) or all the available tracers from the used set otherwise. ============== 1229 !========== The type of the returned value(s) can be string, integer or real, scalar or vector ============== 1230 !============================================================================================================================== 1202 1231 LOGICAL FUNCTION getKeyByName_s1(keyn, val, tname, ky) RESULT(lerr) 1203 !--- Purpose: Get the value of the key named "keyn" for the tracer named "tnam".1204 ! * "ky" unspecified: try in "tracers" for "tnam" with phase and tagging suffixes, then in "isotopes" without.1205 ! * "ky" specified: try in "ky" for "tnam" with phase and tagging suffixes, then without.1206 ! The returned error code is always .FALSE.: an empty string is returned when the key hasn't been found.1207 1232 CHARACTER(LEN=*), INTENT(IN) :: keyn 1208 1233 CHARACTER(LEN=maxlen), INTENT(OUT) :: val 1209 1234 CHARACTER(LEN=*), INTENT(IN) :: tname 1210 1235 TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) 1236 !------------------------------------------------------------------------------------------------------------------------------ 1211 1237 CHARACTER(LEN=maxlen) :: tnam 1212 1238 INTEGER, ALLOCATABLE :: is(:) … … 1235 1261 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:) 1236 1262 TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) 1263 !------------------------------------------------------------------------------------------------------------------------------ 1237 1264 TYPE(keys_type), POINTER :: k(:) 1238 1265 CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:) … … 1254 1281 CHARACTER(LEN=*), INTENT(IN) :: tname 1255 1282 TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) 1283 !------------------------------------------------------------------------------------------------------------------------------ 1256 1284 CHARACTER(LEN=maxlen) :: sval 1257 1285 INTEGER :: ierr … … 1268 1296 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:) 1269 1297 TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) 1298 !------------------------------------------------------------------------------------------------------------------------------ 1270 1299 TYPE(keys_type), POINTER :: k(:) 1271 1300 CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:) … … 1287 1316 CHARACTER(LEN=*), INTENT(IN) :: tname 1288 1317 TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) 1318 !------------------------------------------------------------------------------------------------------------------------------ 1289 1319 CHARACTER(LEN=maxlen) :: sval 1290 1320 INTEGER :: ierr … … 1301 1331 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:) 1302 1332 TYPE(keys_type), OPTIONAL, INTENT(IN) :: ky(:) 1333 !------------------------------------------------------------------------------------------------------------------------------ 1303 1334 TYPE(keys_type), POINTER :: k(:) 1304 1335 CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:) … … 1321 1352 !============================================================================================================================== 1322 1353 ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION delPhase(s) RESULT(out) 1323 CHARACTER(LEN=*), INTENT(IN) :: s 1324 INTEGER :: l, i, ix 1325 CHARACTER(LEN=maxlen) :: sh, st 1326 out = s 1327 IF(s == '') RETURN !--- Empty string: nothing to do 1328 1329 !--- Special case: old phases for water, no phases separator 1330 i = INDEX(s,'_'); sh = s; IF(i/=0) sh=s(1:i-1); st='H2O'; IF(i/=0) st='H2O_'//s(i+1:LEN_TRIM(s)) 1331 IF(ANY([('H2O'//old_phases(ix:ix), ix=1, nphases)] == sh)) THEN; out=st; RETURN; END IF 1332 1333 !--- Index of found phase in "known_phases" 1334 ix = MAXLOC( [(i, i=1,nphases)], MASK=[( INDEX(s, phases_sep//known_phases(i:i))/=0, i=1, nphases)], DIM=1 ) 1335 IF(ix == 0) RETURN !--- No phase pattern found 1336 i = INDEX(s, phases_sep//known_phases(ix:ix)) !--- Index of <sep><pha> pattern in "str" 1337 l = LEN_TRIM(s) 1338 IF(i == l-1) THEN !--- <var><sep><pha> => return <var> 1339 out = s(1:l-2) 1340 ELSE IF(s(i+2:i+2) == '_') THEN !--- <var><sep><pha>_<tag> => return <var>_<tag> 1341 out = s(1:i-1)//s(i+2:l) 1354 CHARACTER(LEN=*), INTENT(IN) :: s 1355 !------------------------------------------------------------------------------------------------------------------------------ 1356 INTEGER :: ix, ip, ns 1357 out = s; ns = LEN_TRIM(s) 1358 IF(s == '') RETURN !--- Empty string: nothing to do 1359 IF(s(1:3)=='H2O' .AND. INDEX(old_phases,s(4:4))/=0 .AND. (ns==4 .OR. s(5:5)=='_')) THEN 1360 out='H2O'//s(5:ns) !--- H2O<phase>[_<iso>][_<tag>] 1361 ELSE IF(s(ns-1:ns-1)==phases_sep .AND. INDEX(known_phases,s(ns:ns))/=0) THEN 1362 out = s(1:ns-2); RETURN !--- <var><phase_sep><phase> 1363 ELSE; DO ip = 1, nphases; ix = INDEX(s, phases_sep//known_phases(ip:ip)//'_'); IF(ix /= 0) EXIT; END DO 1364 IF(ip /= nphases+1) out = s(1:ix-1)//s(ix+2:ns) !--- <var><phase_sep><phase>_<tag> 1342 1365 END IF 1343 1366 END FUNCTION delPhase 1344 ! ------------------------------------------------------------------------------------------------------------------------------1367 !============================================================================================================================== 1345 1368 CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha) RESULT(out) 1346 1369 CHARACTER(LEN=*), INTENT(IN) :: s 1347 1370 CHARACTER(LEN=1), INTENT(IN) :: pha 1371 !------------------------------------------------------------------------------------------------------------------------------ 1348 1372 INTEGER :: l, i 1349 1373 out = s … … 1354 1378 IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l) !--- <var>_<tag> => return <var><sep><pha>_<tag> 1355 1379 END FUNCTION addPhase_s1 1356 ! ------------------------------------------------------------------------------------------------------------------------------1380 !============================================================================================================================== 1357 1381 FUNCTION addPhase_sm(s,pha) RESULT(out) 1358 1382 CHARACTER(LEN=*), INTENT(IN) :: s(:) 1359 1383 CHARACTER(LEN=1), INTENT(IN) :: pha 1360 1384 CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:) 1385 !------------------------------------------------------------------------------------------------------------------------------ 1361 1386 INTEGER :: k 1362 1387 out = [( addPhase_s1(s(k), pha), k=1, SIZE(s) )] 1363 1388 END FUNCTION addPhase_sm 1364 ! ------------------------------------------------------------------------------------------------------------------------------1389 !============================================================================================================================== 1365 1390 CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,phases) RESULT(out) 1366 1391 CHARACTER(LEN=*), INTENT(IN) :: s 1367 1392 INTEGER, INTENT(IN) :: ipha 1368 1393 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases 1394 !------------------------------------------------------------------------------------------------------------------------------ 1369 1395 out = s 1370 1396 IF(s == '') RETURN !--- Empty string: nothing to do 1371 IF(ipha ==0) RETURN !--- Nullindex: no phase to add1397 IF(ipha == 0 .OR. ipha > nphases) RETURN !--- Absurd index: no phase to add 1372 1398 IF( PRESENT(phases)) out = addPhase_s1(s, phases(ipha:ipha)) 1373 1399 IF(.NOT.PRESENT(phases)) out = addPhase_s1(s, known_phases(ipha:ipha)) 1374 1400 END FUNCTION addPhase_i1 1375 ! ------------------------------------------------------------------------------------------------------------------------------1401 !============================================================================================================================== 1376 1402 FUNCTION addPhase_im(s,ipha,phases) RESULT(out) 1377 1403 CHARACTER(LEN=*), INTENT(IN) :: s(:) … … 1379 1405 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases 1380 1406 CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:) 1407 !------------------------------------------------------------------------------------------------------------------------------ 1381 1408 INTEGER :: k 1382 1409 IF( PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, phases), k=1, SIZE(s) )] 1383 1410 IF(.NOT.PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, known_phases), k=1, SIZE(s) )] 1384 1411 END FUNCTION addPhase_im 1385 ! ------------------------------------------------------------------------------------------------------------------------------1412 !============================================================================================================================== 1386 1413 1387 1414 … … 1392 1419 CHARACTER(LEN=*), INTENT(IN) :: tname 1393 1420 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases 1421 !------------------------------------------------------------------------------------------------------------------------------ 1394 1422 CHARACTER(LEN=maxlen) :: phase 1395 1423 IF( PRESENT(phases)) phase = getPhase(tname, phases, iPhase) 1396 1424 IF(.NOT.PRESENT(phases)) phase = getPhase(tname, known_phases, iPhase) 1397 1425 END FUNCTION getiPhase 1398 ! ------------------------------------------------------------------------------------------------------------------------------1426 !============================================================================================================================== 1399 1427 CHARACTER(LEN=1) FUNCTION getPhase(tname, phases, iPhase) RESULT(phase) 1400 1428 CHARACTER(LEN=*), INTENT(IN) :: tname 1401 1429 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases 1402 1430 INTEGER, OPTIONAL, INTENT(OUT) :: iPhase 1431 !------------------------------------------------------------------------------------------------------------------------------ 1403 1432 INTEGER :: ip 1404 1433 phase = TRIM(strHead(strTail(tname, phases_sep, .TRUE.), '_', .TRUE.)) … … 1408 1437 IF(PRESENT(iPhase)) iPhase = ip 1409 1438 END FUNCTION getPhase 1410 !------------------------------------------------------------------------------------------------------------------------------ 1411 1412 1413 !------------------------------------------------------------------------------------------------------------------------------ 1414 CHARACTER(LEN=maxlen) FUNCTION old2newName_1(oldName, iPhase) RESULT(newName) 1415 !--- Convert an old style name into a new one. 1416 ! Only usable with old style "traceur.def" files, in which only water isotopes are allowed. 1417 ! In these files, H2O descendants names are: H2O<phase>[_<isotope>][_<tag>], with: 1418 ! phase = v, l or i ; isotope = eau, HDO, O18, O17 or HTO. 1439 !============================================================================================================================== 1440 1441 1442 !============================================================================================================================== 1443 !============ CONVERT WATER-DERIVED NAMES FROM FORMER TO CURRENT CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ================== 1444 !======= NAMES STRUCTURE: H2O[<phase>][_<isotope>][_<tag>] (<phase> from "old_phases", <isotope> from "oldH2OIso") ============ 1445 !============================================================================================================================== 1446 CHARACTER(LEN=maxlen) FUNCTION old2newH2O_1(oldName, iPhase) RESULT(newName) 1419 1447 CHARACTER(LEN=*), INTENT(IN) :: oldName 1420 1448 INTEGER, OPTIONAL, INTENT(OUT) :: iPhase 1449 !------------------------------------------------------------------------------------------------------------------------------ 1421 1450 CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:) 1422 INTEGER :: ix, ip, it,nt1423 LOGICAL :: lerr , lH2O1451 INTEGER :: ix, ip, nt 1452 LOGICAL :: lerr 1424 1453 newName = oldName 1425 1454 IF(PRESENT(iPhase)) iPhase = 1 !--- Default: gaseous phase 1426 lH2O=.FALSE. 1427 IF(LEN_TRIM(oldName) > 3) THEN 1428 lH2O = oldName(1:3)=='H2O' .AND. INDEX(old_phases,oldName(4:4))/=0 !--- H2O<phase>*, with phase=="v", "l", "i" or "r" 1429 IF(LEN_TRIM(oldName) > 4) lH2O = lH2O .AND. oldName(5:5) == '_' !--- H2O<phase>_*, with phase=="v", "l", "i" or "r" 1455 lerr = strParse(oldName, '_', tmp, n=nt) !--- Parsing: 1 up to 3 elements. 1456 ip = strIdx( [('H2O'//old_phases(ix:ix), ix=1, nphases)], tmp(1) ) !--- Phase index 1457 IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip !--- Returning phase index 1458 IF(ip == 0 .AND. tmp(1) /= 'H2O') RETURN !--- Not an old-style water-related species 1459 IF(nt == 1) THEN 1460 newName = addPhase('H2O',ip) !=== WATER WITH OR WITHOUT PHASE 1461 ELSE 1462 ix = strIdx(oldH2OIso, tmp(2)) !--- Index in the known isotopes list 1463 IF(ix /= 0) tmp(2) = newH2OIso(ix) !--- Move to new isotope name 1464 IF(ip /= 0) tmp(2) = addPhase(tmp(2), ip) !--- Add phase to isotope name 1465 newName = TRIM(strStack(tmp(2:nt), '_')) !=== WATER ISOTOPE OR TAGGING TRACER 1430 1466 END IF 1431 IF(.NOT.lH2O) RETURN 1432 IF(LEN_TRIM(oldName)>3) THEN; IF(INDEX(old_Phases,oldName(4:4))==0) RETURN; END IF 1433 lerr = strParse(oldName, '_', tmp, n=nt) 1434 ip = strIdx([('H2O'//old_phases(ip:ip), ip=1, nphases)], tmp(1)) !--- Phase index (/=0 if any) 1435 IF(PRESENT(iPhase)) iPhase = ip 1436 newName = addPhase('H2O', ip) !--- Water 1437 IF(nt == 1) RETURN !--- Water: finished 1438 ix = strIdx(oldH2OIso, tmp(2)) !--- Index in the known isotopes list 1439 IF(ix == 0) newName = addPhase(tmp(2), ip) !--- Not an isotope 1440 IF(ix /= 0) newName = addPhase(newH2OIso(ix), ip) !--- Isotope 1441 IF(nt == 3) newName = TRIM(newName)//'_'//TRIM(tmp(3)) !--- Tagging tracer 1442 END FUNCTION old2newName_1 1443 !------------------------------------------------------------------------------------------------------------------------------ 1444 FUNCTION old2newName_m(oldName, iPhase) RESULT(newName) 1445 CHARACTER(LEN=*), INTENT(IN) :: oldName(:) 1467 END FUNCTION old2newH2O_1 1468 !============================================================================================================================== 1469 FUNCTION old2newH2O_m(oldName) RESULT(newName) 1470 CHARACTER(LEN=*), INTENT(IN) :: oldName(:) 1471 CHARACTER(LEN=maxlen) :: newName(SIZE(oldName)) 1472 !------------------------------------------------------------------------------------------------------------------------------ 1473 INTEGER :: i 1474 newName = [(old2newH2O_1(oldName(i)), i=1, SIZE(oldName))] 1475 END FUNCTION old2newH2O_m 1476 !============================================================================================================================== 1477 1478 1479 !============================================================================================================================== 1480 !============ CONVERT WATER-DERIVED NAMES FROM CURRENT TO FORMER CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ================== 1481 !==== NAMES STRUCTURE: <var>[<phase_sep><phase>][_<tag>] (<phase> from "known_phases", <var> = 'H2O' or from "newH2OIso") ===== 1482 !============================================================================================================================== 1483 CHARACTER(LEN=maxlen) FUNCTION new2oldH2O_1(newName, iPhase) RESULT(oldName) 1484 CHARACTER(LEN=*), INTENT(IN) :: newName 1446 1485 INTEGER, OPTIONAL, INTENT(OUT) :: iPhase 1447 CHARACTER(LEN=maxlen) :: newName(SIZE(oldName)) 1486 !------------------------------------------------------------------------------------------------------------------------------ 1487 CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:) 1488 INTEGER :: ix, ip 1489 CHARACTER(LEN=maxlen) :: var 1490 oldName = newName 1491 IF(PRESENT(iPhase)) iPhase = 1 !--- Default: gaseous phase 1492 ip = getiPhase(newName) !--- Phase index 1493 IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip !--- Returning phase index 1494 ix = strIdx(newH2OIso, newName) !--- Index in the known H2O isotopes list 1495 IF(ix /= 0) oldName = 'H2O'//'_'//TRIM(oldH2OIso(ix)) !=== WATER ISOTOPE WITHOUT PHASE 1496 IF(ix /= 0 .OR. ip == 0) RETURN 1497 oldName = 'H2O'//old_phases(ip:ip) 1498 IF(newName == addPhase('H2O', ip)) RETURN !=== WATER WITH PHASE 1499 var = TRIM(strHead(newName, phases_sep, .TRUE.)) !--- Head variable name (no phase) 1500 ix = strIdx(newH2OIso, var) !--- Index in the known H2O isotopes list 1501 IF(ix == 0) RETURN !=== H2O[vli]_<var> (<var> /= H2O isotope) 1502 oldName = TRIM(oldName)//'_'//TRIM(oldH2OIso(ix)) !=== WATER ISOTOPE WITH PHASE 1503 var = addPhase(var, ip) !--- Head variable with phase 1504 IF(newName /= var) oldName = TRIM(oldName)//strTail(newName, TRIM(var)) !=== WATER ISOTOPIC TAGGING TRACER 1505 END FUNCTION new2oldH2O_1 1506 !============================================================================================================================== 1507 FUNCTION new2oldH2O_m(newName) RESULT(oldName) 1508 CHARACTER(LEN=*), INTENT(IN) :: newName(:) 1509 CHARACTER(LEN=maxlen) :: oldName(SIZE(newName)) 1510 !------------------------------------------------------------------------------------------------------------------------------ 1448 1511 INTEGER :: i 1449 newName = [(old2newName_1(oldName(i), iPhase), i=1, SIZE(oldName))] 1450 END FUNCTION old2newName_m 1451 !------------------------------------------------------------------------------------------------------------------------------ 1452 1453 !------------------------------------------------------------------------------------------------------------------------------ 1454 CHARACTER(LEN=maxlen) FUNCTION new2oldName_1(newName, iPhase) RESULT(oldName) 1455 !--- Convert a new style name into an old one. 1456 ! Only convertable names are water descendants names H2O_<phase>, <isotope>_<phase>, <isotope>_<phase>_<tag>, with: 1457 ! phase = g, l or s ; isotope = H2[16]O, H[2]O, H2<[18]O, H2[17]O or H[3]O. 1458 CHARACTER(LEN=*), INTENT(IN) :: newName 1459 INTEGER, OPTIONAL, INTENT(OUT) :: iPhase 1460 INTEGER :: ix, ip, it, nt 1461 LOGICAL :: lH2O 1462 CHARACTER(LEN=maxlen) :: tag 1463 ix = strIdx([(addPhase('H2O',ip), ip=1, nphases)], newName) !--- Phase index for H2O_<phase> 1464 IF(ix /= 0) THEN; oldName = 'H2O'//old_phases(ix:ix); RETURN; END IF !--- H2O_<phase> case 1465 ix = strIdx(newH2OIso, strHead(newName, phases_sep, .TRUE.)) !--- Isotope index 1466 IF(ix == 0) THEN; oldName = newName; RETURN; END IF !--- Not a water descendant 1467 ip = getiPhase(newName) !--- Phase index 1468 oldName = TRIM(oldH2OIso(ix))//old_phases(ip:ip) !--- <isotope>_<phase> 1469 tag = strTail(delPhase(newName), TRIM(newH2OIso(ix))) !--- Get "_<tag>" if any 1470 IF(tag /= delPhase(newName) .AND. tag /= '') oldName = TRIM(oldName)//tag !--- Tagging tracer 1471 END FUNCTION new2oldName_1 1472 !------------------------------------------------------------------------------------------------------------------------------ 1473 FUNCTION new2oldName_m(newName, iPhase) RESULT(oldName) 1474 CHARACTER(LEN=*), INTENT(IN) :: newName(:) 1475 INTEGER, OPTIONAL, INTENT(OUT) :: iPhase 1476 CHARACTER(LEN=maxlen) :: oldName(SIZE(newName)) 1477 INTEGER :: i 1478 oldName = [(new2oldName_1(newName(i), iPhase), i=1, SIZE(newName))] 1479 END FUNCTION new2oldName_m 1480 !------------------------------------------------------------------------------------------------------------------------------ 1512 oldName = [(new2oldH2O_1(newName(i)), i=1, SIZE(newName))] 1513 END FUNCTION new2oldH2O_m 1514 !============================================================================================================================== 1481 1515 1482 1516 … … 1488 1522 CHARACTER(LEN=*), INTENT(IN) :: tname 1489 1523 INTEGER, OPTIONAL, INTENT(IN) :: igen 1524 !------------------------------------------------------------------------------------------------------------------------------ 1490 1525 INTEGER :: ig, ix 1491 1526 ig = 0; IF(PRESENT(igen)) ig = igen … … 1493 1528 out = ''; IF(ix /= 0) out = t(ix)%name 1494 1529 END FUNCTION ancestor_1 1495 ! ------------------------------------------------------------------------------------------------------------------------------1530 !============================================================================================================================== 1496 1531 FUNCTION ancestor_m(t, tname, igen) RESULT(out) 1497 1532 CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:) … … 1499 1534 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:) 1500 1535 INTEGER, OPTIONAL, INTENT(IN) :: igen 1536 !------------------------------------------------------------------------------------------------------------------------------ 1501 1537 INTEGER, ALLOCATABLE :: ix(:) 1502 1538 INTEGER :: ig … … 1511 1547 1512 1548 !============================================================================================================================== 1513 !=== GET THE INDEX(ES) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen" IN THE TRACERS DESCRIPTORS LIST "tr"=====1549 !=== GET THE INDEX(ES) OF THE GENERATION "igen" ANCESTOR(S) OF "tname" (t%name IF UNSPECIFIED) IN THE "t" LIST ================ 1514 1550 !============================================================================================================================== 1515 1551 INTEGER FUNCTION idxAncestor_1(t, tname, igen) RESULT(out) 1516 ! Return the name of the generation "igen" (>=0) ancestor of "tname"1517 1552 TYPE(trac_type), INTENT(IN) :: t(:) 1518 1553 CHARACTER(LEN=*), INTENT(IN) :: tname 1519 1554 INTEGER, OPTIONAL, INTENT(IN) :: igen 1555 !------------------------------------------------------------------------------------------------------------------------------ 1520 1556 INTEGER :: ig 1521 1557 ig = 0; IF(PRESENT(igen)) ig = igen … … 1525 1561 DO WHILE(t(out)%iGeneration > ig); out = strIdx(t(:)%name, t(out)%parent); END DO 1526 1562 END FUNCTION idxAncestor_1 1527 ! ------------------------------------------------------------------------------------------------------------------------------1563 !============================================================================================================================== 1528 1564 FUNCTION idxAncestor_m(t, tname, igen) RESULT(out) 1529 1565 INTEGER, ALLOCATABLE :: out(:) … … 1531 1567 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:) 1532 1568 INTEGER, OPTIONAL, INTENT(IN) :: igen 1569 !------------------------------------------------------------------------------------------------------------------------------ 1533 1570 INTEGER :: ig, ix 1534 1571 ig = 0; IF(PRESENT(igen)) ig = igen
Note: See TracChangeset
for help on using the changeset viewer.