Changeset 24 for readTracFiles_mod.f90


Ignore:
Timestamp:
Oct 20, 2022, 7:06:25 PM (2 years ago)
Author:
dcugnet
Message:
  • correct the way tracers names exceptions are handled (old water names, HNO3 related species for REPROBUS, O3/OX for INCA).
  • few minor corrections.
  • add comments + cosmetic changes.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • readTracFiles_mod.f90

    r23 r24  
    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
     3  USE strings_mod,    ONLY: msg, find, get_in, str2int, dispTable, testFile, strReduce,  strFind, strStack, strHead, &
     4       test, removeComment, cat, fmsg, maxlen, int2str, checkList, strParse, strReplace, strTail, strCount, strIdx, reduceExpr
    55  USE trac_types_mod, ONLY: trac_type, isot_type, keys_type
    66
    … …  
    99  PRIVATE
    1010
    11   PUBLIC :: initIsotopes, maxlen, trac_type, isot_type, keys_type
    12   PUBLIC :: readTracersFiles, indexUpdate, setGeneration             !--- TOOLS ASSOCIATED TO TRACERS  DESCRIPTORS
    13   PUBLIC :: readIsotopesFile                                         !--- TOOLS ASSOCIATED TO ISOTOPES DESCRIPTORS
    14   PUBLIC :: getKey_init, getKey, fGetKey, setDirectKeys              !--- GET/SET KEYS FROM/TO tracers & isotopes
    15 
    16   PUBLIC :: addPhase, new2oldName,  getPhase, &                      !--- FUNCTIONS RELATED TO THE PHASES
    17             delPhase, old2newName, getiPhase, &                      !--- + ASSOCIATED VARIABLES
    18             known_phases, old_phases, phases_sep, phases_names, nphases
    19 
    20   PUBLIC :: oldH2OIso, newH2OIso                                     !--- NEEDED FOR BACKWARD COMPATIBILITY (OLD traceur.def)
     11  PUBLIC :: maxlen                                                   !--- PARAMETER FOR CASUAL STRING LENGTH
     12  PUBLIC :: trac_type, readTracersFiles, setGeneration, indexUpdate  !--- TRACERS  DESCRIPTION ASSOCIATED TOOLS
     13  PUBLIC :: keys_type, getKey, fGetKey,  setDirectKeys, getKey_init  !--- TOOLS TO GET/SET KEYS FROM/TO tracers & isotopes
     14
     15  PUBLIC :: addPhase, getiPhase,  old_phases, phases_sep, nphases, & !--- FUNCTIONS RELATED TO THE PHASES
     16            delPhase, getPhase, known_phases, phases_names           !--- + ASSOCIATED VARIABLES
     17
     18  PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O             !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
     19  PUBLIC :: oldHNO3,   newHNO3                                       !--- HNO3 REPRO   BACKWARD COMPATIBILITY (OLD start.nc)
    2120
    2221  PUBLIC :: tran0, idxAncestor, ancestor                             !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
     22
     23  !=== FOR ISOTOPES: GENERAL
     24  PUBLIC :: isot_type, readIsotopesFile, initIsotopes                !--- ISOTOPES DESCRIPTION TYPE + READING ROUTINE
     25
    2326  PUBLIC :: maxTableWidth
    2427!------------------------------------------------------------------------------------------------------------------------------
    … …  
    2932!------------------------------------------------------------------------------------------------------------------------------
    3033  INTERFACE getKey
    31     MODULE PROCEDURE getKeyByName_s1, getKeyByName_i1, getKeyByName_r1, getKeyByName_sm, getKeyByName_im, getKeyByName_rm
     34    MODULE PROCEDURE getKeyByName_s1,  getKeyByName_i1,  getKeyByName_r1, &
     35                     getKeyByName_sm,  getKeyByName_im,  getKeyByName_rm
    3236  END INTERFACE getKey
    3337!------------------------------------------------------------------------------------------------------------------------------
    3438  INTERFACE fGetKey;       MODULE PROCEDURE fgetKeyByIndex_s1, fgetKeyByName_s1; END INTERFACE fGetKey
     39  INTERFACE  old2newH2O;   MODULE PROCEDURE  old2newH2O_1,  old2newH2O_m;        END INTERFACE old2newH2O
     40  INTERFACE  new2oldH2O;   MODULE PROCEDURE  new2oldH2O_1,  new2oldH2O_m;        END INTERFACE new2oldH2O
    3541  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
     42  INTERFACE idxAncestor;   MODULE PROCEDURE idxAncestor_1, idxAncestor_m;        END INTERFACE idxAncestor
     43  INTERFACE    ancestor;   MODULE PROCEDURE    ancestor_1,    ancestor_m;        END INTERFACE    ancestor
    3844  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
    4145!------------------------------------------------------------------------------------------------------------------------------
    4246
    … …  
    4549
    4650  !--- 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
     51  CHARACTER(LEN=maxlen), SAVE      :: tran0        = 'air'      !--- Default transporting fluid
     52  CHARACTER(LEN=maxlen), PARAMETER :: old_phases   = 'vlir'     !--- Old phases for water (no separator)
     53  CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsr'     !--- Known phases initials
     54  INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases)        !--- Number of phases
     55  CHARACTER(LEN=maxlen), SAVE      :: phases_names(nphases) &   !--- Known phases names
    5256                                = ['gaseous', 'liquid ', 'solid  ', 'cloud  ']
    53   CHARACTER(LEN=1), SAVE :: phases_sep  =  '_'                       !--- Phase separator
    54   LOGICAL,          SAVE :: tracs_merge = .TRUE.                     !--- Merge/stack tracers lists
    55   LOGICAL,          SAVE :: lSortByGen  = .TRUE.                     !--- Sort by growing generation
    56 
    57   !--- KEPT JUST TO MANAGE OLD WATER ISOTOPES NAMES
    58   !--- Apart from that context, on limitaion on isotopes names (as long as they have a corresponding line in isotopes_params.def)
     57  CHARACTER(LEN=1), SAVE :: phases_sep  =  '_'                  !--- Phase separator
     58  LOGICAL,          SAVE :: tracs_merge = .TRUE.                !--- Merge/stack tracers lists
     59  LOGICAL,          SAVE :: lSortByGen  = .TRUE.                !--- Sort by growing generation
     60
     61  !--- CORRESPONDANCE BETWEEN OLD AND NEW WATER NAMES
    5962  CHARACTER(LEN=maxlen), SAVE :: oldH2OIso(5) = ['eau',     'HDO',     'O18',     'O17',     'HTO'    ]
    6063  CHARACTER(LEN=maxlen), SAVE :: newH2OIso(5) = ['H2[16]O', 'H[2]HO ', 'H2[18]O', 'H2[17]O', 'H[3]HO ']
     64
     65  !--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES
     66  CHARACTER(LEN=maxlen), SAVE ::   oldHNO3(2) = ['HNO3_g ', 'HNO3   ']
     67  CHARACTER(LEN=maxlen), SAVE ::   newHNO3(2) = ['HNO3   ', 'HNO3tot']
    6168
    6269  !=== LOCAL COPIES OF THE TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey (INITIALIZED IN getKey_init)
    … …  
    7279!==============================================================================================================================
    7380!=== READ ONE OR SEVERAL TRACER FILES AND FILL A "tr" TRACERS DESCRIPTOR DERIVED TYPE.
    74 !=== THE RETURN VALUE fType DEPENDS ON WHAT IS FOUND:
     81!=== THE RETURNED VALUE fType DEPENDS ON WHAT IS FOUND:
    7582!===  0: NO ADEQUATE FILE FOUND ; DEFAULT VALUES MUST BE USED
    7683!===  1: AN "OLD STYLE" TRACERS FILE "traceur.def":
    … …  
    93100!     * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
    94101!==============================================================================================================================
    95 LOGICAL FUNCTION readTracersFiles(type_trac, fType, tracs) RESULT(lerr)
     102LOGICAL FUNCTION readTracersFiles(type_trac, fTyp, tracs, lRepr) RESULT(lerr)
    96103!------------------------------------------------------------------------------------------------------------------------------
    97104  CHARACTER(LEN=*),             INTENT(IN)  :: type_trac              !--- List of components used
    98   INTEGER,                      INTENT(OUT) :: fType                  !--- Type of input file found
     105  INTEGER,         OPTIONAL,    INTENT(OUT) :: fTyp                   !--- Type of input file found
    99106  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tracs(:)
     107  LOGICAL,         OPTIONAL,    INTENT(IN)  :: lRepr
    100108  CHARACTER(LEN=maxlen),  ALLOCATABLE :: s(:), sections(:), trac_files(:)
    101   CHARACTER(LEN=maxlen) :: str, fname, mesg
    102   INTEGER               :: is, nsec, ierr, it, ntrac, ns, ip, ix
     109  CHARACTER(LEN=maxlen) :: str, fname, mesg, tname, pname, cname
     110  INTEGER               :: is, nsec, ierr, it, ntrac, ns, ip, ix, fType
    103111  LOGICAL, ALLOCATABLE  :: ll(:), lGen3(:)
     112  LOGICAL :: lRep
    104113!------------------------------------------------------------------------------------------------------------------------------
    105114  lerr = .FALSE.
    106115  modname = 'readTracersFiles'
    107116  IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
     117  lRep=0; IF(PRESENT(lRepr)) lRep = lRepr
    108118
    109119  !--- Required sections + corresponding files names (new style single section case)
    … …  
    119129  IF(.NOT.testFile('tracer.def'))                fType = 2           !--- NEW STYLE ; SINGLE  FILE, SEVERAL SECTIONS
    120130  IF(ALL(ll))                                    fType = 3           !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
     131  IF(PRESENT(fTyp)) fTyp = fType
    121132  IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
    122133    IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
    … …  
    135146  SELECT CASE(fType)                         !--- Set %name, %genOName, %parent, %type, %phase, %component, %iGeneration, %keys
    136147  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    137     CASE(1)                                                               !=== OLD FORMAT "traceur.def"
     148    CASE(1)                                                          !=== OLD FORMAT "traceur.def"
    138149    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    139150      !--- OPEN THE "traceur.def" FILE
    … …  
    153164        CALL msg('This file is for air tracers only',           modname, ns == 3 .AND. it == 1)
    154165        CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
    155         tracs(it)%name   = old2newName(s(3), ip)                     !--- Set %name:   name   of the tracer
    156         tracs(it)%parent = tran0                                     !--- Default transporting fluid name
    157         IF(ns == 4) tracs(it)%parent = old2newName(s(4))             !--- Set %parent: parent of the tracer
     166
     167        !=== NAME OF THE TRACER
     168        tname = old2newH2O(s(3), ip)
     169        ix = strIdx(oldHNO3, s(3))
     170        IF(ix /= 0 .AND. lRep) tname = newHNO3(ix)                   !--- Exception for HNO3 (REPROBUS ONLY)
     171        tracs(it)%name = tname                                       !--- Set %name
     172        tracs(it)%keys%name = tname                                  !--- Copy tracers names in keys components
     173
     174        !=== NAME OF THE COMPONENT
     175        cname = type_trac                                            !--- Name of the model component
     176        IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
     177        tracs(it)%component = cname                                  !--- Set %component
     178
     179        !=== NAME OF THE PARENT
     180        pname = tran0                                                !--- Default name: default transporting fluid (air)
     181        IF(ns == 4) THEN
     182          pname = old2newH2O(s(4))
     183          ix = strIdx(oldHNO3, s(4))
     184          IF(ix /= 0 .AND. lRep) pname = newHNO3(ix)                 !--- Exception for HNO3 (REPROBUS ONLY)
     185        END IF
     186        tracs(it)%parent = pname                                     !--- Set %parent
     187
     188        !=== PHASE AND ADVECTION SCHEMES NUMBERS
    158189        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         IF(ANY([(addPhase('H2O', ip), ip=1, nphases)] == tracs(it)%name)) tracs(it)%component = 'lmdz'
    161190        tracs(it)%keys%key = ['hadv', 'vadv']                        !--- Set %keys%key
    162191        tracs(it)%keys%val = s(1:2)                                  !--- Set %keys%val
    … …  
    177206  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    178207
    179 
    180208  IF(ALL([2,3] /= fType)) RETURN
    181209
    … …  
    189217    IF(test(cumulTracers(dBase, tracs), lerr)) RETURN
    190218  END IF
    191   WHERE(tracs%gen0Name(1:3) /= 'H2O') tracs%isInPhysics=.TRUE.       !--- Set %isInPhysics: passed to physics
    192219  CALL setDirectKeys(tracs)                                          !--- Set %iqParent, %iqDescen, %nqDescen, %nqChilds
    193220END FUNCTION readTracersFiles
    … …  
    557584  CHARACTER(LEN=1) :: p
    558585  INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
    559   LOGICAL :: lTg, lEx
     586  LOGICAL :: lTag, lExt
    560587!------------------------------------------------------------------------------------------------------------------------------
    561588  nq = SIZE(tr, DIM=1)
    … …  
    571598  it = 1                                                             !--- Current "ttr(:)" index
    572599  DO iq = 1, nq                                                      !--- Loop on "tr(:)" indexes
    573     lTg = tr(iq)%type=='tag'                                         !--- Current tracer is a tag
     600    lTag = tr(iq)%type=='tag'                                        !--- Current tracer is a tag
    574601    i0 = strFind(tr(:)%name, TRIM(tr(iq)%gen0Name), n)               !--- Indexes of first generation ancestor copies
    575602    np = SUM([( LEN_TRIM(tr(i0(i))%phase),i=1,n )], 1)               !--- Number of phases for current tracer tr(iq)
    576     lEx = np>1                                                       !--- Phase suffix only required if phases number is > 1
    577     IF(lTg) lEx = lEx .AND. tr(iq)%iGeneration>0                     !--- No phase suffix for generation 0 tags
     603    lExt = np>1                                                      !--- Phase suffix only required if phases number is > 1
     604    IF(lTag) lExt = lExt .AND. tr(iq)%iGeneration>0                  !--- No phase suffix for generation 0 tags
    578605    DO i=1,n                                                         !=== LOOP ON GENERATION 0 ANCESTORS
    579606      jq = i0(i)                                                     !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq)
    … …  
    583610        p = pha(ip:ip)
    584611        trn = TRIM(tr(iq)%name); nam = trn                           !--- Tracer name (regular case)
    585         IF(lTg) nam = TRIM(tr(iq)%parent)                            !--- Parent name (tagging case)
    586         IF(lEx) nam = addPhase(nam, p )                              !--- Phase extension needed
    587         IF(lTg) nam = TRIM(nam)//'_'//TRIM(trn)                      !--- <parent>_<name> for tags
     612        IF(lTag) nam = TRIM(tr(iq)%parent)                           !--- Parent name (tagging case)
     613        IF(lExt) nam = addPhase(nam, p )                             !--- Phase extension needed
     614        IF(lTag) nam = TRIM(nam)//'_'//TRIM(trn)                     !--- <parent>_<name> for tags
    588615        ttr(it) = tr(iq)                                             !--- Same <key>=<val> pairs
    589616        ttr(it)%name      = TRIM(nam)                                !--- Name with possibly phase suffix
    590617        ttr(it)%keys%name = TRIM(nam)                                !--- Name inside the keys decriptor
    591618        ttr(it)%phase     = p                                        !--- Single phase entry
    592         IF(lEx .AND. tr(iq)%iGeneration>0) THEN
     619        IF(lExt .AND. tr(iq)%iGeneration>0) THEN
    593620          ttr(it)%parent   = addPhase(ttr(it)%parent,   p)
    594621          ttr(it)%gen0Name = addPhase(ttr(it)%gen0Name, p)
    … …  
    802829END FUNCTION dispTraSection
    803830!==============================================================================================================================
    804 !==============================================================================================================================
    805831
    806832
    … …  
    816842  out => NULL(); IF(it /= 0) out => t(it)
    817843END FUNCTION aliasTracer
    818 !------------------------------------------------------------------------------------------------------------------------------
     844!==============================================================================================================================
    819845
    820846
    … …  
    837863  CALL indexUpdate(out)
    838864END FUNCTION trSubset_Name
    839 !------------------------------------------------------------------------------------------------------------------------------
     865!==============================================================================================================================
    840866
    841867
    … …  
    850876  CALL indexUpdate(out)
    851877END FUNCTION trSubset_gen0Name
    852 !------------------------------------------------------------------------------------------------------------------------------
     878!==============================================================================================================================
    853879
    854880
    … …  
    874900  END DO
    875901END SUBROUTINE indexUpdate
    876 !------------------------------------------------------------------------------------------------------------------------------
     902!==============================================================================================================================
    877903 
    878904 
    … …  
    892918LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
    893919  CHARACTER(LEN=*),        INTENT(IN)    :: fnam                     !--- Input file name
    894   TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:)                  !--- Isotopes descriptors (field "prnt" must be defined !)
     920  TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:)                  !--- Isotopes descriptors (field %parent must be defined!)
    895921  INTEGER :: ik, is, it, idb, nk0, i, iis
    896922  INTEGER :: nk, ns, nt, ndb, nb0, i0
    … …  
    912938  ndb = SIZE(dBase, DIM=1)                                           !--- Current database size
    913939  DO idb = nb0, ndb
    914    iis = idb-nb0+1
     940    iis = idb-nb0+1
    915941
    916942    !--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
    … …  
    954980!==============================================================================================================================
    955981
     982
    956983!==============================================================================================================================
    957984!=== IF ISOTOPES (2ND GENERATION TRACERS) ARE DETECTED:                                                                     ===
    … …  
    965992  TYPE(isot_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: isot(:)
    966993  CHARACTER(LEN=maxlen), ALLOCATABLE :: p(:), str(:)                 !--- Temporary storage
    967   CHARACTER(LEN=maxlen) :: iname
     994  CHARACTER(LEN=maxlen) :: iName
    968995  CHARACTER(LEN=1)   :: ph                                           !--- Phase
    969996  INTEGER :: nbIso, ic, ip, iq, it, iz
    … …  
    9751002  t => trac
    9761003
    977   p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1) !--- Parents of generation 1 isotopes
     1004  !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
     1005  p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1)
    9781006  CALL strReduce(p, nbIso)
    9791007  ALLOCATE(isot(nbIso))
    … …  
    10271055    !=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
    10281056    !    (including tagging tracers) is sorted this way:  iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
    1029     i%iqIsoPha = RESHAPE( [( (strIdx(t%name,  addPhase(i%trac(it),i%phase(ip:ip))),    it=1, i%ntiso), ip=1, i%nphas)], &
     1057    i%iqIsoPha = RESHAPE( [( (strIdx(t%name,  addPhase(i%trac(it),i%phase(ip:ip))),      it=1, i%ntiso), ip=1, i%nphas)], &
    10301058                         [i%ntiso, i%nphas] )
    10311059    !=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
    … …  
    10351063
    10361064  !=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE
    1037   !    DONE HERE, AND NOT ONLY IN "infotrac_phy", BECAUSE SOME PHYSICAL PARAMS ARE NEEDED FOR RESTARTS (tnat AND alpha_ideal)
    10381065  lerr = readIsotopesFile('isotopes_params.def',isot)
    10391066
    … …  
    10561083    prf = 'i'//REPEAT('s',nk+1)                                      !--- Profile for table printing
    10571084    ALLOCATE(ttl(nk+2), val(nt,nk+1))
    1058     ttl(1:2) = ['iq  ','name']; ttl(3:nk+2) = ides(ip)%keys(1)%key(:)!--- Titles line with keys names
     1085    ttl(1:2) = ['it  ','name']; ttl(3:nk+2) = ides(ip)%keys(1)%key(:)!--- Titles line with keys names
    10591086    val(:,1) = ides(ip)%keys(:)%name                                 !--- Values table 1st column: isotopes names 
    10601087    DO ik = 1, nk
    … …  
    10721099
    10731100!==============================================================================================================================
     1101!=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS
     1102!==============================================================================================================================
    10741103SUBROUTINE addKey_1(key, val, ky, lOverWrite)
    1075 !------------------------------------------------------------------------------------------------------------------------------
    1076 ! Purpose: Add the <key>=<val> pair in the "ky" keys descriptor.
    1077 !------------------------------------------------------------------------------------------------------------------------------
    10781104  CHARACTER(LEN=*),  INTENT(IN)    :: key, val
    10791105  TYPE(keys_type),   INTENT(INOUT) :: ky
    10801106  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
     1107!------------------------------------------------------------------------------------------------------------------------------
    10811108  CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
    10821109  INTEGER :: iky, nky
    10831110  LOGICAL :: lo
    1084 !------------------------------------------------------------------------------------------------------------------------------
    10851111  lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
    10861112  iky = strIdx(ky%key,key)
    … …  
    10941120!==============================================================================================================================
    10951121SUBROUTINE addKey_m(key, val, ky, lOverWrite)
    1096 !------------------------------------------------------------------------------------------------------------------------------
    1097 ! Purpose: Add the <key>=<val> pair in all the components of the "ky" keys descriptor.
    1098 !------------------------------------------------------------------------------------------------------------------------------
    10991122  CHARACTER(LEN=*),  INTENT(IN)    :: key, val
    11001123  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
    11011124  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
     1125!------------------------------------------------------------------------------------------------------------------------------
    11021126  INTEGER :: itr
    11031127  LOGICAL :: lo
    1104 !------------------------------------------------------------------------------------------------------------------------------
    11051128  lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
    11061129  DO itr = 1, SIZE(ky); CALL addKey_1(key, val, ky(itr), lo); END DO
    11071130END SUBROUTINE addKey_m
    11081131!==============================================================================================================================
     1132
     1133
     1134!==============================================================================================================================
     1135!=== OVERWRITE THE KEYS OF THE TRACER NAMED "tr0" WITH THE VALUES FOUND IN THE *.def FILES, IF ANY. ===========================
     1136!==============================================================================================================================
    11091137SUBROUTINE addKeysFromDef(t, tr0)
    1110 !------------------------------------------------------------------------------------------------------------------------------
    1111 ! Purpose: The values of the keys of the tracer named "tr0" are overwritten by the values found in the *.def files, if any.
    1112 !------------------------------------------------------------------------------------------------------------------------------
    11131138  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: t(:)
    11141139  CHARACTER(LEN=*),             INTENT(IN)    :: tr0
     1140!------------------------------------------------------------------------------------------------------------------------------
    11151141  CHARACTER(LEN=maxlen) :: val
    11161142  INTEGER               :: ik, jd
    … …  
    11231149END SUBROUTINE addKeysFromDef
    11241150!==============================================================================================================================
     1151
     1152
     1153!==============================================================================================================================
     1154!=== REMOVE THE KEYS NAMED "keyn(:)" FROM EITHER THE "itr"th OR ALL THE KEYS DESCRIPTORS OF "ky(:)" ===========================
     1155!==============================================================================================================================
    11251156SUBROUTINE delKey_1(itr, keyn, ky)
    1126 !------------------------------------------------------------------------------------------------------------------------------
    1127 ! Purpose: Internal routine.
    1128 !   Remove <key>=<val> pairs in the "itr"th component of the "ky" keys descriptor.
    1129 !------------------------------------------------------------------------------------------------------------------------------
    11301157  INTEGER,          INTENT(IN)    :: itr
    11311158  CHARACTER(LEN=*), INTENT(IN)    :: keyn(:)
    11321159  TYPE(trac_type),  INTENT(INOUT) :: ky(:)
     1160!------------------------------------------------------------------------------------------------------------------------------
    11331161  CHARACTER(LEN=maxlen), ALLOCATABLE :: k(:), v(:)
    11341162  LOGICAL,               ALLOCATABLE :: ll(:)
    11351163  INTEGER :: iky
    1136 !------------------------------------------------------------------------------------------------------------------------------
    11371164  IF(itr<=0 .OR. itr>SIZE(ky, DIM=1)) RETURN                          !--- Index is out of range
    11381165  ll = [( ALL(keyn/=ky(itr)%keys%key(iky)), iky=1, SIZE(ky(itr)%keys%key) )]
    … …  
    11421169!==============================================================================================================================
    11431170SUBROUTINE delKey(keyn, ky)
    1144 !------------------------------------------------------------------------------------------------------------------------------
    1145 ! Purpose: Internal routine.
    1146 !   Remove <key>=<val> pairs in all the components of the "t" tracers descriptor.
    1147 !------------------------------------------------------------------------------------------------------------------------------
    11481171  CHARACTER(LEN=*), INTENT(IN)    :: keyn(:)
    11491172  TYPE(trac_type),  INTENT(INOUT) :: ky(:)
     1173!------------------------------------------------------------------------------------------------------------------------------
    11501174  INTEGER :: iky
    1151 !------------------------------------------------------------------------------------------------------------------------------
    11521175  DO iky = 1, SIZE(ky); CALL delKey_1(iky, keyn, ky); END DO
    11531176END SUBROUTINE delKey
    … …  
    11561179
    11571180!==============================================================================================================================
    1158 !=== PUBLIC ROUTINES: GET A KEY FROM A <key>=<val> LIST ; VECTORS, TRACER AND DATABASE VERSIONS ===============================
    1159 !=== BEWARE !!! IF THE "ky" ARGUMENT IS NOT PRESENT, THEN THE VARIABLES "tracers" AND "isotopes" ARE USED. ====================
    1160 !===     THEY ARE LOCAL TO THIS MODULE, SO MUST MUST BE INITIALIZED FIRST USING the "getKey_init" ROUTINE  ====================
     1181!=== getKey ROUTINE INITIALIZATION (TO BE EMBEDDED SOMEWHERE)  ================================================================
    11611182!==============================================================================================================================
    11621183SUBROUTINE getKey_init(tracers_, isotopes_)
    … …  
    11661187  IF(PRESENT(isotopes_)) isotopes = isotopes_
    11671188END SUBROUTINE getKey_init
     1189
     1190
     1191!==============================================================================================================================
     1192!================ GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RESULT IS THE RETURNED VALUE ===================
    11681193!==============================================================================================================================
    11691194CHARACTER(LEN=maxlen) FUNCTION fgetKeyByIndex_s1(itr, keyn, ky, def_val) RESULT(val)
    1170 !------------------------------------------------------------------------------------------------------------------------------
    1171 ! Purpose: Internal function ; get a string formatted key value (returned argument) from its name and the tracer index.
    1172 !------------------------------------------------------------------------------------------------------------------------------
    11731195  INTEGER,                    INTENT(IN) :: itr
    11741196  CHARACTER(LEN=*),           INTENT(IN) :: keyn
    … …  
    11831205!==============================================================================================================================
    11841206CHARACTER(LEN=maxlen) FUNCTION fgetKeyByName_s1(tname, keyn, ky, def_val, lerr) RESULT(val)
    1185 !------------------------------------------------------------------------------------------------------------------------------
    1186 ! Purpose: Internal function ; get a string formatted key value (returned argument) from its name and the tracer name.
    1187 !------------------------------------------------------------------------------------------------------------------------------
    11881207  CHARACTER(LEN=*),           INTENT(IN)  :: tname, keyn
    11891208  TYPE(keys_type),            INTENT(IN)  :: ky(:)
    … …  
    12001219END FUNCTION fgetKeyByName_s1
    12011220!==============================================================================================================================
     1221
     1222
     1223!==============================================================================================================================
     1224!========== GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RETURNED VALUE IS THE ERROR CODE        ==============
     1225!==========  The key "keyn" is searched in: 1)           "ky(:)%name" (if given)                                 ==============
     1226!==========                                 2)      "tracers(:)%name"                                            ==============
     1227!==========                                 3) "isotope%keys(:)%name"                                            ==============
     1228!==========  for the tracer[s] "tname[(:)]" (if given) or all the available tracers from the used set otherwise. ==============
     1229!==========  The type of the returned value(s) can be string, integer or real, scalar or vector                  ==============
     1230!==============================================================================================================================
    12021231LOGICAL FUNCTION getKeyByName_s1(keyn, val, tname, ky) RESULT(lerr)
    1203   !--- Purpose: Get the value of the key named "keyn" for the tracer named "tnam".
    1204   !     * "ky" unspecified: try in "tracers" for "tnam" with phase and tagging suffixes, then in "isotopes" without.
    1205   !     * "ky"   specified: try in "ky"      for "tnam" with phase and tagging suffixes, then without.
    1206   !    The returned error code is always .FALSE.: an empty string is returned when the key hasn't been found.
    12071232  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
    12081233  CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
    12091234  CHARACTER(LEN=*),          INTENT(IN)  :: tname
    12101235  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1236!------------------------------------------------------------------------------------------------------------------------------
    12111237  CHARACTER(LEN=maxlen) :: tnam
    12121238  INTEGER, ALLOCATABLE  :: is(:)
    … …  
    12351261  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: tname(:)
    12361262  TYPE(keys_type),          OPTIONAL, INTENT(IN)  ::    ky(:)
     1263!------------------------------------------------------------------------------------------------------------------------------
    12371264  TYPE(keys_type),           POINTER :: k(:)
    12381265  CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
    … …  
    12541281  CHARACTER(LEN=*),          INTENT(IN)  :: tname
    12551282  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1283!------------------------------------------------------------------------------------------------------------------------------
    12561284  CHARACTER(LEN=maxlen) :: sval
    12571285  INTEGER :: ierr
    … …  
    12681296  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: tname(:)
    12691297  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::    ky(:)
     1298!------------------------------------------------------------------------------------------------------------------------------
    12701299  TYPE(keys_type),           POINTER :: k(:)
    12711300  CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
    … …  
    12871316  CHARACTER(LEN=*),          INTENT(IN)  :: tname
    12881317  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1318!------------------------------------------------------------------------------------------------------------------------------
    12891319  CHARACTER(LEN=maxlen) :: sval
    12901320  INTEGER :: ierr
    … …  
    13011331  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: tname(:)
    13021332  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::    ky(:)
     1333!------------------------------------------------------------------------------------------------------------------------------
    13031334  TYPE(keys_type),           POINTER :: k(:)
    13041335  CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
    … …  
    13211352!==============================================================================================================================
    13221353ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION delPhase(s) RESULT(out)
    1323   CHARACTER(LEN=*), INTENT(IN) :: s
    1324   INTEGER :: l, i, ix
    1325   CHARACTER(LEN=maxlen) :: sh, st
    1326   out = s
    1327   IF(s == '') RETURN                                                           !--- Empty string: nothing to do
    1328 
    1329   !--- Special case: old phases for water, no phases separator
    1330   i = INDEX(s,'_'); sh = s; IF(i/=0) sh=s(1:i-1); st='H2O'; IF(i/=0) st='H2O_'//s(i+1:LEN_TRIM(s))
    1331   IF(ANY([('H2O'//old_phases(ix:ix), ix=1, nphases)] == sh)) THEN; out=st; RETURN; END IF
    1332 
    1333   !--- Index of found phase in "known_phases"
    1334   ix = MAXLOC( [(i, i=1,nphases)], MASK=[( INDEX(s, phases_sep//known_phases(i:i))/=0, i=1, nphases)], DIM=1 )
    1335   IF(ix == 0) RETURN                                                           !--- No phase pattern found
    1336   i = INDEX(s, phases_sep//known_phases(ix:ix))                                !--- Index of <sep><pha> pattern in "str"
    1337   l = LEN_TRIM(s)
    1338   IF(i == l-1) THEN                                                            !--- <var><sep><pha>       => return <var>
    1339     out = s(1:l-2)
    1340   ELSE IF(s(i+2:i+2) == '_') THEN                                              !--- <var><sep><pha>_<tag> => return <var>_<tag>
    1341     out = s(1:i-1)//s(i+2:l)
     1354  CHARACTER(LEN=*), INTENT(IN)  :: s
     1355!------------------------------------------------------------------------------------------------------------------------------
     1356  INTEGER :: ix, ip, ns
     1357  out = s; ns = LEN_TRIM(s)
     1358  IF(s == '')               RETURN                                             !--- Empty string: nothing to do
     1359  IF(s(1:3)=='H2O' .AND. INDEX(old_phases,s(4:4))/=0 .AND. (ns==4 .OR. s(5:5)=='_')) THEN
     1360    out='H2O'//s(5:ns)                                                         !--- H2O<phase>[_<iso>][_<tag>]
     1361  ELSE IF(s(ns-1:ns-1)==phases_sep .AND. INDEX(known_phases,s(ns:ns))/=0) THEN
     1362    out = s(1:ns-2); RETURN                                                    !--- <var><phase_sep><phase>
     1363  ELSE; DO ip = 1, nphases; ix = INDEX(s, phases_sep//known_phases(ip:ip)//'_'); IF(ix /= 0) EXIT; END DO
     1364    IF(ip /= nphases+1) out = s(1:ix-1)//s(ix+2:ns)                            !--- <var><phase_sep><phase>_<tag>
    13421365  END IF
    13431366END FUNCTION delPhase
    1344 !------------------------------------------------------------------------------------------------------------------------------
     1367!==============================================================================================================================
    13451368CHARACTER(LEN=maxlen) FUNCTION addPhase_s1(s,pha) RESULT(out)
    13461369  CHARACTER(LEN=*),           INTENT(IN) :: s
    13471370  CHARACTER(LEN=1),           INTENT(IN) :: pha
     1371!------------------------------------------------------------------------------------------------------------------------------
    13481372  INTEGER :: l, i
    13491373  out = s
    … …  
    13541378  IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l)                    !--- <var>_<tag> => return <var><sep><pha>_<tag>
    13551379END FUNCTION addPhase_s1
    1356 !------------------------------------------------------------------------------------------------------------------------------
     1380!==============================================================================================================================
    13571381FUNCTION addPhase_sm(s,pha) RESULT(out)
    13581382  CHARACTER(LEN=*),           INTENT(IN) :: s(:)
    13591383  CHARACTER(LEN=1),           INTENT(IN) :: pha
    13601384  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
     1385!------------------------------------------------------------------------------------------------------------------------------
    13611386  INTEGER :: k
    13621387  out = [( addPhase_s1(s(k), pha), k=1, SIZE(s) )]
    13631388END FUNCTION addPhase_sm
    1364 !------------------------------------------------------------------------------------------------------------------------------
     1389!==============================================================================================================================
    13651390CHARACTER(LEN=maxlen) FUNCTION addPhase_i1(s,ipha,phases) RESULT(out)
    13661391  CHARACTER(LEN=*),           INTENT(IN) :: s
    13671392  INTEGER,                    INTENT(IN) :: ipha
    13681393  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
     1394!------------------------------------------------------------------------------------------------------------------------------
    13691395  out = s
    13701396  IF(s == '') RETURN                                                           !--- Empty string: nothing to do
    1371   IF(ipha==0) RETURN                                                           !--- Null index: no phase to add
     1397  IF(ipha == 0 .OR. ipha > nphases) RETURN                                     !--- Absurd index: no phase to add
    13721398  IF(     PRESENT(phases)) out = addPhase_s1(s,       phases(ipha:ipha))
    13731399  IF(.NOT.PRESENT(phases)) out = addPhase_s1(s, known_phases(ipha:ipha))
    13741400END FUNCTION addPhase_i1
    1375 !------------------------------------------------------------------------------------------------------------------------------
     1401!==============================================================================================================================
    13761402FUNCTION addPhase_im(s,ipha,phases) RESULT(out)
    13771403  CHARACTER(LEN=*),           INTENT(IN) :: s(:)
    … …  
    13791405  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: phases
    13801406  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
     1407!------------------------------------------------------------------------------------------------------------------------------
    13811408  INTEGER :: k
    13821409  IF(     PRESENT(phases)) out = [( addPhase_i1(s(k), ipha,       phases), k=1, SIZE(s) )]
    13831410  IF(.NOT.PRESENT(phases)) out = [( addPhase_i1(s(k), ipha, known_phases), k=1, SIZE(s) )]
    13841411END FUNCTION addPhase_im
    1385 !------------------------------------------------------------------------------------------------------------------------------
     1412!==============================================================================================================================
    13861413
    13871414
    … …  
    13921419  CHARACTER(LEN=*),           INTENT(IN)  :: tname
    13931420  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: phases
     1421!------------------------------------------------------------------------------------------------------------------------------
    13941422  CHARACTER(LEN=maxlen) :: phase
    13951423  IF(     PRESENT(phases)) phase = getPhase(tname,       phases, iPhase)
    13961424  IF(.NOT.PRESENT(phases)) phase = getPhase(tname, known_phases, iPhase)
    13971425END FUNCTION getiPhase
    1398 !------------------------------------------------------------------------------------------------------------------------------
     1426!==============================================================================================================================
    13991427CHARACTER(LEN=1) FUNCTION getPhase(tname, phases, iPhase) RESULT(phase)
    14001428  CHARACTER(LEN=*),           INTENT(IN)  :: tname
    14011429  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: phases
    14021430  INTEGER,          OPTIONAL, INTENT(OUT) :: iPhase
     1431!------------------------------------------------------------------------------------------------------------------------------
    14031432  INTEGER :: ip
    14041433  phase = TRIM(strHead(strTail(tname, phases_sep, .TRUE.), '_', .TRUE.))
    … …  
    14081437  IF(PRESENT(iPhase)) iPhase = ip
    14091438END FUNCTION getPhase
    1410 !------------------------------------------------------------------------------------------------------------------------------
    1411 
    1412 
    1413 !------------------------------------------------------------------------------------------------------------------------------
    1414 CHARACTER(LEN=maxlen) FUNCTION old2newName_1(oldName, iPhase) RESULT(newName)
    1415   !--- Convert an old style name into a new one.
    1416   !    Only usable with old style "traceur.def" files, in which only water isotopes are allowed.
    1417   !    In these files, H2O descendants names are: H2O<phase>[_<isotope>][_<tag>], with:
    1418   !    phase = v, l or i ; isotope = eau, HDO, O18, O17 or HTO.
     1439!==============================================================================================================================
     1440
     1441
     1442!==============================================================================================================================
     1443!============ CONVERT WATER-DERIVED NAMES FROM FORMER TO CURRENT CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
     1444!======= NAMES STRUCTURE: H2O[<phase>][_<isotope>][_<tag>] (<phase> from "old_phases", <isotope> from "oldH2OIso") ============
     1445!==============================================================================================================================
     1446CHARACTER(LEN=maxlen) FUNCTION old2newH2O_1(oldName, iPhase) RESULT(newName)
    14191447  CHARACTER(LEN=*),  INTENT(IN)  :: oldName
    14201448  INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
     1449!------------------------------------------------------------------------------------------------------------------------------
    14211450  CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)
    1422   INTEGER :: ix, ip, it, nt
    1423   LOGICAL :: lerr, lH2O
     1451  INTEGER :: ix, ip, nt
     1452  LOGICAL :: lerr
    14241453  newName = oldName
    14251454  IF(PRESENT(iPhase)) iPhase = 1                                               !--- Default: gaseous phase
    1426   lH2O=.FALSE.
    1427   IF(LEN_TRIM(oldName) > 3) THEN
    1428     lH2O = oldName(1:3)=='H2O' .AND. INDEX(old_phases,oldName(4:4))/=0         !--- H2O<phase>*,  with phase=="v", "l", "i" or "r"
    1429     IF(LEN_TRIM(oldName) > 4) lH2O = lH2O .AND. oldName(5:5) == '_'            !--- H2O<phase>_*, with phase=="v", "l", "i" or "r"
     1455  lerr = strParse(oldName, '_', tmp, n=nt)                                     !--- Parsing: 1 up to 3 elements.
     1456  ip = strIdx( [('H2O'//old_phases(ix:ix), ix=1, nphases)], tmp(1) )           !--- Phase index
     1457  IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip                                !--- Returning phase index
     1458  IF(ip == 0 .AND. tmp(1) /= 'H2O')   RETURN                                   !--- Not an old-style water-related species
     1459  IF(nt == 1) THEN
     1460    newName = addPhase('H2O',ip)                                               !=== WATER WITH OR WITHOUT PHASE
     1461  ELSE
     1462    ix = strIdx(oldH2OIso, tmp(2))                                             !--- Index in the known isotopes list
     1463    IF(ix /= 0) tmp(2) = newH2OIso(ix)                                         !--- Move to new isotope name
     1464    IF(ip /= 0) tmp(2) = addPhase(tmp(2), ip)                                  !--- Add phase to isotope name
     1465    newName = TRIM(strStack(tmp(2:nt), '_'))                                   !=== WATER ISOTOPE OR TAGGING TRACER
    14301466  END IF
    1431   IF(.NOT.lH2O) RETURN
    1432   IF(LEN_TRIM(oldName)>3) THEN; IF(INDEX(old_Phases,oldName(4:4))==0) RETURN; END IF
    1433   lerr = strParse(oldName, '_', tmp, n=nt)
    1434   ip = strIdx([('H2O'//old_phases(ip:ip), ip=1, nphases)], tmp(1))             !--- Phase index (/=0 if any)
    1435   IF(PRESENT(iPhase)) iPhase = ip
    1436   newName = addPhase('H2O', ip)                                                !--- Water
    1437   IF(nt == 1) RETURN                                                           !--- Water: finished
    1438   ix = strIdx(oldH2OIso, tmp(2))                                               !--- Index in the known isotopes list
    1439   IF(ix == 0) newName = addPhase(tmp(2),        ip)                            !--- Not an isotope
    1440   IF(ix /= 0) newName = addPhase(newH2OIso(ix), ip)                            !--- Isotope
    1441   IF(nt == 3) newName = TRIM(newName)//'_'//TRIM(tmp(3))                       !--- Tagging tracer
    1442 END FUNCTION old2newName_1
    1443 !------------------------------------------------------------------------------------------------------------------------------
    1444 FUNCTION old2newName_m(oldName, iPhase) RESULT(newName)
    1445   CHARACTER(LEN=*),  INTENT(IN)  :: oldName(:)
     1467END FUNCTION old2newH2O_1
     1468!==============================================================================================================================
     1469FUNCTION old2newH2O_m(oldName) RESULT(newName)
     1470  CHARACTER(LEN=*), INTENT(IN) :: oldName(:)
     1471  CHARACTER(LEN=maxlen)        :: newName(SIZE(oldName))
     1472!------------------------------------------------------------------------------------------------------------------------------
     1473  INTEGER :: i
     1474  newName = [(old2newH2O_1(oldName(i)), i=1, SIZE(oldName))]
     1475END FUNCTION old2newH2O_m
     1476!==============================================================================================================================
     1477
     1478
     1479!==============================================================================================================================
     1480!============ CONVERT WATER-DERIVED NAMES FROM CURRENT TO FORMER CONVENTION ; OTHER NAMES ARE LEFT UNTOUCHED ==================
     1481!==== NAMES STRUCTURE: <var>[<phase_sep><phase>][_<tag>] (<phase> from "known_phases", <var> = 'H2O' or from "newH2OIso") =====
     1482!==============================================================================================================================
     1483CHARACTER(LEN=maxlen) FUNCTION new2oldH2O_1(newName, iPhase) RESULT(oldName)
     1484  CHARACTER(LEN=*),  INTENT(IN)  :: newName
    14461485  INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
    1447   CHARACTER(LEN=maxlen)          :: newName(SIZE(oldName))
     1486!------------------------------------------------------------------------------------------------------------------------------
     1487  CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)
     1488  INTEGER :: ix, ip
     1489  CHARACTER(LEN=maxlen) :: var
     1490  oldName = newName
     1491  IF(PRESENT(iPhase)) iPhase = 1                                               !--- Default: gaseous phase
     1492  ip = getiPhase(newName)                                                      !--- Phase index
     1493  IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip                                !--- Returning phase index
     1494  ix = strIdx(newH2OIso, newName)                                              !--- Index in the known H2O isotopes list
     1495  IF(ix /= 0) oldName = 'H2O'//'_'//TRIM(oldH2OIso(ix))                        !=== WATER ISOTOPE WITHOUT PHASE
     1496  IF(ix /= 0 .OR. ip == 0)           RETURN
     1497  oldName = 'H2O'//old_phases(ip:ip)
     1498  IF(newName == addPhase('H2O', ip)) RETURN                                    !=== WATER WITH PHASE
     1499  var = TRIM(strHead(newName, phases_sep, .TRUE.))                             !--- Head variable name   (no phase)
     1500  ix = strIdx(newH2OIso, var)                                                  !--- Index in the known H2O isotopes list
     1501  IF(ix == 0)                        RETURN                                    !=== H2O[vli]_<var> (<var> /= H2O isotope)
     1502  oldName = TRIM(oldName)//'_'//TRIM(oldH2OIso(ix))                            !=== WATER ISOTOPE WITH PHASE
     1503  var = addPhase(var, ip)                                                      !--- Head variable with phase
     1504  IF(newName /= var) oldName = TRIM(oldName)//strTail(newName, TRIM(var))      !=== WATER ISOTOPIC TAGGING TRACER
     1505END FUNCTION new2oldH2O_1
     1506!==============================================================================================================================
     1507FUNCTION new2oldH2O_m(newName) RESULT(oldName)
     1508  CHARACTER(LEN=*), INTENT(IN) :: newName(:)
     1509  CHARACTER(LEN=maxlen)        :: oldName(SIZE(newName))
     1510!------------------------------------------------------------------------------------------------------------------------------
    14481511  INTEGER :: i
    1449   newName = [(old2newName_1(oldName(i), iPhase), i=1, SIZE(oldName))]
    1450 END FUNCTION old2newName_m
    1451 !------------------------------------------------------------------------------------------------------------------------------
    1452 
    1453 !------------------------------------------------------------------------------------------------------------------------------
    1454 CHARACTER(LEN=maxlen) FUNCTION new2oldName_1(newName, iPhase) RESULT(oldName)
    1455   !--- Convert a new style name into an old one.
    1456   !    Only convertable names are water descendants names H2O_<phase>, <isotope>_<phase>, <isotope>_<phase>_<tag>, with:
    1457   !    phase = g, l or s ; isotope = H2[16]O, H[2]O, H2<[18]O, H2[17]O or H[3]O.
    1458   CHARACTER(LEN=*),  INTENT(IN)    :: newName
    1459   INTEGER, OPTIONAL, INTENT(OUT)   :: iPhase
    1460   INTEGER :: ix, ip, it, nt
    1461   LOGICAL :: lH2O
    1462   CHARACTER(LEN=maxlen) :: tag
    1463   ix = strIdx([(addPhase('H2O',ip), ip=1, nphases)], newName)                  !--- Phase index for H2O_<phase>
    1464   IF(ix /= 0) THEN; oldName = 'H2O'//old_phases(ix:ix); RETURN; END IF         !--- H2O_<phase> case
    1465   ix = strIdx(newH2OIso, strHead(newName, phases_sep, .TRUE.))                 !--- Isotope index
    1466   IF(ix == 0) THEN; oldName = newName;                  RETURN; END IF         !--- Not a water descendant
    1467   ip = getiPhase(newName)                                                      !--- Phase index
    1468   oldName = TRIM(oldH2OIso(ix))//old_phases(ip:ip)                             !--- <isotope>_<phase>
    1469   tag = strTail(delPhase(newName), TRIM(newH2OIso(ix)))                        !--- Get "_<tag>" if any
    1470   IF(tag /= delPhase(newName) .AND. tag /= '') oldName = TRIM(oldName)//tag    !--- Tagging tracer
    1471 END FUNCTION new2oldName_1
    1472 !------------------------------------------------------------------------------------------------------------------------------
    1473 FUNCTION new2oldName_m(newName, iPhase) RESULT(oldName)
    1474   CHARACTER(LEN=*),  INTENT(IN)  :: newName(:)
    1475   INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
    1476   CHARACTER(LEN=maxlen)          :: oldName(SIZE(newName))
    1477   INTEGER :: i
    1478   oldName = [(new2oldName_1(newName(i), iPhase), i=1, SIZE(newName))]
    1479 END FUNCTION new2oldName_m
    1480 !------------------------------------------------------------------------------------------------------------------------------
     1512  oldName = [(new2oldH2O_1(newName(i)), i=1, SIZE(newName))]
     1513END FUNCTION new2oldH2O_m
     1514!==============================================================================================================================
    14811515
    14821516
    … …  
    14881522  CHARACTER(LEN=*),  INTENT(IN) :: tname
    14891523  INTEGER, OPTIONAL, INTENT(IN) :: igen
     1524!------------------------------------------------------------------------------------------------------------------------------
    14901525  INTEGER :: ig, ix
    14911526  ig = 0; IF(PRESENT(igen)) ig = igen
    … …  
    14931528  out = ''; IF(ix /= 0) out = t(ix)%name
    14941529END FUNCTION ancestor_1
    1495 !------------------------------------------------------------------------------------------------------------------------------
     1530!==============================================================================================================================
    14961531FUNCTION ancestor_m(t, tname, igen) RESULT(out)
    14971532  CHARACTER(LEN=maxlen), ALLOCATABLE     ::   out(:)
    … …  
    14991534  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
    15001535  INTEGER,          OPTIONAL, INTENT(IN) :: igen
     1536!------------------------------------------------------------------------------------------------------------------------------
    15011537  INTEGER, ALLOCATABLE :: ix(:)
    15021538  INTEGER :: ig
    … …  
    15111547
    15121548!==============================================================================================================================
    1513 !=== GET THE INDEX(ES) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen"  IN THE TRACERS DESCRIPTORS LIST "tr" =====
     1549!=== GET THE INDEX(ES) OF THE GENERATION "igen" ANCESTOR(S) OF "tname" (t%name IF UNSPECIFIED) IN THE "t" LIST ================
    15141550!==============================================================================================================================
    15151551INTEGER FUNCTION idxAncestor_1(t, tname, igen) RESULT(out)
    1516 ! Return the name of the generation "igen" (>=0) ancestor of "tname"
    15171552  TYPE(trac_type),   INTENT(IN) :: t(:)
    15181553  CHARACTER(LEN=*),  INTENT(IN) :: tname
    15191554  INTEGER, OPTIONAL, INTENT(IN) :: igen
     1555!------------------------------------------------------------------------------------------------------------------------------
    15201556  INTEGER :: ig
    15211557  ig = 0; IF(PRESENT(igen)) ig = igen
    … …  
    15251561  DO WHILE(t(out)%iGeneration > ig); out = strIdx(t(:)%name, t(out)%parent); END DO
    15261562END FUNCTION idxAncestor_1
    1527 !------------------------------------------------------------------------------------------------------------------------------
     1563!==============================================================================================================================
    15281564FUNCTION idxAncestor_m(t, tname, igen) RESULT(out)
    15291565  INTEGER,          ALLOCATABLE          ::   out(:)
    … …  
    15311567  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
    15321568  INTEGER,          OPTIONAL, INTENT(IN) :: igen
     1569!------------------------------------------------------------------------------------------------------------------------------
    15331570  INTEGER :: ig, ix
    15341571  ig = 0; IF(PRESENT(igen)) ig = igen
Note: See TracChangeset for help on using the changeset viewer.