Changeset 5756 for LMDZ6/trunk/libf/misc
- Timestamp:
- Jul 3, 2025, 3:25:59 PM (11 hours ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/misc/readTracFiles_mod.f90
r5755 r5756 2 2 3 3 USE ioipsl_getin_p_mod, ONLY : getin_p 4 USE strings_mod, ONLY: msg, find, dispTable, strHead, strReduce, strFind, strStack, strIdx, & 5 removeComment, cat, maxlen, checkList, strParse, strReplace, strTail, strCount, reduceExpr, & 6 num2str, str2int, str2real, str2bool 4 USE strings_mod, ONLY: msg, strIdx, dispTable, strHead, strReduce, strFind, strStack, removeComment, num2str, str2real, & 5 reduceExpr, find, cat, maxlen, checkList, strParse, strReplace, strTail, strCount, maxTableWidth, str2int, str2bool 7 6 8 7 IMPLICIT NONE … … 15 14 PUBLIC :: getKeysDBase, setKeysDBase !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes) 16 15 PUBLIC :: addTracer, delTracer !--- ADD/REMOVE A TRACER FROM 17 PUBLIC :: addKey, delKey, getKey, keys_type !--- TOOLS TO SET/DEL/GET KEYS FROM/TO tracers & isotopes 18 PUBLIC :: addPhase, delPhase, getPhase, getiPhase, & !--- FUNCTIONS RELATED TO THE PHASES 19 nphases, old_phases, phases_sep, known_phases, phases_names !--- + ASSOCIATED VARIABLES 16 PUBLIC :: addKey, delKey, getKey, keys_type !--- TOOLS TO SET/DEL/GET A KEY FROM/TO "tracers" / "isotopes" 17 PUBLIC :: addPhase, delPhase, getPhase, getiPhase !--- TOOLS TO SET/DEL/GET A PHASE FROM/TO A TRACER'S NAME 18 PUBLIC :: old_phases, phases_sep, nphases !--- VARIABLES RELATED TO THE PHASES 19 PUBLIC :: known_phases, phases_names 20 20 21 21 PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def) … … 25 25 26 26 !=== FOR ISOTOPES: GENERAL 27 PUBLIC :: isot_type, processIsotopes, isoSelect, ixIso, nbIso !--- PROCESS [AND READ] & SELECT ISOTOPES + CLASS IDX & NUMBER 27 PUBLIC :: isot_type, processIsotopes, isoSelect, isoFamilies !--- ISOTOPES: TYPE, PROCESSING/SELECTION ROUTINES, FAMILIES NAMES 28 PUBLIC :: ixIso, nbIso !--- CURRENTLY SELECTED ISOTOPES FAMILY INDEX, NUMBER OF FAMILIES 28 29 29 30 !=== FOR ISOTOPES: H2O FAMILY ONLY 30 31 PUBLIC :: iH2O 31 32 32 !=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES CLASS33 !=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES FAMILY 33 34 PUBLIC :: isotope, isoKeys !--- SELECTED ISOTOPES DATABASE + ASSOCIATED KEYS 34 35 PUBLIC :: isoName, isoZone, isoPhas !--- ISOTOPES AND TAGGING ZONES NAMES AND PHASES … … 39 40 PUBLIC :: isoCheck !--- FLAG TO RUN ISOTOPES CHECKING ROUTINES 40 41 41 PUBLIC :: maxTableWidth42 42 !------------------------------------------------------------------------------------------------------------------------------ 43 43 TYPE :: keys_type !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT … … 142 142 TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:) 143 143 144 !--- NAMES OF THE ISOTOPES FAMILIES 145 CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: isoFamilies(:) 146 144 147 !=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso)) 145 148 TYPE(isot_type), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR 146 INTEGER, SAVE :: ixIso, iH2O= 0 !--- Index of the selected isotopes family and H2O family147 INTEGER, SAVE :: nbIso !--- N umber of isotopes classes148 LOGICAL, SAVE :: isoCheck !--- F lag to trigger the checking routines149 INTEGER, SAVE :: ixIso, iH2O=-1 !--- INDEX OF THE SELECTED ISOTOPES FAMILY, H2O FAMILY INDEX 150 INTEGER, SAVE :: nbIso !--- NUMBER OF ISOTOPES FAMILIES 151 LOGICAL, SAVE :: isoCheck !--- FLAG TO TRIGGER THE CHECKING ROUTINES 149 152 TYPE(keys_type), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName) 150 153 CHARACTER(LEN=maxlen), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY … … 161 164 LOGICAL, PARAMETER :: lSortByGen = .TRUE. !--- Sort by growing generation 162 165 163 INTEGER, PARAMETER :: maxTableWidth = 192 !--- Maximum width of a table displayed with "dispTable"164 166 CHARACTER(LEN=maxlen) :: modname 165 167 … … 793 795 ! Purpose: Sort tracers: 794 796 ! * Put water at the beginning of the vector, in the "known_phases" order. 795 ! * l GrowGen == T: in ascending generations numbers.796 ! * l GrowGen == F: tracer + its children sorted by growing generation, one after the other.797 ! * lSortByGen == T: in ascending generations numbers. 798 ! * lSortByGen == F: tracer + its children sorted by growing generation, one after the other. 797 799 ! TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END 798 800 !------------------------------------------------------------------------------------------------------------------------------ … … 1100 1102 !=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS PARENTS NAMES IN "isot(:)%parent": ==== 1101 1103 !=== * Each section dBase(i)%name contains the isotopes "dBase(i)%trac(:)" descending on "dBase(i)%name"="iso(i)%parent" ==== 1102 !=== * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot"====1104 !=== * For each isotopes family, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot" ==== 1103 1105 !=== NOTES: ==== 1104 1106 !=== * Most of the "isot" components have been defined in the calling routine (processIsotopes): ==== … … 1125 1127 CALL msg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, lerr); IF(lerr) RETURN 1126 1128 1127 !--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER1129 !--- READ THE FILE SECTIONS, ONE EACH ISOTOPES FAMILY 1128 1130 nb0 = SIZE(dBase, DIM=1)+1 !--- Next database element index 1129 lerr = readSections(fnam,strStack(isot(:)%parent,'|')); IF(lerr) RETURN !--- Read sections, one each parent tracer1131 lerr = readSections(fnam,strStack(isot(:)%parent,'|')); IF(lerr) RETURN !--- Read sections, one each isotopes family 1130 1132 ndb = SIZE(dBase, DIM=1) !--- Current database size 1131 1133 DO idb = nb0, ndb … … 1163 1165 END IF 1164 1166 1165 !--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)1166 CALL getin_p('ok_iso_verif', isot(strIdx(isot%parent, 'H2O'))%check, .FALSE.)1167 1168 1167 lerr = dispIsotopes() 1169 1168 … … 1176 1175 CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:) 1177 1176 CALL msg('Isotopes parameters read from file "'//TRIM(fnam)//'":', modname) 1178 DO ip = 1, SIZE(isot) !--- Loop on parents tracers1177 DO ip = 1, SIZE(isot) !--- Loop on isotopes families 1179 1178 nk = SIZE(isot(ip)%keys(1)%key) !--- Same keys for each isotope 1180 1179 nt = SIZE(isot(ip)%keys) !--- Number of isotopes … … 1230 1229 lerr = getKey('iGeneration', iGen, t%keys); IF(lerr) RETURN !--- Generation number 1231 1230 1232 !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES1231 !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES FAMILIES 1233 1232 p = PACK(delPhase(parent), MASK = dType=='tracer' .AND. iGen==1) 1234 1233 CALL strReduce(p, nbIso) 1235 1234 1236 !--- CHECK WHETHER NEEDED ISOTOPES CLASSES "iNames" ARE AVAILABLE OR NOT1235 !--- CHECK WHETHER NEEDED ISOTOPES FAMILIES "iNames" ARE AVAILABLE OR NOT 1237 1236 IF(PRESENT(iNames)) THEN 1238 1237 DO it = 1, SIZE(iNames) 1239 1238 lerr = ALL(p /= iNames(it)) 1240 CALL msg('No isotopes class"'//TRIM(iNames(it))//'" found among tracers', modname, lerr); IF(lerr) RETURN1239 CALL msg('No isotopes family "'//TRIM(iNames(it))//'" found among tracers', modname, lerr); IF(lerr) RETURN 1241 1240 END DO 1242 1241 p = iNames; nbIso = SIZE(p) 1243 1242 END IF 1244 1243 IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes) 1245 ALLOCATE(isotopes(nbIso) )1244 ALLOCATE(isotopes(nbIso), isoFamilies(nbIso)) 1246 1245 1247 1246 IF(nbIso==0) RETURN !=== NO ISOTOPES: FINISHED … … 1249 1248 !--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES 1250 1249 isotopes(:)%parent = p 1251 DO ic = 1, SIZE(p) !--- Loop on isotopes classes1250 DO ic = 1, SIZE(p) !--- Loop on isotopes families 1252 1251 i => isotopes(ic) 1253 iname = i%parent !--- Current isotopes classname (parent tracer name)1252 iname = i%parent !--- Current isotopes family name (parent tracer name) 1254 1253 1255 1254 !=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname") … … 1315 1314 !=== SELECT WATER ISOTOPES CLASS OR, IF UNFOUND, THE FIRST ISOTOPES CLASS 1316 1315 IF(.NOT.isoSelect('H2O', .TRUE.)) THEN; iH2O = ixIso; ELSE; lerr = isoSelect(1, .TRUE.); END IF 1316 1317 !=== COLLECT THE NAMES OF THE ISOTOPES FAMILIES 1318 isoFamilies = isotopes(:)%parent 1317 1319 1318 1320 CONTAINS … … 1348 1350 !============================================================================================================================== 1349 1351 !=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED 1350 ! Single generic "isoSelect" routine, using the predefined index of the parent(fast version) or its name (first call).1352 ! Single generic "isoSelect" routine, using the predefined index of the family (fast version) or its name (first call). 1351 1353 !============================================================================================================================== 1352 1354 LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr) … … 1540 1542 ! IF(jd == 0) RETURN 1541 1543 ! DO ik = 1, SIZE(t(jd)%keys%key) 1542 ! CALL get _in(t(jd)%keys%key(ik), val, '*none*')1544 ! CALL getin_p(t(jd)%keys%key(ik), val, '*none*') 1543 1545 ! IF(val /= '*none*') CALL addKey(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.) 1544 1546 ! END DO
Note: See TracChangeset
for help on using the changeset viewer.