Changeset 5756 for LMDZ6/trunk/libf/misc


Ignore:
Timestamp:
Jul 3, 2025, 3:25:59 PM (11 hours ago)
Author:
dcugnet
Message:

Add "isoFamilies", the list of defined isotopes families (==H2O? for now).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/trunk/libf/misc/readTracFiles_mod.f90

    r5755 r5756  
    22
    33  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
    76
    87  IMPLICIT NONE
     
    1514  PUBLIC :: getKeysDBase, setKeysDBase                          !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
    1615  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
    2020
    2121  PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O        !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
     
    2525
    2626  !=== 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
    2829
    2930  !=== FOR ISOTOPES: H2O FAMILY ONLY
    3031  PUBLIC :: iH2O
    3132
    32   !=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES CLASS
     33  !=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES FAMILY
    3334  PUBLIC :: isotope, isoKeys                                    !--- SELECTED ISOTOPES DATABASE + ASSOCIATED KEYS
    3435  PUBLIC :: isoName, isoZone, isoPhas                           !--- ISOTOPES AND TAGGING ZONES NAMES AND PHASES
     
    3940  PUBLIC :: isoCheck                                            !--- FLAG TO RUN ISOTOPES CHECKING ROUTINES
    4041
    41   PUBLIC :: maxTableWidth
    4242!------------------------------------------------------------------------------------------------------------------------------
    4343  TYPE :: keys_type                                             !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
     
    142142  TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
    143143
     144  !--- NAMES OF THE ISOTOPES FAMILIES
     145  CHARACTER(LEN=maxlen),   SAVE, ALLOCATABLE :: isoFamilies(:)
     146
    144147  !=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso))
    145148  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 family
    147   INTEGER,                 SAVE          :: nbIso               !--- Number of isotopes classes
    148   LOGICAL,                 SAVE          :: isoCheck            !--- Flag to trigger the checking routines
     149  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
    149152  TYPE(keys_type),         SAVE, POINTER :: isoKeys(:)          !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
    150153  CHARACTER(LEN=maxlen),   SAVE, POINTER :: isoName(:),   &     !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
     
    161164  LOGICAL, PARAMETER :: lSortByGen  = .TRUE.                    !--- Sort by growing generation
    162165
    163   INTEGER,    PARAMETER :: maxTableWidth = 192                  !--- Maximum width of a table displayed with "dispTable"
    164166  CHARACTER(LEN=maxlen) :: modname
    165167
     
    793795! Purpose: Sort tracers:
    794796!  * Put water at the beginning of the vector, in the "known_phases" order.
    795 !  * lGrowGen == T: in ascending generations numbers.
    796 !  * lGrowGen == 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.
    797799!   TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
    798800!------------------------------------------------------------------------------------------------------------------------------
     
    11001102!=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS PARENTS NAMES IN "isot(:)%parent":   ====
    11011103!===  * 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"       ====
    11031105!=== NOTES:                                                                                                                ====
    11041106!===  * Most of the "isot" components have been defined in the calling routine (processIsotopes):                          ====
     
    11251127  CALL msg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, lerr); IF(lerr) RETURN
    11261128
    1127   !--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
     1129  !--- READ THE FILE SECTIONS, ONE EACH ISOTOPES FAMILY
    11281130  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 tracer
     1131  lerr = readSections(fnam,strStack(isot(:)%parent,'|')); IF(lerr) RETURN !--- Read sections, one each isotopes family
    11301132  ndb = SIZE(dBase, DIM=1)                                           !--- Current database size
    11311133  DO idb = nb0, ndb
     
    11631165  END IF
    11641166
    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 
    11681167  lerr = dispIsotopes()
    11691168
     
    11761175  CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
    11771176  CALL msg('Isotopes parameters read from file "'//TRIM(fnam)//'":', modname)
    1178   DO ip = 1, SIZE(isot)                                              !--- Loop on parents tracers
     1177  DO ip = 1, SIZE(isot)                                              !--- Loop on isotopes families
    11791178    nk = SIZE(isot(ip)%keys(1)%key)                                  !--- Same keys for each isotope
    11801179    nt = SIZE(isot(ip)%keys)                                         !--- Number of isotopes
     
    12301229  lerr = getKey('iGeneration', iGen, t%keys); IF(lerr) RETURN       !--- Generation number
    12311230
    1232   !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
     1231  !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES FAMILIES
    12331232  p = PACK(delPhase(parent), MASK = dType=='tracer' .AND. iGen==1)
    12341233  CALL strReduce(p, nbIso)
    12351234
    1236   !--- CHECK WHETHER NEEDED ISOTOPES CLASSES "iNames" ARE AVAILABLE OR NOT
     1235  !--- CHECK WHETHER NEEDED ISOTOPES FAMILIES "iNames" ARE AVAILABLE OR NOT
    12371236  IF(PRESENT(iNames)) THEN
    12381237    DO it = 1, SIZE(iNames)
    12391238      lerr = ALL(p /= iNames(it))
    1240       CALL msg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, lerr); IF(lerr) RETURN
     1239      CALL msg('No isotopes family "'//TRIM(iNames(it))//'" found among tracers', modname, lerr); IF(lerr) RETURN
    12411240    END DO
    12421241    p = iNames; nbIso = SIZE(p)
    12431242  END IF
    12441243  IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes)
    1245   ALLOCATE(isotopes(nbIso))
     1244  ALLOCATE(isotopes(nbIso), isoFamilies(nbIso))
    12461245
    12471246  IF(nbIso==0) RETURN                                                !=== NO ISOTOPES: FINISHED
     
    12491248  !--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
    12501249  isotopes(:)%parent = p
    1251   DO ic = 1, SIZE(p)                                                 !--- Loop on isotopes classes
     1250  DO ic = 1, SIZE(p)                                                 !--- Loop on isotopes families
    12521251    i => isotopes(ic)
    1253     iname = i%parent                                                 !--- Current isotopes class name (parent tracer name)
     1252    iname = i%parent                                                 !--- Current isotopes family name (parent tracer name)
    12541253
    12551254    !=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname")
     
    13151314  !=== SELECT WATER ISOTOPES CLASS OR, IF UNFOUND, THE FIRST ISOTOPES CLASS
    13161315  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
    13171319
    13181320CONTAINS
     
    13481350!==============================================================================================================================
    13491351!=== 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).
    13511353!==============================================================================================================================
    13521354LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
     
    15401542!  IF(jd == 0) RETURN
    15411543!  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*')
    15431545!    IF(val /= '*none*') CALL addKey(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
    15441546!  END DO
Note: See TracChangeset for help on using the changeset viewer.