Changeset 25 for readTracFiles_mod.f90


Ignore:
Timestamp:
Jan 23, 2023, 4:16:21 PM (22 months ago)
Author:
dcugnet
Message:
  • simplify the parser usage:
    • the getKey_init routine is now embedded in the readTracersFile routine.
    • the initIsotopes routine is now embedded in the readIsotopesFile routine.
    • the database is now unique, but can be changed using the get/setKeysDBase.
    • the derived types descriptions, originally located in trac_types_mod, are moved to readTracFiles_mod.
    • few checkings moved from infotrac to the routine testIsotopes, contained in the readIsotopesFile function from readTracFiles_mod.
    • the readTracersFiles and readIsotopesFile routines no longer use a tracers/isotopes argument.
  • the trac_type field %Childs is renamed %Children
  • move the isoSelect routine and the corresponding variables routine from infotrac and infotrac_phy to readTracFiles_mod
  • all the explicit keys of the trac_type are now included in the embedded keys database, accessible using the getKey function.
  • the getKey/addKey routines are expanded to handle vectors of integers, reals, logicals or strings.
  • few subroutines converted into functions with error return value.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • readTracFiles_mod.f90

    r24 r25  
    11MODULE readTracFiles_mod
    22
    3   USE strings_mod,    ONLY: msg, find, get_in, str2int, dispTable, testFile, strReduce,  strFind, strStack, strHead, &
     3  USE strings_mod,    ONLY: msg, find, get_in, str2int, dispTable, testFile, strReduce,  strFind, strStack, strHead,  &
    44       test, removeComment, cat, fmsg, maxlen, int2str, checkList, strParse, strReplace, strTail, strCount, strIdx, reduceExpr
    5   USE trac_types_mod, ONLY: trac_type, isot_type, keys_type
    65
    76  IMPLICIT NONE
    … …  
    98  PRIVATE
    109
    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)
    20 
    21   PUBLIC :: tran0, idxAncestor, ancestor                             !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
     10  PUBLIC :: maxlen                                              !--- PARAMETER FOR CASUAL STRING LENGTH
     11  PUBLIC :: tracers                                             !--- TRACERS  DESCRIPTION DATABASE
     12  PUBLIC :: trac_type, setGeneration, indexUpdate               !--- TRACERS  DESCRIPTION ASSOCIATED TOOLS
     13  PUBLIC :: testTracersFiles, readTracersFiles                  !--- TRACERS FILES READING ROUTINES
     14  PUBLIC :: getKey, fGetKey, setDirectKeys                      !--- TOOLS TO GET/SET KEYS FROM/TO  tracers & isotopes
     15  PUBLIC :: getKeysDBase,    setKeysDBase                       !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
     16
     17  PUBLIC :: addPhase, getiPhase,  old_phases, phases_sep, &     !--- FUNCTIONS RELATED TO THE PHASES
     18   nphases, delPhase, getPhase, known_phases, phases_names      !--- + ASSOCIATED VARIABLES
     19
     20  PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O        !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
     21  PUBLIC :: oldHNO3,   newHNO3                                  !--- HNO3 REPRO   BACKWARD COMPATIBILITY (OLD start.nc)
     22
     23  PUBLIC :: tran0, idxAncestor, ancestor                        !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
    2224
    2325  !=== FOR ISOTOPES: GENERAL
    24   PUBLIC :: isot_type, readIsotopesFile, initIsotopes                !--- ISOTOPES DESCRIPTION TYPE + READING ROUTINE
     26  PUBLIC :: isot_type, readIsotopesFile, isoSelect              !--- ISOTOPES DESCRIPTION TYPE + READING ROUTINE
     27  PUBLIC :: ixIso, nbIso                                        !--- INDEX OF SELECTED ISOTOPES CLASS + NUMBER OF CLASSES
     28
     29  !=== FOR ISOTOPES: H2O FAMILY ONLY
     30  PUBLIC :: iH2O
     31
     32  !=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES CLASS
     33  PUBLIC :: isotope, isoKeys                                    !--- SELECTED ISOTOPES DATABASE + ASSOCIATED KEYS
     34  PUBLIC :: isoName, isoZone, isoPhas                           !--- ISOTOPES AND TAGGING ZONES NAMES AND PHASES
     35  PUBLIC :: niso,    nzone,   nphas,   ntiso                    !---  " " NUMBERS + ISOTOPES AND TAGGING TRACERS NUMBERS
     36  PUBLIC :: itZonIso                                            !--- Idx IN isoName(1:niso) = f(tagging idx, isotope idx)
     37  PUBLIC :: iqIsoPha                                            !--- Idx IN qx(1:nqtot)     = f(isotope idx,   phase idx)
     38  PUBLIC :: isoCheck                                            !--- FLAG TO RUN ISOTOPES CHECKING ROUTINES
    2539
    2640  PUBLIC :: maxTableWidth
    2741!------------------------------------------------------------------------------------------------------------------------------
    28   TYPE :: dataBase_type                                              !=== TYPE FOR TRACERS SECTION
    29     CHARACTER(LEN=maxlen)  :: name                                   !--- Section name
    30     TYPE(trac_type), ALLOCATABLE :: trac(:)                          !--- Tracers descriptors
     42  TYPE :: keys_type                                        !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
     43    CHARACTER(LEN=maxlen)              :: name             !--- Tracer name
     44    CHARACTER(LEN=maxlen), ALLOCATABLE :: key(:)           !--- Keys string list
     45    CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)           !--- Corresponding values string list
     46  END TYPE keys_type
     47!------------------------------------------------------------------------------------------------------------------------------
     48  TYPE :: trac_type                                        !=== TYPE FOR A SINGLE TRACER NAMED "name"
     49    CHARACTER(LEN=maxlen) :: name        = ''              !--- Name of the tracer
     50    CHARACTER(LEN=maxlen) :: gen0Name    = ''              !--- First generation ancestor name
     51    CHARACTER(LEN=maxlen) :: parent      = ''              !--- Parent name
     52    CHARACTER(LEN=maxlen) :: longName    = ''              !--- Long name (with advection scheme suffix)
     53    CHARACTER(LEN=maxlen) :: type        = 'tracer'        !--- Type  (so far: 'tracer' / 'tag')
     54    CHARACTER(LEN=maxlen) :: phase       = 'g'             !--- Phase ('g'as / 'l'iquid / 's'olid)
     55    CHARACTER(LEN=maxlen) :: component   = ''              !--- Coma-separated list of components (Ex: lmdz,inca)
     56    INTEGER               :: iadv        = 10              !--- Advection scheme used
     57    INTEGER               :: iGeneration = -1              !--- Generation number (>=0)
     58    LOGICAL               :: isAdvected  = .FALSE.         !--- "true" tracers: iadv > 0.   COUNT(isAdvected )=nqtrue
     59    LOGICAL               :: isInPhysics = .TRUE.          !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
     60    INTEGER               :: iqParent    = 0               !--- Parent index
     61    INTEGER,  ALLOCATABLE :: iqDescen(:)                   !--- Descendants index (in growing generation order)
     62    INTEGER               :: nqDescen    = 0               !--- Number of descendants (all generations)
     63    INTEGER               :: nqChildren  = 0               !--- Number of children  (first generation)
     64    INTEGER               :: iso_iGroup  = 0               !--- Isotopes group index in isotopes(:)
     65    INTEGER               :: iso_iName   = 0               !--- Isotope  name  index in isotopes(iso_iGroup)%trac(:)
     66    INTEGER               :: iso_iZone   = 0               !--- Isotope  zone  index in isotopes(iso_iGroup)%zone(:)
     67    INTEGER               :: iso_iPhase  = 0               !--- Isotope  phase index in isotopes(iso_iGroup)%phase
     68    TYPE(keys_type)       :: keys                          !--- <key>=<val> pairs vector
     69  END TYPE trac_type
     70!------------------------------------------------------------------------------------------------------------------------------
     71  TYPE :: isot_type                                        !=== TYPE FOR AN ISOTOPES FAMILY DESCENDING ON TRACER "parent"
     72    CHARACTER(LEN=maxlen)              :: parent           !--- Isotopes family name (parent tracer name ; ex: H2O)
     73    LOGICAL                            :: check=.FALSE.    !--- Triggering of the checking routines
     74    TYPE(keys_type),       ALLOCATABLE :: keys(:)          !--- Isotopes keys/values pairs list     (length: niso)
     75    CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:)          !--- Isotopes + tagging tracers list     (length: ntiso)
     76    CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:)          !--- Geographic tagging zones names list (length: nzone)
     77    CHARACTER(LEN=maxlen)              :: phase = 'g'      !--- Phases list: [g][l][s]              (length: nphas)
     78    INTEGER                            :: niso  = 0        !--- Number of isotopes, excluding tagging tracers
     79    INTEGER                            :: nzone = 0        !--- Number of geographic tagging zones
     80    INTEGER                            :: ntiso = 0        !--- Number of isotopes, including tagging tracers
     81    INTEGER                            :: nphas = 0        !--- Number phases
     82    INTEGER,               ALLOCATABLE :: iqIsoPha(:,:)    !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
     83                                                           !---        "iqIsoPha" former name: "iqiso"
     84    INTEGER,               ALLOCATABLE :: itZonIso(:,:)    !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
     85                                                           !---        "itZonIso" former name: "index_trac"
     86  END TYPE isot_type
     87!------------------------------------------------------------------------------------------------------------------------------
     88  TYPE :: dataBase_type                                         !=== TYPE FOR TRACERS SECTION
     89    CHARACTER(LEN=maxlen)  :: name                              !--- Section name
     90    TYPE(trac_type), ALLOCATABLE :: trac(:)                     !--- Tracers descriptors
    3191  END TYPE dataBase_type
    3292!------------------------------------------------------------------------------------------------------------------------------
    3393  INTERFACE getKey
    3494    MODULE PROCEDURE getKeyByName_s1,  getKeyByName_i1,  getKeyByName_r1, &
    35                      getKeyByName_sm,  getKeyByName_im,  getKeyByName_rm
     95                     getKeyByName_sm,  getKeyByName_im,  getKeyByName_rm, &
     96                     getKeyByName_s1m, getKeyByName_i1m, getKeyByName_r1m
    3697  END INTERFACE getKey
    3798!------------------------------------------------------------------------------------------------------------------------------
    38   INTERFACE fGetKey;       MODULE PROCEDURE fgetKeyByIndex_s1, fgetKeyByName_s1; END INTERFACE fGetKey
     99  INTERFACE    isoSelect;  MODULE PROCEDURE  isoSelectByIndex,  isoSelectByName; END INTERFACE isoSelect
    39100  INTERFACE  old2newH2O;   MODULE PROCEDURE  old2newH2O_1,  old2newH2O_m;        END INTERFACE old2newH2O
    40101  INTERFACE  new2oldH2O;   MODULE PROCEDURE  new2oldH2O_1,  new2oldH2O_m;        END INTERFACE new2oldH2O
     102  INTERFACE fGetKey;       MODULE PROCEDURE fgetKeyIdx_s1, fgetKeyNam_s1, fgetKey_sm;        END INTERFACE fGetKey
    41103  INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
    42   INTERFACE idxAncestor;   MODULE PROCEDURE idxAncestor_1, idxAncestor_m;        END INTERFACE idxAncestor
    43   INTERFACE    ancestor;   MODULE PROCEDURE    ancestor_1,    ancestor_m;        END INTERFACE    ancestor
     104  INTERFACE idxAncestor;   MODULE PROCEDURE idxAncestor_1, idxAncestor_m, idxAncestor_mt;    END INTERFACE idxAncestor
     105  INTERFACE    ancestor;   MODULE PROCEDURE    ancestor_1,    ancestor_m,    ancestor_mt;    END INTERFACE    ancestor
     106  INTERFACE      addKey;   MODULE PROCEDURE      addKey_1,      addKey_m,     addKey_mm;     END INTERFACE addKey
    44107  INTERFACE    addPhase;   MODULE PROCEDURE   addPhase_s1,   addPhase_sm,   addPhase_i1,   addPhase_im; END INTERFACE addPhase
    45108!------------------------------------------------------------------------------------------------------------------------------
    … …  
    54117  INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases)        !--- Number of phases
    55118  CHARACTER(LEN=maxlen), SAVE      :: phases_names(nphases) &   !--- Known phases names
    56                                 = ['gaseous', 'liquid ', 'solid  ', 'cloud  ']
     119                                             = ['gaseous', 'liquid ', 'solid  ', 'cloud  ']
    57120  CHARACTER(LEN=1), SAVE :: phases_sep  =  '_'                  !--- Phase separator
    58121  LOGICAL,          SAVE :: tracs_merge = .TRUE.                !--- Merge/stack tracers lists
    59122  LOGICAL,          SAVE :: lSortByGen  = .TRUE.                !--- Sort by growing generation
     123  CHARACTER(LEN=maxlen), SAVE :: isoFile = 'isotopes_params.def'!--- Name of the isotopes parameters file
    60124
    61125  !--- CORRESPONDANCE BETWEEN OLD AND NEW WATER NAMES
    … …  
    67131  CHARACTER(LEN=maxlen), SAVE ::   newHNO3(2) = ['HNO3   ', 'HNO3tot']
    68132
    69   !=== LOCAL COPIES OF THE TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey (INITIALIZED IN getKey_init)
     133  !=== TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey
    70134  TYPE(trac_type), ALLOCATABLE, TARGET, SAVE ::  tracers(:)
    71135  TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
    72136
    73   INTEGER,    PARAMETER :: maxTableWidth = 192                       !--- Maximum width of a table displayed with "dispTable"
     137  !=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso))
     138  TYPE(isot_type),         SAVE, POINTER :: isotope             !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
     139  INTEGER,                 SAVE          :: ixIso, iH2O         !--- Index of the selected isotopes family and H2O family
     140  INTEGER,                 SAVE          :: nbIso               !--- Number of isotopes classes
     141  LOGICAL,                 SAVE          :: isoCheck            !--- Flag to trigger the checking routines
     142  TYPE(keys_type),         SAVE, POINTER :: isoKeys(:)          !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
     143  CHARACTER(LEN=maxlen),   SAVE, POINTER :: isoName(:),   &     !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
     144                                            isoZone(:),   &     !--- TAGGING ZONES  FOR THE CURRENTLY SELECTED FAMILY
     145                                            isoPhas             !--- USED PHASES    FOR THE CURRENTLY SELECTED FAMILY
     146  INTEGER,                 SAVE          ::  niso, nzone, &     !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
     147                                            nphas, ntiso        !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
     148  INTEGER,                 SAVE, POINTER ::itZonIso(:,:), &     !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
     149                                           iqIsoPha(:,:)        !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
     150
     151  INTEGER,    PARAMETER :: maxTableWidth = 192                  !--- Maximum width of a table displayed with "dispTable"
    74152  CHARACTER(LEN=maxlen) :: modname
    75153
    … …  
    100178!     * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
    101179!==============================================================================================================================
    102 LOGICAL FUNCTION readTracersFiles(type_trac, fTyp, tracs, lRepr) RESULT(lerr)
    103 !------------------------------------------------------------------------------------------------------------------------------
    104   CHARACTER(LEN=*),             INTENT(IN)  :: type_trac              !--- List of components used
    105   INTEGER,         OPTIONAL,    INTENT(OUT) :: fTyp                   !--- Type of input file found
    106   TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tracs(:)
    107   LOGICAL,         OPTIONAL,    INTENT(IN)  :: lRepr
     180LOGICAL FUNCTION readTracersFiles(type_trac, fTyp, lRepr) RESULT(lerr)
     181!------------------------------------------------------------------------------------------------------------------------------
     182  CHARACTER(LEN=*),  INTENT(IN)  :: type_trac                        !--- List of components used
     183  INTEGER, OPTIONAL, INTENT(OUT) :: fTyp                             !--- Type of input file found
     184  LOGICAL, OPTIONAL, INTENT(IN)  :: lRepr                            !--- Activate the HNNO3 exceptions for REPROBUS
    108185  CHARACTER(LEN=maxlen),  ALLOCATABLE :: s(:), sections(:), trac_files(:)
    109186  CHARACTER(LEN=maxlen) :: str, fname, mesg, tname, pname, cname
    110   INTEGER               :: is, nsec, ierr, it, ntrac, ns, ip, ix, fType
     187  INTEGER               :: nsec, ierr, it, ntrac, ns, ip, ix, fType
    111188  LOGICAL, ALLOCATABLE  :: ll(:), lGen3(:)
    112189  LOGICAL :: lRep
     190  TYPE(keys_type), POINTER :: k
    113191!------------------------------------------------------------------------------------------------------------------------------
    114192  lerr = .FALSE.
    … …  
    117195  lRep=0; IF(PRESENT(lRepr)) lRep = lRepr
    118196
    119   !--- Required sections + corresponding files names (new style single section case)
    120   IF(test(strParse(type_trac, '|', sections), lerr)) RETURN          !--- Parse "type_trac" list
    121 
    122   nsec = SIZE(sections, DIM=1)
    123   ALLOCATE(trac_files(nsec)); DO is=1, nsec; trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'; END DO
    124 
    125   !--- LOOK AT AVAILABLE FILES
    126   ll = .NOT.testFile(trac_files)
    127   fType = 0
    128   IF(.NOT.testFile('traceur.def') .AND. nsec==1) fType = 1           !--- OLD STYLE FILE
    129   IF(.NOT.testFile('tracer.def'))                fType = 2           !--- NEW STYLE ; SINGLE  FILE, SEVERAL SECTIONS
    130   IF(ALL(ll))                                    fType = 3           !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
     197  !--- Required sections + corresponding files names (new style single section case) for tests
     198  IF(test(testTracersFiles(modname, type_trac, fType, trac_files, sections), lerr)) RETURN
    131199  IF(PRESENT(fTyp)) fTyp = fType
    132   IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
    133     IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
    134   END IF
    135 
    136   !--- CHECK WHETHER type_trac AND FILE TYPE ARE COMPATIBLE
    137   IF(test(fmsg('No multiple sections for the old format "traceur.def"', ll = SIZE(sections)>1 .AND. fType==1), lerr)) RETURN
    138 
    139   !--- TELLS WHAT WAS IS ABOUT TO BE USED
    140   IF (fmsg('No adequate tracers description file(s) found ; default values will be used',          modname, fType==0)) RETURN
    141   CALL msg('Trying to read old-style tracers description file "traceur.def"',                      modname, fType==1)
    142   CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"',    modname, fType==2)
    143   CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
     200  nsec = SIZE(sections)
    144201
    145202  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    … …  
    156213
    157214      !--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
    158       ALLOCATE(tracs(ntrac))
     215      IF(ALLOCATED(tracers)) DEALLOCATE(tracers)
     216      ALLOCATE(tracers(ntrac))
    159217      DO it=1,ntrac                                                  !=== READ RAW DATA: loop on the line/tracer number
    160218        READ(90,'(a)',IOSTAT=ierr) str
    … …  
    164222        CALL msg('This file is for air tracers only',           modname, ns == 3 .AND. it == 1)
    165223        CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
     224        k => tracers(it)%keys
    166225
    167226        !=== NAME OF THE TRACER
    … …  
    169228        ix = strIdx(oldHNO3, s(3))
    170229        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
     230        tracers(it)%name = tname                                     !--- Set %name
     231        CALL addKey('name', tname, k)                                !--- Set the name of the tracer
     232        tracers(it)%keys%name = tname                                !--- Copy tracers names in keys components
    173233
    174234        !=== NAME OF THE COMPONENT
    175235        cname = type_trac                                            !--- Name of the model component
    176236        IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
    177         tracs(it)%component = cname                                  !--- Set %component
     237        tracers(it)%component = cname                                !--- Set %component
     238        CALL addKey('component', cname, k)                           !--- Set the name of the model component
    178239
    179240        !=== NAME OF THE PARENT
    … …  
    184245          IF(ix /= 0 .AND. lRep) pname = newHNO3(ix)                 !--- Exception for HNO3 (REPROBUS ONLY)
    185246        END IF
    186         tracs(it)%parent = pname                                     !--- Set %parent
     247        tracers(it)%parent = pname                                   !--- Set %parent
     248        CALL addKey('parent', pname, k)
    187249
    188250        !=== PHASE AND ADVECTION SCHEMES NUMBERS
    189         tracs(it)%phase = known_phases(ip:ip)                        !--- Set %phase:  tracer phase (default: "g"azeous)
    190         tracs(it)%keys%key = ['hadv', 'vadv']                        !--- Set %keys%key
    191         tracs(it)%keys%val = s(1:2)                                  !--- Set %keys%val
     251        tracers(it)%phase = known_phases(ip:ip)                      !--- Set %phase:  tracer phase (default: "g"azeous)
     252        CALL addKey('phase', known_phases(ip:ip), k)                 !--- Set the phase  of the tracer (default: "g"azeous)
     253        CALL addKey('hadv', s(1),  k)                                !--- Set the horizontal advection schemes number
     254        CALL addKey('vadv', s(2),  k)                                !--- Set the vertical   advection schemes number
    192255      END DO
    193256      CLOSE(90)
    194       CALL setGeneration(tracs)                                      !--- Set %iGeneration and %gen0Name
    195       WHERE(tracs%iGeneration == 2) tracs%type = 'tag'               !--- Set %type:        'tracer' or 'tag'
    196       IF(test(checkTracers(tracs, fname, fname), lerr)) RETURN       !--- Detect orphans and check phases
    197       IF(test(checkUnique (tracs, fname, fname), lerr)) RETURN       !--- Detect repeated tracers
    198       CALL sortTracers  (tracs)                                      !--- Sort the tracers
    199       tracs(:)%keys%name = tracs(:)%name                             !--- Copy tracers names in keys components
     257      IF(test(setGeneration(tracers), lerr)) RETURN                  !--- Set %iGeneration and %gen0Name
     258      WHERE(tracers%iGeneration == 2) tracers(:)%type = 'tag'        !--- Set %type:        'tracer' or 'tag'
     259      CALL addKey('type', tracers(:)%type, tracers(:)%keys)          !--- Set the type of tracers
     260      IF(test(checkTracers(tracers, fname, fname), lerr)) RETURN     !--- Detect orphans and check phases
     261      IF(test(checkUnique (tracers, fname, fname), lerr)) RETURN     !--- Detect repeated tracers
     262      CALL sortTracers    (tracers)                                  !--- Sort the tracers
    200263    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    201264    CASE(2); IF(test(feedDBase(["tracer.def"], [type_trac], modname), lerr)) RETURN !=== SINGLE   FILE, MULTIPLE SECTIONS
    … …  
    209272
    210273  IF(nsec  == 1) THEN;
    211     tracs = dBase(1)%trac
     274    tracers = dBase(1)%trac
    212275  ELSE IF(tracs_merge) THEN
    213276    CALL msg('The multiple required sections will be MERGED.',    modname)
    214     IF(test(mergeTracers(dBase, tracs), lerr)) RETURN
     277    IF(test(mergeTracers(dBase, tracers), lerr)) RETURN
    215278  ELSE
    216279    CALL msg('The multiple required sections will be CUMULATED.', modname)
    217     IF(test(cumulTracers(dBase, tracs), lerr)) RETURN
     280    IF(test(cumulTracers(dBase, tracers), lerr)) RETURN
    218281  END IF
    219   CALL setDirectKeys(tracs)                                          !--- Set %iqParent, %iqDescen, %nqDescen, %nqChilds
     282  CALL setDirectKeys(tracers)                                        !--- Set %iqParent, %iqDescen, %nqDescen, %nqChildren
    220283END FUNCTION readTracersFiles
     284!==============================================================================================================================
     285
     286
     287!==============================================================================================================================
     288LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, tracf, sects) RESULT(lerr)
     289  CHARACTER(LEN=*),                             INTENT(IN)  :: modname, type_trac
     290  INTEGER,                                      INTENT(OUT) :: fType
     291  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: tracf(:), sects(:)
     292  CHARACTER(LEN=maxlen), ALLOCATABLE :: trac_files(:), sections(:)
     293  LOGICAL, ALLOCATABLE :: ll(:)
     294  INTEGER :: is, nsec
     295  lerr = .FALSE.
     296
     297  !--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINNGLE SECTION PER FILE)
     298  IF(test(strParse(type_trac, '|', sections,  n=nsec), lerr)) RETURN !--- Parse "type_trac" list
     299  IF(PRESENT(sects)) sects = sections
     300  ALLOCATE(trac_files(nsec)); DO is=1, nsec; trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'; END DO
     301  IF(PRESENT(tracf)) tracf = trac_files
     302
     303  nsec = SIZE(trac_files, DIM=1)
     304  ll = .NOT.testFile(trac_files)
     305  fType = 0
     306  IF(.NOT.testFile('traceur.def') .AND. nsec==1) fType = 1           !--- OLD STYLE FILE
     307  IF(.NOT.testFile('tracer.def'))                fType = 2           !--- NEW STYLE ; SINGLE  FILE, SEVERAL SECTIONS
     308  IF(ALL(ll))                                    fType = 3           !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
     309  IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
     310    IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
     311  END IF
     312
     313  !--- CHECK WHETHER type_trac AND FILE TYPE ARE COMPATIBLE
     314  IF(test(fmsg('No multiple sections for the old format "traceur.def"', ll = nsec>1 .AND. fType==1), lerr)) RETURN
     315
     316  !--- TELLS WHAT WAS IS ABOUT TO BE USED
     317  CALL msg('Trying to read old-style tracers description file "traceur.def"',                      modname, fType==1)
     318  CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"',    modname, fType==2)
     319  CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
     320END FUNCTION testTracersFiles
    221321!==============================================================================================================================
    222322
    … …  
    253353    lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
    254354    IF(test(expandSection(dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- EXPAND NAMES ;  set %parent, %type, %component
    255     CALL setGeneration   (dBase(idb)%trac)                           !---                 set %iGeneration,   %genOName
     355    IF(test(setGeneration(dBase(idb)%trac),           lerr)) RETURN  !---                 set %iGeneration,   %genOName
    256356    IF(test(checkTracers (dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- CHECK ORPHANS AND PHASES
    257357    IF(test(checkUnique  (dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- CHECK TRACERS UNIQUENESS
    … …  
    359459  ky => t(jd)%keys
    360460  DO k = 1, SIZE(ky%key)                                             !--- Loop on the keys of the tracer named "defName"
    361 !   CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys)                   !--- Add key to all the tracers (no overwriting)
    362     DO it = 1, SIZE(t); CALL addKey_1(ky%key(k), ky%val(k), t(it)%keys); END DO
     461!   CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys, .FALSE.)           !--- Add key to all the tracers (no overwriting)
     462    DO it = 1, SIZE(t); CALL addKey_1(ky%key(k), ky%val(k), t(it)%keys, .FALSE.); END DO
    363463  END DO
    364464  tt = [t(1:jd-1),t(jd+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t)   !--- Remove the virtual tracer named "defName"
    … …  
    409509  TYPE(trac_type),       ALLOCATABLE :: ttr(:)
    410510  CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:)
    411   CHARACTER(LEN=maxlen) :: msg1, modname
    412   INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr, i
     511  CHARACTER(LEN=maxlen) :: msg1, modname, tname, cname , pname
     512  INTEGER :: it, nt, iq, nq, jq, itr, ntr, ipr, npr, i
    413513  LOGICAL :: ll
    414514  modname = 'expandSection'
    … …  
    423523    tr(it)%type      = fgetKey(it, 'type'  , tr(:)%keys, 'tracer')
    424524    tr(it)%component = sname
     525    CALL addKey('component', sname, tr(:)%keys)
    425526
    426527    !--- Determine the number of tracers and parents ; coherence checking
    … …  
    438539  END DO
    439540  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    440   CALL delKey(['parent','type  '], tr)
    441541
    442542  ALLOCATE(ttr(nq))
    … …  
    449549    DO ipr=1,npr                                                     !--- Loop on parents list elts
    450550      DO itr=1,ntr                                                   !--- Loop on tracers list elts
    451         i = iq+itr-1+(ipr-1)*ntr
    452         ttr(i)%name   = TRIM(ta(itr))
    453         ttr(i)%parent = TRIM(pa(ipr))
    454         ttr(i)%keys%name = ta(itr)
    455         ttr(i)%keys%key  = tr(it)%keys%key
    456         ttr(i)%keys%val  = tr(it)%keys%val
    457 !        ttr(i)%keys   = keys_type(ta(itr), tr(it)%keys%key, tr(it)%keys%val)
     551        ttr(iq)%keys%key  = tr(it)%keys%key
     552        ttr(iq)%keys%val  = tr(it)%keys%val
     553        ttr(iq)%keys%name = ta(itr)
     554        ttr(iq)%name      = TRIM(ta(itr));    CALL addKey('name',      ta(itr),          ttr(iq)%keys)
     555        ttr(iq)%parent    = TRIM(pa(ipr));    CALL addKey('parent',    pa(ipr),          ttr(iq)%keys)
     556        ttr(iq)%type      = tr(it)%type;      CALL addKey('type',      tr(it)%type,      ttr(iq)%keys)
     557        ttr(iq)%component = tr(it)%component; CALL addKey('component', tr(it)%component, ttr(iq)%keys)
     558        iq = iq+1
    458559      END DO
    459560    END DO
    460     ttr(iq:iq+ntr*npr-1)%type      = tr(it)%type                     !--- Duplicating type
    461     ttr(iq:iq+ntr*npr-1)%component = tr(it)%component                !--- Duplicating type
    462     iq = iq + ntr*npr
    463561  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    464562  END DO
    … …  
    471569
    472570!==============================================================================================================================
    473 SUBROUTINE setGeneration(tr)
     571LOGICAL FUNCTION setGeneration(tr) RESULT(lerr)
    474572!------------------------------------------------------------------------------------------------------------------------------
    475573! Purpose: Determine, for each tracer of "tr(:)":
    … …  
    479577  TYPE(trac_type),     INTENT(INOUT) :: tr(:)                        !--- Tracer derived type vector
    480578  INTEGER                            :: iq, nq, ig
    481   LOGICAL,               ALLOCATABLE :: lg(:)
    482   CHARACTER(LEN=maxlen), ALLOCATABLE :: prn(:)
    483 !------------------------------------------------------------------------------------------------------------------------------
    484   tr(:)%iGeneration = -1                                             !--- error if -1
     579  CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:), prn(:)
     580  CHARACTER(LEN=maxlen) :: gen0(SIZE(tr))
     581  INTEGER               :: iGen(SIZE(tr))
     582  LOGICAL               ::   lg(SIZE(tr))
     583!------------------------------------------------------------------------------------------------------------------------------
     584  iGen(:) = -1                                                       !--- error if -1
    485585  nq = SIZE(tr, DIM=1)                                               !--- Number of tracers lines
    486   lg = tr(:)%parent == tran0                                         !--- Flag for generation 0 tracers
    487   WHERE(lg) tr(:)%iGeneration = 0                                    !--- Generation 0 tracers
     586  IF(test(fmsg('missing "parent" attribute', 'setGeneration', getKey('parent', parent, ky=tr(:)%keys)), lerr)) RETURN
     587  WHERE(parent == tran0) iGen(:) = 0
    488588
    489589  !=== Determine generation for each tracer
    490590  ig=-1; prn = [tran0]
    491591  DO                                                                 !--- Update current generation flag
    492     IF(ig/=-1) prn = PACK( tr(:)%name, MASK=tr(:)%iGeneration == ig)
    493     lg(:) = [(ANY(prn(:) == tr(iq)%parent), iq=1, nq)]               !--- Current generation tracers flag
     592    IF(ig/=-1) prn = PACK( tr(:)%name, MASK = iGen == ig)
     593    lg(:) = [(ANY(prn(:) == parent(iq)), iq=1, nq)]                  !--- Current generation tracers flag
    494594    IF( ALL( .NOT. lg ) ) EXIT                                       !--- Empty current generation
    495     ig = ig+1; WHERE(lg) tr(:)%iGeneration = ig
    496   END DO
    497   tr(:)%gen0Name = ancestor(tr)                                      !--- First generation ancestor name
    498 
    499 END SUBROUTINE setGeneration
     595    ig = ig+1; WHERE(lg) iGen(:) = ig
     596  END DO
     597  tr%iGeneration = iGen; CALL addKey_mm('iGeneration', int2str(iGen(:)), tr(:)%keys)
     598  CALL ancestor(tr, gen0)                                            !--- First generation ancestor name
     599  tr%gen0Name    = gen0; CALL addKey_mm('gen0Name',    gen0,             tr(:)%keys)
     600
     601END FUNCTION setGeneration
    500602!==============================================================================================================================
    501603
    … …  
    581683  TYPE(trac_type), ALLOCATABLE :: ttr(:)
    582684  INTEGER,   ALLOCATABLE ::  i0(:)
    583   CHARACTER(LEN=maxlen)  :: nam, pha, trn
     685  CHARACTER(LEN=maxlen)  :: nam, pha, tname
     686  CHARACTER(LEN=maxlen), allocatable :: ph(:)
    584687  CHARACTER(LEN=1) :: p
    585688  INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
    … …  
    590693  DO iq = 1, nq                                                      !--- GET THE NUMBER OF TRACERS
    591694    IF(tr(iq)%iGeneration /= 0) CYCLE                                !--- Only deal with generation 0 tracers
    592     nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=0)  !--- Number of childs of tr(iq)
    593     tr(iq)%phase = fgetKey(iq, 'phases', tr(:)%keys)                 !--- Phases list      of tr(iq)
    594     np = LEN_TRIM(tr(iq)%phase)                                      !--- Number of phases of tr(iq)
     695    nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=0)  !--- Number of children of tr(iq)
     696    tr(iq)%phase = fgetKey(iq, 'phases', tr(:)%keys)                 !--- Phases list        of tr(iq)
     697    np = LEN_TRIM(tr(iq)%phase)                                      !--- Number of phases   of tr(iq)
    595698    nt = nt + (1+nc) * np                                            !--- Number of tracers after expansion
    596699  END DO
    … …  
    609712      DO ip = 1, LEN_TRIM(pha)                                       !=== LOOP ON PHASES LISTS
    610713        p = pha(ip:ip)
    611         trn = TRIM(tr(iq)%name); nam = trn                           !--- Tracer name (regular case)
     714        tname = TRIM(tr(iq)%name); nam = tname                       !--- Tracer name (regular case)
    612715        IF(lTag) nam = TRIM(tr(iq)%parent)                           !--- Parent name (tagging case)
    613716        IF(lExt) nam = addPhase(nam, p )                             !--- Phase extension needed
    614         IF(lTag) nam = TRIM(nam)//'_'//TRIM(trn)                     !--- <parent>_<name> for tags
     717        IF(lTag) nam = TRIM(nam)//'_'//TRIM(tname)                   !--- <parent>_<name> for tags
    615718        ttr(it) = tr(iq)                                             !--- Same <key>=<val> pairs
    616719        ttr(it)%name      = TRIM(nam)                                !--- Name with possibly phase suffix
    617720        ttr(it)%keys%name = TRIM(nam)                                !--- Name inside the keys decriptor
    618721        ttr(it)%phase     = p                                        !--- Single phase entry
     722        CALL addKey('name', nam, ttr(it)%keys)
     723        CALL addKey('phase', p,  ttr(it)%keys)
    619724        IF(lExt .AND. tr(iq)%iGeneration>0) THEN
    620           ttr(it)%parent   = addPhase(ttr(it)%parent,   p)
    621           ttr(it)%gen0Name = addPhase(ttr(it)%gen0Name, p)
     725          ttr(it)%parent   = addPhase(tr(iq)%parent,   p)
     726          ttr(it)%gen0Name = addPhase(tr(iq)%gen0Name, p)
     727          CALL addKey('parent',   ttr(it)%parent,   ttr(it)%keys)
     728          CALL addKey('gen0Name', ttr(it)%gen0Name, ttr(it)%keys)
    622729        END IF
    623730        it = it+1
    … …  
    638745!  * Put water at the beginning of the vector, in the "known_phases" order.
    639746!  * lGrowGen == T: in ascending generations numbers.
    640 !  * lGrowGen == F: tracer + its childs sorted by growing generation, one after the other.
     747!  * lGrowGen == F: tracer + its children sorted by growing generation, one after the other.
    641748!   TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
    642749!------------------------------------------------------------------------------------------------------------------------------
    … …  
    671778      ix(iq) = jq                                                    !--- Generation 0 ancestor index first
    672779      iq = iq + 1                                                    !--- Next "iq" for next generations tracers
    673       iy = strFind(tr(:)%gen0Name, TRIM(tr(jq)%name))                !--- Indexes of "tr(jq)" childs in "tr(:)"
     780      iy = strFind(tr(:)%gen0Name, TRIM(tr(jq)%name))                !--- Indexes of "tr(jq)" children in "tr(:)"
    674781      ng = MAXVAL(tr(iy)%iGeneration, MASK=.TRUE., DIM=1)            !--- Number of generations of the "tr(jq)" family
    675782      DO ig = 1, ng                                                  !--- Loop   on generations of the "tr(jq)" family
    … …  
    683790END SUBROUTINE sortTracers
    684791!==============================================================================================================================
     792
    685793
    686794!==============================================================================================================================
    … …  
    793901  TYPE(trac_type), INTENT(INOUT) :: tr(:)
    794902
    795   !--- Update %iqParent, %iqDescen, %nqDescen, %nqChilds
     903  !--- Update %iqParent, %iqDescen, %nqDescen, %nqChildren
    796904  CALL indexUpdate(tr)
    797905
    … …  
    808916  INTEGER :: idb, iq, nq
    809917  INTEGER, ALLOCATABLE :: hadv(:), vadv(:)
    810   CHARACTER(LEN=maxlen), ALLOCATABLE :: phas(:)
     918  CHARACTER(LEN=maxlen), ALLOCATABLE :: phas(:), prnt(:)
    811919  TYPE(trac_type), POINTER :: tm(:)
    812920  lerr = .FALSE.
    … …  
    816924  !--- BEWARE ! Can't use the "getKeyByName" functions yet.
    817925  !             Names must first include the phases for tracers defined on multiple lines.
    818   hadv = str2int([(fgetKey(iq, 'hadv',  tm(:)%keys, '10'), iq=1, nq)])
    819   vadv = str2int([(fgetKey(iq, 'vadv',  tm(:)%keys, '10'), iq=1, nq)])
    820   phas =         [(fgetKey(iq, 'phases',tm(:)%keys, 'g' ), iq=1, nq)]
     926  hadv = str2int(fgetKey('hadv',  tm(:)%keys, '10'))
     927  vadv = str2int(fgetKey('vadv',  tm(:)%keys, '10'))
     928  prnt =         fgetKey('parent',tm(:)%keys,  '' )
     929  IF(getKey('phases', phas, ky=tm(:)%keys)) phas = fGetKey('phase', tm(:)%keys, 'g')
    821930  CALL msg(TRIM(message)//':', modname)
    822   IF(ALL(tm(:)%parent == '')) THEN
    823     IF(test(dispTable('iiiss',   ['iq    ','hadv  ','vadv  ','name  ','phase '], cat(tm%name, phas), &
     931  IF(ALL(prnt == 'air')) THEN
     932    IF(test(dispTable('iiiss',   ['iq    ','hadv  ','vadv  ','name  ','phase '],                   cat(tm%name,       phas),  &
     933                 cat([(iq, iq=1, nq)], hadv, vadv),                 nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
     934  ELSE IF(ALL(tm%iGeneration == -1)) THEN
     935    IF(test(dispTable('iiisss', ['iq    ','hadv  ','vadv  ','name  ','parent','phase '],           cat(tm%name, prnt, phas),  &
    824936                 cat([(iq, iq=1, nq)], hadv, vadv),                 nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
    825937  ELSE
    826     IF(test(dispTable('iiissis', ['iq    ','hadv  ','vadv  ','name  ','parent','igen  ','phase '], cat(tm%name, tm%parent, &
    827       tm%phase), cat([(iq, iq=1, nq)], hadv, vadv, tm%iGeneration), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
     938    IF(test(dispTable('iiissis', ['iq    ','hadv  ','vadv  ','name  ','parent','igen  ','phase '], cat(tm%name, prnt, phas), &
     939                cat([(iq, iq=1, nq)], hadv, vadv, tm%iGeneration), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
    828940  END IF
    829941END FUNCTION dispTraSection
    … …  
    884996SUBROUTINE indexUpdate(tr)
    885997  TYPE(trac_type), INTENT(INOUT) :: tr(:)
    886   INTEGER :: iq, ig, ng, igen, ngen
    887   INTEGER, ALLOCATABLE :: ix(:)
     998  INTEGER :: iq, ig, ng, igen, ngen, ix(SIZE(tr))
    888999  tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent )                !--- Parent index
     1000  CALL addKey('iqParent', int2str(tr%iqParent), tr(:)%keys)
    8891001  ngen = MAXVAL(tr(:)%iGeneration, MASK=.TRUE.)
    8901002  DO iq = 1, SIZE(tr)
    … …  
    8921004    IF(ALLOCATED(tr(iq)%iqDescen)) DEALLOCATE(tr(iq)%iqDescen)
    8931005    ALLOCATE(tr(iq)%iqDescen(0))
    894     ix = idxAncestor(tr, igen=ig)                                    !--- Ancestor of generation "ng" for each tr
     1006    CALL idxAncestor(tr, ix, ig)                                     !--- Ancestor of generation "ng" for each tr
    8951007    DO igen = ig+1, ngen
    8961008      tr(iq)%iqDescen = [tr(iq)%iqDescen, find(ix==iq .AND. tr%iGeneration==igen)]
    8971009      tr(iq)%nqDescen = SIZE(tr(iq)%iqDescen)
    898       IF(igen == ig+1) tr(iq)%nqChilds=tr(iq)%nqDescen
     1010      IF(igen == ig+1) THEN
     1011        tr(iq)%nqChildren = tr(iq)%nqDescen
     1012        CALL addKey('nqChildren', int2str(tr(iq)%nqChildren), tr(iq)%keys)
     1013      END IF
    8991014    END DO
    900   END DO
     1015    CALL addKey('iqDescen', strStack(int2str(tr(iq)%iqDescen)), tr(iq)%keys)
     1016  END DO
     1017  CALL addKey('nqDescen', int2str(tr(:)%nqDescen), tr(:)%keys)
    9011018END SUBROUTINE indexUpdate
    9021019!==============================================================================================================================
    … …  
    9081025!===  * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot"        ====
    9091026!=== NOTES:                                                                                                                ====
    910 !===  * Most of the "isot" components have been defined in the calling routine (initIsotopes):                             ====
     1027!===  * Most of the "isot" components have been defined in the calling routine (readIsotopes):                             ====
    9111028!===      parent,  nzone, zone(:),  niso, keys(:)%name,  ntiso, trac(:),  nphas, phas,  iqIsoPha(:,:),  itZonPhi(:,:)      ====
    9121029!===  * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes       ====
    … …  
    9161033!===  * The routine gives an error if a required isotope is not available in the database stored in "fnam"                 ====
    9171034!==============================================================================================================================
    918 LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
     1035LOGICAL FUNCTION readIsotopesFile_prv(fnam, isot) RESULT(lerr)
    9191036  CHARACTER(LEN=*),        INTENT(IN)    :: fnam                     !--- Input file name
    9201037  TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:)                  !--- Isotopes descriptors (field %parent must be defined!)
    … …  
    9271044  TYPE(trac_type),           POINTER ::   tt(:), t
    9281045  TYPE(dataBase_type),   ALLOCATABLE ::  tdb(:)
    929   LOGICAL,               ALLOCATABLE :: liso(:)
    9301046  modname = 'readIsotopesFile'
    9311047
    … …  
    9531069      is = strIdx(isot(iis)%keys(:)%name, t%name)                    !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name"
    9541070      IF(is == 0) CYCLE
    955       liso = reduceExpr(t%keys%val, vals)                            !--- Reduce expressions (for substituted variables)
    956       IF(test(ANY(liso), lerr)) RETURN                               !--- Some non-numerical elements were found
    957       isot(iis)%keys(is)%key = PACK(t%keys%key, MASK=.NOT.liso)
    958       isot(iis)%keys(is)%val = PACK(  vals,     MASK=.NOT.liso)
     1071      IF(test(ANY(reduceExpr(t%keys%val, vals)), lerr)) RETURN       !--- Reduce expressions ; detect non-numerical elements
     1072      isot(iis)%keys(is)%key = t%keys%key
     1073      isot(iis)%keys(is)%val = vals
    9591074    END DO
    9601075
    9611076    !--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
    962     liso = [( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )]
    963     IF(test(checkList(isot(iis)%keys(:)%name, .NOT.liso, &
    964       'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'),lerr)) RETURN
     1077    IF(test(checkList(isot(iis)%keys(:)%name, .NOT.[( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )], &
     1078      'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'), lerr)) RETURN
    9651079  END DO
    9661080
    … …  
    9751089  CALL get_in('ok_iso_verif', isot(strIdx(isot%parent, 'H2O'))%check, .FALSE.)
    9761090
    977   lerr = dispIsotopes(isot, 'Isotopes parameters read from file "'//TRIM(fnam)//'"', modname)
    978 
    979 END FUNCTION readIsotopesFile
     1091  lerr = dispIsotopes()
     1092
     1093CONTAINS
     1094
     1095!------------------------------------------------------------------------------------------------------------------------------
     1096LOGICAL FUNCTION dispIsotopes() RESULT(lerr)
     1097  INTEGER :: ik, nk, ip, it, nt
     1098  CHARACTER(LEN=maxlen) :: prf
     1099  CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
     1100  CALL msg('Isotopes parameters read from file "'//TRIM(fnam)//'":', modname)
     1101  DO ip = 1, SIZE(isot)                                              !--- Loop on parents tracers
     1102    nk = SIZE(isot(ip)%keys(1)%key)                                  !--- Same keys for each isotope
     1103    nt = SIZE(isot(ip)%keys)                                         !--- Number of isotopes
     1104    prf = 'i'//REPEAT('s',nk+1)                                      !--- Profile for table printing
     1105    ALLOCATE(ttl(nk+2), val(nt,nk+1))
     1106    ttl(1:2) = ['it  ','name']; ttl(3:nk+2) = isot(ip)%keys(1)%key(:)!--- Titles line with keys names
     1107    val(:,1) = isot(ip)%keys(:)%name                                 !--- Values table 1st column: isotopes names 
     1108    DO ik = 1, nk
     1109      DO it = 1, nt
     1110        val(it,ik+1) = isot(ip)%keys(it)%val(ik)                     !--- Other columns: keys values
     1111      END DO
     1112    END DO
     1113    IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, &
     1114            cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)), lerr)) RETURN
     1115    DEALLOCATE(ttl, val)
     1116  END DO       
     1117END FUNCTION dispIsotopes
     1118!------------------------------------------------------------------------------------------------------------------------------
     1119
     1120END FUNCTION readIsotopesFile_prv
    9801121!==============================================================================================================================
    9811122
    … …  
    9851126!===    * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS).                                                       ===
    9861127!===    * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS                                                                  ===
    987 !===    * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS)                                              ===
     1128!===    * CALL readIsotopesFile_prv TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS)                                          ===
    9881129!===      NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS.  ===
    9891130!==============================================================================================================================
    990 LOGICAL FUNCTION initIsotopes(trac, isot) RESULT(lerr)
    991   TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: trac(:)
    992   TYPE(isot_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: isot(:)
     1131LOGICAL FUNCTION readIsotopesFile(iNames) RESULT(lerr)
     1132  CHARACTER(LEN=maxlen), TARGET, OPTIONAL, INTENT(IN)  :: iNames(:)
    9931133  CHARACTER(LEN=maxlen), ALLOCATABLE :: p(:), str(:)                 !--- Temporary storage
    994   CHARACTER(LEN=maxlen) :: iName
     1134  CHARACTER(LEN=maxlen) :: iName, modname
    9951135  CHARACTER(LEN=1)   :: ph                                           !--- Phase
    996   INTEGER :: nbIso, ic, ip, iq, it, iz
     1136  INTEGER :: ic, ip, iq, it, iz
    9971137  LOGICAL, ALLOCATABLE :: ll(:)                                      !--- Mask
    9981138  TYPE(trac_type), POINTER   ::  t(:), t1
    9991139  TYPE(isot_type), POINTER   ::  i
    10001140  lerr = .FALSE.
    1001 
    1002   t => trac
     1141  modname = 'readIsotopesFile'
     1142
     1143  t => tracers
    10031144
    10041145  !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
    10051146  p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1)
    10061147  CALL strReduce(p, nbIso)
    1007   ALLOCATE(isot(nbIso))
     1148
     1149  !--- CHECK WHETHER NEEDED ISOTOPES CLASSES "iNames" ARE AVAILABLE OR NOT
     1150  IF(PRESENT(iNames)) THEN
     1151    DO it = 1, SIZE(iNames)
     1152      IF(test(fmsg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, ALL(p /= iNames(it))), lerr)) RETURN
     1153    END DO
     1154    p = iNames; nbIso = SIZE(p)
     1155  END IF
     1156  IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes)
     1157  ALLOCATE(isotopes(nbIso))
    10081158
    10091159  IF(nbIso==0) RETURN                                                !=== NO ISOTOPES: FINISHED
    10101160
    10111161  !--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
    1012   isot(:)%parent = p
     1162  isotopes(:)%parent = p
    10131163  DO ic = 1, SIZE(p)                                                 !--- Loop on isotopes classes
    1014     i => isot(ic)
     1164    i => isotopes(ic)
    10151165    iname = i%parent                                                 !--- Current isotopes class name (parent tracer name)
    10161166
    1017     !=== Isotopes childs of tracer "iname": mask, names, number (same for each phase of "iname")
     1167    !=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname")
    10181168    ll = t(:)%type=='tracer' .AND. delPhase(t(:)%parent) == iname .AND. t(:)%phase == 'g'
    10191169    str = PACK(delPhase(t(:)%name), MASK = ll)                       !--- Effectively found isotopes of "iname"
    … …  
    10281178    i%nzone = SIZE(i%zone)                                           !--- Tagging zones number for isotopes category "iname"
    10291179
    1030     !=== Geographic tracers of the isotopes childs of tracer "iname" (same for each phase of "iname")
     1180    !=== Geographic tracers of the isotopes children of tracer "iname" (same for each phase of "iname")
    10311181    !    NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
    10321182    str = PACK(delPhase(t(:)%name), MASK=ll)
    … …  
    10441194    !=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
    10451195    DO iq = 1, SIZE(t)
    1046       t1 => trac(iq)
     1196      t1 => tracers(iq)
    10471197      IF(delPhase(t1%gen0Name)/=iname .OR. t1%iGeneration==0) CYCLE  !--- Only deal with tracers descending on "iname"
    10481198      t1%iso_iGroup = ic                                             !--- Isotopes family       idx in list "isotopes(:)%parent"
    … …  
    10551205    !=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
    10561206    !    (including tagging tracers) is sorted this way:  iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
    1057     i%iqIsoPha = RESHAPE( [( (strIdx(t%name,  addPhase(i%trac(it),i%phase(ip:ip))),      it=1, i%ntiso), ip=1, i%nphas)], &
     1207    i%iqIsoPha = RESHAPE( [( (strIdx(t%name,  addPhase(i%trac(it),i%phase(ip:ip))),       it=1, i%ntiso), ip=1, i%nphas)], &
    10581208                         [i%ntiso, i%nphas] )
    10591209    !=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
    … …  
    10621212  END DO
    10631213
    1064   !=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE
    1065   lerr = readIsotopesFile('isotopes_params.def',isot)
    1066 
    1067 END FUNCTION initIsotopes
    1068 !==============================================================================================================================
    1069 
    1070 
    1071 !==============================================================================================================================
    1072 LOGICAL FUNCTION dispIsotopes(ides, message, modname) RESULT(lerr)
    1073   TYPE(isot_type),  INTENT(IN) :: ides(:)                            !--- Isotopes descriptor vector
    1074   CHARACTER(LEN=*), INTENT(IN) :: message                            !--- Message to display
    1075   CHARACTER(LEN=*), INTENT(IN) :: modname                            !--- Calling subroutine name
    1076   INTEGER :: ik, nk, ip, it, nt
    1077   CHARACTER(LEN=maxlen) :: prf
    1078   CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
    1079   CALL msg(TRIM(message)//':', modname)
    1080   DO ip = 1, SIZE(ides)                                              !--- Loop on parents tracers
    1081     nk = SIZE(ides(ip)%keys(1)%key)                                  !--- Same keys for each isotope
    1082     nt = SIZE(ides(ip)%keys)                                         !--- Number of isotopes
    1083     prf = 'i'//REPEAT('s',nk+1)                                      !--- Profile for table printing
    1084     ALLOCATE(ttl(nk+2), val(nt,nk+1))
    1085     ttl(1:2) = ['it  ','name']; ttl(3:nk+2) = ides(ip)%keys(1)%key(:)!--- Titles line with keys names
    1086     val(:,1) = ides(ip)%keys(:)%name                                 !--- Values table 1st column: isotopes names 
    1087     DO ik = 1, nk
    1088       DO it = 1, nt
    1089         val(it,ik+1) = ides(ip)%keys(it)%val(ik)                     !--- Other columns: keys values
    1090       END DO
     1214  !=== READ PHYSICAL PARAMETERS FROM isoFile FILE
     1215  IF(test(readIsotopesFile_prv(isoFile, isotopes), lerr)) RETURN
     1216
     1217  !=== CHECK CONSISTENCY
     1218  IF(test(testIsotopes(), lerr)) RETURN
     1219
     1220  !=== SELECT FIRST ISOTOPES CLASS OR, IF POSSIBLE, WATER CLASS
     1221  IF(.NOT.test(isoSelect(1, .TRUE.), lerr)) THEN; IF(isotope%parent == 'H2O') iH2O = ixIso; END IF
     1222
     1223CONTAINS
     1224
     1225!------------------------------------------------------------------------------------------------------------------------------
     1226LOGICAL FUNCTION testIsotopes() RESULT(lerr)     !--- MAKE SURE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
     1227!------------------------------------------------------------------------------------------------------------------------------
     1228  INTEGER :: ix, it, ip, np, iz, nz
     1229  TYPE(isot_type), POINTER :: i
     1230  DO ix = 1, nbIso
     1231    i => isotopes(ix)
     1232    !--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
     1233    DO it = 1, i%ntiso
     1234      np = SUM([(COUNT(tracers(:)%name == addPhase(i%trac(it), i%phase(ip:ip))), ip=1, i%nphas)])
     1235      IF(test(fmsg(TRIM(int2str(np))//' phases instead of '//TRIM(int2str(i%nphas))//' for '//TRIM(i%trac(it)), &
     1236        modname, np /= i%nphas), lerr)) RETURN
    10911237    END DO
    1092     IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, &
    1093             cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)), lerr)) RETURN
    1094     DEALLOCATE(ttl, val)
    1095   END DO       
    1096 END FUNCTION dispIsotopes
     1238    DO it = 1, i%niso
     1239      nz = SUM([(COUNT(i%trac == TRIM(i%trac(it))//'_'//i%zone(iz)), iz=1, i%nzone)])
     1240      IF(test(fmsg(TRIM(int2str(nz))//' tagging zones instead of '//TRIM(int2str(i%nzone))//' for '//TRIM(i%trac(it)), &
     1241        modname, nz /= i%nzone), lerr)) RETURN
     1242    END DO
     1243  END DO
     1244END FUNCTION testIsotopes
     1245!------------------------------------------------------------------------------------------------------------------------------
     1246
     1247END FUNCTION readIsotopesFile
     1248!==============================================================================================================================
     1249
     1250
     1251!==============================================================================================================================
     1252!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
     1253!     Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
     1254!==============================================================================================================================
     1255LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
     1256   IMPLICIT NONE
     1257   CHARACTER(LEN=*),  INTENT(IN) :: iName
     1258   LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
     1259   INTEGER :: iIso
     1260   LOGICAL :: lV
     1261   lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
     1262   iIso = strIdx(isotopes(:)%parent, iName)
     1263   IF(test(iIso == 0, lerr)) THEN
     1264      niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck=.FALSE.
     1265      CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV)
     1266      RETURN
     1267   END IF
     1268   lerr = isoSelectByIndex(iIso, lV)
     1269END FUNCTION isoSelectByName
     1270!==============================================================================================================================
     1271LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
     1272   IMPLICIT NONE
     1273   INTEGER,           INTENT(IN) :: iIso
     1274   LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
     1275   LOGICAL :: lV
     1276   lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
     1277   lerr = .FALSE.
     1278   IF(iIso == ixIso) RETURN                                          !--- Nothing to do if the index is already OK
     1279   lerr = iIso<=0 .OR. iIso>SIZE(isotopes)
     1280   CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '&
     1281          //TRIM(int2str(SIZE(isotopes)))//'"', ll = lerr .AND. lV)
     1282   IF(lerr) RETURN
     1283   ixIso = iIso                                                      !--- Update currently selected family index
     1284   isotope  => isotopes(ixIso)                                       !--- Select corresponding component
     1285   isoKeys  => isotope%keys;     niso     = isotope%niso
     1286   isoName  => isotope%trac;     ntiso    = isotope%ntiso
     1287   isoZone  => isotope%zone;     nzone    = isotope%nzone
     1288   isoPhas  => isotope%phase;    nphas    = isotope%nphas
     1289   itZonIso => isotope%itZonIso; isoCheck = isotope%check
     1290   iqIsoPha => isotope%iqIsoPha
     1291END FUNCTION isoSelectByIndex
    10971292!==============================================================================================================================
    10981293
    … …  
    11091304  INTEGER :: iky, nky
    11101305  LOGICAL :: lo
    1111   lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
     1306  lo=.TRUE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
    11121307  iky = strIdx(ky%key,key)
    11131308  IF(iky == 0) THEN
    11141309    nky = SIZE(ky%key)
    11151310    IF(nky == 0) THEN; ky%key = [key]; ky%val = [val]; ELSE; ky%key = [ky%key, key]; ky%val = [ky%val, val]; END IF
    1116   ELSE IF(lo) THEN                                                   !--- Overwriting
     1311  ELSE IF(lo) THEN
    11171312    ky%key(iky) = key; ky%val(iky) = val
    11181313  END IF
    … …  
    11251320!------------------------------------------------------------------------------------------------------------------------------
    11261321  INTEGER :: itr
    1127   LOGICAL :: lo
    1128   lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
    1129   DO itr = 1, SIZE(ky); CALL addKey_1(key, val, ky(itr), lo); END DO
     1322  DO itr = 1, SIZE(ky); CALL addKey_1(key, val, ky(itr), lOverWrite); END DO
    11301323END SUBROUTINE addKey_m
     1324!==============================================================================================================================
     1325SUBROUTINE addKey_mm(key, val, ky, lOverWrite)
     1326  CHARACTER(LEN=*),  INTENT(IN)    :: key, val(:)
     1327  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
     1328  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
     1329!------------------------------------------------------------------------------------------------------------------------------
     1330  INTEGER :: itr
     1331  DO itr = 1, SIZE(ky); CALL addKey_1(key, val(itr), ky(itr), lOverWrite); END DO
     1332END SUBROUTINE addKey_mm
    11311333!==============================================================================================================================
    11321334
    … …  
    11791381
    11801382!==============================================================================================================================
    1181 !=== getKey ROUTINE INITIALIZATION (TO BE EMBEDDED SOMEWHERE)  ================================================================
    1182 !==============================================================================================================================
    1183 SUBROUTINE getKey_init(tracers_, isotopes_)
    1184   TYPE(trac_type), OPTIONAL, INTENT(IN) ::  tracers_(:)
    1185   TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
    1186   IF(PRESENT( tracers_))  tracers =  tracers_
    1187   IF(PRESENT(isotopes_)) isotopes = isotopes_
    1188 END SUBROUTINE getKey_init
    1189 
    1190 
    1191 !==============================================================================================================================
    11921383!================ GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RESULT IS THE RETURNED VALUE ===================
    11931384!==============================================================================================================================
    1194 CHARACTER(LEN=maxlen) FUNCTION fgetKeyByIndex_s1(itr, keyn, ky, def_val) RESULT(val)
    1195   INTEGER,                    INTENT(IN) :: itr
    1196   CHARACTER(LEN=*),           INTENT(IN) :: keyn
    1197   TYPE(keys_type),            INTENT(IN) :: ky(:)
    1198   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
     1385CHARACTER(LEN=maxlen) FUNCTION fgetKeyIdx_s1(itr, keyn, ky, def_val, lerr) RESULT(val)
     1386  INTEGER,                    INTENT(IN)  :: itr
     1387  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
     1388  TYPE(keys_type),            INTENT(IN)  :: ky(:)
     1389  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: def_val
     1390  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
    11991391!------------------------------------------------------------------------------------------------------------------------------
    12001392  INTEGER :: iky
    1201   iky = 0;  IF(itr >  0 .AND. itr <= SIZE(ky)) iky = strIdx(ky(itr)%key(:), keyn)
    1202   val = ''; IF(iky /= 0) val = ky(itr)%val(iky)                      !--- Key was found
    1203   IF(PRESENT(def_val) .AND. iky == 0) val = def_val                  !--- Default value from arguments
    1204 END FUNCTION fgetKeyByIndex_s1
    1205 !==============================================================================================================================
    1206 CHARACTER(LEN=maxlen) FUNCTION fgetKeyByName_s1(tname, keyn, ky, def_val, lerr) RESULT(val)
     1393  LOGICAL :: ler
     1394  iky = 0; val = ''
     1395  IF(.NOT.test(itr <= 0 .OR. itr > SIZE(ky), ler)) iky = strIdx(ky(itr)%key(:), keyn)    !--- Correct index
     1396  IF(.NOT.test(iky == 0, ler))                     val = ky(itr)%val(iky)                !--- Found key
     1397  IF(iky == 0) THEN
     1398    IF(.NOT.test(.NOT.PRESENT(def_val), ler))      val = def_val                         !--- Default value
     1399  END IF
     1400  IF(PRESENT(lerr)) lerr = ler
     1401END FUNCTION fgetKeyIdx_s1
     1402!==============================================================================================================================
     1403CHARACTER(LEN=maxlen) FUNCTION fgetKeyNam_s1(tname, keyn, ky, def_val, lerr) RESULT(val)
    12071404  CHARACTER(LEN=*),           INTENT(IN)  :: tname, keyn
    12081405  TYPE(keys_type),            INTENT(IN)  :: ky(:)
    … …  
    12101407  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
    12111408!------------------------------------------------------------------------------------------------------------------------------
    1212   INTEGER :: iky, itr
    1213   val = ''; iky = 0
    1214   itr = strIdx(ky(:)%name, tname)                                    !--- Get the index of the wanted tracer
    1215   IF(PRESENT(lerr)) lerr = itr==0; IF(itr == 0) RETURN
    1216   IF(itr >  0 .AND. itr <= SIZE(ky)) iky = strIdx(ky(itr)%key(:), keyn)
    1217   IF(iky /= 0) val = ky(itr)%val(iky)                                !--- Key was found
    1218   IF(PRESENT(def_val) .AND. iky == 0) val = def_val                  !--- Default value from arguments
    1219 END FUNCTION fgetKeyByName_s1
     1409  val = fgetKeyIdx_s1(strIdx(ky(:)%name, tname), keyn, ky, def_val, lerr)
     1410END FUNCTION fgetKeyNam_s1
     1411!==============================================================================================================================
     1412FUNCTION fgetKey_sm(keyn, ky, def_val, lerr) RESULT(val)
     1413CHARACTER(LEN=maxlen),        ALLOCATABLE :: val(:)
     1414  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
     1415  TYPE(keys_type),            INTENT(IN)  :: ky(:)
     1416  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: def_val
     1417  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
     1418!------------------------------------------------------------------------------------------------------------------------------
     1419  LOGICAL :: ler(SIZE(ky))
     1420  INTEGER :: it
     1421  val = [(fgetKeyIdx_s1(it, keyn, ky, def_val, ler(it)), it = 1, SIZE(ky))]
     1422  IF(PRESENT(lerr)) lerr = ANY(ler)
     1423END FUNCTION fgetKey_sm
    12201424!==============================================================================================================================
    12211425
    … …  
    12361440!------------------------------------------------------------------------------------------------------------------------------
    12371441  CHARACTER(LEN=maxlen) :: tnam
    1238   INTEGER, ALLOCATABLE  :: is(:)
    1239   INTEGER :: i, itr
    1240   tnam = delPhase(strHead(tname,'_',.FALSE.))                        !--- Remove tag and phase
    1241   IF(PRESENT(ky)) THEN
    1242     val = fgetKeyByName_s1(tname, keyn, ky, lerr=lerr)               !--- "ky" and "tname"
    1243     IF(val /= '' .OR. lerr)      RETURN
    1244     val = fgetKeyByName_s1(tnam,  keyn, ky, lerr=lerr)               !--- "ky" and "tnam"
     1442  tnam = strHead(delPhase(tname),'_',.FALSE.)                                            !--- Remove tag and phase
     1443  IF(PRESENT(ky)) THEN                                                                   !=== KEY FROM "ky"
     1444               val = fgetKeyNam_s1(tname, keyn, ky,           lerr=lerr)                 !--- "ky" and "tname"
     1445    IF( lerr ) val = fgetKeyNam_s1(tnam,  keyn, ky,           lerr=lerr)                 !--- "ky" and "tnam"
    12451446  ELSE
    1246     IF(.NOT.ALLOCATED(tracers))  RETURN
    1247     val = fgetKeyByName_s1(tname, keyn, tracers(:)%keys, lerr=lerr)  !--- "tracers" and "tname"
    1248     IF(val /= ''.AND..NOT.lerr)  RETURN
    1249     IF(.NOT.ALLOCATED(isotopes)) RETURN
    1250     IF(SIZE(isotopes) == 0)      RETURN
    1251     !--- Search the "is" isotopes class index of the isotope named "tnam"
    1252     is = find([(ANY(isotopes(i)%keys(:)%name == tnam), i=1, SIZE(isotopes))])
    1253     IF(test(SIZE(is) == 0,lerr)) RETURN
    1254     val = fgetKeyByName_s1(tname, keyn, isotopes(is(1))%keys(:),lerr=lerr)!--- "isotopes" and "tnam"
     1447    IF(         .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0    !=== KEY FROM "tracers"
     1448    IF(.NOT.lerr) THEN
     1449               val = fgetKeyNam_s1(tname, keyn, tracers%keys, lerr=lerr)                 !--- "ky" and "tname"
     1450      IF(lerr) val = fgetKeyNam_s1(tnam,  keyn, tracers%keys, lerr=lerr)                 !--- "ky" and "tnam"
     1451    END IF
     1452    IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0    !=== KEY FROM "isotope"
     1453    IF(.NOT.lerr) THEN
     1454               val = fgetKeyNam_s1(tname, keyn, isotope%keys, lerr=lerr)                 !--- "ky" and "tname"
     1455      IF(lerr) val = fgetKeyNam_s1(tnam,  keyn, isotope%keys, lerr=lerr)                 !--- "ky" and "tnam"
     1456    END IF
    12551457  END IF
    12561458END FUNCTION getKeyByName_s1
    12571459!==============================================================================================================================
    1258 LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky) RESULT(lerr)
     1460LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky, nam) RESULT(lerr)
     1461  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1462  CHARACTER(LEN=maxlen), ALLOCATABLE,           INTENT(OUT) :: val(:)
     1463  CHARACTER(LEN=*),           TARGET, OPTIONAL, INTENT(IN)  :: tname(:)
     1464  TYPE(keys_type),            TARGET, OPTIONAL, INTENT(IN)  :: ky(:)
     1465  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: nam(:)
     1466!------------------------------------------------------------------------------------------------------------------------------
     1467  CHARACTER(LEN=maxlen), ALLOCATABLE :: names(:)
     1468  TYPE(keys_type),       POINTER     ::  keys(:)
     1469  LOGICAL :: lk, lt, li, ll
     1470  INTEGER :: iq, nq
     1471
     1472  !--- DETERMINE THE DATABASE TO BE USED (ky, tracers or isotope)
     1473  lk = PRESENT(ky)
     1474  lt = .NOT.lk .AND. ALLOCATED(tracers);  IF(lt) lt = SIZE(tracers)  /= 0; IF(lt) lt = ANY(tracers(1)%keys%key(:) == keyn)
     1475  li = .NOT.lt .AND. ALLOCATED(isotopes); IF(li) li = SIZE(isotopes) /= 0; IF(li) li = ANY(isotope%keys(1)%key(:) == keyn)
     1476
     1477  IF(test(.NOT.ANY([lk,lt,li]), lerr)) RETURN
     1478  IF(lk) keys => ky(:)
     1479  IF(lt) keys => tracers(:)%keys
     1480  IF(li) keys => isotope%keys(:)
     1481
     1482  !--- DETERMINE THE NAMES
     1483  IF(PRESENT(tname)) THEN
     1484    ALLOCATE(names(SIZE(tname))); names(:) = tname(:)
     1485  ELSE
     1486    ALLOCATE(names(SIZE(keys)));  names(:) = keys(:)%name
     1487  END IF
     1488  nq = SIZE(names); ALLOCATE(val(nq)); IF(PRESENT(nam)) THEN; ALLOCATE(nam(nq)); nam(:) = names(:); END IF
     1489
     1490  !--- GET THE DATA
     1491  lerr = ANY([(getKeyByName_s1(keyn, val(iq), names(iq), keys(:)), iq=1, nq)])
     1492
     1493END FUNCTION getKeyByName_sm
     1494!==============================================================================================================================
     1495LOGICAL FUNCTION getKeyByName_s1m(keyn, val, tname, ky) RESULT(lerr)
    12591496  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn
    1260   CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) ::   val(:)
    1261   CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: tname(:)
    1262   TYPE(keys_type),          OPTIONAL, INTENT(IN)  ::    ky(:)
    1263 !------------------------------------------------------------------------------------------------------------------------------
    1264   TYPE(keys_type),           POINTER :: k(:)
    1265   CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
    1266   INTEGER :: iq, nq
    1267   IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
    1268   IF(PRESENT(ky   )) nq = SIZE(ky%name)
    1269   IF(PRESENT(tname)) nq = SIZE(  tname)
    1270   ALLOCATE(val(nq))
    1271   IF(PRESENT(tname)) THEN
    1272     IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq),   ky), iq=1, nq)])
    1273     IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq)      ), iq=1, nq)])
    1274   ELSE;                  lerr = ANY([(getKeyByName_s1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
    1275   END IF
    1276 END FUNCTION getKeyByName_sm
     1497  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
     1498  CHARACTER(LEN=*),                   INTENT(IN)  :: tname
     1499  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
     1500!------------------------------------------------------------------------------------------------------------------------------
     1501  CHARACTER(LEN=maxlen) :: sval
     1502  lerr = getKeyByName_s1(keyn, sval, tname, ky)
     1503  IF(test(fmsg('missing key "'//TRIM(keyn)//'" for tracer "'//TRIM(tname)//'"', modname, lerr), lerr)) RETURN
     1504  lerr = strParse(sval, ',', val)
     1505END FUNCTION getKeyByName_s1m
    12771506!==============================================================================================================================
    12781507LOGICAL FUNCTION getKeyByName_i1(keyn, val, tname, ky) RESULT(lerr)
    … …  
    12841513  CHARACTER(LEN=maxlen) :: sval
    12851514  INTEGER :: ierr
    1286   IF(     PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname, ky)
    1287   IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname)
    1288   IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing',        modname, lerr), lerr)) RETURN
     1515  lerr = getKeyByName_s1(keyn, sval, tname, ky)
     1516  IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
    12891517  READ(sval, *, IOSTAT=ierr) val
     1518  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, ierr/=0), lerr)) RETURN
     1519END FUNCTION getKeyByName_i1
     1520!==============================================================================================================================
     1521LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky) RESULT(lerr)
     1522  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn
     1523  INTEGER,               ALLOCATABLE, INTENT(OUT) ::   val(:)
     1524  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN)  :: tname(:)
     1525  TYPE(keys_type),  OPTIONAL, TARGET, INTENT(IN)  ::    ky(:)
     1526!------------------------------------------------------------------------------------------------------------------------------
     1527  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), nam(:)
     1528  INTEGER :: ierr, iq
     1529  IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN
     1530  ALLOCATE(val(SIZE(sval)))
     1531  DO iq = 1, SIZE(sval)                                              !--- CONVERT THE KEYS TO INTEGERS
     1532    READ(sval(iq), *, IOSTAT=ierr) val(iq)
     1533    IF(test(fmsg('key "'//TRIM(keyn)//'" of "'//TRIM(nam(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
     1534  END DO
     1535END FUNCTION getKeyByName_im
     1536!==============================================================================================================================
     1537LOGICAL FUNCTION getKeyByName_i1m(keyn, val, tname, ky) RESULT(lerr)
     1538  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
     1539  INTEGER,       ALLOCATABLE, INTENT(OUT) :: val(:)
     1540  CHARACTER(LEN=*),           INTENT(IN)  :: tname
     1541  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::  ky(:)
     1542!------------------------------------------------------------------------------------------------------------------------------
     1543  CHARACTER(LEN=maxlen), ALLOCATABLE :: v(:)
     1544  INTEGER :: ierr, iq
     1545  IF(test(getKeyByName_s1m(keyn, v, tname, ky), lerr)) RETURN
     1546  ALLOCATE(val(SIZE(v)))
     1547  lerr = .FALSE.; DO iq=1, SIZE(v); READ(v(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
    12901548  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, lerr), lerr)) RETURN
    1291 END FUNCTION getKeyByName_i1
    1292 !==============================================================================================================================
    1293 LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky) RESULT(lerr)
    1294   CHARACTER(LEN=*),           INTENT(IN)  :: keyn
    1295   INTEGER,       ALLOCATABLE, INTENT(OUT) ::   val(:)
    1296   CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: tname(:)
    1297   TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::    ky(:)
    1298 !------------------------------------------------------------------------------------------------------------------------------
    1299   TYPE(keys_type),           POINTER :: k(:)
    1300   CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
    1301   INTEGER :: iq, nq
    1302   IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
    1303   IF(PRESENT(ky   )) nq = SIZE(ky%name)
    1304   IF(PRESENT(tname)) nq = SIZE(  tname)
    1305   ALLOCATE(val(nq))
    1306   IF(PRESENT(tname)) THEN
    1307     IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), tname(iq),   ky), iq=1, nq)])
    1308     IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), tname(iq)      ), iq=1, nq)])
    1309   ELSE;                  lerr = ANY([(getKeyByName_i1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
    1310   END IF
    1311 END FUNCTION getKeyByName_im
     1549END FUNCTION getKeyByName_i1m
    13121550!==============================================================================================================================
    13131551LOGICAL FUNCTION getKeyByName_r1(keyn, val, tname, ky) RESULT(lerr)
    … …  
    13191557  CHARACTER(LEN=maxlen) :: sval
    13201558  INTEGER :: ierr
    1321   IF(     PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname, ky)
    1322   IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname)
     1559  lerr = getKeyByName_s1(keyn, sval, tname, ky)
    13231560  IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing',    modname, lerr), lerr)) RETURN
    13241561  READ(sval, *, IOSTAT=ierr) val
    1325   IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, lerr), lerr)) RETURN
     1562  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, ierr/=0), lerr)) RETURN
    13261563END FUNCTION getKeyByName_r1
    13271564!==============================================================================================================================
    … …  
    13321569  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::    ky(:)
    13331570!------------------------------------------------------------------------------------------------------------------------------
    1334   TYPE(keys_type),           POINTER :: k(:)
    1335   CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
    1336   INTEGER :: iq, nq
    1337   IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
    1338   IF(PRESENT(ky   )) nq = SIZE(ky%name)
    1339   IF(PRESENT(tname)) nq = SIZE(  tname)
    1340   ALLOCATE(val(nq))
    1341   IF(PRESENT(tname)) THEN
    1342     IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), tname(iq),   ky), iq=1, nq)])
    1343     IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), tname(iq)      ), iq=1, nq)])
    1344   ELSE;                  lerr = ANY([(getKeyByName_r1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
     1571  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), nam(:)
     1572  INTEGER :: ierr, iq
     1573  IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN
     1574  ALLOCATE(val(SIZE(sval)))
     1575  DO iq = 1, SIZE(sval)                                              !--- CONVERT THE KEYS TO INTEGERS
     1576    READ(sval(iq), *, IOSTAT=ierr) val(iq)
     1577    IF(test(fmsg('key "'//TRIM(keyn)//'" of "'//TRIM(nam(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
     1578  END DO
     1579END FUNCTION getKeyByName_rm
     1580!==============================================================================================================================
     1581LOGICAL FUNCTION getKeyByName_r1m(keyn, val, tname, ky) RESULT(lerr)
     1582  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
     1583  REAL,          ALLOCATABLE, INTENT(OUT) :: val(:)
     1584  CHARACTER(LEN=*),           INTENT(IN)  :: tname
     1585  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::  ky(:)
     1586!------------------------------------------------------------------------------------------------------------------------------
     1587  CHARACTER(LEN=maxlen), ALLOCATABLE :: v(:)
     1588  INTEGER :: ierr, iq
     1589  IF(     PRESENT(ky)) lerr = getKeyByName_s1m(keyn, v, tname, ky)
     1590  IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1m(keyn, v, tname)
     1591  ALLOCATE(val(SIZE(v)))
     1592  lerr = .FALSE.; DO iq=1, SIZE(v); READ(v(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
     1593  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, lerr), lerr)) RETURN
     1594END FUNCTION getKeyByName_r1m
     1595!==============================================================================================================================
     1596
     1597
     1598!==============================================================================================================================
     1599!=== ROUTINES TO GET OR PUT TRACERS AND ISOTOPES DATABASES, SINCE tracers AND isotopes ARE PRIVATE VARIABLES ==================
     1600!==============================================================================================================================
     1601SUBROUTINE setKeysDBase(tracers_, isotopes_, isotope_)
     1602  TYPE(trac_type), OPTIONAL, INTENT(IN) ::  tracers_(:)
     1603  TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
     1604  TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotope_
     1605!------------------------------------------------------------------------------------------------------------------------------
     1606  TYPE(isot_type), ALLOCATABLE :: iso(:)
     1607  INTEGER :: ix, nbIso
     1608  IF(PRESENT( tracers_)) THEN;  tracers =  tracers_; ELSE; ALLOCATE( tracers(0)); END IF
     1609  IF(PRESENT(isotopes_)) THEN; isotopes = isotopes_; ELSE; ALLOCATE(isotopes(0)); END IF
     1610  IF(PRESENT(isotope_ )) THEN
     1611    ix = strIdx(isotopes(:)%parent, isotope%parent)
     1612    IF(ix /= 0) THEN
     1613      isotopes(ix) = isotope_
     1614    ELSE
     1615      nbIso = SIZE(isotopes); ALLOCATE(iso(nbIso+1)); iso(1:nbIso) = isotopes; iso(nbIso+1) = isotope_
     1616      CALL MOVE_ALLOC(FROM=iso, TO=isotopes)
     1617    END IF
    13451618  END IF
    1346 END FUNCTION getKeyByName_rm
     1619END SUBROUTINE setKeysDBase
     1620!==============================================================================================================================
     1621SUBROUTINE getKeysDBase(tracers_, isotopes_, isotope_)
     1622  TYPE(trac_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  tracers_(:)
     1623  TYPE(isot_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: isotopes_(:)
     1624  TYPE(isot_type), OPTIONAL,              INTENT(OUT) :: isotope_
     1625!------------------------------------------------------------------------------------------------------------------------------
     1626  INTEGER :: ix
     1627  IF(PRESENT( tracers_)) THEN;  tracers_ =  tracers; ELSE; ALLOCATE( tracers_(0)); END IF
     1628  IF(PRESENT(isotopes_)) THEN; isotopes_ = isotopes; ELSE; ALLOCATE(isotopes_(0)); END IF
     1629  IF(PRESENT(isotope_ )) THEN; ix = strIdx(isotopes(:)%parent, isotope%parent); IF(ix /= 0) isotope_=isotopes(ix); END IF
     1630END SUBROUTINE getKeysDBase
    13471631!==============================================================================================================================
    13481632
    … …  
    13521636!==============================================================================================================================
    13531637ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION delPhase(s) RESULT(out)
    1354   CHARACTER(LEN=*), INTENT(IN)  :: s
     1638  CHARACTER(LEN=*), INTENT(IN) :: s
    13551639!------------------------------------------------------------------------------------------------------------------------------
    13561640  INTEGER :: ix, ip, ns
    … …  
    15181802!=== GET THE NAME(S) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen"  IN THE TRACERS DESCRIPTORS LIST "tr" =======
    15191803!==============================================================================================================================
    1520 CHARACTER(LEN=maxlen) FUNCTION ancestor_1(t, tname, igen) RESULT(out)
    1521   TYPE(trac_type),   INTENT(IN) :: t(:)
    1522   CHARACTER(LEN=*),  INTENT(IN) :: tname
    1523   INTEGER, OPTIONAL, INTENT(IN) :: igen
    1524 !------------------------------------------------------------------------------------------------------------------------------
    1525   INTEGER :: ig, ix
    1526   ig = 0; IF(PRESENT(igen)) ig = igen
    1527   ix = idxAncestor_1(t, tname, ig)
     1804SUBROUTINE ancestor_1(t, out, tname, igen)
     1805  TYPE(trac_type),       INTENT(IN) :: t(:)
     1806  CHARACTER(LEN=maxlen), INTENT(OUT) :: out
     1807  CHARACTER(LEN=*),      INTENT(IN)  :: tname
     1808  INTEGER,     OPTIONAL, INTENT(IN)  :: igen
     1809!------------------------------------------------------------------------------------------------------------------------------
     1810  INTEGER :: ix
     1811  CALL idxAncestor_1(t, ix, tname, igen)
    15281812  out = ''; IF(ix /= 0) out = t(ix)%name
    1529 END FUNCTION ancestor_1
    1530 !==============================================================================================================================
    1531 FUNCTION ancestor_m(t, tname, igen) RESULT(out)
    1532   CHARACTER(LEN=maxlen), ALLOCATABLE     ::   out(:)
    1533   TYPE(trac_type),            INTENT(IN) ::     t(:)
    1534   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
    1535   INTEGER,          OPTIONAL, INTENT(IN) :: igen
    1536 !------------------------------------------------------------------------------------------------------------------------------
    1537   INTEGER, ALLOCATABLE :: ix(:)
     1813END SUBROUTINE ancestor_1
     1814!==============================================================================================================================
     1815SUBROUTINE ancestor_mt(t, out, tname, igen)
     1816  TYPE(trac_type),       INTENT(IN)  :: t(:)
     1817  CHARACTER(LEN=*),      INTENT(IN)  :: tname(:)
     1818  CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(tname))
     1819  INTEGER,     OPTIONAL, INTENT(IN)  :: igen
     1820!------------------------------------------------------------------------------------------------------------------------------
     1821  INTEGER :: ix(SIZE(tname))
     1822  CALL idxAncestor_mt(t, ix, tname, igen)
     1823  out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
     1824END SUBROUTINE ancestor_mt
     1825!==============================================================================================================================
     1826SUBROUTINE ancestor_m(t, out, igen)
     1827  TYPE(trac_type),       INTENT(IN)  :: t(:)
     1828  CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(t))
     1829  INTEGER,     OPTIONAL, INTENT(IN)  :: igen
     1830!------------------------------------------------------------------------------------------------------------------------------
     1831  INTEGER :: ix(SIZE(t))
     1832  CALL idxAncestor_m(t, ix, igen)
     1833  out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
     1834END SUBROUTINE ancestor_m
     1835!==============================================================================================================================
     1836
     1837
     1838!==============================================================================================================================
     1839!=== GET THE INDEX(ES) OF THE GENERATION "igen" ANCESTOR(S) OF "tname" (t%name IF UNSPECIFIED) IN THE "t" LIST ================
     1840!==============================================================================================================================
     1841SUBROUTINE idxAncestor_1(t, idx, tname, igen)
     1842  TYPE(trac_type),   INTENT(IN)  :: t(:)
     1843  INTEGER,           INTENT(OUT) :: idx
     1844  CHARACTER(LEN=*),  INTENT(IN)  :: tname
     1845  INTEGER, OPTIONAL, INTENT(IN)  :: igen
    15381846  INTEGER :: ig
    15391847  ig = 0; IF(PRESENT(igen)) ig = igen
    1540   IF(     PRESENT(tname)) ix = idxAncestor_m(t, tname,     ig)
    1541   IF(.NOT.PRESENT(tname)) ix = idxAncestor_m(t, t(:)%name, ig)
    1542   ALLOCATE(out(SIZE(ix))); out(:) = ''
    1543   WHERE(ix /= 0) out = t(ix)%name
    1544 END FUNCTION ancestor_m
    1545 !==============================================================================================================================
    1546 
    1547 
    1548 !==============================================================================================================================
    1549 !=== GET THE INDEX(ES) OF THE GENERATION "igen" ANCESTOR(S) OF "tname" (t%name IF UNSPECIFIED) IN THE "t" LIST ================
    1550 !==============================================================================================================================
    1551 INTEGER FUNCTION idxAncestor_1(t, tname, igen) RESULT(out)
    1552   TYPE(trac_type),   INTENT(IN) :: t(:)
    1553   CHARACTER(LEN=*),  INTENT(IN) :: tname
    1554   INTEGER, OPTIONAL, INTENT(IN) :: igen
    1555 !------------------------------------------------------------------------------------------------------------------------------
    1556   INTEGER :: ig
    1557   ig = 0; IF(PRESENT(igen)) ig = igen
    1558   out = strIdx(t(:)%name, tname)
    1559   IF(out == 0)                 RETURN            !--- Tracer not found
    1560   IF(t(out)%iGeneration <= ig) RETURN            !--- Tracer has a lower generation number than asked generation 'igen"
    1561   DO WHILE(t(out)%iGeneration > ig); out = strIdx(t(:)%name, t(out)%parent); END DO
    1562 END FUNCTION idxAncestor_1
    1563 !==============================================================================================================================
    1564 FUNCTION idxAncestor_m(t, tname, igen) RESULT(out)
    1565   INTEGER,          ALLOCATABLE          ::   out(:)
    1566   TYPE(trac_type),            INTENT(IN) ::     t(:)
    1567   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
    1568   INTEGER,          OPTIONAL, INTENT(IN) :: igen
    1569 !------------------------------------------------------------------------------------------------------------------------------
    1570   INTEGER :: ig, ix
    1571   ig = 0; IF(PRESENT(igen)) ig = igen
    1572   IF(     PRESENT(tname)) out = [(idxAncestor_1(t, tname(ix),  ig), ix=1, SIZE(tname))]
    1573   IF(.NOT.PRESENT(tname)) out = [(idxAncestor_1(t, t(ix)%name, ig), ix=1, SIZE(t))]
    1574 END FUNCTION idxAncestor_m
     1848  idx = strIdx(t(:)%name, tname)
     1849  IF(idx == 0)                 RETURN            !--- Tracer not found
     1850  IF(t(idx)%iGeneration <= ig) RETURN            !--- Tracer has a lower generation number than asked generation 'igen"
     1851  DO WHILE(t(idx)%iGeneration > ig); idx = strIdx(t(:)%name, t(idx)%parent); END DO
     1852END SUBROUTINE idxAncestor_1
     1853!------------------------------------------------------------------------------------------------------------------------------
     1854SUBROUTINE idxAncestor_mt(t, idx, tname, igen)
     1855  TYPE(trac_type),   INTENT(IN)  :: t(:)
     1856  CHARACTER(LEN=*),  INTENT(IN)  :: tname(:)
     1857  INTEGER,           INTENT(OUT) :: idx(SIZE(tname))
     1858  INTEGER, OPTIONAL, INTENT(IN)  :: igen
     1859  INTEGER :: ix
     1860  DO ix = 1, SIZE(tname); CALL idxAncestor_1(t, idx(ix), tname(ix), igen); END DO
     1861END SUBROUTINE idxAncestor_mt
     1862!------------------------------------------------------------------------------------------------------------------------------
     1863SUBROUTINE idxAncestor_m(t, idx, igen)
     1864  TYPE(trac_type),   INTENT(IN)  :: t(:)
     1865  INTEGER,           INTENT(OUT) :: idx(SIZE(t))
     1866  INTEGER, OPTIONAL, INTENT(IN)  :: igen
     1867  INTEGER :: ix
     1868  DO ix = 1, SIZE(t); CALL idxAncestor_1(t, idx(ix), t(ix)%name, igen); END DO
     1869END SUBROUTINE idxAncestor_m
    15751870!==============================================================================================================================
    15761871
    15771872
    15781873END MODULE readTracFiles_mod
     1874
Note: See TracChangeset for help on using the changeset viewer.