Changeset 13 for readTracFiles_mod.f90


Ignore:
Timestamp:
Mar 2, 2022, 6:30:48 PM (3 years ago)
Author:
dcugnet
Message:
  • Rename "iTraPha" and "iZonIso": now named "iqTraPha" and "itZonIso".
  • Add the possibility of a cloud H2O tracer (nqo=4) for ok_ice_sursat=y and 4 H2O tracers in traceur.def (commit from O. Boucher on the LMDZ trunk branch, r4075).
  • Simplify the naming (old and new conventions) operations using old2newName and new2oldName routines.
  • Remove the useless "old2newPhase".
  • Add a function form "fGetKey" for string keys, using either a string tracer name or its index.
  • Function addPhase accepts now a phase index instead of the string phase itself.
  • The fType==1 case (old traceur.def files) now really complies with the old conventions, especially for isotopes with name structure <parent[phase]>_<isotope>.
  • Add the calling routine name "modname" to some routines to improve displayed messages accuracy.
  • Propagates the new generations counting convention (from 0 and not from 1).
  • Few fixes about the %isInPhysics and %component frames.
  • Few fixes about the code imposing the water to be at the beginning of the tracers table.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • readTracFiles_mod.f90

    r12 r13  
    11MODULE readTracFiles_mod
    22
    3   USE strings_mod,    ONLY: msg, testFile,  strFind, strStack, strReduce,  strHead, strCount,   find, maxlen, fmsg, &
    4              removeComment, cat, checkList, strIdx,  strParse, strReplace, strTail, reduceExpr, test, get_in, dispTable
     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
    55  USE trac_types_mod, ONLY: trac_type, isot_type, keys_type
    66
    … …  
    1212  PUBLIC :: readTracersFiles, indexUpdate, setGeneration             !--- TOOLS ASSOCIATED TO TRACERS  DESCRIPTORS
    1313  PUBLIC :: readIsotopesFile                                         !--- TOOLS ASSOCIATED TO ISOTOPES DESCRIPTORS
    14   PUBLIC :: getKey_init, getKey, setDirectKeys                       !--- GET/SET KEYS FROM/TO tracers & isotopes
     14  PUBLIC :: getKey_init, getKey, fGetKey, setDirectKeys              !--- GET/SET KEYS FROM/TO tracers & isotopes
    1515
    1616  PUBLIC :: known_phases, old_phases, nphases, phases_names, &       !--- VARIABLES RELATED TO THE PHASES
    17             phases_sep, delPhase, addPhase, &                        !--- + ROUTINES TO ADD/REMOVE PHASE TO/FROM A NAME
    18             old2newPhase, new2oldPhase
     17            phases_sep, delPhase, addPhase, new2oldPhase,    &       !--- + ROUTINES TO ADD/REMOVE PHASE TO/FROM A NAME
     18            old2newName, new2oldName
    1919
    2020  PUBLIC :: tran0, idxAncestor, ancestor                             !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
    … …  
    3030  END INTERFACE getKey
    3131!------------------------------------------------------------------------------------------------------------------------------
     32  INTERFACE fGetKey;       MODULE PROCEDURE fgetKeyByIndex_s1, fgetKeyByName_s1; END INTERFACE fGetKey
    3233  INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
    3334  INTERFACE idxAncestor;   MODULE PROCEDURE idxAncestor_1, idxAncestor_m; END INTERFACE idxAncestor
    … …  
    4142  !--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
    4243  CHARACTER(LEN=maxlen), SAVE      :: tran0        = 'air'           !--- Default transporting fluid
    43   CHARACTER(LEN=maxlen), PARAMETER :: old_phases   = 'vlir'          !--- Old phases for water (no separator)
    44   CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsr'          !--- Known phases initials
     44  CHARACTER(LEN=maxlen), PARAMETER :: old_phases   = 'vli'           !--- Old phases for water (no separator)
     45  CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'gls'           !--- Known phases initials
    4546  INTEGER,               PARAMETER :: nphases=LEN_TRIM(known_phases) !--- Number of phases
    4647  CHARACTER(LEN=maxlen), SAVE      :: phases_names(nphases) &        !--- Known phases names
    47                                 = ['gaseous', 'liquid ', 'solid  ', 'cloud  ']
     48                                = ['gaseous', 'liquid ', 'solid  ']
    4849  CHARACTER(LEN=1), SAVE :: phases_sep  =  '_'                       !--- Phase separator
    4950  LOGICAL,          SAVE :: tracs_merge = .TRUE.                     !--- Merge/stack tracers lists
    … …  
    8788  INTEGER,                      INTENT(OUT) :: fType                  !--- Type of input file found
    8889  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tracs(:)
    89   CHARACTER(LEN=maxlen),  ALLOCATABLE ::  s(:), sections(:), trac_files(:)
    90   CHARACTER(LEN=maxlen) :: str, fname, mesg, oldH2O, newH2O
     90  CHARACTER(LEN=maxlen),  ALLOCATABLE :: s(:), sections(:), trac_files(:)
     91  CHARACTER(LEN=maxlen) :: str, fname, mesg
    9192  INTEGER               :: is, nsec, ierr, it, ntrac, ns, ip, ix
    9293  LOGICAL, ALLOCATABLE  :: ll(:), lGen3(:)
    … …  
    142143        CALL msg('This file is for air tracers only',           modname, ns == 3 .AND. it == 1)
    143144        CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
    144         tracs(it)%name = TRIM(s(3))                                  !--- Set %name:   name of the tracer
    145         tracs(it)%parent = tran0                                     !--- Set %parent: transporting fluid
    146         IF(ns == 4) tracs(it)%parent = s(4)                          !---     default: 'air' or defined in the file
    147         tracs(it)%phase = known_phases(1:1)                          !--- Set %phase:  tracer phase (default: "g"azeous)
     145        tracs(it)%name   = old2newName(s(3), ip)                     !--- Set %name:   name  of the tracer
     146        tracs(it)%parent = tran0                                     !--- Default transporting fluid name
     147        IF(ns == 4) tracs(it)%parent = old2newName(s(4))             !--- Set %parent: parent of the tracer
     148        tracs(it)%phase = known_phases(ip:ip)                        !--- Set %phase:  tracer phase (default: "g"azeous)
    148149        tracs(it)%component = TRIM(type_trac)                        !--- Set %component: model component name
    149150        tracs(it)%keys%key = ['hadv', 'vadv']                        !--- Set %keys%key
    … …  
    151152      END DO
    152153      CLOSE(90)
    153       DO ip = 1, nphases                                             !--- Deal with old water names
    154         oldH2O = addPhase('H2O', ip, '')
    155         newH2O = addPhase('H2O', ip)
    156         ix = strIdx(tracs(:)%name, oldH2O)
    157         IF(ix == 0) CYCLE
    158         tracs(ix)%name  = newH2O                                     !--- Set %name:   name of the tracer
    159         WHERE(tracs(:)%parent == oldH2O) tracs(:)%parent = newH2O    !--- Set %parent: transporting fluid
    160         tracs(ix)%phase = known_phases(ip:ip)                        !--- Set %phase:  tracer phase
    161       END DO
    162154      CALL setGeneration(tracs)                                      !--- Set %iGeneration and %gen0Name
    163       WHERE(tracs%iGeneration == 3) tracs%type = 'tag'               !--- Set %type:        'tracer' or 'tag'
     155      WHERE(tracs%iGeneration == 2) tracs%type = 'tag'               !--- Set %type:        'tracer' or 'tag'
    164156      IF(test(checkTracers(tracs, fname, fname), lerr)) RETURN       !--- Detect orphans and check phases
    165157      IF(test(checkUnique (tracs, fname, fname), lerr)) RETURN       !--- Detect repeated tracers
    … …  
    167159      tracs(:)%keys%name = tracs(:)%name                             !--- Copy tracers names in keys components
    168160    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    169     CASE(2); IF(test(feedDBase(["tracer.def"],[type_trac]), lerr)) RETURN  !=== SINGLE FILE, COMA-SEPARATED SECTIONS LIST
     161    CASE(2); IF(test(feedDBase(["tracer.def"], [type_trac], modname), lerr)) RETURN !=== SINGLE   FILE, MULTIPLE SECTIONS
    170162    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    171     CASE(3); IF(test(feedDBase(  trac_files  , sections  ), lerr)) RETURN  !=== MULTIPLE FILES, ONE SECTION EACH FILE
     163    CASE(3); IF(test(feedDBase(  trac_files  ,  sections,   modname), lerr)) RETURN !=== MULTIPLE FILES, SINGLE  SECTION
    172164  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    173165  END SELECT
    174166  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    175167
    176   IF(ANY([2,3] == fType) .AND. nsec > 1) THEN
    177     IF(tracs_merge) THEN
    178       CALL msg('The multiple required sections will be MERGED.',    modname)
    179       IF(test(mergeTracers(dBase, tracs), lerr)) RETURN
    180     ELSE
    181       CALL msg('The multiple required sections will be CUMULATED.', modname)
    182       IF(test(cumulTracers(dBase, tracs), lerr)) RETURN
    183     END IF
    184     WHERE(tracs%gen0Name(1:3) /= 'H2O') tracs%isInPhysics=.TRUE.     !--- Set %isInPhysics: passed to physics
    185     CALL setDirectKeys(tracs)                                        !--- Set %iqParent, %iqDescen, %nqDescen, %nqChilds
     168  IF(ALL([2,3] /= fType)) RETURN
     169
     170  IF(nsec  == 1) THEN;
     171    tracs = dBase(1)%trac
     172  ELSE IF(tracs_merge) THEN
     173    CALL msg('The multiple required sections will be MERGED.',    modname)
     174    IF(test(mergeTracers(dBase, tracs), lerr)) RETURN
     175  ELSE
     176    CALL msg('The multiple required sections will be CUMULATED.', modname)
     177    IF(test(cumulTracers(dBase, tracs), lerr)) RETURN
    186178  END IF
     179  WHERE(tracs%gen0Name(1:3) /= 'H2O') tracs%isInPhysics=.TRUE.       !--- Set %isInPhysics: passed to physics
     180  CALL setDirectKeys(tracs)                                          !--- Set %iqParent, %iqDescen, %nqDescen, %nqChilds
    187181
    188182END FUNCTION readTracersFiles
    … …  
    190184
    191185!==============================================================================================================================
    192 LOGICAL FUNCTION feedDBase(fnames, snames) RESULT(lerr)
     186LOGICAL FUNCTION feedDBase(fnames, snames, modname) RESULT(lerr)
    193187! Purpose: Read the sections "snames(is)" (coma-separated list) from each "fnames(is)"
    194188!   file and create the corresponding tracers set descriptors in the database "dBase":
    … …  
    200194  CHARACTER(LEN=*), INTENT(IN)  :: fnames(:)                         !--- Files names
    201195  CHARACTER(LEN=*), INTENT(IN)  :: snames(:)                         !--- Coma-deparated list of sections (one list each file)
    202   INTEGER,  ALLOCATABLE :: ndb(:)                                    !--- Nuber of sections for each file
     196  CHARACTER(LEN=*), INTENT(IN)  :: modname                           !--- Calling routine name
     197  INTEGER,  ALLOCATABLE :: ndb(:)                                    !--- Number of sections for each file
    203198  INTEGER,  ALLOCATABLE :: ixf(:)                                    !--- File index for each section of the expanded list
    204199  LOGICAL,  ALLOCATABLE :: lTg(:)                                    !--- Tagging tracers mask
    205   CHARACTER(LEN=maxlen) :: fnm, snm, modname
     200  CHARACTER(LEN=maxlen) :: fnm, snm
    206201  INTEGER               :: idb, i
    207202  LOGICAL :: ll
    208203!------------------------------------------------------------------------------------------------------------------------------
    209   modname = 'feedDBase'
    210204  !=== READ THE REQUIRED SECTIONS
    211205  ll = strCount(snames, ',', ndb)                                    !--- Number of sections for each file
    … …  
    219213  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    220214    fnm = fnames(ixf(idb)); snm = dBase(idb)%name                    !--- FILE AND SECTION NAMES
     215    lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
    221216    IF(test(expandSection(dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- EXPAND NAMES ;  set %parent, %type, %component
    222217    CALL setGeneration   (dBase(idb)%trac)                           !---                 set %iGeneration,   %genOName
    … …  
    225220    CALL expandPhases    (dBase(idb)%trac)                           !--- EXPAND PHASES ; set %phase
    226221    CALL sortTracers     (dBase(idb)%trac)                           !--- SORT TRACERS
     222    lerr = ANY([(dispTraSection('EXPANDED CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
    227223  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    228224  END DO
    229225  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    230 
    231   !=== DISPLAY BASIC INFORMATION
    232   lerr = ANY([( dispTraSection('Expanded list for section "'//TRIM(dBase(idb)%name)//'"', dBase(idb)%name, modname), &
    233                 idb=1, SIZE(dBase) )])
    234226END FUNCTION feedDBase
    235227!------------------------------------------------------------------------------------------------------------------------------
    … …  
    406398  DO it = 1, nt                                                      !=== EXPAND TRACERS AND PARENTS NAMES LISTS
    407399  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    408     ll = strParse(tr(it)%name, ',', ta, n=ntr)                       !--- Number of tracers
     400    ll = strParse(tr(it)%name,   ',', ta, n=ntr)                     !--- Number of tracers
    409401    ll = strParse(tr(it)%parent, ',', pa, n=npr)                     !--- Number of parents
    410402    DO ipr=1,npr                                                     !--- Loop on parents list elts
    411403      DO itr=1,ntr                                                   !--- Loop on tracers list elts
    412404        i = iq+itr-1+(ipr-1)*ntr
    413         ttr(i)%name = TRIM(ta(itr)); ttr(i)%parent = pa(ipr)
    414         ttr(i)%keys = keys_type(ta(itr), tr(it)%keys%key, tr(it)%keys%val)
     405        ttr(i)%name   = TRIM(ta(itr))
     406        ttr(i)%parent = TRIM(pa(ipr))
     407        ttr(i)%keys   = keys_type(ta(itr), tr(it)%keys%key, tr(it)%keys%val)
    415408      END DO
    416409    END DO
    417     ttr(iq:iq+ntr*npr-1)%type = tr(it)%type                          !--- Duplicating type
     410    ttr(iq:iq+ntr*npr-1)%type      = tr(it)%type                     !--- Duplicating type
     411    ttr(iq:iq+ntr*npr-1)%component = tr(it)%component                !--- Duplicating type
    418412    iq = iq + ntr*npr
    419413  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    … …  
    440434  tr(:)%iGeneration = -1                                             !--- error if -1
    441435  nq = SIZE(tr, DIM=1)                                               !--- Number of tracers lines
    442   lg = tr(:)%parent == tran0                                         !--- First generation tracers flag
    443   WHERE(lg) tr(:)%iGeneration = 0                                    !--- First generation tracers
     436  lg = tr(:)%parent == tran0                                         !--- Flag for generation 0 tracers
     437  WHERE(lg) tr(:)%iGeneration = 0                                    !--- Generation 0 tracers
    444438
    445439  !=== Determine generation for each tracer
    … …  
    511505    ll = tr(:)%name==TRIM(tnam)                                      !--- Mask for current tracer name
    512506    IF(COUNT(ll)==1 ) CYCLE                                          !--- Tracer is not repeated
    513     IF(tr(iq)%iGeneration>1) THEN
    514       tdup(iq) = tnam                                                !--- gen>1: MUST be unique
     507    IF(tr(iq)%iGeneration>0) THEN
     508      tdup(iq) = tnam                                                !--- gen>0: MUST be unique
    515509    ELSE
    516510      DO ip=1,nphases; p=known_phases(ip:ip)                         !--- Loop on known phases
    … …  
    531525SUBROUTINE expandPhases(tr)
    532526!------------------------------------------------------------------------------------------------------------------------------
    533 ! Purpose: Expand the phases in the tracers descriptor "tr".
     527! Purpose: Expand the phases in the tracers descriptor "tr". Phases are not repeated for a tracer, thanks to "checkUnique".
    534528!------------------------------------------------------------------------------------------------------------------------------
    535529  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)               !--- Tracer derived type vector
    … …  
    538532  INTEGER,   ALLOCATABLE ::  i0(:)
    539533  CHARACTER(LEN=maxlen)  :: nam, pha, trn
     534  CHARACTER(LEN=1) :: p
    540535  INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
    541536  LOGICAL :: lTg, lEx
    … …  
    544539  nt = 0
    545540  DO iq = 1, nq                                                      !--- GET THE NUMBER OF TRACERS
    546     IF(tr(iq)%iGeneration /= 1) CYCLE
    547     nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=1)  !--- Number of childs of tr(iq)
     541    IF(tr(iq)%iGeneration /= 0) CYCLE                                !--- Only deal with generation 0 tracers
     542    nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=0)  !--- Number of childs of tr(iq)
    548543    tr(iq)%phase = fgetKey(iq, 'phases', tr(:)%keys)                 !--- Phases list      of tr(iq)
    549544    np = LEN_TRIM(tr(iq)%phase)                                      !--- Number of phases of tr(iq)
    550545    nt = nt + (1+nc) * np                                            !--- Number of tracers after expansion
    551546  END DO
    552   ALLOCATE(ttr(nt))
     547  ALLOCATE(ttr(nt))                                                  !--- Version  of "tr" after phases expansion
    553548  it = 1                                                             !--- Current "ttr(:)" index
    554549  DO iq = 1, nq                                                      !--- Loop on "tr(:)" indexes
    555550    lTg = tr(iq)%type=='tag'                                         !--- Current tracer is a tag
    556551    i0 = strFind(tr(:)%name, TRIM(tr(iq)%gen0Name), n)               !--- Indexes of first generation ancestor copies
    557     np = SUM( [( LEN_TRIM(tr(i0(i))%phase),i=1,n )],1)               !--- Number of phases for current tracer tr(iq)
    558     lEx = np>1                                                       !--- Need of a phase suffix
    559     IF(lTg) lEx=lEx.AND.tr(iq)%iGeneration>1                         !--- No phase suffix for first generation tags
    560     DO i=1,n                                                         !=== LOOP ON FIRST GENERATION ANCESTORS
    561       jq=i0(i)                                                       !--- tr(jq): ith copy of 1st gen. ancestor of tr(iq)
    562       IF(tr(iq)%iGeneration==1) jq=iq                                !--- Generation 1: current tracer phases only
     552    np = SUM([( LEN_TRIM(tr(i0(i))%phase),i=1,n )], 1)               !--- Number of phases for current tracer tr(iq)
     553    lEx = np>1                                                       !--- Phase suffix only required if phases number is > 1
     554    IF(lTg) lEx = lEx .AND. tr(iq)%iGeneration>0                     !--- No phase suffix for generation 0 tags
     555    DO i=1,n                                                         !=== LOOP ON GENERATION 0 ANCESTORS
     556      jq = i0(i)                                                     !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq)
     557      IF(tr(iq)%iGeneration==0) jq=iq                                !--- Generation 0: count the current tracer phases only
    563558      pha = tr(jq)%phase                                             !--- Phases list for tr(jq)
    564       DO ip=1,LEN_TRIM(pha)                                          !=== LOOP ON PHASES LISTS
    565         trn=TRIM(tr(iq)%name); nam=trn                               !--- Tracer name (regular case)
     559      DO ip = 1, LEN_TRIM(pha)                                       !=== LOOP ON PHASES LISTS
     560        p = pha(ip:ip)
     561        trn = TRIM(tr(iq)%name); nam = trn                           !--- Tracer name (regular case)
    566562        IF(lTg) nam = TRIM(tr(iq)%parent)                            !--- Parent name (tagging case)
    567         IF(lEx) nam = addPhase(nam, ip)                              !--- Phase extension needed
     563        IF(lEx) nam = addPhase(nam, p )                              !--- Phase extension needed
    568564        IF(lTg) nam = TRIM(nam)//'_'//TRIM(trn)                      !--- <parent>_<name> for tags
    569565        ttr(it) = tr(iq)                                             !--- Same <key>=<val> pairs
    570         ttr(it)%name = TRIM(nam)                                     !--- Name with possibly phase suffix
     566        ttr(it)%name      = TRIM(nam)                                !--- Name with possibly phase suffix
    571567        ttr(it)%keys%name = TRIM(nam)                                !--- Name inside the keys decriptor
    572         ttr(it)%phase = pha(ip:ip)                                   !--- Single phase entry
    573         IF(lEx.AND.tr(iq)%iGeneration>1) THEN
    574           ttr(it)%parent   = addPhase(ttr(it)%parent,   ip)          !--- Modify parent name
    575           ttr(it)%gen0Name = addPhase(ttr(it)%gen0Name, ip)          !--- Modify generation 0 ancestor name
     568        ttr(it)%phase     = p                                        !--- Single phase entry
     569        IF(lEx .AND. tr(iq)%iGeneration>0) THEN
     570          ttr(it)%parent   = addPhase(ttr(it)%parent,   p)
     571          ttr(it)%gen0Name = addPhase(ttr(it)%gen0Name, p)
    576572        END IF
    577         it=it+1
     573        it = it+1
    578574      END DO
    579       IF(tr(iq)%iGeneration==1) EXIT                                 !--- Break phase loop for gen 1
     575      IF(tr(iq)%iGeneration==0) EXIT                                 !--- Break phase loop for gen 0
    580576    END DO
    581577  END DO
    … …  
    590586!------------------------------------------------------------------------------------------------------------------------------
    591587! Purpose: Sort tracers:
    592 !  * Put water at first places, in the "known_phases" order.
     588!  * Put water at the beginning of the vector, in the "known_phases" order.
    593589!  * lGrowGen == T: in ascending generations numbers.
    594590!  * lGrowGen == F: tracer + its childs sorted by growing generation, one after the other.
    595591!   TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
    596592!------------------------------------------------------------------------------------------------------------------------------
    597   TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)               !--- Tracer derived type vector
     593  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)         !--- Tracer derived type vector
     594!  TYPE(trac_type), ALLOCATABLE :: ttr(:)
     595  INTEGER,         ALLOCATABLE :: iy(:), iz(:)
    598596  INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
    599   INTEGER, ALLOCATABLE :: iy(:), iz(:)
    600597!------------------------------------------------------------------------------------------------------------------------------
    601598  nq = SIZE(tr)
    602   iy = [(k, k=1, nq)]
    603599  DO ip = nphases, 1, -1
    604600    iq = strIdx(tr(:)%name, addPhase('H2O', ip))
    605     IF(iq/=0) iy = [iq, iy(1:iq-1), iy(iq+1:nq)]
    606   END DO
    607   tr = tr(iy)                                                        !--- Water displaces at first positions
    608   iq = 1
     601    IF(iq == 0) CYCLE
     602    tr = tr([iq, 1:iq-1, iq+1:nq])
     603!    tr(:)%name = nam
     604  END DO
    609605  IF(lSortByGen) THEN
     606    iq = 1
    610607    ng = MAXVAL(tr(:)%iGeneration, MASK=.TRUE., DIM=1)               !--- Number of generations
    611608    DO ig = 0, ng                                                    !--- Loop on generations
    … …  
    616613    END DO
    617614  ELSE
    618     DO jq = 1, nq                                                    !--- Loop on first generation tracers
    619       IF(tr(jq)%iGeneration /= 1) CYCLE                              !--- Skip generations >= 1
    620       ix(iq) = jq                                                    !--- First generation ancestor index first
    621       iq = iq + 1
     615    iq = 1
     616    DO jq = 1, nq                                                    !--- Loop on generation 0 tracers
     617      IF(tr(jq)%iGeneration /= 0) CYCLE                              !--- Skip generations /= 0
     618      ix(iq) = jq                                                    !--- Generation 0 ancestor index first
     619      iq = iq + 1                                                    !--- Next "iq" for next generations tracers
    622620      iy = strFind(tr(:)%gen0Name, TRIM(tr(jq)%name))                !--- Indexes of "tr(jq)" childs in "tr(:)"
    623       ng = MAXVAL(tr(iy)%iGeneration, MASK=.TRUE., DIM=1)            !--- Generations number of the "tr(jq)" family
    624       DO ig = 2, ng                                                  !--- Loop   on generations for the tr(jq) family
     621      ng = MAXVAL(tr(iy)%iGeneration, MASK=.TRUE., DIM=1)            !--- Number of generations of the "tr(jq)" family
     622      DO ig = 1, ng                                                  !--- Loop   on generations of the "tr(jq)" family
    625623        iz = find(tr(iy)%iGeneration, ig, n)                         !--- Indexes of the tracers "tr(iy(:))" of generation "ig"
    626624        ix(iq:iq+n-1) = iy(iz)                                       !--- Same indexes in "tr(:)"
    … …  
    757755  INTEGER :: idb, iq, nq
    758756  INTEGER, ALLOCATABLE :: hadv(:), vadv(:)
     757  CHARACTER(LEN=maxlen), ALLOCATABLE :: phas(:)
    759758  TYPE(trac_type), POINTER :: tm(:)
    760759  lerr = .FALSE.
    … …  
    762761  tm => dBase(idb)%trac
    763762  nq = SIZE(tm)
    764   IF(test(getKeyByName_im('hadv', hadv, tm(:)%name, tm(:)%keys),lerr)) RETURN
    765   IF(test(getKeyByName_im('vadv', vadv, tm(:)%name, tm(:)%keys),lerr)) RETURN
     763  !--- BEWARE ! Can't always already use the "getKeyByName" functions.
     764  !             Names must first include the phases for tracers defined on multiple lines.
     765  hadv = str2int([(fgetKey(iq, 'hadv',  tm(:)%keys, '10'), iq=1, nq)])
     766  vadv = str2int([(fgetKey(iq, 'vadv',  tm(:)%keys, '10'), iq=1, nq)])
     767  phas =         [(fgetKey(iq, 'phases',tm(:)%keys, 'g' ), iq=1, nq)]
    766768  CALL msg(TRIM(message)//':', modname)
    767   IF(test(dispTable('iiissis', ['iq        ','hadv      ','vadv      ','short name','parent    ','igen      ','phase     '], &
    768     cat(tm(:)%name,  tm(:)%parent, tm(:)%phase), cat([(iq, iq=1, nq)],  hadv,  vadv, tm(:)%iGeneration)), lerr)) RETURN
     769  IF(tm(1)%parent == '') THEN
     770    IF(test(dispTable('iiiss',   ['iq    ','hadv  ','vadv  ','name  ','phase '], cat(tm%name, phas), cat([(iq, iq=1, nq)], &
     771                                            hadv,    vadv),                 sub=modname), lerr)) RETURN
     772  ELSE
     773    IF(test(dispTable('iiissis', ['iq    ','hadv  ','vadv  ','name  ','parent','igen  ','phase '], cat(tm%name, tm%parent, &
     774           tm%phase), cat([(iq, iq=1, nq)], hadv,    vadv, tm%iGeneration), sub=modname), lerr)) RETURN
     775  END IF
    769776END FUNCTION dispTraSection
    770777!==============================================================================================================================
    … …  
    847854!=== NOTES:                                                                                                                ====
    848855!===  * Most of the "isot" components have been defined in the calling routine (initIsotopes):                             ====
    849 !===      parent,  nzone, zone(:),  niso, keys(:)%name,  ntiso, trac(:),  nphas, phas,  iTraPha(:,:),  iZonPhi(:,:)        ====
     856!===      parent,  nzone, zone(:),  niso, keys(:)%name,  ntiso, trac(:),  nphas, phas,  iqTraPha(:,:),  itZonPhi(:,:)      ====
    850857!===  * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes       ====
    851858!===  * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values             ====
    … …  
    909916    ALLOCATE(tdb(nb0-1)); tdb(1:nb0-1)=dBase(1:nb0-1); CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
    910917  END IF
     918
     919  !--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
     920  CALL get_in('ok_iso_verif', isot(strIdx(isot%parent, 'H2O'))%check, .FALSE.)
     921
    911922  lerr = dispIsotopes(isot, 'Isotopes parameters read from file', modname)
    912923
    … …  
    930941  LOGICAL, ALLOCATABLE :: ll(:)                                      !--- Mask
    931942  TYPE(trac_type), POINTER   ::  t(:), t1
    932   TYPE(isot_type), POINTER   ::  s
     943  TYPE(isot_type), POINTER   ::  i
    933944
    934945  t => trac
    935946
    936   p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==2) !--- Parents of 2nd generation isotopes
     947  p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1) !--- Parents of generation 1 isotopes
    937948  CALL strReduce(p, nbIso)
    938949  ALLOCATE(isot(nbIso))
    … …  
    943954  isot(:)%parent = p
    944955  DO ic = 1, SIZE(p)                                                 !--- Loop on isotopes classes
    945     s => isot(ic)
    946     iname = s%parent                                                 !--- Current isotopes class name (parent tracer name)
     956    i => isot(ic)
     957    iname = i%parent                                                 !--- Current isotopes class name (parent tracer name)
    947958
    948959    !=== Isotopes childs of tracer "iname": mask, names, number (same for each phase of "iname")
    949960    ll = t(:)%type=='tracer' .AND. delPhase(t(:)%parent) == iname .AND. t(:)%phase == 'g'
    950961    str = PACK(delPhase(t(:)%name), MASK = ll)                       !--- Effectively found isotopes of "iname"
    951     s%niso = SIZE(str)                                               !--- Number of "effectively found isotopes of "iname"
    952     ALLOCATE(s%keys(s%niso))
    953     FORALL(it = 1:s%niso) s%keys(it)%name = str(it)
     962    i%niso = SIZE(str)                                               !--- Number of "effectively found isotopes of "iname"
     963    ALLOCATE(i%keys(i%niso))
     964    FORALL(it = 1:i%niso) i%keys(it)%name = str(it)
    954965
    955966    !=== Geographic tagging tracers descending on tracer "iname": mask, names, number
    956     ll = t(:)%type=='tag'    .AND. delPhase(t(:)%gen0Name) == iname .AND. t(:)%iGeneration == 3
    957     s%zone = PACK(strTail(t(:)%name,'_',lFirst=.TRUE.), MASK = ll)   !--- Tagging zones names  for isotopes category "iname"
    958     CALL strReduce(s%zone)
    959     s%nzone = SIZE(s%zone)                                           !--- Tagging zones number for isotopes category "iname"
     967    ll = t(:)%type=='tag'    .AND. delPhase(t(:)%gen0Name) == iname .AND. t(:)%iGeneration == 2
     968    i%zone = PACK(strTail(t(:)%name,'_',lFirst=.TRUE.), MASK = ll)   !--- Tagging zones names  for isotopes category "iname"
     969    CALL strReduce(i%zone)
     970    i%nzone = SIZE(i%zone)                                           !--- Tagging zones number for isotopes category "iname"
    960971
    961972    !=== Geographic tracers of the isotopes childs of tracer "iname" (same for each phase of "iname")
    … …  
    963974    str = PACK(delPhase(t(:)%name), MASK=ll)
    964975    CALL strReduce(str)
    965     s%ntiso = s%niso + SIZE(str)                                     !--- Number of isotopes + their geographic tracers [ntraciso]
    966     ALLOCATE(s%trac(s%ntiso))
    967     FORALL(it = 1:s%niso) s%trac(it) = s%keys(it)%name
    968     FORALL(it = s%niso+1:s%ntiso) s%trac(it) = str(it-s%niso)
     976    i%ntiso = i%niso + SIZE(str)                                     !--- Number of isotopes + their geographic tracers [ntraciso]
     977    ALLOCATE(i%trac(i%ntiso))
     978    FORALL(it = 1:i%niso) i%trac(it) = i%keys(it)%name
     979    FORALL(it = i%niso+1:i%ntiso) i%trac(it) = str(it-i%niso)
    969980
    970981    !=== Phases for tracer "iname"
    971     s%phase = ''
    972     DO ip = 1, nphases; ph = known_phases(ip:ip); IF(strIdx(t%name,addPhase(iname, ph)) /= 0) s%phase = TRIM(s%phase)//ph; END DO
    973     s%nphas = LEN_TRIM(s%phase)                                       !--- Equal to "nqo" for water
     982    i%phase = ''
     983    DO ip = 1, nphases; ph = known_phases(ip:ip); IF(strIdx(t%name,addPhase(iname, ph)) /= 0) i%phase = TRIM(i%phase)//ph; END DO
     984    i%nphas = LEN_TRIM(i%phase)                                       !--- Equal to "nqo" for water
    974985
    975986    !=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
    976987    DO iq = 1, SIZE(t)
    977988      t1 => trac(iq)
    978       IF(delPhase(t1%gen0Name) /= iname) CYCLE                       !--- Only deal with tracers descending on "iname"
     989      IF(delPhase(t1%gen0Name)/=iname .OR. t1%iGeneration==0) CYCLE  !--- Only deal with tracers descending on "iname"
    979990      t1%iso_iGroup = ic                                             !--- Isotopes family       idx in list "isotopes(:)%parent"
    980       t1%iso_iName  = strIdx(s%trac, delPhase(strHead(t1%name,'_'))) !--- Current isotope       idx in effective isotopes list
    981       t1%iso_iZone  = strIdx(s%zone,          strTail(t1%name,'_') ) !--- Current isotope zone  idx in effective zones    list
    982       t1%iso_iPhase =  INDEX(s%phase,TRIM(t1%phase))                 !--- Current isotope phase idx in effective phases   list
    983       IF(t1%iGeneration /= 3) t1%iso_iZone = 0                       !--- Skip possible generation 2 tagging tracers
     991      t1%iso_iName  = strIdx(i%trac, delPhase(strHead(t1%name,'_'))) !--- Current isotope       idx in effective isotopes list
     992      t1%iso_iZone  = strIdx(i%zone,          strTail(t1%name,'_') ) !--- Current isotope zone  idx in effective zones    list
     993      t1%iso_iPhase =  INDEX(i%phase,TRIM(t1%phase))                 !--- Current isotope phase idx in effective phases   list
     994      IF(t1%iGeneration /= 2) t1%iso_iZone = 0                       !--- Skip possible generation 1 tagging tracers
    984995    END DO
    985996
    986997    !=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
    987998    !    (including tagging tracers) is sorted this way:  iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
    988     s%iTraPha = RESHAPE( [( (strIdx(t(:)%name,  addPhase(s%trac(it),s%phase(ip:ip))),    it=1, s%ntiso), ip=1, s%nphas)], &
    989                          [s%ntiso, s%nphas] )
    990 
     999    i%iqTraPha = RESHAPE( [( (strIdx(t%name,  addPhase(i%trac(it),i%phase(ip:ip))),    it=1, i%ntiso), ip=1, i%nphas)], &
     1000                         [i%ntiso, i%nphas] )
    9911001    !=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
    992     s%iZonIso = RESHAPE( [( (strIdx(s%trac(:), TRIM(s%trac(it))//'_'//TRIM(s%zone(iz))), iz=1, s%nzone), it=1, s%niso )], &
    993                          [s%nzone, s%niso] )
     1002    i%itZonIso = RESHAPE( [( (strIdx(i%trac(:), TRIM(i%trac(it))//'_'//TRIM(i%zone(iz))), iz=1, i%nzone), it=1, i%niso )], &
     1003                         [i%nzone, i%niso] )
    9941004  END DO
    9951005
    … …  
    10231033      END DO
    10241034    END DO
    1025     IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, cat([(it,it=1,nt)]), rFmt='(EN8.4)')), &
    1026        lerr)) RETURN
     1035    IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, cat([(it,it=1,nt)]), rFmt='(EN8.4)',    &
     1036       sub=modname)), lerr)) RETURN
    10271037    DEALLOCATE(ttl, val)
    10281038  END DO       
    … …  
    10781088  IF(jd == 0) RETURN
    10791089  DO ik = 1, SIZE(t(jd)%keys%key)
    1080     CALL get_in(t(jd)%keys%key(ik), val, 'zzzz')
    1081     IF(val /= 'zzzz') CALL addKey_1(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
     1090    CALL get_in(t(jd)%keys%key(ik), val, '*none*')
     1091    IF(val /= '*none*') CALL addKey_1(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
    10821092  END DO
    10831093END SUBROUTINE addKeysFromDef
    … …  
    11271137END SUBROUTINE getKey_init
    11281138!==============================================================================================================================
    1129 CHARACTER(LEN=maxlen) FUNCTION fgetKey(itr, keyn, ky, def_val) RESULT(out)
    1130 !------------------------------------------------------------------------------------------------------------------------------
    1131 ! Purpose: Internal function ; get a key value in string format (this is the returned argument).
     1139CHARACTER(LEN=maxlen) FUNCTION fgetKeyByIndex_s1(itr, keyn, ky, def_val) RESULT(val)
     1140!------------------------------------------------------------------------------------------------------------------------------
     1141! Purpose: Internal function ; get a string formatted key value (returned argument) from its name and the tracer index.
    11321142!------------------------------------------------------------------------------------------------------------------------------
    11331143  INTEGER,                    INTENT(IN) :: itr
    … …  
    11361146  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
    11371147!------------------------------------------------------------------------------------------------------------------------------
    1138   INTEGER :: ik
    1139   ik = 0; IF(itr>0 .AND. itr<=SIZE(ky)) ik = strIdx(ky(itr)%key(:), keyn)
    1140   out = '';              IF(ik /= 0) out = ky(itr)%val(ik)           !--- Key was found
    1141   IF(PRESENT(def_val) .AND. ik == 0) out = def_val                   !--- Default value from arguments
    1142 END FUNCTION fgetKey
     1148  INTEGER :: iky
     1149  iky = 0;  IF(itr >  0 .AND. itr <= SIZE(ky)) iky = strIdx(ky(itr)%key(:), keyn)
     1150  val = ''; IF(iky /= 0) val = ky(itr)%val(iky)                      !--- Key was found
     1151  IF(PRESENT(def_val) .AND. iky == 0) val = def_val                  !--- Default value from arguments
     1152END FUNCTION fgetKeyByIndex_s1
     1153!==============================================================================================================================
     1154CHARACTER(LEN=maxlen) FUNCTION fgetKeyByName_s1(tname, keyn, ky, def_val, lerr) RESULT(val)
     1155!------------------------------------------------------------------------------------------------------------------------------
     1156! Purpose: Internal function ; get a string formatted key value (returned argument) from its name and the tracer name.
     1157!------------------------------------------------------------------------------------------------------------------------------
     1158  CHARACTER(LEN=*),           INTENT(IN)  :: tname, keyn
     1159  TYPE(keys_type),            INTENT(IN)  :: ky(:)
     1160  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: def_val
     1161  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
     1162!------------------------------------------------------------------------------------------------------------------------------
     1163  INTEGER :: iky, itr
     1164  val = ''; iky = 0
     1165  itr = strIdx(ky(:)%name, tname)                                    !--- Get the index of the wanted tracer
     1166  IF(PRESENT(lerr)) lerr = itr==0; IF(itr == 0) RETURN
     1167  IF(itr >  0 .AND. itr <= SIZE(ky)) iky = strIdx(ky(itr)%key(:), keyn)
     1168  IF(iky /= 0) val = ky(itr)%val(iky)                                !--- Key was found
     1169  IF(PRESENT(def_val) .AND. iky == 0) val = def_val                  !--- Default value from arguments
     1170END FUNCTION fgetKeyByName_s1
    11431171!==============================================================================================================================
    11441172LOGICAL FUNCTION getKeyByName_s1(keyn, val, tname, ky) RESULT(lerr)
    … …  
    11511179  CHARACTER(LEN=*),          INTENT(IN)  :: tname
    11521180  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
    1153   INTEGER :: is
    1154   lerr = .FALSE.
     1181  CHARACTER(LEN=maxlen) :: tnam
     1182  INTEGER, ALLOCATABLE  :: is(:)
     1183  INTEGER :: i, itr
     1184  tnam = delPhase(strHead(tname,'_',.FALSE.))                        !--- Remove tag and phase
    11551185  IF(PRESENT(ky)) THEN
    1156     val = getKeyByName_prv(keyn, tname, ky);              IF(val /= '') RETURN !--- "ky" and "tnam"
    1157     val = getKeyByName_prv(keyn, delPhase(strHead(tname,'_')), ky)             !--- "ky" and "tnam" without phase
     1186    val = fgetKeyByName_s1(tname, keyn, ky, lerr=lerr)               !--- "ky" and "tname"
     1187    IF(val /= '' .OR. lerr)      RETURN
     1188    val = fgetKeyByName_s1(tnam,  keyn, ky, lerr=lerr)               !--- "ky" and "tnam"
    11581189  ELSE
    11591190    IF(.NOT.ALLOCATED(tracers))  RETURN
    1160     val = getKeyByName_prv(keyn, tname, tracers(:)%keys); IF(val /= '') RETURN !--- "tracers" and "tnam"
     1191    val = fgetKeyByName_s1(tname, keyn, tracers(:)%keys, lerr=lerr)  !--- "tracers" and "tname"
     1192    IF(val /= ''.AND..NOT.lerr)  RETURN
    11611193    IF(.NOT.ALLOCATED(isotopes)) RETURN
    11621194    IF(SIZE(isotopes) == 0)      RETURN
    1163     DO is = 1, SIZE(isotopes); IF(strIdx(isotopes(is)%keys(:)%name, delPhase(strHead(tname,'_'))) /= 0) EXIT; END DO
    1164     IF(is /= 0) val = getKeyByName_prv(keyn, tname, isotopes(is)%keys(:))      !--- "isotopes" and "tnam" without phase
     1195    !--- Search the "is" isotopes class index of the isotope named "tnam"
     1196    is = find([(ANY(isotopes(i)%keys(:)%name == tnam), i=1, SIZE(isotopes))])
     1197    IF(test(SIZE(is) == 0,lerr)) RETURN
     1198    val = fgetKeyByName_s1(tname, keyn, isotopes(is(1))%keys(:),lerr=lerr)!--- "isotopes" and "tnam"
    11651199  END IF
    1166 
    1167 CONTAINS
    1168 
    1169 FUNCTION getKeyByName_prv(keyn, tname, ky) RESULT(val)
    1170   CHARACTER(LEN=maxlen)         :: val
    1171   CHARACTER(LEN=*), INTENT(IN)  :: keyn
    1172   CHARACTER(LEN=*), INTENT(IN)  :: tname
    1173   TYPE(keys_type),  INTENT(IN)  :: ky(:)
    1174   INTEGER :: itr, iky
    1175   val = ''; iky = 0
    1176   itr = strIdx(ky(:)%name, tname);                 IF(itr==0) RETURN           !--- Get the index of the wanted tracer
    1177   IF(itr /= 0) iky = strIdx(ky(itr)%key(:), keyn); IF(iky==0) RETURN           !--- Wanted key    index
    1178   val = ky(itr)%val(iky)
    1179 END FUNCTION getKeyByName_prv
    1180 
    11811200END FUNCTION getKeyByName_s1
    11821201!==============================================================================================================================
    1183 LOGICAL FUNCTION getKeyByName_sm(keyn, val, tnam, ky) RESULT(lerr)
     1202LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky) RESULT(lerr)
    11841203  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn
    1185   CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) ::  val(:)
    1186   CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN)  :: tnam(:)
    1187   TYPE(keys_type),  TARGET, OPTIONAL, INTENT(IN)  ::   ky(:)
    1188   TYPE(keys_type),       POINTER :: k(:)
    1189   CHARACTER(LEN=maxlen), POINTER :: n(:)
    1190   INTEGER :: iq
    1191   k => tracers(:)%keys; IF(PRESENT(ky  )) k => ky
    1192   n => k(:)%name;       IF(PRESENT(tnam)) n => tnam
    1193   ALLOCATE(val(SIZE(n)))
    1194   lerr = ANY([(getKeyByName_s1(keyn, val(iq), n(iq), k), iq=1, SIZE(n))])
     1204  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) ::   val(:)
     1205  CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN)  :: tname(:)
     1206  TYPE(keys_type),  TARGET, OPTIONAL, INTENT(IN)  ::    ky(:)
     1207  TYPE(keys_type),           POINTER :: k(:)
     1208  CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
     1209  INTEGER :: iq, nq
     1210  IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
     1211  IF(PRESENT(ky   )) nq = SIZE(ky%name)
     1212  IF(PRESENT(tname)) nq = SIZE(  tname)
     1213  ALLOCATE(val(nq))
     1214  IF(PRESENT(tname)) THEN
     1215    IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq),   ky), iq=1, nq)])
     1216    IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq)      ), iq=1, nq)])
     1217  ELSE;                  lerr = ANY([(getKeyByName_s1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
     1218  END IF
    11951219END FUNCTION getKeyByName_sm
    11961220!==============================================================================================================================
    1197 LOGICAL FUNCTION getKeyByName_i1(keyn, val, tnam, ky) RESULT(lerr)
     1221LOGICAL FUNCTION getKeyByName_i1(keyn, val, tname, ky) RESULT(lerr)
    11981222  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
    11991223  INTEGER,                   INTENT(OUT) :: val
    1200   CHARACTER(LEN=*),          INTENT(IN)  :: tnam
     1224  CHARACTER(LEN=*),          INTENT(IN)  :: tname
    12011225  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
    12021226  CHARACTER(LEN=maxlen) :: sval
    12031227  INTEGER :: ierr
    1204   IF(     PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tnam, ky)
    1205   IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tnam)
    1206   IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tnam)//'" is missing',        modname, lerr), lerr)) RETURN
     1228  IF(     PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname, ky)
     1229  IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname)
     1230  IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing',        modname, lerr), lerr)) RETURN
    12071231  READ(sval, *, IOSTAT=ierr) val
    1208   IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tnam)//'" is not an integer', modname, lerr), lerr)) RETURN
     1232  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, lerr), lerr)) RETURN
    12091233END FUNCTION getKeyByName_i1
    12101234!==============================================================================================================================
    1211 LOGICAL FUNCTION getKeyByName_im(keyn, val, tnam, ky) RESULT(lerr)
     1235LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky) RESULT(lerr)
    12121236  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn
    1213   INTEGER,               ALLOCATABLE, INTENT(OUT) ::  val(:)
    1214   CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN)  :: tnam(:)
    1215   TYPE(keys_type),  TARGET, OPTIONAL, INTENT(IN)  ::   ky(:)
    1216   TYPE(keys_type),       POINTER :: k(:)
    1217   CHARACTER(LEN=maxlen), POINTER :: n(:)
    1218   INTEGER :: iq
    1219   k => tracers(:)%keys; IF(PRESENT(ky  )) k => ky
    1220   n => k(:)%name;       IF(PRESENT(tnam)) n => tnam
    1221   ALLOCATE(val(SIZE(n)))
    1222   lerr = ANY([(getKeyByName_i1(keyn, val(iq), n(iq), k), iq=1, SIZE(n))])
     1237  INTEGER,               ALLOCATABLE, INTENT(OUT) ::   val(:)
     1238  CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN)  :: tname(:)
     1239  TYPE(keys_type),  TARGET, OPTIONAL, INTENT(IN)  ::    ky(:)
     1240  TYPE(keys_type),           POINTER :: k(:)
     1241  CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
     1242  INTEGER :: iq, nq
     1243  IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
     1244  IF(PRESENT(ky   )) nq = SIZE(ky%name)
     1245  IF(PRESENT(tname)) nq = SIZE(  tname)
     1246  ALLOCATE(val(nq))
     1247  IF(PRESENT(tname)) THEN
     1248    IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), tname(iq),   ky), iq=1, nq)])
     1249    IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), tname(iq)      ), iq=1, nq)])
     1250  ELSE;                  lerr = ANY([(getKeyByName_i1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
     1251  END IF
    12231252END FUNCTION getKeyByName_im
    12241253!==============================================================================================================================
    1225 LOGICAL FUNCTION getKeyByName_r1(keyn, val, tnam, ky) RESULT(lerr)
     1254LOGICAL FUNCTION getKeyByName_r1(keyn, val, tname, ky) RESULT(lerr)
    12261255  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
    12271256  REAL,                      INTENT(OUT) :: val
    1228   CHARACTER(LEN=*),          INTENT(IN)  :: tnam
     1257  CHARACTER(LEN=*),          INTENT(IN)  :: tname
    12291258  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
    12301259  CHARACTER(LEN=maxlen) :: sval
    12311260  INTEGER :: ierr
    1232   IF(     PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tnam, ky)
    1233   IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tnam)
    1234   IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tnam)//'" is missing',    modname, lerr), lerr)) RETURN
     1261  IF(     PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname, ky)
     1262  IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname)
     1263  IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing',    modname, lerr), lerr)) RETURN
    12351264  READ(sval, *, IOSTAT=ierr) val
    1236   IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tnam)//'" is not a real', modname, lerr), lerr)) RETURN
     1265  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, lerr), lerr)) RETURN
    12371266END FUNCTION getKeyByName_r1
    12381267!==============================================================================================================================
    1239 LOGICAL FUNCTION getKeyByName_rm(keyn, val, tnam, ky) RESULT(lerr)
     1268LOGICAL FUNCTION getKeyByName_rm(keyn, val, tname, ky) RESULT(lerr)
    12401269  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn
    1241   REAL,                  ALLOCATABLE, INTENT(OUT) ::  val(:)
    1242   CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN)  :: tnam(:)
    1243   TYPE(keys_type),  TARGET, OPTIONAL, INTENT(IN)  ::   ky(:)
    1244   TYPE(keys_type),       POINTER :: k(:)
    1245   CHARACTER(LEN=maxlen), POINTER :: n(:)
    1246   INTEGER :: iq
    1247   k => tracers(:)%keys; IF(PRESENT(ky  )) k => ky
    1248   n => k(:)%name;       IF(PRESENT(tnam)) n => tnam
    1249   ALLOCATE(val(SIZE(n)))
    1250   lerr = ANY([(getKeyByName_r1(keyn, val(iq), n(iq), k), iq=1, SIZE(n))])
     1270  REAL,                  ALLOCATABLE, INTENT(OUT) ::   val(:)
     1271  CHARACTER(LEN=*), TARGET, OPTIONAL, INTENT(IN)  :: tname(:)
     1272  TYPE(keys_type),  TARGET, OPTIONAL, INTENT(IN)  ::    ky(:)
     1273  TYPE(keys_type),           POINTER :: k(:)
     1274  CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
     1275  INTEGER :: iq, nq
     1276  IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
     1277  IF(PRESENT(ky   )) nq = SIZE(ky%name)
     1278  IF(PRESENT(tname)) nq = SIZE(  tname)
     1279  ALLOCATE(val(nq))
     1280  IF(PRESENT(tname)) THEN
     1281    IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), tname(iq),   ky), iq=1, nq)])
     1282    IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), tname(iq)      ), iq=1, nq)])
     1283  ELSE;                  lerr = ANY([(getKeyByName_r1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
     1284  END IF
    12511285END FUNCTION getKeyByName_rm
    12521286!==============================================================================================================================
    … …  
    13291363!------------------------------------------------------------------------------------------------------------------------------
    13301364
    1331 CHARACTER(LEN=1) FUNCTION old2newPhase(op) RESULT(np)
    1332   CHARACTER(LEN=1), INTENT(IN) :: op
    1333   np = known_phases(INDEX(old_phases,op):INDEX(old_phases,op))
    1334 END FUNCTION old2newPhase
    1335 
     1365
     1366INTEGER FUNCTION getiPhase(tname, lPhase) RESULT(iphase)
     1367  CHARACTER(LEN=*),  INTENT(IN)  :: tname
     1368  LOGICAL, OPTIONAL, INTENT(OUT) :: lPhase
     1369  CHARACTER(LEN=maxlen) :: s1
     1370  INTEGER :: ip
     1371  IF(PRESENT(lPhase)) lPhase = .TRUE.
     1372
     1373  !--- Old tracer name descending on water: H2O[v][l][i][_<isotope>][_<tag>]
     1374  iphase = strIdx([('H2O'//old_phases(ip:ip), ip=1, nphases)], tname(1:MIN(4,LEN_TRIM(tname))))
     1375  IF(iphase /= 0) RETURN
     1376
     1377  !--- New tracer name: <name>[_<phase>][_<tag>]
     1378  iphase = INDEX(known_phases, TRIM(strHead(strTail(tname, phases_sep, .TRUE.), '_', .TRUE.)))
     1379  IF(iphase /= 0) RETURN
     1380
     1381  !---Default case: 1 (gaseous phase)
     1382  iphase = 1
     1383  IF(PRESENT(lPhase)) lPhase = .FALSE.
     1384END FUNCTION getiPhase 
     1385
     1386!------------------------------------------------------------------------------------------------------------------------------
    13361387CHARACTER(LEN=1) FUNCTION new2oldPhase(np) RESULT(op)
    13371388  CHARACTER(LEN=1), INTENT(IN) :: np
    13381389  op = old_phases(INDEX(known_phases,np):INDEX(known_phases,np))
    13391390END FUNCTION new2oldPhase
     1391!------------------------------------------------------------------------------------------------------------------------------
     1392
     1393!------------------------------------------------------------------------------------------------------------------------------
     1394CHARACTER(LEN=maxlen) FUNCTION old2newName(oldName, iPhase) RESULT(newName)
     1395  !--- Convert an old style name into a new one.
     1396  !    Only usable with old style "traceur.def" files, in which only water isotopes are allowed.
     1397  !    In these files, H2O descendants names are: H2O<phase>[_<isotope>][_<tag>], with:
     1398  !    phase = v, l or i ; isotope = eau, HDO, O18, O17 or HTO.
     1399  CHARACTER(LEN=*),  INTENT(IN)  :: oldName
     1400  INTEGER, OPTIONAL, INTENT(OUT) :: iPhase
     1401  CHARACTER(LEN=maxlen) :: oldIso(5) = ['eau',     'HDO',     'O18',     'O17',     'HTO'    ]
     1402  CHARACTER(LEN=maxlen) :: newIso(5) = ['H2[16]O', 'H[2]HO ', 'H2[18]O', 'H2[17]O', 'H[3]HO ']
     1403  CHARACTER(LEN=maxlen), ALLOCATABLE :: tmp(:)
     1404  INTEGER :: ix, ip, it, nt
     1405  LOGICAL :: lPhase, lerr
     1406  ip = getiPhase(oldName, lPhase)                                              !--- Get the phase ; lPhase==T: phase is needed
     1407  IF(PRESENT(iPhase)) iPhase = ip
     1408  IF(.NOT.lPhase) THEN; newName = oldName ; RETURN; END IF                     !--- Not a water descendant
     1409  newName = addPhase('H2O', ip)
     1410  lerr = strParse(oldName, '_', tmp, n=nt)
     1411  IF(nt == 1) RETURN                                                           !--- H2O with phase
     1412  ix = strIdx(oldIso, tmp(2))
     1413  newName = tmp(2); IF(ix /= 0) newName = newIso(ix)                           !--- Isotope name
     1414  IF(lPhase)  newName = addPhase(newName, ip)                                  !--- Phase is needed
     1415  IF(nt == 3) newName = TRIM(newName)//'_'//TRIM(tmp(3))                       !--- Tagging tracer
     1416END FUNCTION old2newName
     1417!------------------------------------------------------------------------------------------------------------------------------
     1418
     1419!------------------------------------------------------------------------------------------------------------------------------
     1420CHARACTER(LEN=maxlen) FUNCTION new2oldName(newName, iPhase) RESULT(oldName)
     1421  !--- Convert a new style name into an old one.
     1422  !    Only convertable names are water descendants names H2O_<phase>, <isotope>_<phase>, <isotope>_<phase>_<tag>, with:
     1423  !    phase = g, l or s ; isotope = H2[16]O, H[2]O, H2<[18]O, H2[17]O or H[3]O.
     1424  CHARACTER(LEN=*),  INTENT(IN)    :: newName
     1425  INTEGER, OPTIONAL, INTENT(OUT)   :: iPhase
     1426  CHARACTER(LEN=maxlen) :: oldIso(5) = ['eau',     'HDO',     'O18',     'O17',     'HTO'    ]
     1427  CHARACTER(LEN=maxlen) :: newIso(5) = ['H2[16]O', 'H[2]HO ', 'H2[18]O', 'H2[17]O', 'H[3]HO '], tag
     1428  INTEGER :: ix, ip, it, nt
     1429  LOGICAL :: lPhase, lH2O
     1430  lH2O = newName(1:MIN(3,LEN_TRIM(newName)))=='H2O'
     1431  ix = strIdx(newIso, strHead(strHead(newName,'_',.TRUE.),phases_sep,.TRUE.))  !--- Isotope index
     1432  IF(ix == 0 .AND. .NOT.lH2O) THEN; oldName=newName; RETURN; END IF            !--- Not a water descendant
     1433  ip = getiPhase(newName, lPhase)                                              !--- Get the phase ; lPhase==T: phase is needed
     1434  oldName = 'H2O'; IF(lPhase) oldName = addPhase('H2O', ip, '')                !--- H2O with phase
     1435  IF(ix == 0) RETURN
     1436  oldName = TRIM(oldName)//'_'//oldIso(ix)                                     !--- Isotope
     1437  tag = strTail(delPhase(newName), TRIM(newIso(ix)))
     1438  IF(tag /= delPhase(newName) .AND. tag /= '') oldName = TRIM(oldName)//tag    !--- Tagging tracer
     1439END FUNCTION new2oldName
     1440!------------------------------------------------------------------------------------------------------------------------------
     1441
    13401442
    13411443!==============================================================================================================================
Note: See TracChangeset for help on using the changeset viewer.