Ignore:
Timestamp:
Mar 29, 2023, 3:14:27 PM (15 months ago)
Author:
lguez
Message:

Sync latest trunk changes to branch LMDZ_ECRad

Location:
LMDZ6/branches/LMDZ_ECRad
Files:
1 deleted
4 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/LMDZ_ECRad

  • LMDZ6/branches/LMDZ_ECRad/libf/misc/readTracFiles_mod.f90

    r4203 r4482  
    11MODULE readTracFiles_mod
    22
    3   USE strings_mod,    ONLY: msg, testFile,  strFind, strStack, strReduce,  strHead, strCount, find, fmsg, reduceExpr, &
    4              removeComment, cat, checkList, str2int, strParse, strReplace, strTail, strIdx, maxlen, test, dispTable, get_in
    5   USE trac_types_mod, ONLY: trac_type, isot_type, keys_type
     3  USE strings_mod,    ONLY: msg, find, get_in, str2int, dispTable, strHead,  strReduce,  strFind, strStack, strIdx, &
     4       test, removeComment, cat, fmsg, maxlen, int2str, checkList, strParse, strReplace, strTail, strCount, reduceExpr
    65
    76  IMPLICIT NONE
    … …  
    98  PRIVATE
    109
    11   PUBLIC :: initIsotopes, maxlen, trac_type, isot_type, keys_type
    12   PUBLIC :: readTracersFiles, indexUpdate, setGeneration             !--- TOOLS ASSOCIATED TO TRACERS  DESCRIPTORS
    13   PUBLIC :: readIsotopesFile                                         !--- TOOLS ASSOCIATED TO ISOTOPES DESCRIPTORS
    14   PUBLIC :: getKey_init, getKey, fGetKey, setDirectKeys              !--- GET/SET KEYS FROM/TO tracers & isotopes
    15 
    16   PUBLIC :: addPhase, new2oldName,  getPhase, &                      !--- FUNCTIONS RELATED TO THE PHASES
    17             delPhase, old2newName, getiPhase, &                      !--- + ASSOCIATED VARIABLES
    18             known_phases, old_phases, phases_sep, phases_names, nphases
    19 
    20   PUBLIC :: oldH2OIso, newH2OIso                                     !--- NEEDED FOR BACKWARD COMPATIBILITY (OLD traceur.def)
    21 
    22   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, fGetKeys, addKey, 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
     24
     25  !=== FOR ISOTOPES: GENERAL
     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
     39
    2340  PUBLIC :: maxTableWidth
    2441!------------------------------------------------------------------------------------------------------------------------------
    25   TYPE :: dataBase_type                                              !=== TYPE FOR TRACERS SECTION
    26     CHARACTER(LEN=maxlen)  :: name                                   !--- Section name
    27     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               :: iGeneration = -1              !--- Generation number (>=0)
     57    INTEGER               :: iqParent    = 0               !--- Parent index
     58    INTEGER,  ALLOCATABLE :: iqDescen(:)                   !--- Descendants index (in growing generation order)
     59    INTEGER               :: nqDescen    = 0               !--- Number of descendants (all generations)
     60    INTEGER               :: nqChildren  = 0               !--- Number of children  (first generation)
     61    TYPE(keys_type)       :: keys                          !--- <key>=<val> pairs vector
     62    INTEGER               :: iadv        = 10              !--- Advection scheme used
     63    LOGICAL               :: isAdvected  = .FALSE.         !--- "true" tracers: iadv > 0.   COUNT(isAdvected )=nqtrue
     64    LOGICAL               :: isInPhysics = .TRUE.          !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
     65    INTEGER               :: iso_iGroup  = 0               !--- Isotopes group index in isotopes(:)
     66    INTEGER               :: iso_iName   = 0               !--- Isotope  name  index in isotopes(iso_iGroup)%trac(:)
     67    INTEGER               :: iso_iZone   = 0               !--- Isotope  zone  index in isotopes(iso_iGroup)%zone(:)
     68    INTEGER               :: iso_iPhase  = 0               !--- Isotope  phase index in isotopes(iso_iGroup)%phase
     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
    2891  END TYPE dataBase_type
    2992!------------------------------------------------------------------------------------------------------------------------------
    3093  INTERFACE getKey
    31     MODULE PROCEDURE getKeyByName_s1, getKeyByName_i1, getKeyByName_r1, getKeyByName_sm, getKeyByName_im, getKeyByName_rm
     94    MODULE PROCEDURE getKeyByName_s1, getKeyByName_s1m, getKeyByName_sm, getKey_sm, &
     95                     getKeyByName_i1, getKeyByName_i1m, getKeyByName_im, getKey_im, &
     96                     getKeyByName_r1, getKeyByName_r1m, getKeyByName_rm, getKey_rm, &
     97                     getKeyByName_l1, getKeyByName_l1m, getKeyByName_lm, getKey_lm
    3298  END INTERFACE getKey
    3399!------------------------------------------------------------------------------------------------------------------------------
    34   INTERFACE fGetKey;       MODULE PROCEDURE fgetKeyByIndex_s1, fgetKeyByName_s1; END INTERFACE fGetKey
     100  INTERFACE    isoSelect;  MODULE PROCEDURE  isoSelectByIndex,  isoSelectByName; END INTERFACE isoSelect
     101  INTERFACE  old2newH2O;   MODULE PROCEDURE  old2newH2O_1,  old2newH2O_m;        END INTERFACE old2newH2O
     102  INTERFACE  new2oldH2O;   MODULE PROCEDURE  new2oldH2O_1,  new2oldH2O_m;        END INTERFACE new2oldH2O
     103  INTERFACE fGetKey;       MODULE PROCEDURE fgetKeyIdx_s1, fgetKeyNam_s1;        END INTERFACE fGetKey
    35104  INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
    36   INTERFACE idxAncestor;   MODULE PROCEDURE idxAncestor_1, idxAncestor_m; END INTERFACE idxAncestor
    37   INTERFACE    ancestor;   MODULE PROCEDURE    ancestor_1,    ancestor_m; END INTERFACE    ancestor
     105  INTERFACE idxAncestor;   MODULE PROCEDURE idxAncestor_1, idxAncestor_m, idxAncestor_mt;    END INTERFACE idxAncestor
     106  INTERFACE    ancestor;   MODULE PROCEDURE    ancestor_1,    ancestor_m,    ancestor_mt;    END INTERFACE    ancestor
     107  INTERFACE      addKey;   MODULE PROCEDURE      addKey_1; END INTERFACE addKey!,      addKey_m,     addKey_mm;     END INTERFACE addKey
    38108  INTERFACE    addPhase;   MODULE PROCEDURE   addPhase_s1,   addPhase_sm,   addPhase_i1,   addPhase_im; END INTERFACE addPhase
    39   INTERFACE old2newName;   MODULE PROCEDURE old2newName_1, old2newName_m; END INTERFACE old2newName
    40   INTERFACE new2oldName;   MODULE PROCEDURE new2oldName_1, new2oldName_m; END INTERFACE new2oldName
    41109!------------------------------------------------------------------------------------------------------------------------------
    42110
    … …  
    45113
    46114  !--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
    47   CHARACTER(LEN=maxlen), SAVE      :: tran0        = 'air'           !--- Default transporting fluid
    48   CHARACTER(LEN=maxlen), PARAMETER :: old_phases   = 'vlir'          !--- Old phases for water (no separator)
    49   CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsr'          !--- Known phases initials
    50   INTEGER,               PARAMETER :: nphases=LEN_TRIM(known_phases) !--- Number of phases
    51   CHARACTER(LEN=maxlen), SAVE      :: phases_names(nphases) &        !--- Known phases names
    52                                 = ['gaseous', 'liquid ', 'solid  ', 'cloud  ']
    53   CHARACTER(LEN=1), SAVE :: phases_sep  =  '_'                       !--- Phase separator
    54   LOGICAL,          SAVE :: tracs_merge = .TRUE.                     !--- Merge/stack tracers lists
    55   LOGICAL,          SAVE :: lSortByGen  = .TRUE.                     !--- Sort by growing generation
    56 
    57   !--- KEPT JUST TO MANAGE OLD WATER ISOTOPES NAMES
    58   !--- Apart from that context, on limitaion on isotopes names (as long as they have a corresponding line in isotopes_params.def)
    59   CHARACTER(LEN=maxlen), SAVE :: oldH2OIso(5) = ['eau',     'HDO',     'O18',     'O17',     'HTO'    ]
    60   CHARACTER(LEN=maxlen), SAVE :: newH2OIso(5) = ['H2[16]O', 'H[2]HO ', 'H2[18]O', 'H2[17]O', 'H[3]HO ']
    61 
    62   !=== LOCAL COPIES OF THE TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey (INITIALIZED IN getKey_init)
     115  CHARACTER(LEN=maxlen), SAVE      :: tran0        = 'air'      !--- Default transporting fluid
     116  CHARACTER(LEN=maxlen), PARAMETER :: old_phases   = 'vlir'     !--- Old phases for water (no separator)
     117  CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsr'     !--- Known phases initials
     118  INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases)        !--- Number of phases
     119  CHARACTER(LEN=maxlen), SAVE      :: phases_names(nphases) &   !--- Known phases names
     120                                             = ['gaseous', 'liquid ', 'solid  ', 'cloud  ']
     121  CHARACTER(LEN=1), SAVE :: phases_sep  =  '_'                  !--- Phase separator
     122  LOGICAL,          SAVE :: tracs_merge = .TRUE.                !--- Merge/stack tracers lists
     123  LOGICAL,          SAVE :: lSortByGen  = .TRUE.                !--- Sort by growing generation
     124  CHARACTER(LEN=maxlen), SAVE :: isoFile = 'isotopes_params.def'!--- Name of the isotopes parameters file
     125
     126  !--- CORRESPONDANCE BETWEEN OLD AND NEW WATER NAMES
     127  CHARACTER(LEN=maxlen), SAVE :: oldH2OIso(5) = ['eau',   'HDO',   'O18',   'O17',   'HTO'  ]
     128  CHARACTER(LEN=maxlen), SAVE :: newH2OIso(5) = ['H216O', 'HDO  ', 'H218O', 'H217O', 'HTO  ']
     129
     130  !--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES
     131  CHARACTER(LEN=maxlen), SAVE ::   oldHNO3(2) = ['HNO3_g ', 'HNO3   ']
     132  CHARACTER(LEN=maxlen), SAVE ::   newHNO3(2) = ['HNO3   ', 'HNO3tot']
     133
     134  !=== TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey
    63135  TYPE(trac_type), ALLOCATABLE, TARGET, SAVE ::  tracers(:)
    64136  TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
    65137
    66   INTEGER,    PARAMETER :: maxTableWidth = 192                       !--- Maximum width of a table displayed with "dispTable"
     138  !=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso))
     139  TYPE(isot_type),         SAVE, POINTER :: isotope             !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
     140  INTEGER,                 SAVE          :: ixIso, iH2O         !--- Index of the selected isotopes family and H2O family
     141  INTEGER,                 SAVE          :: nbIso               !--- Number of isotopes classes
     142  LOGICAL,                 SAVE          :: isoCheck            !--- Flag to trigger the checking routines
     143  TYPE(keys_type),         SAVE, POINTER :: isoKeys(:)          !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
     144  CHARACTER(LEN=maxlen),   SAVE, POINTER :: isoName(:),   &     !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
     145                                            isoZone(:),   &     !--- TAGGING ZONES  FOR THE CURRENTLY SELECTED FAMILY
     146                                            isoPhas             !--- USED PHASES    FOR THE CURRENTLY SELECTED FAMILY
     147  INTEGER,                 SAVE          ::  niso, nzone, &     !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
     148                                            nphas, ntiso        !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
     149  INTEGER,                 SAVE, POINTER ::itZonIso(:,:), &     !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
     150                                           iqIsoPha(:,:)        !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
     151
     152  INTEGER,    PARAMETER :: maxTableWidth = 192                  !--- Maximum width of a table displayed with "dispTable"
    67153  CHARACTER(LEN=maxlen) :: modname
    68154
    … …  
    72158!==============================================================================================================================
    73159!=== READ ONE OR SEVERAL TRACER FILES AND FILL A "tr" TRACERS DESCRIPTOR DERIVED TYPE.
    74 !=== THE RETURN VALUE fType DEPENDS ON WHAT IS FOUND:
     160!=== THE RETURNED VALUE fType DEPENDS ON WHAT IS FOUND:
    75161!===  0: NO ADEQUATE FILE FOUND ; DEFAULT VALUES MUST BE USED
    76162!===  1: AN "OLD STYLE" TRACERS FILE "traceur.def":
    … …  
    93179!     * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
    94180!==============================================================================================================================
    95 LOGICAL FUNCTION readTracersFiles(type_trac, fType, tracs) RESULT(lerr)
    96 !------------------------------------------------------------------------------------------------------------------------------
    97   CHARACTER(LEN=*),             INTENT(IN)  :: type_trac              !--- List of components used
    98   INTEGER,                      INTENT(OUT) :: fType                  !--- Type of input file found
    99   TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tracs(:)
     181LOGICAL FUNCTION readTracersFiles(type_trac, lRepr) RESULT(lerr)
     182!------------------------------------------------------------------------------------------------------------------------------
     183  CHARACTER(LEN=*),  INTENT(IN)  :: type_trac                        !--- List of components used
     184  LOGICAL, OPTIONAL, INTENT(IN)  :: lRepr                            !--- Activate the HNNO3 exceptions for REPROBUS
    100185  CHARACTER(LEN=maxlen),  ALLOCATABLE :: s(:), sections(:), trac_files(:)
    101   CHARACTER(LEN=maxlen) :: str, fname, mesg
    102   INTEGER               :: is, nsec, ierr, it, ntrac, ns, ip, ix
    103   LOGICAL, ALLOCATABLE  :: ll(:), lGen3(:)
     186  CHARACTER(LEN=maxlen) :: str, fname, tname, pname, cname
     187  INTEGER               :: nsec, ierr, it, ntrac, ns, ip, ix, fType
     188  LOGICAL :: lRep
     189  TYPE(keys_type), POINTER :: k
    104190!------------------------------------------------------------------------------------------------------------------------------
    105191  lerr = .FALSE.
    106192  modname = 'readTracersFiles'
    107193  IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
    108 
    109   !--- Required sections + corresponding files names (new style single section case)
    110   IF(test(strParse(type_trac, '|', sections), lerr)) RETURN          !--- Parse "type_trac" list
    111 
    112   nsec = SIZE(sections, DIM=1)
    113   ALLOCATE(trac_files(nsec)); DO is=1, nsec; trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'; END DO
    114 
    115   !--- LOOK AT AVAILABLE FILES
    116   ll = .NOT.testFile(trac_files)
    117   fType = 0
    118   IF(.NOT.testFile('traceur.def') .AND. nsec==1) fType = 1           !--- OLD STYLE FILE
    119   IF(.NOT.testFile('tracer.def'))                fType = 2           !--- NEW STYLE ; SINGLE  FILE, SEVERAL SECTIONS
    120   IF(ALL(ll))                                    fType = 3           !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
    121   IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
    122     IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
    123   END IF
    124 
    125   !--- CHECK WHETHER type_trac AND FILE TYPE ARE COMPATIBLE
    126   IF(test(fmsg('No multiple sections for the old format "traceur.def"', ll = SIZE(sections)>1 .AND. fType==1), lerr)) RETURN
    127 
    128   !--- TELLS WHAT WAS IS ABOUT TO BE USED
    129   IF (fmsg('No adequate tracers description file(s) found ; default values will be used',          modname, fType==0)) RETURN
    130   CALL msg('Trying to read old-style tracers description file "traceur.def"',                      modname, fType==1)
    131   CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"',    modname, fType==2)
    132   CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
     194  lRep=.FALSE.; IF(PRESENT(lRepr)) lRep = lRepr
     195
     196  !--- Required sections + corresponding files names (new style single section case) for tests
     197  IF(test(testTracersFiles(modname, type_trac, fType, .FALSE., trac_files, sections), lerr)) RETURN
     198  nsec = SIZE(sections)
    133199
    134200  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    135201  SELECT CASE(fType)                         !--- Set %name, %genOName, %parent, %type, %phase, %component, %iGeneration, %keys
    136202  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    137     CASE(1)                                                               !=== OLD FORMAT "traceur.def"
     203    CASE(1)                                                          !=== OLD FORMAT "traceur.def"
    138204    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    139205      !--- OPEN THE "traceur.def" FILE
    … …  
    145211
    146212      !--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
    147       ALLOCATE(tracs(ntrac))
     213      IF(ALLOCATED(tracers)) DEALLOCATE(tracers)
     214      ALLOCATE(tracers(ntrac))
    148215      DO it=1,ntrac                                                  !=== READ RAW DATA: loop on the line/tracer number
    149216        READ(90,'(a)',IOSTAT=ierr) str
    150217        IF(test(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, ierr>0), lerr)) RETURN
    151218        IF(test(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, ierr<0), lerr)) RETURN
    152         ll = strParse(str, ' ', s, n=ns)
     219        lerr = strParse(str, ' ', s, ns)
    153220        CALL msg('This file is for air tracers only',           modname, ns == 3 .AND. it == 1)
    154221        CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
    155         tracs(it)%name   = old2newName(s(3), ip)                     !--- Set %name:   name   of the tracer
    156         tracs(it)%parent = tran0                                     !--- Default transporting fluid name
    157         IF(ns == 4) tracs(it)%parent = old2newName(s(4))             !--- Set %parent: parent of the tracer
    158         tracs(it)%phase = known_phases(ip:ip)                        !--- Set %phase:  tracer phase (default: "g"azeous)
    159         tracs(it)%component = TRIM(type_trac)                        !--- Set %component: model component name
    160         tracs(it)%keys%key = ['hadv', 'vadv']                        !--- Set %keys%key
    161         tracs(it)%keys%val = s(1:2)                                  !--- Set %keys%val
     222        k => tracers(it)%keys
     223
     224        !=== NAME OF THE TRACER
     225        tname = old2newH2O(s(3), ip)
     226        ix = strIdx(oldHNO3, s(3))
     227        IF(ix /= 0 .AND. lRep) tname = newHNO3(ix)                   !--- Exception for HNO3 (REPROBUS ONLY)
     228        tracers(it)%name = tname                                     !--- Set %name
     229        CALL addKey_1('name', tname, k)                              !--- Set the name of the tracer
     230        tracers(it)%keys%name = tname                                !--- Copy tracers names in keys components
     231
     232        !=== NAME OF THE COMPONENT
     233        cname = type_trac                                            !--- Name of the model component
     234        IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
     235        tracers(it)%component = cname                                !--- Set %component
     236        CALL addKey_1('component', cname, k)                         !--- Set the name of the model component
     237
     238        !=== NAME OF THE PARENT
     239        pname = tran0                                                !--- Default name: default transporting fluid (air)
     240        IF(ns == 4) THEN
     241          pname = old2newH2O(s(4))
     242          ix = strIdx(oldHNO3, s(4))
     243          IF(ix /= 0 .AND. lRep) pname = newHNO3(ix)                 !--- Exception for HNO3 (REPROBUS ONLY)
     244        END IF
     245        tracers(it)%parent = pname                                   !--- Set %parent
     246        CALL addKey_1('parent', pname, k)
     247
     248        !=== PHASE AND ADVECTION SCHEMES NUMBERS
     249        tracers(it)%phase = known_phases(ip:ip)                      !--- Set %phase:  tracer phase (default: "g"azeous)
     250        CALL addKey_1('phase', known_phases(ip:ip), k)               !--- Set the phase  of the tracer (default: "g"azeous)
     251        CALL addKey_1('hadv', s(1),  k)                              !--- Set the horizontal advection schemes number
     252        CALL addKey_1('vadv', s(2),  k)                              !--- Set the vertical   advection schemes number
    162253      END DO
    163254      CLOSE(90)
    164       CALL setGeneration(tracs)                                      !--- Set %iGeneration and %gen0Name
    165       WHERE(tracs%iGeneration == 2) tracs%type = 'tag'               !--- Set %type:        'tracer' or 'tag'
    166       IF(test(checkTracers(tracs, fname, fname), lerr)) RETURN       !--- Detect orphans and check phases
    167       IF(test(checkUnique (tracs, fname, fname), lerr)) RETURN       !--- Detect repeated tracers
    168       CALL sortTracers  (tracs)                                      !--- Sort the tracers
    169       tracs(:)%keys%name = tracs(:)%name                             !--- Copy tracers names in keys components
     255      IF(test(setGeneration(tracers), lerr)) RETURN                  !--- Set %iGeneration and %gen0Name
     256      WHERE(tracers%iGeneration == 2) tracers(:)%type = 'tag'        !--- Set %type:        'tracer' or 'tag'
     257      DO it=1,ntrac
     258        CALL addKey_1('type', tracers(it)%type, tracers(it)%keys)    !--- Set the type of tracer
     259      END DO
     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
    170263    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    171264    CASE(2); IF(test(feedDBase(["tracer.def"], [type_trac], modname), lerr)) RETURN !=== SINGLE   FILE, MULTIPLE SECTIONS
    … …  
    175268  END SELECT
    176269  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    177 
    178270  IF(ALL([2,3] /= fType)) RETURN
    179271
    180272  IF(nsec  == 1) THEN;
    181     tracs = dBase(1)%trac
     273    tracers = dBase(1)%trac
    182274  ELSE IF(tracs_merge) THEN
    183275    CALL msg('The multiple required sections will be MERGED.',    modname)
    184     IF(test(mergeTracers(dBase, tracs), lerr)) RETURN
     276    IF(test(mergeTracers(dBase, tracers), lerr)) RETURN
    185277  ELSE
    186278    CALL msg('The multiple required sections will be CUMULATED.', modname)
    187     IF(test(cumulTracers(dBase, tracs), lerr)) RETURN
     279    IF(test(cumulTracers(dBase, tracers), lerr)) RETURN
    188280  END IF
    189   WHERE(tracs%gen0Name(1:3) /= 'H2O') tracs%isInPhysics=.TRUE.       !--- Set %isInPhysics: passed to physics
    190   CALL setDirectKeys(tracs)                                          !--- Set %iqParent, %iqDescen, %nqDescen, %nqChilds
     281  CALL setDirectKeys(tracers)                                        !--- Set %iqParent, %iqDescen, %nqDescen, %nqChildren
    191282END FUNCTION readTracersFiles
     283!==============================================================================================================================
     284
     285
     286!==============================================================================================================================
     287LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, lDisp, tracf, sects) RESULT(lerr)
     288  CHARACTER(LEN=*),                             INTENT(IN)  :: modname, type_trac
     289  INTEGER,                                      INTENT(OUT) :: fType
     290  LOGICAL,                            OPTIONAL, INTENT(IN)  :: lDisp
     291  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: tracf(:), sects(:)
     292  CHARACTER(LEN=maxlen), ALLOCATABLE :: trac_files(:), sections(:)
     293  LOGICAL, ALLOCATABLE :: ll(:)
     294  LOGICAL :: lD, lFound
     295  INTEGER :: is, nsec
     296  lD = .FALSE.; IF(PRESENT(lDisp)) lD = lDisp
     297  lerr = .FALSE.
     298
     299  !--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINGLE SECTION PER FILE)
     300  !--- If type_trac is a scalar (case 1), "sections" and "trac_files" are not usable, but are meaningless for case 1 anyway.
     301  IF(test(strParse(type_trac, '|', sections,  n=nsec), lerr)) RETURN !--- Parse "type_trac" list
     302  IF(PRESENT(sects)) sects = sections
     303  ALLOCATE(trac_files(nsec), ll(nsec))
     304  DO is=1, nsec
     305     trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'
     306     INQUIRE(FILE=TRIM(trac_files(is)), EXIST=ll(is))
     307  END DO
     308  IF(PRESENT(tracf)) tracf = trac_files
     309  fType = 0
     310  INQUIRE(FILE='traceur.def', EXIST=lFound); IF(lFound)  fType = 1   !--- OLD STYLE FILE
     311  INQUIRE(FILE='tracer.def',  EXIST=lFound); IF(lFound)  fType = 2   !--- NEW STYLE ; SINGLE  FILE, SEVERAL SECTIONS
     312                                             IF(ALL(ll)) fType = 3   !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
     313  IF(.NOT.lD) RETURN                                                 !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType
     314  IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
     315    IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
     316  END IF
     317
     318  !--- TELLS WHAT WAS IS ABOUT TO BE USED
     319  CALL msg('Trying to read old-style tracers description file "traceur.def"',                      modname, fType==1)
     320  CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"',    modname, fType==2)
     321  CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
     322END FUNCTION testTracersFiles
    192323!==============================================================================================================================
    193324
    … …  
    206337  INTEGER,  ALLOCATABLE :: ndb(:)                                    !--- Number of sections for each file
    207338  INTEGER,  ALLOCATABLE :: ixf(:)                                    !--- File index for each section of the expanded list
    208   LOGICAL,  ALLOCATABLE :: lTg(:)                                    !--- Tagging tracers mask
    209339  CHARACTER(LEN=maxlen) :: fnm, snm
    210340  INTEGER               :: idb, i
    … …  
    224354    lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
    225355    IF(test(expandSection(dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- EXPAND NAMES ;  set %parent, %type, %component
    226     CALL setGeneration   (dBase(idb)%trac)                           !---                 set %iGeneration,   %genOName
     356    IF(test(setGeneration(dBase(idb)%trac),           lerr)) RETURN  !---                 set %iGeneration,   %genOName
    227357    IF(test(checkTracers (dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- CHECK ORPHANS AND PHASES
    228358    IF(test(checkUnique  (dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- CHECK TRACERS UNIQUENESS
    … …  
    246376  CHARACTER(LEN=maxlen), ALLOCATABLE :: sec(:)
    247377  INTEGER,               ALLOCATABLE ::  ix(:)
    248   INTEGER :: n0, idb, ndb, i, j
     378  INTEGER :: n0, idb, ndb
    249379  LOGICAL :: ll
    250380!------------------------------------------------------------------------------------------------------------------------------
    … …  
    299429      CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
    300430    ELSE                                                             !=== TRACER LINE
    301       ll = strParse(str,' ', keys = s, vals = v, n = n)              !--- Parse <key>=<val> pairs
     431      ll = strParse(str,' ', s, n, v)                                !--- Parse <key>=<val> pairs
    302432      tt = dBase(ndb)%trac(:)
    303433      tmp%name = s(1); tmp%keys = keys_type(s(1), s(2:n), v(2:n))    !--- Set %name and %keys
    … …  
    330460  ky => t(jd)%keys
    331461  DO k = 1, SIZE(ky%key)                                             !--- Loop on the keys of the tracer named "defName"
    332 !   CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys)                   !--- Add key to all the tracers (no overwriting)
    333     DO it = 1, SIZE(t); CALL addKey_1(ky%key(k), ky%val(k), t(it)%keys); END DO
     462!   CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys, .FALSE.)           !--- Add key to all the tracers (no overwriting)
     463    DO it = 1, SIZE(t); CALL addKey_1(ky%key(k), ky%val(k), t(it)%keys, .FALSE.); END DO
    334464  END DO
    335465  tt = [t(1:jd-1),t(jd+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t)   !--- Remove the virtual tracer named "defName"
    … …  
    381511  CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:)
    382512  CHARACTER(LEN=maxlen) :: msg1, modname
    383   INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr, i
     513  INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr
    384514  LOGICAL :: ll
    385515  modname = 'expandSection'
    … …  
    394524    tr(it)%type      = fgetKey(it, 'type'  , tr(:)%keys, 'tracer')
    395525    tr(it)%component = sname
     526!   CALL addKey_m('component', sname, tr(:)%keys)
     527    DO iq=1,SIZE(tr); CALL addKey_1('component', sname, tr(iq)%keys); END DO
    396528
    397529    !--- Determine the number of tracers and parents ; coherence checking
    … …  
    409541  END DO
    410542  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    411   CALL delKey(['parent','type  '], tr)
    412543
    413544  ALLOCATE(ttr(nq))
    … …  
    416547  DO it = 1, nt                                                      !=== EXPAND TRACERS AND PARENTS NAMES LISTS
    417548  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    418     ll = strParse(tr(it)%name,   ',', ta, n=ntr)                     !--- Number of tracers
    419     ll = strParse(tr(it)%parent, ',', pa, n=npr)                     !--- Number of parents
     549    ll = strParse(tr(it)%name,   ',', ta, ntr)                       !--- Number of tracers
     550    ll = strParse(tr(it)%parent, ',', pa, npr)                       !--- Number of parents
    420551    DO ipr=1,npr                                                     !--- Loop on parents list elts
    421552      DO itr=1,ntr                                                   !--- Loop on tracers list elts
    422         i = iq+itr-1+(ipr-1)*ntr
    423         ttr(i)%name   = TRIM(ta(itr))
    424         ttr(i)%parent = TRIM(pa(ipr))
    425         ttr(i)%keys%name = ta(itr)
    426         ttr(i)%keys%key  = tr(it)%keys%key
    427         ttr(i)%keys%val  = tr(it)%keys%val
    428 !        ttr(i)%keys   = keys_type(ta(itr), tr(it)%keys%key, tr(it)%keys%val)
     553        ttr(iq)%keys%key  = tr(it)%keys%key
     554        ttr(iq)%keys%val  = tr(it)%keys%val
     555        ttr(iq)%keys%name = ta(itr)
     556        ttr(iq)%name      = TRIM(ta(itr));    CALL addKey_1('name',      ta(itr),          ttr(iq)%keys)
     557        ttr(iq)%parent    = TRIM(pa(ipr));    CALL addKey_1('parent',    pa(ipr),          ttr(iq)%keys)
     558        ttr(iq)%type      = tr(it)%type;      CALL addKey_1('type',      tr(it)%type,      ttr(iq)%keys)
     559        ttr(iq)%component = tr(it)%component; CALL addKey_1('component', tr(it)%component, ttr(iq)%keys)
     560        iq = iq+1
    429561      END DO
    430562    END DO
    431     ttr(iq:iq+ntr*npr-1)%type      = tr(it)%type                     !--- Duplicating type
    432     ttr(iq:iq+ntr*npr-1)%component = tr(it)%component                !--- Duplicating type
    433     iq = iq + ntr*npr
    434563  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    435564  END DO
    … …  
    441570!==============================================================================================================================
    442571
    443 !==============================================================================================================================
    444 SUBROUTINE setGeneration(tr)
     572
     573!==============================================================================================================================
     574LOGICAL FUNCTION setGeneration(tr) RESULT(lerr)
    445575!------------------------------------------------------------------------------------------------------------------------------
    446576! Purpose: Determine, for each tracer of "tr(:)":
    447577!   * %iGeneration: the generation number
    448578!   * %gen0Name:    the generation 0 ancestor name
     579!          Check also for orphan tracers (tracers not descending on "tran0").
    449580!------------------------------------------------------------------------------------------------------------------------------
    450581  TYPE(trac_type),     INTENT(INOUT) :: tr(:)                        !--- Tracer derived type vector
    451   INTEGER                            :: iq, nq, ig
    452   LOGICAL,               ALLOCATABLE :: lg(:)
    453   CHARACTER(LEN=maxlen), ALLOCATABLE :: prn(:)
    454 !------------------------------------------------------------------------------------------------------------------------------
    455   tr(:)%iGeneration = -1                                             !--- error if -1
    456   nq = SIZE(tr, DIM=1)                                               !--- Number of tracers lines
    457   lg = tr(:)%parent == tran0                                         !--- Flag for generation 0 tracers
    458   WHERE(lg) tr(:)%iGeneration = 0                                    !--- Generation 0 tracers
    459 
    460   !=== Determine generation for each tracer
    461   ig=-1; prn = [tran0]
    462   DO                                                                 !--- Update current generation flag
    463     IF(ig/=-1) prn = PACK( tr(:)%name, MASK=tr(:)%iGeneration == ig)
    464     lg(:) = [(ANY(prn(:) == tr(iq)%parent), iq=1, nq)]               !--- Current generation tracers flag
    465     IF( ALL( .NOT. lg ) ) EXIT                                       !--- Empty current generation
    466     ig = ig+1; WHERE(lg) tr(:)%iGeneration = ig
    467   END DO
    468   tr(:)%gen0Name = ancestor(tr)                                      !--- First generation ancestor name
    469 
    470 END SUBROUTINE setGeneration
    471 !==============================================================================================================================
     582  INTEGER                            :: iq, jq, ig
     583  CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:)
     584!------------------------------------------------------------------------------------------------------------------------------
     585  CHARACTER(LEN=maxlen) :: modname
     586  modname = 'setGeneration'
     587  IF(test(fmsg('missing "parent" attribute', modname, getKey('parent', parent, ky=tr(:)%keys)), lerr)) RETURN
     588  DO iq = 1, SIZE(tr)
     589    jq = iq; ig = 0
     590    DO WHILE(parent(jq) /= tran0)
     591      jq = strIdx(tr(:)%name, parent(jq))
     592      IF(test(fmsg('Orphan tracer "'//TRIM(tr(iq)%name)//'"', modname, jq == 0), lerr)) RETURN
     593      ig = ig + 1
     594    END DO
     595    tr(iq)%gen0Name = tr(jq)%name; CALL addKey_1('gen0Name',    tr(iq)%gen0Name,   tr(iq)%keys)
     596    tr(iq)%iGeneration = ig;       CALL addKey_1('iGeneration', TRIM(int2str(ig)), tr(iq)%keys)
     597  END DO
     598END FUNCTION setGeneration
     599!==============================================================================================================================
     600
    472601
    473602!==============================================================================================================================
    … …  
    503632END FUNCTION checkTracers
    504633!==============================================================================================================================
     634
    505635
    506636!==============================================================================================================================
    … …  
    543673!==============================================================================================================================
    544674
     675
    545676!==============================================================================================================================
    546677SUBROUTINE expandPhases(tr)
    … …  
    552683  TYPE(trac_type), ALLOCATABLE :: ttr(:)
    553684  INTEGER,   ALLOCATABLE ::  i0(:)
    554   CHARACTER(LEN=maxlen)  :: nam, pha, trn
     685  CHARACTER(LEN=maxlen)  :: nam, pha, tname
    555686  CHARACTER(LEN=1) :: p
    556687  INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
    557   LOGICAL :: lTg, lEx
     688  LOGICAL :: lTag, lExt
    558689!------------------------------------------------------------------------------------------------------------------------------
    559690  nq = SIZE(tr, DIM=1)
    … …  
    561692  DO iq = 1, nq                                                      !--- GET THE NUMBER OF TRACERS
    562693    IF(tr(iq)%iGeneration /= 0) CYCLE                                !--- Only deal with generation 0 tracers
    563     nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=0)  !--- Number of childs of tr(iq)
    564     tr(iq)%phase = fgetKey(iq, 'phases', tr(:)%keys)                 !--- Phases list      of tr(iq)
    565     np = LEN_TRIM(tr(iq)%phase)                                      !--- Number of phases of tr(iq)
     694    nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=0)  !--- Number of children of tr(iq)
     695    tr(iq)%phase = fgetKey(iq, 'phases', tr(:)%keys)                 !--- Phases list        of tr(iq)
     696    np = LEN_TRIM(tr(iq)%phase)                                      !--- Number of phases   of tr(iq)
    566697    nt = nt + (1+nc) * np                                            !--- Number of tracers after expansion
    567698  END DO
    … …  
    569700  it = 1                                                             !--- Current "ttr(:)" index
    570701  DO iq = 1, nq                                                      !--- Loop on "tr(:)" indexes
    571     lTg = tr(iq)%type=='tag'                                         !--- Current tracer is a tag
     702    lTag = tr(iq)%type=='tag'                                        !--- Current tracer is a tag
    572703    i0 = strFind(tr(:)%name, TRIM(tr(iq)%gen0Name), n)               !--- Indexes of first generation ancestor copies
    573704    np = SUM([( LEN_TRIM(tr(i0(i))%phase),i=1,n )], 1)               !--- Number of phases for current tracer tr(iq)
    574     lEx = np>1                                                       !--- Phase suffix only required if phases number is > 1
    575     IF(lTg) lEx = lEx .AND. tr(iq)%iGeneration>0                     !--- No phase suffix for generation 0 tags
     705    lExt = np>1                                                      !--- Phase suffix only required if phases number is > 1
     706    IF(lTag) lExt = lExt .AND. tr(iq)%iGeneration>0                  !--- No phase suffix for generation 0 tags
    576707    DO i=1,n                                                         !=== LOOP ON GENERATION 0 ANCESTORS
    577708      jq = i0(i)                                                     !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq)
    … …  
    580711      DO ip = 1, LEN_TRIM(pha)                                       !=== LOOP ON PHASES LISTS
    581712        p = pha(ip:ip)
    582         trn = TRIM(tr(iq)%name); nam = trn                           !--- Tracer name (regular case)
    583         IF(lTg) nam = TRIM(tr(iq)%parent)                            !--- Parent name (tagging case)
    584         IF(lEx) nam = addPhase(nam, p )                              !--- Phase extension needed
    585         IF(lTg) nam = TRIM(nam)//'_'//TRIM(trn)                      !--- <parent>_<name> for tags
     713        tname = TRIM(tr(iq)%name); nam = tname                       !--- Tracer name (regular case)
     714        IF(lTag) nam = TRIM(tr(iq)%parent)                           !--- Parent name (tagging case)
     715        IF(lExt) nam = addPhase(nam, p )                             !--- Phase extension needed
     716        IF(lTag) nam = TRIM(nam)//'_'//TRIM(tname)                   !--- <parent>_<name> for tags
    586717        ttr(it) = tr(iq)                                             !--- Same <key>=<val> pairs
    587718        ttr(it)%name      = TRIM(nam)                                !--- Name with possibly phase suffix
    588719        ttr(it)%keys%name = TRIM(nam)                                !--- Name inside the keys decriptor
    589720        ttr(it)%phase     = p                                        !--- Single phase entry
    590         IF(lEx .AND. tr(iq)%iGeneration>0) THEN
    591           ttr(it)%parent   = addPhase(ttr(it)%parent,   p)
    592           ttr(it)%gen0Name = addPhase(ttr(it)%gen0Name, p)
     721        CALL addKey_1('name', nam, ttr(it)%keys)
     722        CALL addKey_1('phase', p,  ttr(it)%keys)
     723        IF(lExt .AND. tr(iq)%iGeneration>0) THEN
     724          ttr(it)%parent   = addPhase(tr(iq)%parent,   p)
     725          ttr(it)%gen0Name = addPhase(tr(iq)%gen0Name, p)
     726          CALL addKey_1('parent',   ttr(it)%parent,   ttr(it)%keys)
     727          CALL addKey_1('gen0Name', ttr(it)%gen0Name, ttr(it)%keys)
    593728        END IF
    594729        it = it+1
    … …  
    603738!==============================================================================================================================
    604739
     740
    605741!==============================================================================================================================
    606742SUBROUTINE sortTracers(tr)
    … …  
    609745!  * Put water at the beginning of the vector, in the "known_phases" order.
    610746!  * lGrowGen == T: in ascending generations numbers.
    611 !  * 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.
    612748!   TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
    613749!------------------------------------------------------------------------------------------------------------------------------
    614750  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)         !--- Tracer derived type vector
    615   INTEGER,         ALLOCATABLE :: iy(:), iz(:)
    616   INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
     751!------------------------------------------------------------------------------------------------------------------------------
     752  TYPE(trac_type), ALLOCATABLE        :: tr2(:)
     753  INTEGER,         ALLOCATABLE        :: iy(:), iz(:)
     754  INTEGER                             :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
     755!  tr2 is introduced in order to cope with a bug in gfortran 4.8.5 compiler
    617756!------------------------------------------------------------------------------------------------------------------------------
    618757  nq = SIZE(tr)
    … …  
    620759    iq = strIdx(tr(:)%name, addPhase('H2O', ip))
    621760    IF(iq == 0) CYCLE
    622     tr = [tr(iq), tr(1:iq-1), tr(iq+1:nq)]
     761    tr2 = tr(:)
     762    tr = [tr2(iq), tr2(1:iq-1), tr2(iq+1:nq)]
    623763  END DO
    624764  IF(lSortByGen) THEN
    … …  
    637777      ix(iq) = jq                                                    !--- Generation 0 ancestor index first
    638778      iq = iq + 1                                                    !--- Next "iq" for next generations tracers
    639       iy = strFind(tr(:)%gen0Name, TRIM(tr(jq)%name))                !--- Indexes of "tr(jq)" childs in "tr(:)"
     779      iy = strFind(tr(:)%gen0Name, TRIM(tr(jq)%name))                !--- Indexes of "tr(jq)" children in "tr(:)"
    640780      ng = MAXVAL(tr(iy)%iGeneration, MASK=.TRUE., DIM=1)            !--- Number of generations of the "tr(jq)" family
    641781      DO ig = 1, ng                                                  !--- Loop   on generations of the "tr(jq)" family
    … …  
    649789END SUBROUTINE sortTracers
    650790!==============================================================================================================================
     791
    651792
    652793!==============================================================================================================================
    … …  
    724865  TYPE(dataBase_type),  TARGET, INTENT(IN)  :: sections(:)
    725866  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) ::       tr(:)
    726   TYPE(trac_type), POINTER     :: t1(:), t2(:)
     867  TYPE(trac_type), POINTER     :: t(:)
    727868  INTEGER,   ALLOCATABLE :: nt(:)
    728869  CHARACTER(LEN=maxlen)  :: tnam, tnam_new
    … …  
    735876  DO is=1, nsec                                                      !=== LOOP ON SECTIONS
    736877  !----------------------------------------------------------------------------------------------------------------------------
    737     t1 => sections(is)%trac(:)
     878    t => sections(is)%trac(:)
    738879    !--------------------------------------------------------------------------------------------------------------------------
    739880    DO iq=1, nt(is)                                                  !=== LOOP ON TRACERS
    740881    !--------------------------------------------------------------------------------------------------------------------------
    741       tnam = TRIM(t1(iq)%name)                                       !--- Original name
    742       IF(COUNT(t1%name == tnam) == 1) CYCLE                          !--- Current tracer is not duplicated: finished
     882      tnam = TRIM(t(iq)%name)                                        !--- Original name
     883      IF(COUNT(t%name == tnam) == 1) CYCLE                           !--- Current tracer is not duplicated: finished
    743884      tnam_new = TRIM(tnam)//'_'//TRIM(sections(is)%name)            !--- Same with section extension
    744885      nq = SUM(nt(1:is-1))                                           !--- Number of tracers in previous sections
    … …  
    759900  TYPE(trac_type), INTENT(INOUT) :: tr(:)
    760901
    761   !--- Update %iqParent, %iqDescen, %nqDescen, %nqChilds
     902  !--- Update %iqParent, %iqDescen, %nqDescen, %nqChildren
    762903  CALL indexUpdate(tr)
    763904
    … …  
    774915  INTEGER :: idb, iq, nq
    775916  INTEGER, ALLOCATABLE :: hadv(:), vadv(:)
    776   CHARACTER(LEN=maxlen), ALLOCATABLE :: phas(:)
     917  CHARACTER(LEN=maxlen), ALLOCATABLE :: phas(:), prnt(:)
    777918  TYPE(trac_type), POINTER :: tm(:)
    778919  lerr = .FALSE.
    … …  
    782923  !--- BEWARE ! Can't use the "getKeyByName" functions yet.
    783924  !             Names must first include the phases for tracers defined on multiple lines.
    784   hadv = str2int([(fgetKey(iq, 'hadv',  tm(:)%keys, '10'), iq=1, nq)])
    785   vadv = str2int([(fgetKey(iq, 'vadv',  tm(:)%keys, '10'), iq=1, nq)])
    786   phas =         [(fgetKey(iq, 'phases',tm(:)%keys, 'g' ), iq=1, nq)]
     925  hadv = str2int(fgetKeys('hadv',  tm(:)%keys, '10'))
     926  vadv = str2int(fgetKeys('vadv',  tm(:)%keys, '10'))
     927  prnt =         fgetKeys('parent',tm(:)%keys,  '' )
     928  IF(getKey('phases', phas, ky=tm(:)%keys)) phas = fGetKeys('phase', tm(:)%keys, 'g')
    787929  CALL msg(TRIM(message)//':', modname)
    788   IF(ALL(tm(:)%parent == '')) THEN
    789     IF(test(dispTable('iiiss',   ['iq    ','hadv  ','vadv  ','name  ','phase '], cat(tm%name, phas), &
     930  IF(ALL(prnt == 'air')) THEN
     931    IF(test(dispTable('iiiss',   ['iq    ','hadv  ','vadv  ','name  ','phase '],                   cat(tm%name,       phas),  &
     932                 cat([(iq, iq=1, nq)], hadv, vadv),                 nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
     933  ELSE IF(ALL(tm%iGeneration == -1)) THEN
     934    IF(test(dispTable('iiisss', ['iq    ','hadv  ','vadv  ','name  ','parent','phase '],           cat(tm%name, prnt, phas),  &
    790935                 cat([(iq, iq=1, nq)], hadv, vadv),                 nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
    791936  ELSE
    792     IF(test(dispTable('iiissis', ['iq    ','hadv  ','vadv  ','name  ','parent','igen  ','phase '], cat(tm%name, tm%parent, &
    793       tm%phase), cat([(iq, iq=1, nq)], hadv, vadv, tm%iGeneration), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
     937    IF(test(dispTable('iiissis', ['iq    ','hadv  ','vadv  ','name  ','parent','igen  ','phase '], cat(tm%name, prnt, phas), &
     938                cat([(iq, iq=1, nq)], hadv, vadv, tm%iGeneration), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
    794939  END IF
    795940END FUNCTION dispTraSection
    796 !==============================================================================================================================
    797941!==============================================================================================================================
    798942
    … …  
    809953  out => NULL(); IF(it /= 0) out => t(it)
    810954END FUNCTION aliasTracer
    811 !------------------------------------------------------------------------------------------------------------------------------
     955!==============================================================================================================================
    812956
    813957
    … …  
    830974  CALL indexUpdate(out)
    831975END FUNCTION trSubset_Name
    832 !------------------------------------------------------------------------------------------------------------------------------
     976!==============================================================================================================================
    833977
    834978
    … …  
    843987  CALL indexUpdate(out)
    844988END FUNCTION trSubset_gen0Name
    845 !------------------------------------------------------------------------------------------------------------------------------
     989!==============================================================================================================================
    846990
    847991
    … …  
    851995SUBROUTINE indexUpdate(tr)
    852996  TYPE(trac_type), INTENT(INOUT) :: tr(:)
    853   INTEGER :: iq, ig, ng, igen, ngen
    854   INTEGER, ALLOCATABLE :: ix(:)
     997  INTEGER :: iq, ig, igen, ngen, ix(SIZE(tr))
    855998  tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent )                !--- Parent index
     999  DO iq = 1, SIZE(tr); CALL addKey_1('iqParent', int2str(tr(iq)%iqParent), tr(iq)%keys); END DO
    8561000  ngen = MAXVAL(tr(:)%iGeneration, MASK=.TRUE.)
    8571001  DO iq = 1, SIZE(tr)
    … …  
    8591003    IF(ALLOCATED(tr(iq)%iqDescen)) DEALLOCATE(tr(iq)%iqDescen)
    8601004    ALLOCATE(tr(iq)%iqDescen(0))
    861     ix = idxAncestor(tr, igen=ig)                                    !--- Ancestor of generation "ng" for each tr
     1005    CALL idxAncestor(tr, ix, ig)                                     !--- Ancestor of generation "ng" for each tr
    8621006    DO igen = ig+1, ngen
    8631007      tr(iq)%iqDescen = [tr(iq)%iqDescen, find(ix==iq .AND. tr%iGeneration==igen)]
    8641008      tr(iq)%nqDescen = SIZE(tr(iq)%iqDescen)
    865       IF(igen == ig+1) tr(iq)%nqChilds=tr(iq)%nqDescen
     1009      IF(igen == ig+1) THEN
     1010        tr(iq)%nqChildren = tr(iq)%nqDescen
     1011        CALL addKey_1('nqChildren', int2str(tr(iq)%nqChildren), tr(iq)%keys)
     1012      END IF
    8661013    END DO
     1014    CALL addKey_1('iqDescen', strStack(int2str(tr(iq)%iqDescen)), tr(iq)%keys)
     1015    CALL addKey_1('nqDescen',          int2str(tr(iq)%nqDescen) , tr(iq)%keys)
    8671016  END DO
    8681017END SUBROUTINE indexUpdate
    869 !------------------------------------------------------------------------------------------------------------------------------
     1018!==============================================================================================================================
    8701019 
    8711020 
    … …  
    8751024!===  * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot"        ====
    8761025!=== NOTES:                                                                                                                ====
    877 !===  * Most of the "isot" components have been defined in the calling routine (initIsotopes):                             ====
     1026!===  * Most of the "isot" components have been defined in the calling routine (readIsotopes):                             ====
    8781027!===      parent,  nzone, zone(:),  niso, keys(:)%name,  ntiso, trac(:),  nphas, phas,  iqIsoPha(:,:),  itZonPhi(:,:)      ====
    8791028!===  * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes       ====
    … …  
    8831032!===  * The routine gives an error if a required isotope is not available in the database stored in "fnam"                 ====
    8841033!==============================================================================================================================
    885 LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
     1034LOGICAL FUNCTION readIsotopesFile_prv(fnam, isot) RESULT(lerr)
    8861035  CHARACTER(LEN=*),        INTENT(IN)    :: fnam                     !--- Input file name
    887   TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:)                  !--- Isotopes descriptors (field "prnt" must be defined !)
    888   INTEGER :: ik, is, it, idb, nk0, i, iis
    889   INTEGER :: nk, ns, nt, ndb, nb0, i0
    890   CHARACTER(LEN=maxlen), POINTER     :: k(:), v(:), k0(:), v0(:)
     1036  TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:)                  !--- Isotopes descriptors (field %parent must be defined!)
     1037  LOGICAL :: lFound
     1038  INTEGER :: is, iis, it, idb, ndb, nb0
    8911039  CHARACTER(LEN=maxlen), ALLOCATABLE :: vals(:)
    892   CHARACTER(LEN=maxlen)              :: val, modname
    893   TYPE(keys_type),           POINTER ::   ky(:)
     1040  CHARACTER(LEN=maxlen)              :: modname
    8941041  TYPE(trac_type),           POINTER ::   tt(:), t
    8951042  TYPE(dataBase_type),   ALLOCATABLE ::  tdb(:)
    896   LOGICAL,               ALLOCATABLE :: liso(:)
    8971043  modname = 'readIsotopesFile'
    8981044
    8991045  !--- THE INPUT FILE MUST BE PRESENT
    900   IF(test(fmsg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, testFile(fnam)),lerr)) RETURN
     1046  INQUIRE(FILE=TRIM(fnam), EXIST=lFound); lerr = .NOT.lFound
     1047  IF(fmsg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, lerr)) RETURN
    9011048
    9021049  !--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
    … …  
    9051052  ndb = SIZE(dBase, DIM=1)                                           !--- Current database size
    9061053  DO idb = nb0, ndb
    907    iis = idb-nb0+1
     1054    iis = idb-nb0+1
    9081055
    9091056    !--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
    … …  
    9201067      is = strIdx(isot(iis)%keys(:)%name, t%name)                    !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name"
    9211068      IF(is == 0) CYCLE
    922       liso = reduceExpr(t%keys%val, vals)                            !--- Reduce expressions (for substituted variables)
    923       IF(test(ANY(liso), lerr)) RETURN                               !--- Some non-numerical elements were found
    924       isot(iis)%keys(is)%key = PACK(t%keys%key, MASK=.NOT.liso)
    925       isot(iis)%keys(is)%val = PACK(  vals,     MASK=.NOT.liso)
     1069      IF(test(ANY(reduceExpr(t%keys%val, vals)), lerr)) RETURN       !--- Reduce expressions ; detect non-numerical elements
     1070      isot(iis)%keys(is)%key = t%keys%key
     1071      isot(iis)%keys(is)%val = vals
    9261072    END DO
    9271073
    9281074    !--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
    929     liso = [( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )]
    930     IF(test(checkList(isot(iis)%keys(:)%name, .NOT.liso, &
    931       'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'),lerr)) RETURN
     1075    IF(test(checkList(isot(iis)%keys(:)%name, .NOT.[( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )], &
     1076      'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'), lerr)) RETURN
    9321077  END DO
    9331078
    … …  
    9421087  CALL get_in('ok_iso_verif', isot(strIdx(isot%parent, 'H2O'))%check, .FALSE.)
    9431088
    944   lerr = dispIsotopes(isot, 'Isotopes parameters read from file "'//TRIM(fnam)//'"', modname)
    945 
    946 END FUNCTION readIsotopesFile
    947 !==============================================================================================================================
     1089  lerr = dispIsotopes()
     1090
     1091CONTAINS
     1092
     1093!------------------------------------------------------------------------------------------------------------------------------
     1094LOGICAL FUNCTION dispIsotopes() RESULT(lerr)
     1095  INTEGER :: ik, nk, ip, it, nt
     1096  CHARACTER(LEN=maxlen) :: prf
     1097  CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
     1098  CALL msg('Isotopes parameters read from file "'//TRIM(fnam)//'":', modname)
     1099  DO ip = 1, SIZE(isot)                                              !--- Loop on parents tracers
     1100    nk = SIZE(isot(ip)%keys(1)%key)                                  !--- Same keys for each isotope
     1101    nt = SIZE(isot(ip)%keys)                                         !--- Number of isotopes
     1102    prf = 'i'//REPEAT('s',nk+1)                                      !--- Profile for table printing
     1103    ALLOCATE(ttl(nk+2), val(nt,nk+1))
     1104    ttl(1:2) = ['it  ','name']; ttl(3:nk+2) = isot(ip)%keys(1)%key(:)!--- Titles line with keys names
     1105    val(:,1) = isot(ip)%keys(:)%name                                 !--- Values table 1st column: isotopes names 
     1106    DO ik = 1, nk
     1107      DO it = 1, nt
     1108        val(it,ik+1) = isot(ip)%keys(it)%val(ik)                     !--- Other columns: keys values
     1109      END DO
     1110    END DO
     1111    IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, &
     1112            cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)), lerr)) RETURN
     1113    DEALLOCATE(ttl, val)
     1114  END DO       
     1115END FUNCTION dispIsotopes
     1116!------------------------------------------------------------------------------------------------------------------------------
     1117
     1118END FUNCTION readIsotopesFile_prv
     1119!==============================================================================================================================
     1120
    9481121
    9491122!==============================================================================================================================
    … …  
    9511124!===    * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS).                                                       ===
    9521125!===    * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS                                                                  ===
    953 !===    * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS)                                              ===
     1126!===    * CALL readIsotopesFile_prv TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS)                                          ===
    9541127!===      NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS.  ===
    9551128!==============================================================================================================================
    956 LOGICAL FUNCTION initIsotopes(trac, isot) RESULT(lerr)
    957   TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: trac(:)
    958   TYPE(isot_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: isot(:)
     1129LOGICAL FUNCTION readIsotopesFile(iNames) RESULT(lerr)
     1130  CHARACTER(LEN=maxlen), TARGET, OPTIONAL, INTENT(IN)  :: iNames(:)
    9591131  CHARACTER(LEN=maxlen), ALLOCATABLE :: p(:), str(:)                 !--- Temporary storage
    960   CHARACTER(LEN=maxlen) :: iname
     1132  CHARACTER(LEN=maxlen) :: iName, modname
    9611133  CHARACTER(LEN=1)   :: ph                                           !--- Phase
    962   INTEGER :: nbIso, ic, ip, iq, it, iz
     1134  INTEGER :: ic, ip, iq, it, iz
    9631135  LOGICAL, ALLOCATABLE :: ll(:)                                      !--- Mask
    9641136  TYPE(trac_type), POINTER   ::  t(:), t1
    9651137  TYPE(isot_type), POINTER   ::  i
    9661138  lerr = .FALSE.
    967 
    968   t => trac
    969 
    970   p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1) !--- Parents of generation 1 isotopes
     1139  modname = 'readIsotopesFile'
     1140
     1141  t => tracers
     1142
     1143  !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
     1144  p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1)
    9711145  CALL strReduce(p, nbIso)
    972   ALLOCATE(isot(nbIso))
     1146
     1147  !--- CHECK WHETHER NEEDED ISOTOPES CLASSES "iNames" ARE AVAILABLE OR NOT
     1148  IF(PRESENT(iNames)) THEN
     1149    DO it = 1, SIZE(iNames)
     1150      IF(test(fmsg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, ALL(p /= iNames(it))), lerr)) RETURN
     1151    END DO
     1152    p = iNames; nbIso = SIZE(p)
     1153  END IF
     1154  IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes)
     1155  ALLOCATE(isotopes(nbIso))
    9731156
    9741157  IF(nbIso==0) RETURN                                                !=== NO ISOTOPES: FINISHED
    9751158
    9761159  !--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
    977   isot(:)%parent = p
     1160  isotopes(:)%parent = p
    9781161  DO ic = 1, SIZE(p)                                                 !--- Loop on isotopes classes
    979     i => isot(ic)
     1162    i => isotopes(ic)
    9801163    iname = i%parent                                                 !--- Current isotopes class name (parent tracer name)
    9811164
    982     !=== Isotopes childs of tracer "iname": mask, names, number (same for each phase of "iname")
     1165    !=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname")
    9831166    ll = t(:)%type=='tracer' .AND. delPhase(t(:)%parent) == iname .AND. t(:)%phase == 'g'
    9841167    str = PACK(delPhase(t(:)%name), MASK = ll)                       !--- Effectively found isotopes of "iname"
    … …  
    9891172    !=== Geographic tagging tracers descending on tracer "iname": mask, names, number
    9901173    ll = t(:)%type=='tag'    .AND. delPhase(t(:)%gen0Name) == iname .AND. t(:)%iGeneration == 2
    991     i%zone = PACK(strTail(t(:)%name,'_'), MASK = ll)                 !--- Tagging zones names  for isotopes category "iname"
     1174    i%zone = PACK(strTail(t(:)%name,'_',.TRUE.), MASK = ll)          !--- Tagging zones names  for isotopes category "iname"
    9921175    CALL strReduce(i%zone)
    9931176    i%nzone = SIZE(i%zone)                                           !--- Tagging zones number for isotopes category "iname"
    9941177
    995     !=== Geographic tracers of the isotopes childs of tracer "iname" (same for each phase of "iname")
     1178    !=== Geographic tracers of the isotopes children of tracer "iname" (same for each phase of "iname")
    9961179    !    NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
    9971180    str = PACK(delPhase(t(:)%name), MASK=ll)
    … …  
    10091192    !=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
    10101193    DO iq = 1, SIZE(t)
    1011       t1 => trac(iq)
     1194      t1 => tracers(iq)
    10121195      IF(delPhase(t1%gen0Name)/=iname .OR. t1%iGeneration==0) CYCLE  !--- Only deal with tracers descending on "iname"
    10131196      t1%iso_iGroup = ic                                             !--- Isotopes family       idx in list "isotopes(:)%parent"
    1014       t1%iso_iName  = strIdx(i%trac, delPhase(strHead(t1%name,'_'))) !--- Current isotope       idx in effective isotopes list
    1015       t1%iso_iZone  = strIdx(i%zone,          strTail(t1%name,'_') ) !--- Current isotope zone  idx in effective zones    list
     1197      t1%iso_iName  = strIdx(i%trac, strHead(delPhase(t1%name),'_',.TRUE.)) !--- Current isotope       idx in effective isotopes list
     1198      t1%iso_iZone  = strIdx(i%zone,          strTail(t1%name, '_',.TRUE.)) !--- Current isotope zone  idx in effective zones    list
    10161199      t1%iso_iPhase =  INDEX(i%phase,TRIM(t1%phase))                 !--- Current isotope phase idx in effective phases   list
    10171200      IF(t1%iGeneration /= 2) t1%iso_iZone = 0                       !--- Skip possible generation 1 tagging tracers
    … …  
    10201203    !=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
    10211204    !    (including tagging tracers) is sorted this way:  iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
    1022     i%iqIsoPha = RESHAPE( [( (strIdx(t%name,  addPhase(i%trac(it),i%phase(ip:ip))),    it=1, i%ntiso), ip=1, i%nphas)], &
     1205    i%iqIsoPha = RESHAPE( [( (strIdx(t%name,  addPhase(i%trac(it),i%phase(ip:ip))),       it=1, i%ntiso), ip=1, i%nphas)], &
    10231206                         [i%ntiso, i%nphas] )
    10241207    !=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
    … …  
    10271210  END DO
    10281211
    1029   !=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE
    1030   !    DONE HERE, AND NOT ONLY IN "infotrac_phy", BECAUSE SOME PHYSICAL PARAMS ARE NEEDED FOR RESTARTS (tnat AND alpha_ideal)
    1031   lerr = readIsotopesFile('isotopes_params.def',isot)
    1032 
    1033 END FUNCTION initIsotopes
    1034 !==============================================================================================================================
    1035 
    1036 
    1037 !==============================================================================================================================
    1038 LOGICAL FUNCTION dispIsotopes(ides, message, modname) RESULT(lerr)
    1039   TYPE(isot_type),  INTENT(IN) :: ides(:)                            !--- Isotopes descriptor vector
    1040   CHARACTER(LEN=*), INTENT(IN) :: message                            !--- Message to display
    1041   CHARACTER(LEN=*), INTENT(IN) :: modname                            !--- Calling subroutine name
    1042   INTEGER :: ik, nk, ip, it, nt
    1043   CHARACTER(LEN=maxlen) :: prf
    1044   CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
    1045   CALL msg(TRIM(message)//':', modname)
    1046   DO ip = 1, SIZE(ides)                                              !--- Loop on parents tracers
    1047     nk = SIZE(ides(ip)%keys(1)%key)                                  !--- Same keys for each isotope
    1048     nt = SIZE(ides(ip)%keys)                                         !--- Number of isotopes
    1049     prf = 'i'//REPEAT('s',nk+1)                                      !--- Profile for table printing
    1050     ALLOCATE(ttl(nk+2), val(nt,nk+1))
    1051     ttl(1:2) = ['iq  ','name']; ttl(3:nk+2) = ides(ip)%keys(1)%key(:)!--- Titles line with keys names
    1052     val(:,1) = ides(ip)%keys(:)%name                                 !--- Values table 1st column: isotopes names 
    1053     DO ik = 1, nk
    1054       DO it = 1, nt
    1055         val(it,ik+1) = ides(ip)%keys(it)%val(ik)                     !--- Other columns: keys values
    1056       END DO
     1212  !=== READ PHYSICAL PARAMETERS FROM isoFile FILE
     1213  IF(test(readIsotopesFile_prv(isoFile, isotopes), lerr)) RETURN
     1214
     1215  !=== CHECK CONSISTENCY
     1216  IF(test(testIsotopes(), lerr)) RETURN
     1217
     1218  !=== SELECT FIRST ISOTOPES CLASS OR, IF POSSIBLE, WATER CLASS
     1219  IF(.NOT.test(isoSelect(1, .TRUE.), lerr)) THEN; IF(isotope%parent == 'H2O') iH2O = ixIso; END IF
     1220
     1221CONTAINS
     1222
     1223!------------------------------------------------------------------------------------------------------------------------------
     1224LOGICAL FUNCTION testIsotopes() RESULT(lerr)     !--- MAKE SURE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
     1225!------------------------------------------------------------------------------------------------------------------------------
     1226  INTEGER :: ix, it, ip, np, iz, nz
     1227  TYPE(isot_type), POINTER :: i
     1228  DO ix = 1, nbIso
     1229    i => isotopes(ix)
     1230    !--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
     1231    DO it = 1, i%ntiso
     1232      np = SUM([(COUNT(tracers(:)%name == addPhase(i%trac(it), i%phase(ip:ip))), ip=1, i%nphas)])
     1233      IF(test(fmsg(TRIM(int2str(np))//' phases instead of '//TRIM(int2str(i%nphas))//' for '//TRIM(i%trac(it)), &
     1234        modname, np /= i%nphas), lerr)) RETURN
    10571235    END DO
    1058     IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, &
    1059             cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)), lerr)) RETURN
    1060     DEALLOCATE(ttl, val)
    1061   END DO       
    1062 END FUNCTION dispIsotopes
    1063 !==============================================================================================================================
    1064 
    1065 
     1236    DO it = 1, i%niso
     1237      nz = SUM([(COUNT(i%trac == TRIM(i%trac(it))//'_'//i%zone(iz)), iz=1, i%nzone)])
     1238      IF(test(fmsg(TRIM(int2str(nz))//' tagging zones instead of '//TRIM(int2str(i%nzone))//' for '//TRIM(i%trac(it)), &
     1239        modname, nz /= i%nzone), lerr)) RETURN
     1240    END DO
     1241  END DO
     1242END FUNCTION testIsotopes
     1243!------------------------------------------------------------------------------------------------------------------------------
     1244
     1245END FUNCTION readIsotopesFile
     1246!==============================================================================================================================
     1247
     1248
     1249!==============================================================================================================================
     1250!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
     1251!     Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
     1252!==============================================================================================================================
     1253LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
     1254   IMPLICIT NONE
     1255   CHARACTER(LEN=*),  INTENT(IN) :: iName
     1256   LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
     1257   INTEGER :: iIso
     1258   LOGICAL :: lV
     1259   lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
     1260   iIso = strIdx(isotopes(:)%parent, iName)
     1261   IF(test(iIso == 0, lerr)) THEN
     1262      niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck=.FALSE.
     1263      CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV)
     1264      RETURN
     1265   END IF
     1266   lerr = isoSelectByIndex(iIso, lV)
     1267END FUNCTION isoSelectByName
     1268!==============================================================================================================================
     1269LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
     1270   IMPLICIT NONE
     1271   INTEGER,           INTENT(IN) :: iIso
     1272   LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
     1273   LOGICAL :: lV
     1274   lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
     1275   lerr = .FALSE.
     1276   IF(iIso == ixIso) RETURN                                          !--- Nothing to do if the index is already OK
     1277   lerr = iIso<=0 .OR. iIso>SIZE(isotopes)
     1278   CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '&
     1279          //TRIM(int2str(SIZE(isotopes)))//'"', ll = lerr .AND. lV)
     1280   IF(lerr) RETURN
     1281   ixIso = iIso                                                      !--- Update currently selected family index
     1282   isotope  => isotopes(ixIso)                                       !--- Select corresponding component
     1283   isoKeys  => isotope%keys;     niso     = isotope%niso
     1284   isoName  => isotope%trac;     ntiso    = isotope%ntiso
     1285   isoZone  => isotope%zone;     nzone    = isotope%nzone
     1286   isoPhas  => isotope%phase;    nphas    = isotope%nphas
     1287   itZonIso => isotope%itZonIso; isoCheck = isotope%check
     1288   iqIsoPha => isotope%iqIsoPha
     1289END FUNCTION isoSelectByIndex
     1290!==============================================================================================================================
     1291
     1292
     1293!==============================================================================================================================
     1294!=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS
    10661295!==============================================================================================================================
    10671296SUBROUTINE addKey_1(key, val, ky, lOverWrite)
    1068 !------------------------------------------------------------------------------------------------------------------------------
    1069 ! Purpose: Add the <key>=<val> pair in the "ky" keys descriptor.
    1070 !------------------------------------------------------------------------------------------------------------------------------
    10711297  CHARACTER(LEN=*),  INTENT(IN)    :: key, val
    10721298  TYPE(keys_type),   INTENT(INOUT) :: ky
    10731299  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
     1300!------------------------------------------------------------------------------------------------------------------------------
    10741301  CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
    10751302  INTEGER :: iky, nky
    10761303  LOGICAL :: lo
    1077 !------------------------------------------------------------------------------------------------------------------------------
    1078   lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
     1304  lo=.TRUE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
     1305  IF(.NOT.ALLOCATED(ky%key)) THEN
     1306    ALLOCATE(ky%key(1)); ky%key(1)=key
     1307    ALLOCATE(ky%val(1)); ky%val(1)=val
     1308    RETURN
     1309  END IF
    10791310  iky = strIdx(ky%key,key)
    10801311  IF(iky == 0) THEN
    10811312    nky = SIZE(ky%key)
    1082     IF(nky == 0) THEN; ky%key = [key]; ky%val = [val]; ELSE; ky%key = [ky%key, key]; ky%val = [ky%val, val]; END IF
    1083   ELSE IF(lo) THEN                                                   !--- Overwriting
     1313    ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key; ky%key = k
     1314    ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = val; ky%val = v
     1315  ELSE IF(lo) THEN
    10841316    ky%key(iky) = key; ky%val(iky) = val
    10851317  END IF
    … …  
    10871319!==============================================================================================================================
    10881320SUBROUTINE addKey_m(key, val, ky, lOverWrite)
    1089 !------------------------------------------------------------------------------------------------------------------------------
    1090 ! Purpose: Add the <key>=<val> pair in all the components of the "ky" keys descriptor.
    1091 !------------------------------------------------------------------------------------------------------------------------------
    10921321  CHARACTER(LEN=*),  INTENT(IN)    :: key, val
    10931322  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
    10941323  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
     1324!------------------------------------------------------------------------------------------------------------------------------
    10951325  INTEGER :: itr
    1096   LOGICAL :: lo
    1097 !------------------------------------------------------------------------------------------------------------------------------
    1098   lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
    1099   DO itr = 1, SIZE(ky); CALL addKey_1(key, val, ky(itr), lo); END DO
     1326  DO itr = 1, SIZE(ky)
     1327    CALL addKey_1(key, val, ky(itr), lOverWrite)
     1328  END DO
    11001329END SUBROUTINE addKey_m
    11011330!==============================================================================================================================
     1331SUBROUTINE addKey_mm(key, val, ky, lOverWrite)
     1332  CHARACTER(LEN=*),  INTENT(IN)    :: key, val(:)
     1333  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
     1334  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
     1335!------------------------------------------------------------------------------------------------------------------------------
     1336  INTEGER :: itr
     1337  DO itr = 1, SIZE(ky); CALL addKey_1(key, val(itr), ky(itr), lOverWrite); END DO
     1338END SUBROUTINE addKey_mm
     1339!==============================================================================================================================
     1340
     1341
     1342!==============================================================================================================================
     1343!=== OVERWRITE THE KEYS OF THE TRACER NAMED "tr0" WITH THE VALUES FOUND IN THE *.def FILES, IF ANY. ===========================
     1344!==============================================================================================================================
    11021345SUBROUTINE addKeysFromDef(t, tr0)
    1103 !------------------------------------------------------------------------------------------------------------------------------
    1104 ! Purpose: The values of the keys of the tracer named "tr0" are overwritten by the values found in the *.def files, if any.
    1105 !------------------------------------------------------------------------------------------------------------------------------
    11061346  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: t(:)
    11071347  CHARACTER(LEN=*),             INTENT(IN)    :: tr0
     1348!------------------------------------------------------------------------------------------------------------------------------
    11081349  CHARACTER(LEN=maxlen) :: val
    11091350  INTEGER               :: ik, jd
    … …  
    11161357END SUBROUTINE addKeysFromDef
    11171358!==============================================================================================================================
     1359
     1360
     1361!==============================================================================================================================
     1362!=== REMOVE THE KEYS NAMED "keyn(:)" FROM EITHER THE "itr"th OR ALL THE KEYS DESCRIPTORS OF "ky(:)" ===========================
     1363!==============================================================================================================================
    11181364SUBROUTINE delKey_1(itr, keyn, ky)
    1119 !------------------------------------------------------------------------------------------------------------------------------
    1120 ! Purpose: Internal routine.
    1121 !   Remove <key>=<val> pairs in the "itr"th component of the "ky" keys descriptor.
    1122 !------------------------------------------------------------------------------------------------------------------------------
    11231365  INTEGER,          INTENT(IN)    :: itr
    11241366  CHARACTER(LEN=*), INTENT(IN)    :: keyn(:)
    11251367  TYPE(trac_type),  INTENT(INOUT) :: ky(:)
     1368!------------------------------------------------------------------------------------------------------------------------------
    11261369  CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
    11271370  LOGICAL,               ALLOCATABLE :: ll(:)
    11281371  INTEGER :: iky
    1129 !------------------------------------------------------------------------------------------------------------------------------
    11301372  IF(itr<=0 .OR. itr>SIZE(ky, DIM=1)) RETURN                          !--- Index is out of range
    11311373  ll = [( ALL(keyn/=ky(itr)%keys%key(iky)), iky=1, SIZE(ky(itr)%keys%key) )]
    … …  
    11351377!==============================================================================================================================
    11361378SUBROUTINE delKey(keyn, ky)
    1137 !------------------------------------------------------------------------------------------------------------------------------
    1138 ! Purpose: Internal routine.
    1139 !   Remove <key>=<val> pairs in all the components of the "t" tracers descriptor.
    1140 !------------------------------------------------------------------------------------------------------------------------------
    11411379  CHARACTER(LEN=*), INTENT(IN)    :: keyn(:)
    11421380  TYPE(trac_type),  INTENT(INOUT) :: ky(:)
     1381!------------------------------------------------------------------------------------------------------------------------------
    11431382  INTEGER :: iky
    1144 !------------------------------------------------------------------------------------------------------------------------------
    11451383  DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky); END DO
    11461384END SUBROUTINE delKey
    … …  
    11491387
    11501388!==============================================================================================================================
    1151 !=== PUBLIC ROUTINES: GET A KEY FROM A <key>=<val> LIST ; VECTORS, TRACER AND DATABASE VERSIONS ===============================
    1152 !=== BEWARE !!! IF THE "ky" ARGUMENT IS NOT PRESENT, THEN THE VARIABLES "tracers" AND "isotopes" ARE USED. ====================
    1153 !===     THEY ARE LOCAL TO THIS MODULE, SO MUST MUST BE INITIALIZED FIRST USING the "getKey_init" ROUTINE  ====================
    1154 !==============================================================================================================================
    1155 SUBROUTINE getKey_init(tracers_, isotopes_)
    1156   TYPE(trac_type), OPTIONAL, INTENT(IN) ::  tracers_(:)
    1157   TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
    1158   IF(PRESENT( tracers_))  tracers =  tracers_
    1159   IF(PRESENT(isotopes_)) isotopes = isotopes_
    1160 END SUBROUTINE getKey_init
    1161 !==============================================================================================================================
    1162 CHARACTER(LEN=maxlen) FUNCTION fgetKeyByIndex_s1(itr, keyn, ky, def_val) RESULT(val)
    1163 !------------------------------------------------------------------------------------------------------------------------------
    1164 ! Purpose: Internal function ; get a string formatted key value (returned argument) from its name and the tracer index.
    1165 !------------------------------------------------------------------------------------------------------------------------------
    1166   INTEGER,                    INTENT(IN) :: itr
    1167   CHARACTER(LEN=*),           INTENT(IN) :: keyn
    1168   TYPE(keys_type),            INTENT(IN) :: ky(:)
    1169   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
     1389!================ GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RESULT IS THE RETURNED VALUE ===================
     1390!==============================================================================================================================
     1391CHARACTER(LEN=maxlen) FUNCTION fgetKeyIdx_s1(itr, keyn, ky, def_val, lerr) RESULT(val)
     1392  INTEGER,                    INTENT(IN)  :: itr
     1393  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
     1394  TYPE(keys_type),            INTENT(IN)  :: ky(:)
     1395  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: def_val
     1396  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
    11701397!------------------------------------------------------------------------------------------------------------------------------
    11711398  INTEGER :: iky
    1172   iky = 0;  IF(itr >  0 .AND. itr <= SIZE(ky)) iky = strIdx(ky(itr)%key(:), keyn)
    1173   val = ''; IF(iky /= 0) val = ky(itr)%val(iky)                      !--- Key was found
    1174   IF(PRESENT(def_val) .AND. iky == 0) val = def_val                  !--- Default value from arguments
    1175 END FUNCTION fgetKeyByIndex_s1
    1176 !==============================================================================================================================
    1177 CHARACTER(LEN=maxlen) FUNCTION fgetKeyByName_s1(tname, keyn, ky, def_val, lerr) RESULT(val)
    1178 !------------------------------------------------------------------------------------------------------------------------------
    1179 ! Purpose: Internal function ; get a string formatted key value (returned argument) from its name and the tracer name.
    1180 !------------------------------------------------------------------------------------------------------------------------------
     1399  LOGICAL :: ler
     1400  iky = 0; val = ''
     1401  IF(.NOT.test(itr <= 0 .OR. itr > SIZE(ky), ler)) iky = strIdx(ky(itr)%key(:), keyn)    !--- Correct index
     1402  IF(.NOT.test(iky == 0, ler))                     val = ky(itr)%val(iky)                !--- Found key
     1403  IF(iky == 0) THEN
     1404    IF(.NOT.test(.NOT.PRESENT(def_val), ler))      val = def_val                         !--- Default value
     1405  END IF
     1406  IF(PRESENT(lerr)) lerr = ler
     1407END FUNCTION fgetKeyIdx_s1
     1408!==============================================================================================================================
     1409CHARACTER(LEN=maxlen) FUNCTION fgetKeyNam_s1(tname, keyn, ky, def_val, lerr) RESULT(val)
    11811410  CHARACTER(LEN=*),           INTENT(IN)  :: tname, keyn
    11821411  TYPE(keys_type),            INTENT(IN)  :: ky(:)
    … …  
    11841413  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
    11851414!------------------------------------------------------------------------------------------------------------------------------
    1186   INTEGER :: iky, itr
    1187   val = ''; iky = 0
    1188   itr = strIdx(ky(:)%name, tname)                                    !--- Get the index of the wanted tracer
    1189   IF(PRESENT(lerr)) lerr = itr==0; IF(itr == 0) RETURN
    1190   IF(itr >  0 .AND. itr <= SIZE(ky)) iky = strIdx(ky(itr)%key(:), keyn)
    1191   IF(iky /= 0) val = ky(itr)%val(iky)                                !--- Key was found
    1192   IF(PRESENT(def_val) .AND. iky == 0) val = def_val                  !--- Default value from arguments
    1193 END FUNCTION fgetKeyByName_s1
     1415  val = fgetKeyIdx_s1(strIdx(ky(:)%name, tname), keyn, ky, def_val, lerr)
     1416END FUNCTION fgetKeyNam_s1
     1417!==============================================================================================================================
     1418FUNCTION fgetKeys(keyn, ky, def_val, lerr) RESULT(val)
     1419CHARACTER(LEN=maxlen),        ALLOCATABLE :: val(:)
     1420  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
     1421  TYPE(keys_type),            INTENT(IN)  :: ky(:)
     1422  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: def_val
     1423  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
     1424!------------------------------------------------------------------------------------------------------------------------------
     1425  LOGICAL :: ler(SIZE(ky))
     1426  INTEGER :: it
     1427  val = [(fgetKeyIdx_s1(it, keyn, ky, def_val, ler(it)), it = 1, SIZE(ky))]
     1428  IF(PRESENT(lerr)) lerr = ANY(ler)
     1429END FUNCTION fgetKeys
     1430!==============================================================================================================================
     1431
     1432
     1433!==============================================================================================================================
     1434!========== GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RETURNED VALUE IS THE ERROR CODE        ==============
     1435!==========  The key "keyn" is searched in: 1)           "ky(:)%name" (if given)                                 ==============
     1436!==========                                 2)      "tracers(:)%name"                                            ==============
     1437!==========                                 3) "isotope%keys(:)%name"                                            ==============
     1438!==========  for the tracer[s] "tname[(:)]" (if given) or all the available tracers from the used set otherwise. ==============
     1439!==========  The type of the returned value(s) can be string, integer or real, scalar or vector                  ==============
    11941440!==============================================================================================================================
    11951441LOGICAL FUNCTION getKeyByName_s1(keyn, val, tname, ky) RESULT(lerr)
    1196   !--- Purpose: Get the value of the key named "keyn" for the tracer named "tnam".
    1197   !     * "ky" unspecified: try in "tracers" for "tnam" with phase and tagging suffixes, then in "isotopes" without.
    1198   !     * "ky"   specified: try in "ky"      for "tnam" with phase and tagging suffixes, then without.
    1199   !    The returned error code is always .FALSE.: an empty string is returned when the key hasn't been found.
    12001442  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
    12011443  CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
    12021444  CHARACTER(LEN=*),          INTENT(IN)  :: tname
    12031445  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1446!------------------------------------------------------------------------------------------------------------------------------
    12041447  CHARACTER(LEN=maxlen) :: tnam
    1205   INTEGER, ALLOCATABLE  :: is(:)
    1206   INTEGER :: i, itr
    1207   tnam = delPhase(strHead(tname,'_',.FALSE.))                        !--- Remove tag and phase
    1208   IF(PRESENT(ky)) THEN
    1209     val = fgetKeyByName_s1(tname, keyn, ky, lerr=lerr)               !--- "ky" and "tname"
    1210     IF(val /= '' .OR. lerr)      RETURN
    1211     val = fgetKeyByName_s1(tnam,  keyn, ky, lerr=lerr)               !--- "ky" and "tnam"
     1448  tnam = strHead(delPhase(tname),'_',.TRUE.)                                             !--- Remove phase and tag
     1449  IF(PRESENT(ky)) THEN                                                                   !=== KEY FROM "ky"
     1450               val = fgetKeyNam_s1(tname, keyn, ky,           lerr=lerr)                 !--- "ky" and "tname"
     1451    IF( lerr ) val = fgetKeyNam_s1(tnam,  keyn, ky,           lerr=lerr)                 !--- "ky" and "tnam"
    12121452  ELSE
    1213     IF(.NOT.ALLOCATED(tracers))  RETURN
    1214     val = fgetKeyByName_s1(tname, keyn, tracers(:)%keys, lerr=lerr)  !--- "tracers" and "tname"
    1215     IF(val /= ''.AND..NOT.lerr)  RETURN
    1216     IF(.NOT.ALLOCATED(isotopes)) RETURN
    1217     IF(SIZE(isotopes) == 0)      RETURN
    1218     !--- Search the "is" isotopes class index of the isotope named "tnam"
    1219     is = find([(ANY(isotopes(i)%keys(:)%name == tnam), i=1, SIZE(isotopes))])
    1220     IF(test(SIZE(is) == 0,lerr)) RETURN
    1221     val = fgetKeyByName_s1(tname, keyn, isotopes(is(1))%keys(:),lerr=lerr)!--- "isotopes" and "tnam"
     1453    IF(         .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0    !=== KEY FROM "tracers"
     1454    IF(.NOT.lerr) THEN
     1455               val = fgetKeyNam_s1(tname, keyn, tracers%keys, lerr=lerr)                 !--- "ky" and "tname"
     1456      IF(lerr) val = fgetKeyNam_s1(tnam,  keyn, tracers%keys, lerr=lerr)                 !--- "ky" and "tnam"
     1457    END IF
     1458    IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0    !=== KEY FROM "isotope"
     1459    IF(.NOT.lerr) THEN
     1460               val = fgetKeyNam_s1(tname, keyn, isotope%keys, lerr=lerr)                 !--- "ky" and "tname"
     1461      IF(lerr) val = fgetKeyNam_s1(tnam,  keyn, isotope%keys, lerr=lerr)                 !--- "ky" and "tnam"
     1462    END IF
    12221463  END IF
    12231464END FUNCTION getKeyByName_s1
    12241465!==============================================================================================================================
    1225 LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky) RESULT(lerr)
     1466LOGICAL FUNCTION getKeyByName_s1m(keyn, val, tname, ky) RESULT(lerr)
    12261467  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn
    1227   CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) ::   val(:)
    1228   CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: tname(:)
    1229   TYPE(keys_type),          OPTIONAL, INTENT(IN)  ::    ky(:)
    1230   TYPE(keys_type),           POINTER :: k(:)
    1231   CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
     1468  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
     1469  CHARACTER(LEN=*),                   INTENT(IN)  :: tname
     1470  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
     1471!------------------------------------------------------------------------------------------------------------------------------
     1472  CHARACTER(LEN=maxlen) :: sval
     1473  lerr = getKeyByName_s1(keyn, sval, tname, ky)
     1474  IF(test(fmsg('missing key "'//TRIM(keyn)//'" for tracer "'//TRIM(tname)//'"', modname, lerr), lerr)) RETURN
     1475  lerr = strParse(sval, ',', val)
     1476END FUNCTION getKeyByName_s1m
     1477!==============================================================================================================================
     1478LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky, nam) RESULT(lerr)
     1479  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1480  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: val(:)
     1481  CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
     1482  TYPE(keys_type),       OPTIONAL, TARGET,      INTENT(IN)  :: ky(:)
     1483  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
     1484!------------------------------------------------------------------------------------------------------------------------------
     1485  TYPE(keys_type), POINTER ::  keys(:)
     1486  LOGICAL :: lk, lt, li
    12321487  INTEGER :: iq, nq
    1233   IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
    1234   IF(PRESENT(ky   )) nq = SIZE(ky%name)
    1235   IF(PRESENT(tname)) nq = SIZE(  tname)
     1488
     1489  !--- DETERMINE THE DATABASE TO BE USED (ky, tracers or isotope)
     1490  lk = PRESENT(ky)
     1491  lt = .NOT.lk .AND. ALLOCATED(tracers);  IF(lt) lt = SIZE(tracers)  /= 0; IF(lt) lt = ANY(tracers(1)%keys%key(:) == keyn)
     1492  li = .NOT.lt .AND. ALLOCATED(isotopes); IF(li) li = SIZE(isotopes) /= 0; IF(li) li = ANY(isotope%keys(1)%key(:) == keyn)
     1493
     1494  !--- LINK "keys" TO THE RIGHT DATABASE
     1495  IF(test(.NOT.ANY([lk,lt,li]), lerr)) RETURN
     1496  IF(lk) keys => ky(:)
     1497  IF(lt) keys => tracers(:)%keys
     1498  IF(li) keys => isotope%keys(:)
     1499
     1500  !--- GET THE DATA
     1501  nq = SIZE(tname)
    12361502  ALLOCATE(val(nq))
    1237   IF(PRESENT(tname)) THEN
    1238     IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq),   ky), iq=1, nq)])
    1239     IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq)      ), iq=1, nq)])
    1240   ELSE;                  lerr = ANY([(getKeyByName_s1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
     1503  lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq), keys(:)), iq=1, nq)])
     1504  IF(PRESENT(nam)) nam = tname(:)
     1505
     1506END FUNCTION getKeyByName_sm
     1507!==============================================================================================================================
     1508LOGICAL FUNCTION getKey_sm(keyn, val, ky, nam) RESULT(lerr)
     1509  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1510  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: val(:)
     1511  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  :: ky(:)
     1512  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
     1513!------------------------------------------------------------------------------------------------------------------------------
     1514! Note: if names are repeated, getKeyByName_sm can't be used ; this routine, using indexes, must be used instead.
     1515  IF(PRESENT(ky)) THEN                                                                   !=== KEY FROM "ky"
     1516    val = fgetKeys(keyn, ky, lerr=lerr)
     1517    IF(PRESENT(nam)) nam = ky(:)%name
     1518  ELSE
     1519    IF(         .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0    !=== KEY FROM "tracers"
     1520    IF(.NOT.lerr) val = fgetKeys(keyn, tracers%keys, lerr=lerr)
     1521    IF(.NOT.lerr.AND.PRESENT(nam)) nam = tracers(:)%keys%name
     1522    IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0    !=== KEY FROM "isotope"
     1523    IF(.NOT.lerr) val = fgetKeys(keyn, isotope%keys, lerr=lerr)
     1524    IF(.NOT.lerr.AND.PRESENT(nam)) nam = isotope%keys(:)%name
    12411525  END IF
    1242 END FUNCTION getKeyByName_sm
     1526END FUNCTION getKey_sm
    12431527!==============================================================================================================================
    12441528LOGICAL FUNCTION getKeyByName_i1(keyn, val, tname, ky) RESULT(lerr)
    … …  
    12471531  CHARACTER(LEN=*),          INTENT(IN)  :: tname
    12481532  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1533!------------------------------------------------------------------------------------------------------------------------------
    12491534  CHARACTER(LEN=maxlen) :: sval
    12501535  INTEGER :: ierr
    1251   IF(     PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname, ky)
    1252   IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname)
    1253   IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing',        modname, lerr), lerr)) RETURN
     1536  lerr = getKeyByName_s1(keyn, sval, tname, ky)
     1537  IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
    12541538  READ(sval, *, IOSTAT=ierr) val
     1539  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, ierr/=0), lerr)) RETURN
     1540END FUNCTION getKeyByName_i1
     1541!==============================================================================================================================
     1542LOGICAL FUNCTION getKeyByName_i1m(keyn, val, tname, ky) RESULT(lerr)
     1543  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
     1544  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
     1545  CHARACTER(LEN=*),          INTENT(IN)  :: tname
     1546  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::  ky(:)
     1547!------------------------------------------------------------------------------------------------------------------------------
     1548  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
     1549  INTEGER :: ierr, iq, nq
     1550  IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
     1551  nq = SIZE(sval); ALLOCATE(val(nq))
     1552  lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
    12551553  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, lerr), lerr)) RETURN
    1256 END FUNCTION getKeyByName_i1
    1257 !==============================================================================================================================
    1258 LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky) RESULT(lerr)
    1259   CHARACTER(LEN=*),           INTENT(IN)  :: keyn
    1260   INTEGER,       ALLOCATABLE, INTENT(OUT) ::   val(:)
    1261   CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: tname(:)
    1262   TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::    ky(:)
    1263   TYPE(keys_type),           POINTER :: k(:)
    1264   CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
    1265   INTEGER :: iq, nq
    1266   IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
    1267   IF(PRESENT(ky   )) nq = SIZE(ky%name)
    1268   IF(PRESENT(tname)) nq = SIZE(  tname)
    1269   ALLOCATE(val(nq))
    1270   IF(PRESENT(tname)) THEN
    1271     IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), tname(iq),   ky), iq=1, nq)])
    1272     IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), tname(iq)      ), iq=1, nq)])
    1273   ELSE;                  lerr = ANY([(getKeyByName_i1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
    1274   END IF
     1554END FUNCTION getKeyByName_i1m
     1555!==============================================================================================================================
     1556LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky, nam) RESULT(lerr)
     1557  CHARACTER(LEN=*),                             INTENT(IN)  ::  keyn
     1558  INTEGER,                         ALLOCATABLE, INTENT(OUT) ::   val(:)
     1559  CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
     1560  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::    ky(:)
     1561  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::   nam(:)
     1562!------------------------------------------------------------------------------------------------------------------------------
     1563  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
     1564  INTEGER :: ierr, iq, nq
     1565  IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN
     1566  nq = SIZE(sval); ALLOCATE(val(nq))
     1567  DO iq = 1, nq                                                      !--- CONVERT THE KEYS TO INTEGERS
     1568    READ(sval(iq), *, IOSTAT=ierr) val(iq)
     1569    IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
     1570  END DO
     1571  IF(PRESENT(nam)) nam = names(:)
    12751572END FUNCTION getKeyByName_im
     1573!==============================================================================================================================
     1574LOGICAL FUNCTION getKey_im(keyn, val, ky, nam) RESULT(lerr)
     1575  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1576  INTEGER,                         ALLOCATABLE, INTENT(OUT) ::  val(:)
     1577  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
     1578  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
     1579!------------------------------------------------------------------------------------------------------------------------------
     1580  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
     1581  INTEGER :: ierr, iq, nq
     1582  IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN
     1583  nq = SIZE(sval); ALLOCATE(val(nq))
     1584  DO iq = 1, nq
     1585    READ(sval(iq), *, IOSTAT=ierr) val(iq)
     1586    IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
     1587  END DO
     1588  IF(PRESENT(nam)) nam = names
     1589END FUNCTION getKey_im
    12761590!==============================================================================================================================
    12771591LOGICAL FUNCTION getKeyByName_r1(keyn, val, tname, ky) RESULT(lerr)
    … …  
    12801594  CHARACTER(LEN=*),          INTENT(IN)  :: tname
    12811595  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1596!------------------------------------------------------------------------------------------------------------------------------
    12821597  CHARACTER(LEN=maxlen) :: sval
    12831598  INTEGER :: ierr
    1284   IF(     PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname, ky)
    1285   IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname)
     1599  lerr = getKeyByName_s1(keyn, sval, tname, ky)
    12861600  IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing',    modname, lerr), lerr)) RETURN
    12871601  READ(sval, *, IOSTAT=ierr) val
    1288   IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, lerr), lerr)) RETURN
     1602  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, ierr/=0), lerr)) RETURN
    12891603END FUNCTION getKeyByName_r1
    12901604!==============================================================================================================================
    1291 LOGICAL FUNCTION getKeyByName_rm(keyn, val, tname, ky) RESULT(lerr)
     1605LOGICAL FUNCTION getKeyByName_r1m(keyn, val, tname, ky) RESULT(lerr)
    12921606  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
    1293   REAL,          ALLOCATABLE, INTENT(OUT) ::   val(:)
    1294   CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: tname(:)
    1295   TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::    ky(:)
    1296   TYPE(keys_type),           POINTER :: k(:)
    1297   CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
     1607  REAL,          ALLOCATABLE, INTENT(OUT) :: val(:)
     1608  CHARACTER(LEN=*),           INTENT(IN)  :: tname
     1609  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::  ky(:)
     1610!------------------------------------------------------------------------------------------------------------------------------
     1611  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
     1612  INTEGER :: ierr, iq, nq
     1613  IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
     1614  nq = SIZE(sval); ALLOCATE(val(nq))
     1615  lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
     1616  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a vector of reals', modname, lerr), lerr)) RETURN
     1617END FUNCTION getKeyByName_r1m
     1618!==============================================================================================================================
     1619LOGICAL FUNCTION getKeyByName_rm(keyn, val, tname, ky, nam) RESULT(lerr)
     1620  CHARACTER(LEN=*),                             INTENT(IN)  ::  keyn
     1621  REAL,                            ALLOCATABLE, INTENT(OUT) ::   val(:)
     1622  CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
     1623  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::    ky(:)
     1624  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::   nam(:)
     1625!------------------------------------------------------------------------------------------------------------------------------
     1626  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
     1627  INTEGER :: ierr, iq, nq
     1628  IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN
     1629  nq = SIZE(sval); ALLOCATE(val(nq))
     1630  DO iq = 1, nq                                                      !--- CONVERT THE KEYS TO INTEGERS
     1631    READ(sval(iq), *, IOSTAT=ierr) val(iq)
     1632    IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
     1633  END DO
     1634  IF(PRESENT(nam)) nam = names
     1635END FUNCTION getKeyByName_rm
     1636!==============================================================================================================================
     1637LOGICAL FUNCTION getKey_rm(keyn, val, ky, nam) RESULT(lerr)
     1638  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1639  REAL,                            ALLOCATABLE, INTENT(OUT) ::  val(:)
     1640  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
     1641  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
     1642!------------------------------------------------------------------------------------------------------------------------------
     1643  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
     1644  INTEGER :: ierr, iq, nq
     1645  IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN
     1646  nq = SIZE(sval); ALLOCATE(val(nq))
     1647  DO iq = 1, nq                                                      !--- CONVERT THE KEYS TO INTEGERS
     1648    READ(sval(iq), *, IOSTAT=ierr) val(iq)
     1649    IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
     1650  END DO
     1651  IF(PRESENT(nam)) nam = names
     1652END FUNCTION getKey_rm
     1653!==============================================================================================================================
     1654LOGICAL FUNCTION getKeyByName_l1(keyn, val, tname, ky) RESULT(lerr)
     1655  USE strings_mod, ONLY: str2bool
     1656  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
     1657  LOGICAL,                   INTENT(OUT) :: val
     1658  CHARACTER(LEN=*),          INTENT(IN)  :: tname
     1659  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1660!------------------------------------------------------------------------------------------------------------------------------
     1661  CHARACTER(LEN=maxlen) :: sval
     1662  lerr = getKeyByName_s1(keyn, sval, tname, ky)
     1663  IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
     1664  val = str2bool(sval)
     1665END FUNCTION getKeyByName_l1
     1666!==============================================================================================================================
     1667LOGICAL FUNCTION getKeyByName_l1m(keyn, val, tname, ky) RESULT(lerr)
     1668  USE strings_mod, ONLY: str2bool
     1669  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
     1670  LOGICAL,       ALLOCATABLE, INTENT(OUT) :: val(:)
     1671  CHARACTER(LEN=*),           INTENT(IN)  :: tname
     1672  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::  ky(:)
     1673!------------------------------------------------------------------------------------------------------------------------------
     1674  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
    12981675  INTEGER :: iq, nq
    1299   IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
    1300   IF(PRESENT(ky   )) nq = SIZE(ky%name)
    1301   IF(PRESENT(tname)) nq = SIZE(  tname)
    1302   ALLOCATE(val(nq))
    1303   IF(PRESENT(tname)) THEN
    1304     IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), tname(iq),   ky), iq=1, nq)])
    1305     IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), tname(iq)      ), iq=1, nq)])
    1306   ELSE;                  lerr = ANY([(getKeyByName_r1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
     1676  IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
     1677  nq = SIZE(sval); ALLOCATE(val(nq))
     1678  lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
     1679END FUNCTION getKeyByName_l1m
     1680!==============================================================================================================================
     1681LOGICAL FUNCTION getKeyByName_lm(keyn, val, tname, ky, nam) RESULT(lerr)
     1682  USE strings_mod, ONLY: str2bool
     1683  CHARACTER(LEN=*),                             INTENT(IN)  ::  keyn
     1684  LOGICAL,                         ALLOCATABLE, INTENT(OUT) ::   val(:)
     1685  CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
     1686  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::    ky(:)
     1687  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::   nam(:)
     1688!------------------------------------------------------------------------------------------------------------------------------
     1689  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
     1690  INTEGER :: iq, nq
     1691  IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN
     1692  nq = SIZE(sval); ALLOCATE(val(nq))
     1693  lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
     1694END FUNCTION getKeyByName_lm
     1695!==============================================================================================================================
     1696LOGICAL FUNCTION getKey_lm(keyn, val, ky, nam) RESULT(lerr)
     1697  USE strings_mod, ONLY: str2bool
     1698  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1699  LOGICAL,                         ALLOCATABLE, INTENT(OUT) ::  val(:)
     1700  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
     1701  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
     1702!------------------------------------------------------------------------------------------------------------------------------
     1703  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
     1704  INTEGER :: iq, nq
     1705  IF(test(getKey_sm(keyn, sval, ky, nam), lerr)) RETURN
     1706  nq = SIZE(sval); ALLOCATE(val(nq))
     1707  lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
     1708END FUNCTION getKey_lm
     1709!==============================================================================================================================
     1710
     1711
     1712!==============================================================================================================================
     1713!=== ROUTINES TO GET OR PUT TRACERS AND ISOTOPES DATABASES, SINCE tracers AND isotopes ARE PRIVATE VARIABLES ==================
     1714!==============================================================================================================================
     1715SUBROUTINE setKeysDBase(tracers_, isotopes_, isotope_)
     1716  TYPE(trac_type), OPTIONAL, INTENT(IN) ::  tracers_(:)
     1717  TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
     1718  TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotope_
     1719!------------------------------------------------------------------------------------------------------------------------------
     1720  TYPE(isot_type), ALLOCATABLE :: iso(:)
     1721  INTEGER :: ix, nbIso
     1722  IF(PRESENT( tracers_)) THEN;  tracers =  tracers_; ELSE; ALLOCATE( tracers(0)); END IF
     1723  IF(PRESENT(isotopes_)) THEN; isotopes = isotopes_; ELSE; ALLOCATE(isotopes(0)); END IF
     1724  IF(PRESENT(isotope_ )) THEN
     1725    ix = strIdx(isotopes(:)%parent, isotope_%parent)
     1726    IF(ix /= 0) THEN
     1727      isotopes(ix) = isotope_
     1728    ELSE
     1729      nbIso = SIZE(isotopes); ALLOCATE(iso(nbIso+1)); iso(1:nbIso) = isotopes; iso(nbIso+1) = isotope_
     1730      CALL MOVE_ALLOC(FROM=iso, TO=isotopes)
     1731    END IF
    13071732  END IF
    1308 END FUNCTION getKeyByName_rm
     1733END SUBROUTINE setKeysDBase
     1734!==============================================================================================================================
     1735SUBROUTINE getKeysDBase(tracers_, isotopes_, isotope_)
     1736  TYPE(trac_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  tracers_(:)
     1737  TYPE(isot_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: isotopes_(:)
     1738  TYPE(isot_type), OPTIONAL,              INTENT(OUT) :: isotope_
     1739!------------------------------------------------------------------------------------------------------------------------------
     1740  INTEGER :: ix
     1741  IF(PRESENT( tracers_)) THEN;  tracers_ =  tracers; ELSE; ALLOCATE( tracers_(0)); END IF
     1742  IF(PRESENT(isotopes_)) THEN; isotopes_ = isotopes; ELSE; ALLOCATE(isotopes_(0)); END IF
     1743  IF(PRESENT(isotope_ )) THEN; ix = strIdx(isotopes(:)%parent, isotope%parent); IF(ix /= 0) isotope_=isotopes(ix); END IF
     1744END SUBROUTINE getKeysDBase
    13091745!==============================================================================================================================
    13101746
    … …  
    13151751ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION delPhase(s) RESULT(out)
    13161752  CHARACTER(LEN=*), INTENT(IN) :: s
    1317   INTEGER :: l, i, ix
    1318   CHARACTER(LEN=maxlen) :: sh, st
    1319   out = s
    1320   IF(s == '') RETURN                                                           !--- Empty string: nothing to do
    1321 
    1322   !--- Special case: old phases for water, no phases separator
    1323   i = INDEX(s,'_'); sh = s; IF(i/=0) sh=s(1:i-1); st='H2O'; IF(i/=0) st='H2O_'//s(i+1:LEN_TRIM(s))
    1324   IF(ANY([('H2O'//old_phases(ix:ix), ix=1, nphases)] == sh)) THEN; out=st; RETURN; END IF
    1325 
    1326   !--- Index of found phase in "known_phases"
    1327   ix = MAXLOC( [(i, i=1,nphases)], MASK=[( INDEX(s, phases_sep//known_phases(i:i))/=0, i=1, nphases)], DIM=1 )
    1328   IF(ix == 0) RETURN                                                           !--- No phase pattern found
    1329   i = INDEX(s, phases_sep//known_phases(ix:ix))                                !--- Index of <sep><pha> pattern in "str"
    1330   l = LEN_TRIM(s)
    1331   IF(i == l-1) THEN                                                            !--- <var><sep><pha>       => return <var>
    1332     out = s(1:l-2)
    1333   ELSE IF(s(i+2:i+2) == '_') THEN                                              !--- <var><sep><pha>_<tag> => return <var>_<tag>
    1334     out = s(1:i-1)//s(i+2:l)
     1753!------------------------------------------------------------------------------------------------------------------------------
     1754  INTEGER :: ix, ip, ns
     1755  out = s; ns = LEN_TRIM(s)
     1756  IF(s == '' .OR. ns<=2) RETURN                                                !--- Empty string or LEN(name)<=2: nothing to do
     1757  IF(s(1:3)=='H2O' .AND. INDEX(old_phases,s(4:4))/=0 .AND. (ns==4 .OR. s(5:5)=='_')) THEN
     1758    out='H2O'//s(5:ns)                                                         !--- H2O<phase>[_<iso>][_<tag>]
     1759  ELSE IF(s(ns-1:ns-1)==phases_sep .AND. INDEX(known_phases,s(ns:ns))/=0) THEN
     1760    out = s(1:ns-2); RETURN                                                    !--- <var><phase_sep><phase>
     1761  ELSE; DO ip = 1, nphases; ix = INDEX(s, phases_sep//known_phases(ip:ip)//'_'); IF(ix /= 0) EXIT; END DO
     1762    IF(ip /= nphases+1) out = s(1:ix-1)//s(ix+2:ns)                            !--- <var><phase_sep><phase>_<tag>
    13351763  END IF
    13361764END FUNCTION delPhase
    1337 !------------------------------------------------------------------------------------------------------------------------------
     1765!==============================================================================================================================
    13381766CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha) RESULT(out)
    13391767  CHARACTER(LEN=*),           INTENT(IN) :: s
    13401768  CHARACTER(LEN=1),           INTENT(IN) :: pha
     1769!------------------------------------------------------------------------------------------------------------------------------
    13411770  INTEGER :: l, i
    13421771  out = s
    … …  
    13471776  IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l)                    !--- <var>_<tag> => return <var><sep><pha>_<tag>
    13481777END FUNCTION addPhase_s1
    1349 !------------------------------------------------------------------------------------------------------------------------------
     1778!==============================================================================================================================
    13501779FUNCTION addPhase_sm(s,pha) RESULT(out)
    13511780  CHARACTER(LEN=*),           INTENT(IN) :: s(:)
    13521781  CHARACTER(LEN=1),           INTENT(IN) :: pha
    13531782  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
     1783!------------------------------------------------------------------------------------------------------------------------------
    13541784  INTEGER :: k
    13551785  out = [( addPhase_s1(s(k), pha), k=1, SIZE(s) )]
    13561786END FUNCTION addPhase_sm
    1357 !------------------------------------------------------------------------------------------------------------------------------
     1787!==============================================================================================================================
    13581788CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,phases) RESULT(out)
    13591789  CHARACTER(LEN=*),           INTENT(IN) :: s
    13601790  INTEGER,                    INTENT(IN) :: ipha
    13611791  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
     1792!------------------------------------------------------------------------------------------------------------------------------
    13621793  out = s
    13631794  IF(s == '') RETURN                                                           !--- Empty string: nothing to do
    1364   IF(ipha==0) RETURN                                                           !--- Null index: no phase to add
     1795  IF(ipha == 0 .OR. ipha > nphases) RETURN                                     !--- Absurd index: no phase to add
    13651796  IF(     PRESENT(phases)) out = addPhase_s1(s,       phases(ipha:ipha))
    13661797  IF(.NOT.PRESENT(phases)) out = addPhase_s1(s, known_phases(ipha:ipha))
    13671798END FUNCTION addPhase_i1
    1368 !------------------------------------------------------------------------------------------------------------------------------
     1799!==============================================================================================================================
    13691800FUNCTION addPhase_im(s,ipha,phases) RESULT(out)
    13701801  CHARACTER(LEN=*),           INTENT(IN) :: s(:)
    … …  
    13721803  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
    13731804  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
     1805!------------------------------------------------------------------------------------------------------------------------------
    13741806  INTEGER :: k
    13751807  IF(     PRESENT(phases)) out = [( addPhase_i1(s(k), ipha,       phases), k=1, SIZE(s) )]
    13761808  IF(.NOT.PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, known_phases), k=1, SIZE(s) )]
    13771809END FUNCTION addPhase_im
    1378 !------------------------------------------------------------------------------------------------------------------------------
     1810!==============================================================================================================================
    13791811
    13801812
    … …  
    13851817  CHARACTER(LEN=*),           INTENT(IN)  :: tname
    13861818  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: phases
     1819!------------------------------------------------------------------------------------------------------------------------------
    13871820  CHARACTER(LEN=maxlen) :: phase
    13881821  IF(     PRESENT(phases)) phase = getPhase(tname,       phases, iPhase)
    13891822  IF(.NOT.PRESENT(phases)) phase = getPhase(tname, known_phases, iPhase)
    13901823END FUNCTION getiPhase
    1391 !------------------------------------------------------------------------------------------------------------------------------
     1824!==============================================================================================================================
    13921825CHARACTER(LEN=1) FUNCTION getPhase(tname, phases, iPhase) RESULT(phase)
    13931826  CHARACTER(LEN=*),           INTENT(IN)  :: tname
    13941827  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: phases
    13951828  INTEGER,          OPTIONAL, INTENT(OUT) :: iPhase
     1829!------------------------------------------------------------------------------------------------------------------------------
    13961830  INTEGER :: ip
    1397   phase = TRIM(strHead(strTail(tname, phases_sep, .TRUE.), '_', .TRUE.))
     1831  phase = TRIM(strHead(strTail(tname, phases_sep), '_', .TRUE.))     !--- <nam><sep><pha>[_<tag>] -> <pha>[_<tag>] -> <pha>
    13981832  IF(     PRESENT(phases)) ip = INDEX(      phases, phase)
    13991833  IF(.NOT.PRESENT(phases)) ip = INDEX(known_phases, phase)
    … …  
    14011835  IF(PRESENT(iPhase)) iPhase = ip
    14021836END FUNCTION getPhase
    1403 !------------------------------------------------------------------------------------------------------------------------------
    1404 
    1405 
    1406 !------------------------------------------------------------------------------------------------------------------------------
    1407 CHARACTER(LEN=maxlen) FUNCTION old2newName_1(oldName, iPhase) RESULT(newName)
    1408   !--- Convert an old style name into a new one.
    1409   !    Only usable with old style "traceur.def" files, in which only water isotopes are allowed.
    1410   !    In these files, H2O descendants names are: H2O<phase>[_<isotope>][_<tag>], with:
    1411   !    phase = v, l or i ; isotope = eau, HDO, O18, O17 or HTO.
     1837!==============================================================================================================================
     1838
     1839
     1840!==============================================================================================================================
     1841!============ CONVERT WATER-DERIVED NAMES FROM FORMER TO CURRENT CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
     1842!======= NAMES STRUCTURE: H2O[<phase>][_<isotope>][_<tag>] (<phase> from "old_phases", <isotope> from "oldH2OIso") ============
     1843!==============================================================================================================================
     1844CHARACTER(LEN=maxlen) FUNCTION old2newH2O_1(oldName, iPhase) RESULT(newName)
    14121845  CHARACTER(LEN=*),  INTENT(IN)  :: oldName
    14131846  INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
     1847!------------------------------------------------------------------------------------------------------------------------------
    14141848  CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)
    1415   INTEGER :: ix, ip, it, nt
    1416   LOGICAL :: lerr, lH2O
     1849  INTEGER :: ix, ip, nt
     1850  LOGICAL :: lerr
    14171851  newName = oldName
    14181852  IF(PRESENT(iPhase)) iPhase = 1                                               !--- Default: gaseous phase
    1419   lH2O=.FALSE.
    1420   IF(LEN_TRIM(oldName) > 3) THEN
    1421     lH2O = oldName(1:3)=='H2O' .AND. INDEX(old_phases,oldName(4:4))/=0         !--- H2O<phase>*,  with phase=="v", "l", "i" or "r"
    1422     IF(LEN_TRIM(oldName) > 4) lH2O = lH2O .AND. oldName(5:5) == '_'            !--- H2O<phase>_*, with phase=="v", "l", "i" or "r"
     1853  lerr = strParse(oldName, '_', tmp, nt)                                       !--- Parsing: 1 up to 3 elements.
     1854  ip = strIdx( [('H2O'//old_phases(ix:ix), ix=1, nphases)], tmp(1) )           !--- Phase index
     1855  IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip                                !--- Returning phase index
     1856  IF(ip == 0 .AND. tmp(1) /= 'H2O')   RETURN                                   !--- Not an old-style water-related species
     1857  IF(nt == 1) THEN
     1858    newName = addPhase('H2O',ip)                                               !=== WATER WITH OR WITHOUT PHASE
     1859  ELSE
     1860    ix = strIdx(oldH2OIso, tmp(2))                                             !--- Index in the known isotopes list
     1861    IF(ix /= 0) newName = newH2OIso(ix)                                        !--- Move to new isotope name
     1862    IF(ip /= 0) newName = addPhase(newName, ip)                                !--- Add phase to isotope name
     1863    IF(nt == 3) newName = TRIM(newName)//'_'//TRIM(tmp(3))                     !=== WATER ISOTOPE OR TAGGING TRACER
    14231864  END IF
    1424   IF(.NOT.lH2O) RETURN
    1425   IF(LEN_TRIM(oldName)>3) THEN; IF(INDEX(old_Phases,oldName(4:4))==0) RETURN; END IF
    1426   lerr = strParse(oldName, '_', tmp, n=nt)
    1427   ip = strIdx([('H2O'//old_phases(ip:ip), ip=1, nphases)], tmp(1))             !--- Phase index (/=0 if any)
    1428   IF(PRESENT(iPhase)) iPhase = ip
    1429   newName = addPhase('H2O', ip)                                                !--- Water
    1430   IF(nt == 1) RETURN                                                           !--- Water: finished
    1431   ix = strIdx(oldH2OIso, tmp(2))                                               !--- Index in the known isotopes list
    1432   IF(ix == 0) newName = addPhase(tmp(2),        ip)                            !--- Not an isotope
    1433   IF(ix /= 0) newName = addPhase(newH2OIso(ix), ip)                            !--- Isotope
    1434   IF(nt == 3) newName = TRIM(newName)//'_'//TRIM(tmp(3))                       !--- Tagging tracer
    1435 END FUNCTION old2newName_1
    1436 !------------------------------------------------------------------------------------------------------------------------------
    1437 FUNCTION old2newName_m(oldName, iPhase) RESULT(newName)
    1438   CHARACTER(LEN=*),  INTENT(IN)  :: oldName(:)
     1865END FUNCTION old2newH2O_1
     1866!==============================================================================================================================
     1867FUNCTION old2newH2O_m(oldName) RESULT(newName)
     1868  CHARACTER(LEN=*), INTENT(IN) :: oldName(:)
     1869  CHARACTER(LEN=maxlen)        :: newName(SIZE(oldName))
     1870!------------------------------------------------------------------------------------------------------------------------------
     1871  INTEGER :: i
     1872  newName = [(old2newH2O_1(oldName(i)), i=1, SIZE(oldName))]
     1873END FUNCTION old2newH2O_m
     1874!==============================================================================================================================
     1875
     1876
     1877!==============================================================================================================================
     1878!============ CONVERT WATER-DERIVED NAMES FROM CURRENT TO FORMER CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
     1879!==== NAMES STRUCTURE: <var>[<phase_sep><phase>][_<tag>] (<phase> from "known_phases", <var> = 'H2O' or from "newH2OIso") =====
     1880!==============================================================================================================================
     1881CHARACTER(LEN=maxlen) FUNCTION new2oldH2O_1(newName, iPhase) RESULT(oldName)
     1882  CHARACTER(LEN=*),  INTENT(IN)  :: newName
    14391883  INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
    1440   CHARACTER(LEN=maxlen)          :: newName(SIZE(oldName))
     1884!------------------------------------------------------------------------------------------------------------------------------
     1885  INTEGER :: ix, ip
     1886  CHARACTER(LEN=maxlen) :: var
     1887  oldName = newName
     1888  ip = getiPhase(newName)                                                      !--- Phase index
     1889  IF(PRESENT(iPhase)) iPhase = MAX(ip, 1)                                      !--- Return phase index ; default: 1 (gazeous)
     1890  var = TRIM(strHead(newName, phases_sep, .TRUE.))                             !--- Variable without phase and tag
     1891  ix = strIdx(newH2OIso, var)                                                  !--- Index in the known H2O isotopes list
     1892  IF(ix == 0 .AND. var /= 'H2O') RETURN                                        !--- Neither H2O nor an H2O isotope => finished
     1893  oldName = 'H2O'
     1894  IF(ip /= 0) oldName = TRIM(oldName)//old_phases(ip:ip)                       !--- Add phase if needed
     1895  IF(ix /= 0) oldName = TRIM(oldName)//'_'//oldH2OIso(ix)                      !--- H2O isotope name
     1896  IF(newName /= addPhase(var, ip)) &
     1897    oldName = TRIM(oldName)//strTail(newName, '_', .TRUE.)                     !--- Add the tag suffix
     1898  IF(ip == 0 .AND. ix /= 0) oldName = strTail(oldName, '_')                    !--- Isotope with no phase: remove 'H2O_' prefix
     1899END FUNCTION new2oldH2O_1
     1900!==============================================================================================================================
     1901FUNCTION new2oldH2O_m(newName) RESULT(oldName)
     1902  CHARACTER(LEN=*), INTENT(IN) :: newName(:)
     1903  CHARACTER(LEN=maxlen)        :: oldName(SIZE(newName))
     1904!------------------------------------------------------------------------------------------------------------------------------
    14411905  INTEGER :: i
    1442   newName = [(old2newName_1(oldName(i), iPhase), i=1, SIZE(oldName))]
    1443 END FUNCTION old2newName_m
    1444 !------------------------------------------------------------------------------------------------------------------------------
    1445 
    1446 !------------------------------------------------------------------------------------------------------------------------------
    1447 CHARACTER(LEN=maxlen) FUNCTION new2oldName_1(newName, iPhase) RESULT(oldName)
    1448   !--- Convert a new style name into an old one.
    1449   !    Only convertable names are water descendants names H2O_<phase>, <isotope>_<phase>, <isotope>_<phase>_<tag>, with:
    1450   !    phase = g, l or s ; isotope = H2[16]O, H[2]O, H2<[18]O, H2[17]O or H[3]O.
    1451   CHARACTER(LEN=*),  INTENT(IN)    :: newName
    1452   INTEGER, OPTIONAL, INTENT(OUT)   :: iPhase
    1453   INTEGER :: ix, ip, it, nt
    1454   LOGICAL :: lH2O
    1455   CHARACTER(LEN=maxlen) :: tag
    1456   ix = strIdx([(addPhase('H2O',ip), ip=1, nphases)], newName)                  !--- Phase index for H2O_<phase>
    1457   IF(ix /= 0) THEN; oldName = 'H2O'//old_phases(ix:ix); RETURN; END IF         !--- H2O_<phase> case
    1458   ix = strIdx(newH2OIso, strHead(newName, phases_sep, .TRUE.))                 !--- Isotope index
    1459   IF(ix == 0) THEN; oldName = newName;                  RETURN; END IF         !--- Not a water descendant
    1460   ip = getiPhase(newName)                                                      !--- Phase index
    1461   oldName = TRIM(oldH2OIso(ix))//old_phases(ip:ip)                             !--- <isotope>_<phase>
    1462   tag = strTail(delPhase(newName), TRIM(newH2OIso(ix)))                        !--- Get "_<tag>" if any
    1463   IF(tag /= delPhase(newName) .AND. tag /= '') oldName = TRIM(oldName)//tag    !--- Tagging tracer
    1464 END FUNCTION new2oldName_1
    1465 !------------------------------------------------------------------------------------------------------------------------------
    1466 FUNCTION new2oldName_m(newName, iPhase) RESULT(oldName)
    1467   CHARACTER(LEN=*),  INTENT(IN)  :: newName(:)
    1468   INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
    1469   CHARACTER(LEN=maxlen)          :: oldName(SIZE(newName))
    1470   INTEGER :: i
    1471   oldName = [(new2oldName_1(newName(i), iPhase), i=1, SIZE(newName))]
    1472 END FUNCTION new2oldName_m
    1473 !------------------------------------------------------------------------------------------------------------------------------
     1906  oldName = [(new2oldH2O_1(newName(i)), i=1, SIZE(newName))]
     1907END FUNCTION new2oldH2O_m
     1908!==============================================================================================================================
    14741909
    14751910
    … …  
    14771912!=== GET THE NAME(S) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen"  IN THE TRACERS DESCRIPTORS LIST "tr" =======
    14781913!==============================================================================================================================
    1479 CHARACTER(LEN=maxlen) FUNCTION ancestor_1(t, tname, igen) RESULT(out)
    1480   TYPE(trac_type),   INTENT(IN) :: t(:)
    1481   CHARACTER(LEN=*),  INTENT(IN) :: tname
    1482   INTEGER, OPTIONAL, INTENT(IN) :: igen
    1483   INTEGER :: ig, ix
    1484   ig = 0; IF(PRESENT(igen)) ig = igen
    1485   ix = idxAncestor_1(t, tname, ig)
     1914SUBROUTINE ancestor_1(t, out, tname, igen)
     1915  TYPE(trac_type),       INTENT(IN)  :: t(:)
     1916  CHARACTER(LEN=maxlen), INTENT(OUT) :: out
     1917  CHARACTER(LEN=*),      INTENT(IN)  :: tname
     1918  INTEGER,     OPTIONAL, INTENT(IN)  :: igen
     1919!------------------------------------------------------------------------------------------------------------------------------
     1920  INTEGER :: ix
     1921  CALL idxAncestor_1(t, ix, tname, igen)
    14861922  out = ''; IF(ix /= 0) out = t(ix)%name
    1487 END FUNCTION ancestor_1
    1488 !------------------------------------------------------------------------------------------------------------------------------
    1489 FUNCTION ancestor_m(t, tname, igen) RESULT(out)
    1490   CHARACTER(LEN=maxlen), ALLOCATABLE     ::   out(:)
    1491   TYPE(trac_type),            INTENT(IN) ::     t(:)
    1492   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
    1493   INTEGER,          OPTIONAL, INTENT(IN) :: igen
    1494   INTEGER, ALLOCATABLE :: ix(:)
     1923END SUBROUTINE ancestor_1
     1924!==============================================================================================================================
     1925SUBROUTINE ancestor_mt(t, out, tname, igen)
     1926  TYPE(trac_type),       INTENT(IN)  :: t(:)
     1927  CHARACTER(LEN=*),      INTENT(IN)  :: tname(:)
     1928  CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(tname))
     1929  INTEGER,     OPTIONAL, INTENT(IN)  :: igen
     1930!------------------------------------------------------------------------------------------------------------------------------
     1931  INTEGER :: ix(SIZE(tname))
     1932  CALL idxAncestor_mt(t, ix, tname, igen)
     1933  out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
     1934END SUBROUTINE ancestor_mt
     1935!==============================================================================================================================
     1936SUBROUTINE ancestor_m(t, out, igen)
     1937  TYPE(trac_type),       INTENT(IN)  :: t(:)
     1938  CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(t))
     1939  INTEGER,     OPTIONAL, INTENT(IN)  :: igen
     1940!------------------------------------------------------------------------------------------------------------------------------
     1941  INTEGER :: ix(SIZE(t))
     1942  CALL idxAncestor_m(t, ix, igen)
     1943  out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
     1944END SUBROUTINE ancestor_m
     1945!==============================================================================================================================
     1946
     1947
     1948!==============================================================================================================================
     1949!=== GET THE INDEX(ES) OF THE GENERATION "igen" ANCESTOR(S) OF "tname" (t%name IF UNSPECIFIED) IN THE "t" LIST ================
     1950!==============================================================================================================================
     1951SUBROUTINE idxAncestor_1(t, idx, tname, igen)
     1952  TYPE(trac_type),   INTENT(IN)  :: t(:)
     1953  INTEGER,           INTENT(OUT) :: idx
     1954  CHARACTER(LEN=*),  INTENT(IN)  :: tname
     1955  INTEGER, OPTIONAL, INTENT(IN)  :: igen
    14951956  INTEGER :: ig
    14961957  ig = 0; IF(PRESENT(igen)) ig = igen
    1497   IF(     PRESENT(tname)) ix = idxAncestor_m(t, tname,     ig)
    1498   IF(.NOT.PRESENT(tname)) ix = idxAncestor_m(t, t(:)%name, ig)
    1499   ALLOCATE(out(SIZE(ix))); out(:) = ''
    1500   WHERE(ix /= 0) out = t(ix)%name
    1501 END FUNCTION ancestor_m
    1502 !==============================================================================================================================
    1503 
    1504 
    1505 !==============================================================================================================================
    1506 !=== GET THE INDEX(ES) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen"  IN THE TRACERS DESCRIPTORS LIST "tr" =====
    1507 !==============================================================================================================================
    1508 INTEGER FUNCTION idxAncestor_1(t, tname, igen) RESULT(out)
    1509 ! Return the name of the generation "igen" (>=0) ancestor of "tname"
    1510   TYPE(trac_type),   INTENT(IN) :: t(:)
    1511   CHARACTER(LEN=*),  INTENT(IN) :: tname
    1512   INTEGER, OPTIONAL, INTENT(IN) :: igen
    1513   INTEGER :: ig
    1514   ig = 0; IF(PRESENT(igen)) ig = igen
    1515   out = strIdx(t(:)%name, tname)
    1516   IF(out == 0)                 RETURN            !--- Tracer not found
    1517   IF(t(out)%iGeneration <= ig) RETURN            !--- Tracer has a lower generation number than asked generation 'igen"
    1518   DO WHILE(t(out)%iGeneration > ig); out = strIdx(t(:)%name, t(out)%parent); END DO
    1519 END FUNCTION idxAncestor_1
    1520 !------------------------------------------------------------------------------------------------------------------------------
    1521 FUNCTION idxAncestor_m(t, tname, igen) RESULT(out)
    1522   INTEGER,          ALLOCATABLE          ::   out(:)
    1523   TYPE(trac_type),            INTENT(IN) ::     t(:)
    1524   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
    1525   INTEGER,          OPTIONAL, INTENT(IN) :: igen
    1526   INTEGER :: ig, ix
    1527   ig = 0; IF(PRESENT(igen)) ig = igen
    1528   IF(     PRESENT(tname)) out = [(idxAncestor_1(t, tname(ix),  ig), ix=1, SIZE(tname))]
    1529   IF(.NOT.PRESENT(tname)) out = [(idxAncestor_1(t, t(ix)%name, ig), ix=1, SIZE(t))]
    1530 END FUNCTION idxAncestor_m
     1958  idx = strIdx(t(:)%name, tname)
     1959  IF(idx == 0)                 RETURN            !--- Tracer not found
     1960  IF(t(idx)%iGeneration <= ig) RETURN            !--- Tracer has a lower generation number than asked generation 'igen"
     1961  DO WHILE(t(idx)%iGeneration > ig); idx = strIdx(t(:)%name, t(idx)%parent); END DO
     1962END SUBROUTINE idxAncestor_1
     1963!------------------------------------------------------------------------------------------------------------------------------
     1964SUBROUTINE idxAncestor_mt(t, idx, tname, igen)
     1965  TYPE(trac_type),   INTENT(IN)  :: t(:)
     1966  CHARACTER(LEN=*),  INTENT(IN)  :: tname(:)
     1967  INTEGER,           INTENT(OUT) :: idx(SIZE(tname))
     1968  INTEGER, OPTIONAL, INTENT(IN)  :: igen
     1969  INTEGER :: ix
     1970  DO ix = 1, SIZE(tname); CALL idxAncestor_1(t, idx(ix), tname(ix), igen); END DO
     1971END SUBROUTINE idxAncestor_mt
     1972!------------------------------------------------------------------------------------------------------------------------------
     1973SUBROUTINE idxAncestor_m(t, idx, igen)
     1974  TYPE(trac_type),   INTENT(IN)  :: t(:)
     1975  INTEGER,           INTENT(OUT) :: idx(SIZE(t))
     1976  INTEGER, OPTIONAL, INTENT(IN)  :: igen
     1977  INTEGER :: ix
     1978  DO ix = 1, SIZE(t); CALL idxAncestor_1(t, idx(ix), t(ix)%name, igen); END DO
     1979END SUBROUTINE idxAncestor_m
    15311980!==============================================================================================================================
    15321981

  • LMDZ6/branches/LMDZ_ECRad/libf/misc/strings_mod.F90

    r4203 r4482  
    1010  PUBLIC :: is_numeric, bool2str, int2str, real2str, dble2str
    1111  PUBLIC :: reduceExpr, str2bool, str2int, str2real, str2dble
    12   PUBLIC :: addQuotes, testFile, checkList, removeComment, test
     12  PUBLIC :: addQuotes, checkList, removeComment, test
    1313
    1414  INTERFACE get_in;     MODULE PROCEDURE getin_s,  getin_i,  getin_r,  getin_l;  END INTERFACE get_in
    … …  
    2121  INTERFACE strIdx;     MODULE PROCEDURE     strIdx_1,                 strIdx_m; END INTERFACE strIdx
    2222  INTERFACE strCount;   MODULE PROCEDURE  strCount_m1, strCount_11, strCount_1m; END INTERFACE strCount
    23   INTERFACE strParse;   MODULE PROCEDURE   strParse_1,               strParse_m; END INTERFACE strParse
    2423  INTERFACE strReplace; MODULE PROCEDURE strReplace_1,             strReplace_m; END INTERFACE strReplace
    2524  INTERFACE cat;        MODULE PROCEDURE   horzcat_s1,  horzcat_i1,  horzcat_r1, &
    … …  
    3029  INTERFACE reduceExpr;   MODULE PROCEDURE   reduceExpr_1,   reduceExpr_m; END INTERFACE reduceExpr
    3130  INTERFACE addQuotes;    MODULE PROCEDURE    addQuotes_1,    addQuotes_m; END INTERFACE addQuotes
    32   INTERFACE testFile;     MODULE PROCEDURE     testFile_1,     testFile_m; END INTERFACE testFile
    3331
    3432  INTEGER, PARAMETER :: maxlen    = 256                    !--- Standard maximum length for strings
    … …  
    3836CONTAINS
    3937
     38!==============================================================================================================================
    4039LOGICAL FUNCTION test(lcond, lout) RESULT(lerr)
    4140  LOGICAL, INTENT(IN)  :: lcond
    … …  
    4342  lerr = lcond; lout = lcond
    4443END FUNCTION test
     44!==============================================================================================================================
     45
    4546
    4647!==============================================================================================================================
    4748SUBROUTINE init_printout(lunout_, prt_level_)
    4849  INTEGER, INTENT(IN) :: lunout_, prt_level_
    49   lunout = lunout_
     50  lunout    = lunout_
     51  prt_level = prt_level_
    5052END SUBROUTINE init_printout
    5153!==============================================================================================================================
    … …  
    105107  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
    106108  INTEGER,          OPTIONAL, INTENT(IN) :: unit
     109!------------------------------------------------------------------------------------------------------------------------------
    107110  CHARACTER(LEN=maxlen) :: subn
    108111  INTEGER :: unt
    … …  
    121124  INTEGER,          OPTIONAL, INTENT(IN) :: unit
    122125  INTEGER,          OPTIONAL, INTENT(IN) :: nmax
     126!------------------------------------------------------------------------------------------------------------------------------
    123127  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
    124128  CHARACTER(LEN=maxlen) :: subn
    … …  
    138142  LOGICAL,          OPTIONAL, INTENT(IN) :: ll
    139143  INTEGER,          OPTIONAL, INTENT(IN) :: unit
     144!------------------------------------------------------------------------------------------------------------------------------
    140145  CHARACTER(LEN=maxlen) :: subn
    141146  INTEGER :: unt
    … …  
    152157  INTEGER,          OPTIONAL, INTENT(IN) :: unit
    153158  INTEGER,          OPTIONAL, INTENT(IN)  :: nmax
     159!------------------------------------------------------------------------------------------------------------------------------
    154160  CHARACTER(LEN=maxlen) :: subn
    155161  INTEGER :: unt, nmx
    … …  
    187193
    188194!==============================================================================================================================
    189 !=== Extract the substring in front of the last (first if lFirst==TRUE) occurrence of separator "sep" in "str" ================
     195!=== Extract the substring in front of the first (last if lBackward==TRUE) occurrence of "sep" in "str"        ================
    190196!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect:                           ================
    191197!===    * strHead(..,.FALSE.) = 'a'           ${str%%$sep*}                                                    ================
    192198!===    * strHead(..,.TRUE.)  = 'a_b'         ${str%$sep*}                                                     ================
    193199!==============================================================================================================================
    194 CHARACTER(LEN=maxlen) FUNCTION strHead_1(str,sep,lFirst) RESULT(out)
     200CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep, lBackward) RESULT(out)
    195201  CHARACTER(LEN=*),           INTENT(IN) :: str
    196202  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    197   LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
    198   LOGICAL :: lf
    199   lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
     203  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackward
     204!------------------------------------------------------------------------------------------------------------------------------
    200205  IF(PRESENT(sep)) THEN
    201     out = str(1:INDEX(str,sep,.NOT.lf)-1)
     206    IF(     PRESENT(lBackWard)) out = str(1:INDEX(str,sep,lBackWard)-1)
     207    IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,sep)-1)
    202208  ELSE
    203     out = str(1:INDEX(str,'/',.NOT.lf)-1)
     209    IF(     PRESENT(lBackWard)) out = str(1:INDEX(str,'/',lBackWard)-1)
     210    IF(.NOT.PRESENT(lBackWard)) out = str(1:INDEX(str,'/')-1)
    204211  END IF
    205212  IF(out == '') out = str
    206213END FUNCTION strHead_1
    207214!==============================================================================================================================
    208 FUNCTION strHead_m(str,sep,lFirst) RESULT(out)
     215FUNCTION strHead_m(str, sep, lBackward) RESULT(out)
    209216  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    210217  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    211218  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    212   LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
    213   LOGICAL :: lf
     219  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackward
     220!------------------------------------------------------------------------------------------------------------------------------
    214221  INTEGER :: k
    215   lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
    216222  IF(PRESENT(sep)) THEN
    217     out = [(strHead_1(str(k), sep,   lf), k=1, SIZE(str))]
     223    IF(     PRESENT(lBackWard)) out = [(strHead_1(str(k), sep, lBackWard), k=1, SIZE(str))]
     224    IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), sep),            k=1, SIZE(str))]
    218225  ELSE
    219     out = [(strHead_1(str(k), lFirst=lf), k=1, SIZE(str))]
     226    IF(     PRESENT(lBackWard)) out = [(strHead_1(str(k), '/', lBackWard), k=1, SIZE(str))]
     227    IF(.NOT.PRESENT(lBackWard)) out = [(strHead_1(str(k), '/'),            k=1, SIZE(str))]
    220228  END IF
    221229END FUNCTION strHead_m
    222230!==============================================================================================================================
    223 !=== Extract the substring following the last (first if lFirst==TRUE) occurrence of separator "sep" in "str"   ================
     231!=== Extract the substring following the first (last if lBackward==TRUE) occurrence of "sep" in "str"          ================
    224232!=== Examples for str='a_b_c' and sep='_' and the bash command with the same effect:                           ================
    225 !===    * strTail(..,.FALSE.) = 'c'           ${str#*$sep}                                                     ================
    226 !===    * strTail(..,.TRUE.)  = 'b_c'         ${str##*$sep}                                                    ================
    227 !==============================================================================================================================
    228 CHARACTER(LEN=maxlen) FUNCTION strTail_1(str,sep,lFirst) RESULT(out)
     233!===    * strTail(str, '_', .FALSE.) = 'b_c'         ${str#*$sep}                                              ================
     234!===    * strTail(str, '_', .TRUE.)  = 'c'           ${str##*$sep}                                             ================
     235!==============================================================================================================================
     236CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep, lBackWard) RESULT(out)
    229237  CHARACTER(LEN=*),           INTENT(IN) :: str
    230238  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    231   LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
    232   LOGICAL :: lf
    233   lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
     239  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackWard
     240!------------------------------------------------------------------------------------------------------------------------------
    234241  IF(PRESENT(sep)) THEN
    235     out = str(INDEX(str,sep,.NOT.lf)+LEN(sep):LEN_TRIM(str))
     242    IF(     PRESENT(lBackWard)) out = str(INDEX(str,sep,lBackWard)+LEN(sep):LEN_TRIM(str))
     243    IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,sep)          +LEN(sep):LEN_TRIM(str))
    236244  ELSE
    237     out = str(INDEX(str,'/',.NOT.lf)+1:LEN_TRIM(str))
     245    IF(     PRESENT(lBackWard)) out = str(INDEX(str,'/',lBackWard)+1:LEN_TRIM(str))
     246    IF(.NOT.PRESENT(lBackWard)) out = str(INDEX(str,'/')          +1:LEN_TRIM(str))
    238247  END IF
    239248  IF(out == '') out = str
    240249END FUNCTION strTail_1
    241250!==============================================================================================================================
    242 FUNCTION strTail_m(str,sep,lFirst) RESULT(out)
     251FUNCTION strTail_m(str, sep, lBackWard) RESULT(out)
    243252  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    244253  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    245254  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    246   LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
    247   LOGICAL :: lf
     255  LOGICAL,          OPTIONAL, INTENT(IN) :: lBackWard
     256!------------------------------------------------------------------------------------------------------------------------------
    248257  INTEGER :: k
    249   lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
    250258  IF(PRESENT(sep)) THEN
    251     out = [(strTail_1(str(k), sep,   lf), k=1, SIZE(str))]
     259    IF(     PRESENT(lBackWard)) out = [(strTail_1(str(k), sep, lBackWard), k=1, SIZE(str))]
     260    IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), sep),            k=1, SIZE(str))]
    252261  ELSE
    253     out = [(strTail_1(str(k), lFirst=lf), k=1, SIZE(str))]
     262    IF(     PRESENT(lBackWard)) out = [(strTail_1(str(k), '/', lBackWard), k=1, SIZE(str))]
     263    IF(.NOT.PRESENT(lBackWard)) out = [(strTail_1(str(k), '/'),            k=1, SIZE(str))]
    254264  END IF
    255265END FUNCTION strTail_m
    … …  
    265275  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    266276  LOGICAL,          OPTIONAL, INTENT(IN) :: mask(:)
     277!------------------------------------------------------------------------------------------------------------------------------
    267278  CHARACTER(LEN=:), ALLOCATABLE :: s
    268279  INTEGER :: is, i0
    … …  
    285296  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    286297  INTEGER,          OPTIONAL, INTENT(IN) :: nmax
     298!------------------------------------------------------------------------------------------------------------------------------
    287299  CHARACTER(LEN=maxlen), ALLOCATABLE :: t(:)
    288300  CHARACTER(LEN=maxlen) :: sp
    … …  
    339351  CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
    340352  INTEGER,          OPTIONAL,    INTENT(OUT)   :: nb
     353!------------------------------------------------------------------------------------------------------------------------------
    341354  CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:)
    342355  INTEGER :: k, n, n1
    … …  
    355368  CHARACTER(LEN=*),   ALLOCATABLE, INTENT(INOUT) :: str1(:)
    356369  CHARACTER(LEN=*),                INTENT(IN)    :: str2(:)
     370!------------------------------------------------------------------------------------------------------------------------------
    357371  CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:), s2(:)
    358372  INTEGER :: k
    … …  
    374388
    375389!==============================================================================================================================
    376 !=== GET THE INDEX OF THE FIRST APPEARANCE IN THE STRING VECTOR "str(:)" OF THE STRING(s) "s" =================================
     390!=== GET THE INDEX OF THE FIRST APPEARANCE IN THE STRING VECTOR "str(:)" OF THE STRING(s) "s[(:)]" ============================
     391!=== OPTIONALY: GET THE NUMBER OF FOUND ELEMENTS "n". NB: UNFOUND => INDEX=0                       ============================
    377392!==============================================================================================================================
    378393INTEGER FUNCTION strIdx_1(str, s) RESULT(out)
    … …  
    386401  INTEGER, OPTIONAL, INTENT(OUT) :: n
    387402  INTEGER,           ALLOCATABLE :: out(:)
     403!------------------------------------------------------------------------------------------------------------------------------
    388404  INTEGER :: k
    389405  out = [(strIdx_1(str(:), s(k)), k=1, SIZE(s))]
    … …  
    400416  INTEGER, OPTIONAL, INTENT(OUT) :: n
    401417  INTEGER,           ALLOCATABLE :: out(:)
     418!------------------------------------------------------------------------------------------------------------------------------
    402419  INTEGER :: k
    403420  out = PACK( [(k, k=1, SIZE(str(:), DIM=1))], MASK = str(:) == s )
    … …  
    409426  INTEGER, OPTIONAL, INTENT(OUT) :: n
    410427  INTEGER,           ALLOCATABLE :: out(:)
     428!------------------------------------------------------------------------------------------------------------------------------
    411429  INTEGER :: k
    412430  out = PACK( [(k, k=1, SIZE(i(:), DIM=1))], MASK = i(:) == j )
    … …  
    418436  INTEGER, OPTIONAL, INTENT(OUT) :: n
    419437  INTEGER,           ALLOCATABLE :: out(:)
     438!------------------------------------------------------------------------------------------------------------------------------
    420439  INTEGER :: k
    421440  out = PACK( [(k, k=1, SIZE(l(:), DIM=1))], MASK = l(:) )
    422441  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
    423442END FUNCTION find_boo
    424 !==============================================================================================================================
    425 
    426 
    427 
    428 !==============================================================================================================================
    429 !=== GET 1ST APPEARANCE INDEX OF EACH ELEMENT OF "t(:)" IN "s(:)" (UNFOUND: INDEX=0) ==========================================
    430 !=== OPTIONALY: GET THE NUMBER OF FOUND ELEMENTS "n"                                 ==========================================
    431443!==============================================================================================================================
    432444
    … …  
    444456  INTEGER,           INTENT(OUT) :: idel                             !--- Index of the identified delimiter (0 if idx==0)
    445457  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc                              !--- Care about nbs with front sign or in scient. notation
    446 
    447   INTEGER               :: idx0                                      !--- Used to display an identified non-numeric string
    448   INTEGER, ALLOCATABLE  :: ii(:)
    449   LOGICAL               :: ll, ls
    450   CHARACTER(LEN=maxlen) :: d
    451 !  modname = 'strIdx'
     458!------------------------------------------------------------------------------------------------------------------------------
     459  INTEGER :: idx0                                                    !--- Used to display an identified non-numeric string
    452460  lerr = .FALSE.
    453   idx = strIdx1(rawList, del, ibeg, idel)                            !--- del(idel) appears in "rawList" at position idx
     461  idx = strIdx1(rawList, del, ibeg, idel)                            !--- idx/=0: del(idel) is at position "idx" in "rawList"
    454462  IF(.NOT.PRESENT(lSc))               RETURN                         !--- No need to check exceptions for numbers => finished
    455463  IF(.NOT.        lSc )               RETURN                         !--- No need to check exceptions for numbers => finished
    456   IF(idx == 0) THEN                                                  !--- No element of "del" in "rawList":
    457     lerr = .NOT.is_numeric(rawList(ibeg:))                           !--- String must be a number
    458     IF(lerr) idx = LEN_TRIM(rawList); RETURN                         !--- Update idx => rawList(ibeg:idx-1) is the whole string
    459   END IF
    460   idx0 = idx
    461   IF(test(idx==1.AND.INDEX('+-',del(idel))/=0, lerr)) RETURN         !--- Front separator different from +/-: error
    462   IF(idx/=1.AND.is_numeric(rawList(ibeg:idx-1)))      RETURN         !--- The input string tail is a valid number
    463   idx = strIdx1(rawList, del, idx+1, idel)                           !---   => TO THE NEXT DELIMITER
     464
     465  !=== No delimiter found: the whole string must be a valid number
     466  IF(idx == 0) THEN                                                  !--- No element of "del" in "rawList"
     467    lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList)))          !--- String must be a number
     468    IF(lerr) idx = LEN_TRIM(rawList); RETURN                         !--- Set idx so that rawList(ibeg:idx-1) = whole string
     469  END IF
     470
     471  IF(test(idx == 1 .AND. INDEX('+-',del(idel)) /= 0, lerr)) RETURN   !--- The front delimiter is different from +/-: error
     472  IF(     idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1)))   RETURN   !--- The input string head is a valid number
     473
     474  !=== The string part in front of the 1st delimiter is not a valid number: search for next delimiter index "idx"
     475  idx0 = idx ; idx = strIdx1(rawList, del, idx+1, idel)              !--- Keep start index because idx is recycled
    464476  IF(idx == 0) THEN
    465     lerr = .NOT.is_numeric(rawList(ibeg:))                           !--- No delimiter detected: string must be a number
     477    lerr = .NOT.is_numeric(rawList(ibeg:LEN_TRIM(rawList)))          !--- No other delimiter: whole string must be a valid numb
    466478    IF(lerr) idx = idx0; RETURN
    467479  END IF
    468   idx0 = idx
    469   IF(is_numeric(rawList(ibeg:idx-1)))                 RETURN         !--- The input string tail is a valid number
    470   IF(test(          INDEX('eE',rawList(idx-1:idx-1)) /= 0  &         !--- Sole possible exception: scientific notation: E+/-
    471                .OR. INDEX('+-',del(idel)) /=0, lerr)) RETURN
    472   idx = strIdx1(rawList, del, idx+1, idel)                           !---   => TO THE NEXT DELIMITER
    473   IF(idx == 0) THEN
    474     lerr = .NOT.is_numeric(rawList(ibeg:))                           !--- No separator detected: string must be a number
    475     IF(lerr) idx = idx0; RETURN
    476   END IF
    477480  lerr = .NOT.is_numeric(rawList(ibeg:idx-1))
     481
    478482CONTAINS
    479483
    480 INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(idx)
    481   CHARACTER(LEN=*),  INTENT(IN)  :: str
    482   CHARACTER(LEN=*),  INTENT(IN)  :: del(:)
     484!------------------------------------------------------------------------------------------------------------------------------
     485INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(i)
     486!--- Get the index of the first appereance of one of the delimiters "del(:)" in "str" starting from position "ib".
     487!--- "id" is the index in "del(:)" of the first delimiter found.
     488  IMPLICIT NONE
     489  CHARACTER(LEN=*),  INTENT(IN)  :: str, del(:)
    483490  INTEGER,           INTENT(IN)  :: ib
    484491  INTEGER,           INTENT(OUT) :: id
    485 
    486   INTEGER              :: nd, ns, i
    487   INTEGER, ALLOCATABLE :: ii(:)
    488 
    489   nd  = SIZE(del)                                                    !--- Number of separators
    490   ns  = LEN_TRIM(str)                                                !--- Length of the raw chain
    491   ii  = [(INDEX( str(ib:ns), del(i) ), i = 1, nd)]                   !--- Determine the next separator start index
    492   id  =  MINLOC( ii, MASK = ii /= 0, DIM = 1 )                       !--- Current delimiter index in the "delimiter(:)" list
    493   idx = 0
    494   IF(ANY(ii /= 0)) idx = MINVAL( ii, MASK = ii /= 0 ) + ib - 1       !--- Index in "str(1:ns)" of the delimiter first character
    495   IF(idx == 0) id = 0
     492!------------------------------------------------------------------------------------------------------------------------------
     493  DO i = ib, LEN_TRIM(str); id = strIdx(del, str(i:i)); IF(id /= 0) EXIT; END DO
     494  IF(i > LEN_TRIM(str)) THEN; i = 0; id = 0; END IF
    496495END FUNCTION strIdx1
    497496
    … …  
    501500
    502501!==============================================================================================================================
    503 !=== Return the index of first appearance of "del" in "str" starting from index "ib"
    504 !==============================================================================================================================
    505 INTEGER FUNCTION strIndex(str, del, ib) RESULT(idx)
    506   CHARACTER(LEN=*),  INTENT(IN)  :: str
    507   CHARACTER(LEN=*),  INTENT(IN)  :: del
    508   INTEGER,           INTENT(IN)  :: ib
    509   idx  = INDEX( str(ib:LEN_TRIM(str)), del ) + ib -1
    510 END FUNCTION strIndex
    511 !==============================================================================================================================
    512 
    513 
    514 !==============================================================================================================================
    515502!=== Count the number of elements separated by "delimiter" in list "rawList". =================================================
    516503!==============================================================================================================================
    517 LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(out)
     504LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
    518505  CHARACTER(LEN=*),  INTENT(IN)  :: rawList
    519506  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter
    520507  INTEGER,           INTENT(OUT) :: nb
    521508  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc
     509!------------------------------------------------------------------------------------------------------------------------------
    522510  LOGICAL :: ll
    523511  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    524   out = strCount_1m(rawList, [delimiter], nb, ll)
     512  lerr = strCount_1m(rawList, [delimiter], nb, ll)
    525513END FUNCTION strCount_11
    526514!==============================================================================================================================
    527 LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(out)
     515LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
    528516  CHARACTER(LEN=*),     INTENT(IN)  :: rawList(:)
    529517  CHARACTER(LEN=*),     INTENT(IN)  :: delimiter
    530518  INTEGER, ALLOCATABLE, INTENT(OUT) :: nb(:)
    531519  LOGICAL,    OPTIONAL, INTENT(IN)  :: lSc
    532 
     520!------------------------------------------------------------------------------------------------------------------------------
    533521  LOGICAL :: ll
    534522  INTEGER :: id
    535 
    536523  ll  = .FALSE.; IF(PRESENT(lSc)) ll = lSc .AND. INDEX('+-', delimiter) /= 0
    537   out = .TRUE.
     524  lerr = .TRUE.
    538525  ALLOCATE(nb(SIZE(rawList)))
    539526  DO id = 1, SIZE(rawList)
    540     out = out .AND. strCount_1m(rawList(id), [delimiter], nb(id), ll)
     527    lerr = lerr .AND. strCount_1m(rawList(id), [delimiter], nb(id), ll)
    541528  END DO
    542529END FUNCTION strCount_m1
    … …  
    547534  INTEGER,           INTENT(OUT) :: nb
    548535  LOGICAL, OPTIONAL, INTENT(IN)  :: lSc
     536!------------------------------------------------------------------------------------------------------------------------------
    549537  INTEGER              :: ib, ie, jd, nr
    550538  LOGICAL              :: ll
    551539  CHARACTER(LEN=1024)  :: r
    552 !  modname = 'strCount'
    553540  lerr = .FALSE.
    554541  ll   = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    … …  
    559546    lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
    560547    IF(fmsg('"'//TRIM(r(ib:ie-1))//'" is not numeric', ll=lerr)) RETURN
    561     IF(jd == 0) EXIT
     548    IF(ie == 0 .OR. jd == 0) EXIT
    562549    ib = ie + LEN(delimiter(jd))
    563550    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
    … …  
    572559!===          Corresponding "vals" remains empty if the element does not contain "=" sign. ====================================
    573560!==============================================================================================================================
    574 LOGICAL FUNCTION strParse_1(rawList, delimiter, keys, lSc, vals, n) RESULT(lerr)
     561LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
    575562  CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter
    576563  CHARACTER(LEN=maxlen), ALLOCATABLE,           INTENT(OUT) :: keys(:)
    577   LOGICAL,                            OPTIONAL, INTENT(IN)  :: lSc      !--- Take care about numbers in scientific notation
     564  INTEGER,                            OPTIONAL, INTENT(OUT) :: n
    578565  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: vals(:)
    579   INTEGER,                            OPTIONAL, INTENT(OUT) :: n
    580   LOGICAL :: ll
    581 !  modname = 'strParse'
    582   ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    583   IF(.NOT.PRESENT(vals)) lerr = strParse_m(rawList, [delimiter], keys, ll)
    584   IF(     PRESENT(vals)) lerr = strParse_m(rawList, [delimiter], keys, ll, vals)
    585   IF(PRESENT(n)) n = SIZE(keys)
    586 END FUNCTION strParse_1
    587 !==============================================================================================================================
    588 LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, lSc, vals, n, id) RESULT(lerr)
     566!------------------------------------------------------------------------------------------------------------------------------
     567  CHARACTER(LEN=1024) :: r
     568  INTEGER :: nr, nk
     569  lerr = .FALSE.
     570  r  = TRIM(ADJUSTL(rawList))
     571  nr = LEN_TRIM(r); IF(nr == 0) THEN; keys = ['']; RETURN; END IF
     572  CALL strParse_prv(nk)                                              !--- COUNT THE ELEMENTS
     573  ALLOCATE(keys(nk))
     574  IF(PRESENT(vals)) THEN
     575    ALLOCATE(vals(nk)); CALL strParse_prv(nk, keys, vals)            !--- PARSE THE KEYS
     576  ELSE
     577    CALL strParse_prv(nk, keys)                                      !--- PARSE THE KEYS
     578  END IF
     579  IF(PRESENT(n)) n = nk
     580
     581CONTAINS
     582
     583!------------------------------------------------------------------------------------------------------------------------------
     584SUBROUTINE strParse_prv(nkeys, keys, vals)
     585!--- * Get the number of elements after parsing ("nkeys" only is present)
     586!--- * Parse the <key>=<val> pairs and store result in "keys" and "vals" (already allocated)
     587  IMPLICIT NONE
     588  INTEGER,                         INTENT(OUT) :: nkeys
     589  CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: keys(:)
     590  CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: vals(:)
     591!------------------------------------------------------------------------------------------------------------------------------
     592  INTEGER :: ib, ie
     593  nkeys = 1; ib = 1
     594  DO
     595    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
     596    IF(ie == ib-1) EXIT
     597    IF(PRESENT(keys)) keys(nkeys) = r(ib:ie-1)                       !--- Get the ikth key
     598    IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys))       !--- Parse the ikth <key>=<val> pair
     599    ib = ie + LEN(delimiter)
     600    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
     601    nkeys = nkeys+1
     602  END DO
     603  IF(PRESENT(keys)) keys(nkeys) = r(ib:nr)                           !--- Get the last key
     604  IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys))         !--- Parse the last <key>=<val> pair
     605END SUBROUTINE strParse_prv
     606
     607!------------------------------------------------------------------------------------------------------------------------------
     608SUBROUTINE parseKeys(key, val)
     609  CHARACTER(LEN=*), INTENT(INOUT) :: key
     610  CHARACTER(LEN=*), INTENT(OUT)   :: val
     611!------------------------------------------------------------------------------------------------------------------------------
     612  INTEGER :: ix
     613  ix = INDEX(key, '='); IF(ix == 0) RETURN                           !--- First "=" index in "key"
     614  val = ADJUSTL(key(ix+1:LEN_TRIM(key)))
     615  key = ADJUSTL(key(1:ix-1))
     616END SUBROUTINE parseKeys
     617
     618END FUNCTION strParse
     619!==============================================================================================================================
     620LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
    589621  CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter(:)
    590622  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: keys(:)  !--- Parsed keys vector
     623  INTEGER,               OPTIONAL,              INTENT(OUT) :: n        !--- Length of the parsed vector
     624  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: vals(:)  !--- Values for <name>=<value> keys
    591625  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lSc      !--- Take care about numbers in scientific notation
    592   CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: vals(:)  !--- Values for <name>=<value> keys
    593   INTEGER,               OPTIONAL,              INTENT(OUT) :: n        !--- Length of the parsed vector
    594626  INTEGER,               OPTIONAL, ALLOCATABLE, INTENT(OUT) :: id(:)    !--- Indexes of the separators in "delimiter(:)" vector
    595 
     627!------------------------------------------------------------------------------------------------------------------------------
    596628  CHARACTER(LEN=1024) :: r
    597629  INTEGER :: nr, ik, nk, ib, ie, jd
    598630  LOGICAL :: ll
    599 
    600 !  modname = 'strParse'
    601631  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    602632  IF(test(fmsg("Couldn't parse list: non-numerical strings were found", ll=strCount_1m(rawList, delimiter, nk, ll)),lerr)) RETURN
    … …  
    625655CONTAINS
    626656
     657!------------------------------------------------------------------------------------------------------------------------------
    627658SUBROUTINE parseKeys(key, val)
    628659  CHARACTER(LEN=*), INTENT(INOUT) :: key
    629660  CHARACTER(LEN=*), INTENT(OUT)   :: val
     661!------------------------------------------------------------------------------------------------------------------------------
    630662  INTEGER :: ix
    631663  ix = INDEX(key, '='); IF(ix == 0) RETURN                           !--- First "=" index in "key"
    … …  
    645677  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
    646678  LOGICAL, OPTIONAL, INTENT(IN)    :: lsurr      !--- TRUE => key must be surrounded by special characters to be substituted
    647 
    648   CHARACTER(LEN=1024) :: s, t
     679!------------------------------------------------------------------------------------------------------------------------------
    649680  INTEGER :: i0, ix, nk, ns
    650681  LOGICAL :: lsur, lb, le
    651 
    652682  lsur = .FALSE.; IF(PRESENT(lsurr)) lsur = lsurr
    653683  nk = LEN_TRIM(key)
    … …  
    688718  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
    689719  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
     720!------------------------------------------------------------------------------------------------------------------------------
    690721  CHARACTER(LEN=maxlen), POINTER     :: s
    691722  LOGICAL :: lv(10)
    … …  
    707738  CHARACTER(LEN=*), OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
    708739  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:)
     740!------------------------------------------------------------------------------------------------------------------------------
    709741  CHARACTER(LEN=maxlen), POINTER     :: s(:)
    710742  LOGICAL :: lv(10)
    … …  
    729761  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
    730762  INTEGER, ALLOCATABLE :: out(:)
     763!------------------------------------------------------------------------------------------------------------------------------
    731764  INTEGER, POINTER     :: i
    732765  LOGICAL :: lv(10)
    … …  
    748781  INTEGER, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
    749782  INTEGER, ALLOCATABLE :: out(:,:)
     783!------------------------------------------------------------------------------------------------------------------------------
    750784  INTEGER, POINTER     :: i(:)
    751785  LOGICAL :: lv(10)
    … …  
    770804  REAL, OPTIONAL, TARGET, INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
    771805  REAL, ALLOCATABLE :: out(:)
     806!------------------------------------------------------------------------------------------------------------------------------
    772807  REAL, POINTER     :: r
    773808  LOGICAL :: lv(10)
    … …  
    789824  REAL, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
    790825  REAL, ALLOCATABLE :: out(:,:)
     826!------------------------------------------------------------------------------------------------------------------------------
    791827  REAL, POINTER     :: r(:)
    792828  LOGICAL :: lv(10)
    … …  
    811847  DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
    812848  DOUBLE PRECISION, ALLOCATABLE :: out(:)
     849!------------------------------------------------------------------------------------------------------------------------------
    813850  DOUBLE PRECISION, POINTER     :: d
    814851  LOGICAL :: lv(10)
    … …  
    830867  DOUBLE PRECISION, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
    831868  DOUBLE PRECISION, ALLOCATABLE :: out(:,:)
     869!------------------------------------------------------------------------------------------------------------------------------
    832870  DOUBLE PRECISION, POINTER     :: d(:)
    833871  LOGICAL :: lv(10)
    … …  
    869907  INTEGER,          OPTIONAL, INTENT(IN)  :: unit          !--- Output unit (default: screen)
    870908  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: sub           !--- Subroutine name
    871 
     909!------------------------------------------------------------------------------------------------------------------------------
    872910  CHARACTER(LEN=2048) :: row
    873911  CHARACTER(LEN=maxlen)  :: rFm, el, subn
    … …  
    879917  INTEGER, PARAMETER   :: nm=1                             !--- Space between values & columns
    880918  LOGICAL :: ls, li, lr
    881 
    882919  subn = '';    IF(PRESENT(sub)) subn = sub
    883920  rFm = '*';    IF(PRESENT(rFmt)) rFm = rFmt               !--- Specified format for reals
    … …  
    954991      nr = LEN_TRIM(row)-1                                           !--- Final separator removed
    955992      CALL msg(row(1:nr), subn, unit=unt)
    956       IF(ir /= 1) CYCLE                                              !--- Titles are underlined
     993      IF(ir /= 1) CYCLE                                              !--- Titles only are underlined
    957994      row=''; DO ic=1,nHd; row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO
    958995      DO ic = ib,ncmx(it); row=TRIM(row)//REPEAT('-',n(ic))//'+'; END DO
    … …  
    9751012  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: rFmt          !--- Format for reals
    9761013  LOGICAL,          OPTIONAL, INTENT(IN)  :: llast         !--- Last variable: no final ','
    977 
     1014!------------------------------------------------------------------------------------------------------------------------------
    9781015  CHARACTER(LEN=maxlen)  :: rFm, el
    9791016  CHARACTER(LEN=maxlen), ALLOCATABLE :: d(:,:)
    … …  
    9831020  INTEGER, ALLOCATABLE :: n(:)
    9841021  LOGICAL :: ls, li, lr, la
    985 
    986 !  modname = 'dispNamelist'
    9871022  rFm = '*';    IF(PRESENT(rFmt)) rFm = rFmt               !--- Specified format for reals
    9881023  ls = PRESENT(s); li = PRESENT(i); lr = PRESENT(r)
    … …  
    10561091  REAL,                       INTENT(IN)  ::  a(:)                   !--- Linearized array of values
    10571092  INTEGER,                    INTENT(IN)  ::  n(:)                   !--- Profile before linearization
    1058 
    10591093  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: err_msg, nam(:), subn   !--- Error message, variables and calling subroutine names
    10601094  INTEGER,          OPTIONAL, INTENT(IN)  :: nRowMax                 !--- Maximum number of lines to display    (default: all)
    … …  
    10621096  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Number of front columns to duplicate  (default: 1)
    10631097  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
     1098!------------------------------------------------------------------------------------------------------------------------------
    10641099  CHARACTER(LEN=maxlen),      ALLOCATABLE :: ttl(:)
    10651100  LOGICAL,                    ALLOCATABLE :: m(:)
    … …  
    11391174  INTEGER,          OPTIONAL, INTENT(IN)  :: nHead                   !--- Number of front columns to duplicate  (default: 1)
    11401175  INTEGER,          OPTIONAL, INTENT(IN)  :: unit                    !--- Output unit                           (def: lunout)
    1141 
     1176!------------------------------------------------------------------------------------------------------------------------------
    11421177  CHARACTER(LEN=maxlen)                   :: mes, sub, fm='(f12.9)', prf
    11431178  CHARACTER(LEN=maxlen),      ALLOCATABLE :: ttl(:), vnm(:)
    1144   LOGICAL,                    ALLOCATABLE :: m(:)
    11451179  INTEGER,                    ALLOCATABLE :: ki(:), kj(:), kl(:)
    1146   INTEGER                                 :: i, j, k, rk, ib, ie, itr, nm, nv, unt, nRmx, nCmx, nHd, rk1
     1180  INTEGER                                 :: i, j, k, rk, nv, unt, nRmx, nCmx, nHd
    11471181  REAL,                       ALLOCATABLE :: val(:,:)
    11481182
    … …  
    11601194  lerr= SIZE(a,1) /= PRODUCT(n); IF(fmsg('profile "n" does not match "a" and "ll"', sub, lerr, unt)) RETURN
    11611195
    1162   SELECT CASE(rk1)                                                   !--- Indices list
     1196  SELECT CASE(rk)                                                   !--- Indices list
    11631197    CASE(0); IF(ll(1)) THEN; WRITE(unt,'(a,", ",a," = ",2f12.9)')TRIM(vnm(1)),TRIM(vnm(2)),a(1,1),a(1,2); RETURN; END IF
    11641198    CASE(1); ki = [  (i,i=1,n(1)) ]
    … …  
    11891223  CHARACTER(LEN=*),      INTENT(IN)  :: str
    11901224  CHARACTER(LEN=maxlen), INTENT(OUT) :: val
    1191 
     1225!------------------------------------------------------------------------------------------------------------------------------
    11921226  CHARACTER(LEN=maxlen)              :: v
    11931227  CHARACTER(LEN=1024)                :: s, vv
    … …  
    11961230  INTEGER :: nl, nn, i, j, im, ix
    11971231  LOGICAL :: ll
    1198 !  modname = 'reduceExpr_1'
    11991232  s = str
    12001233
    … …  
    12431276  CHARACTER(LEN=maxlen), ALLOCATABLE :: ky(:)
    12441277  CHARACTER(LEN=1),      ALLOCATABLE :: op(:)
    1245 
     1278!------------------------------------------------------------------------------------------------------------------------------
    12461279  CHARACTER(LEN=1024) :: s
    12471280  DOUBLE PRECISION :: v, vm, vp
    12481281  INTEGER      :: i, ni, io
    1249 
    1250 !  modname = 'reduceExpr_basic'
    12511282  lerr = .FALSE.
    12521283  IF(is_numeric(str)) THEN; val=TRIM(str); RETURN; END IF
    12531284  op = ['^','/','*','+','-']                                                   !--- List of recognized operations
    12541285  s = str
    1255   IF(test(strParse_m(s, op, ky, .TRUE., id = id), lerr)) RETURN                !--- Parse the values
     1286  IF(test(strParse_m(s, op, ky, lSc=.TRUE., id = id), lerr)) RETURN            !--- Parse the values
    12561287  vl = str2dble(ky)                                                            !--- Conversion to doubles
    12571288  lerr = ANY(vl >= HUGE(1.d0))
    … …  
    12621293      IF(id(i) /= io) CYCLE                                                    !--- Current found operator is not op(io)
    12631294      vm = vl(i); vp = vl(i+1)                                                 !--- Couple of values used for current operation
    1264       SELECT CASE(io)                                                          !--- Perform operation on the two values
    1265         CASE(1); v = vm**vp  !--- ^
    1266         CASE(2); v = vm/vp   !--- /
    1267         CASE(3); v = vm*vp   !--- *
    1268         CASE(4); v = vm+vp   !--- +
    1269         CASE(5); v = vm-vp   !--- +
     1295      SELECT CASE(op(io))                                                          !--- Perform operation on the two values
     1296        CASE('^'); v = vm**vp
     1297        CASE('/'); v = vm/vp
     1298        CASE('*'); v = vm*vp
     1299        CASE('+'); v = vm+vp
     1300        CASE('-'); v = vm-vp
    12701301      END SELECT
    12711302      IF(i == ni) THEN; vl = [vl(1:ni-1), v]; ELSE; vl = [vl(1:i-1), v, vl(i+2:ni+1)]; END IF
    … …  
    12831314  CHARACTER(LEN=*),                   INTENT(IN)  :: str(:)
    12841315  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
     1316!------------------------------------------------------------------------------------------------------------------------------
    12851317  INTEGER :: i
    12861318  ALLOCATE(lerr(SIZE(str)),val(SIZE(str)))
    … …  
    13021334  READ(str,fmt,IOSTAT=e) x
    13031335  out = e==0 .AND. INDEX('Ee',str(LEN_TRIM(str):LEN_TRIM(str)))==0
    1304   IF(str == '') out = .FALSE.
    13051336END FUNCTION is_numeric
    13061337!==============================================================================================================================
    … …  
    13481379  INTEGER,           INTENT(IN) :: i
    13491380  INTEGER, OPTIONAL, INTENT(IN) :: nDigits
     1381!------------------------------------------------------------------------------------------------------------------------------
    13501382  WRITE(out,*)i
    13511383  out = ADJUSTL(out)
    … …  
    13571389  REAL,                       INTENT(IN) :: r
    13581390  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
     1391!------------------------------------------------------------------------------------------------------------------------------
    13591392  IF(     PRESENT(fmt)) WRITE(out,fmt)r
    13601393  IF(.NOT.PRESENT(fmt)) WRITE(out, * )r
    … …  
    13651398  DOUBLE PRECISION,           INTENT(IN) :: d
    13661399  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
     1400!------------------------------------------------------------------------------------------------------------------------------
    13671401  IF(     PRESENT(fmt)) WRITE(out,fmt)d
    13681402  IF(.NOT.PRESENT(fmt)) WRITE(out, * )d
    … …  
    13851419!==============================================================================================================================
    13861420
     1421
    13871422!==============================================================================================================================
    13881423FUNCTION addQuotes_1(s) RESULT(out)
    … …  
    13951430  CHARACTER(LEN=*), INTENT(IN)  :: s(:)
    13961431  CHARACTER(LEN=:), ALLOCATABLE :: out(:)
     1432!------------------------------------------------------------------------------------------------------------------------------
    13971433  INTEGER :: k, n
    13981434  n = MAXVAL(LEN_TRIM(s), MASK=.TRUE.)
    … …  
    14061442  CHARACTER(LEN=*), INTENT(IN) :: s
    14071443  CHARACTER(LEN=1) :: b, e
     1444!------------------------------------------------------------------------------------------------------------------------------
    14081445  out = .TRUE.; IF(TRIM(s) == '') RETURN
    14091446  b = s(1:1); e = s(MAX(1,LEN_TRIM(s)):MAX(1,LEN_TRIM(s)))
    14101447  out = .NOT.is_numeric(s) .AND. (b /= "'" .OR. e /= "'") .AND. ( b /= '"' .OR. e /= '"')
    14111448END FUNCTION needQuotes
    1412 !==============================================================================================================================
    1413 
    1414 
    1415 !==============================================================================================================================
    1416 !=== TEST WHETHER A FILE IS PRESENT OR NOT ====================================================================================
    1417 !==============================================================================================================================
    1418 LOGICAL FUNCTION testFile_1(fname) RESULT(out)
    1419   CHARACTER(LEN=*), INTENT(IN) :: fname
    1420   INTEGER :: ierr
    1421   OPEN(90, FILE=fname, FORM='formatted', STATUS='old', IOSTAT=ierr); CLOSE(99)
    1422   out = ierr/=0
    1423 END FUNCTION testFile_1
    1424 !==============================================================================================================================
    1425 FUNCTION testFile_m(fname) RESULT(out)
    1426   LOGICAL,         ALLOCATABLE ::   out(:)
    1427   CHARACTER(LEN=*), INTENT(IN) :: fname(:)
    1428   INTEGER :: k
    1429   out = [(testFile_1(fname(k)), k=1, SIZE(fname))]
    1430 END FUNCTION testFile_m
    14311449!==============================================================================================================================
    14321450
    … …  
    14421460  CHARACTER(LEN=*),   INTENT(IN)  :: message, items, reason
    14431461  INTEGER,  OPTIONAL, INTENT(IN)  :: nmax
     1462!------------------------------------------------------------------------------------------------------------------------------
    14441463  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)
    14451464  INTEGER :: i, nmx
    … …  
    14641483
    14651484
    1466 
    14671485END MODULE strings_mod

  • LMDZ6/branches/LMDZ_ECRad/libf/misc/wxios.F90

    r4146 r4482  
    308308        IF (xios_is_valid_axis("axis_lat")) THEN
    309309           CALL xios_set_axis_attr( "axis_lat", n_glo=nbp_lat, n=jj_nb, begin=jj_begin-1, value=io_lat(jj_begin:jj_end))
     310        ENDIF
     311        IF (xios_is_valid_axis("axis_lat_greordered")) THEN
     312           CALL xios_set_axis_attr( "axis_lat_greordered", n_glo=nbp_lat, n=jj_nb, begin=jj_begin-1, &
     313                                    value=io_lat(jj_begin:jj_end)*(-1.))
    310314        ENDIF
    311315
Note: See TracChangeset for help on using the changeset viewer.