Changeset 5001 for LMDZ6


Ignore:
Timestamp:
Jul 1, 2024, 11:25:05 AM (3 months ago)
Author:
dcugnet
Message:
  • strings_mod:
    • remove "test()" function (was not very clear)
    • modifications of the "str2bool" function: result is O/1 for .FALSE./.TRUE. and -1 if the string was not a boolean.
    • more general "find()" function (for several numerical types)
    • more general "cat()" function (can append a 2D array with vectors, 1D arrays with scalars)
    • few simplifications (in "strParse") and minor changes
  • readTracFiles_mod:
    • remove internal usage of direct keys ("%" symbol) in favor of the "getKey" function. => moving toward a totally generic tracers derived type.
    • improve the internal management of the error return value "lerr".
    • remove "fGetKey", "fGetKeys", "setDirectKeys" functions
    • new functions to add/remove a phase: "addPhase", "delPhase"
    • more general "addKey(key[(:)], val[(:)], ky(:), [lOverWrite])" function: . input argument "val" can be string/integer/real/logical . (key, val, ky ): add the <key> =<val> pair to ky . (key, val(:), ky(:)): add the <key> =<val(i)> pair to ky(i) for 1<=i<=SIZE(ky) . (key(:), val(:), ky(:)): add the <key(i)>=<val(i)> pair to ky(i) for 1<=i<=SIZE(ky)
    • more general "getKey(key[(:)], val[(:)], itr [, ky(:)][, nam(:)][, def][, lDisp])" (tracer index version)

and "getKey(key[(:)], val[(:)], tname[, ky(:)]. [, def][, lDisp])" (tracer name version) functions:

. output argument "val" can be string/integer/real/logical
. if present, the default value <def> is retained if the corresponding key was not found.
. get values from "ky(:)" if present, otherwise from internal database "tracers(:)" or "isotope ».
. if "keyn" is a vector, try with each element in indices order until a value is found
. (key[(:)], val, itr/tname[,ky(:)][, ...]): get the value <val> of tracer nr. itr or named "tname"
. (key[(:)], val(:), itr/tname[,ky(:)][, ...]): same + parsing of the value with « , », then storage in <val(:)>
. (key[(:)], val(:)[, ky(:)][, nam(:)][, ...]): same for all tracers (optional names list <nam(:)>) of database.
. (key[(:)], val(:), tname(:)[, ky(:)][, ...]): same for the tracers named « tnames(:)"

  • more general "dispTraSection" function
  • much simplified "indexUpdate" function ; "ancestor*" and "idxAncestor" functions are removed.
  • "readIsotopesFile" is renamed to "processIsotopes" for more clarity
  • cosmetic changes
  • fix for isotopes: iq_val and iq_liq are usable for "q" only, not for "q_follow" and "zx_defau_diag" => use hardcoded indices (1 for vapor and 2 for liquid) for these variables
Location:
LMDZ6/trunk/libf
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d/qminimum.F

    r4143 r5001  
    2828c     .................................................................
    2929c
     30cDC iq_val and iq_liq are usable for q only, NOT for q_follow
     31c   and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid
     32c   water at hardcoded indices 1/2 in these variables
    3033      INTEGER i, k, iq
    3134      REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
    … …  
    5861
    5962      zx_defau_diag(:,:,:)=0.0
    60       q_follow(:,:,1:2)=q(:,:,1:2) 
    61       DO 1000 k = 1, llm
    62         DO 1040 i = 1, ip1jmp1
     63      q_follow(:,:,1)=q(:,:,iq_vap) 
     64      q_follow(:,:,2)=q(:,:,iq_liq) 
     65      DO k = 1, llm
     66        DO i = 1, ip1jmp1
    6367          if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
    6468
    65               if (niso > 0) zx_defau_diag(i,k,iq_liq)=AMAX1
     69            if (niso > 0) zx_defau_diag(i,k,2)=AMAX1
    6670     :               ( seuil_liq - q(i,k,iq_liq), 0.0 )
    6771
    68              q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
    69              q(i,k,iq_liq) = seuil_liq
    70            endif
    71  1040   CONTINUE
    72  1000 CONTINUE
     72            q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
     73            q(i,k,iq_liq) = seuil_liq
     74          endif
     75        ENDDO
     76      ENDDO
    7377c
    7478c Quand l'eau vapeur est trop faible (ou negative), on complete
    7579c le defaut en prennant de l'eau vapeur de la couche au-dessous.
    7680c
    77       iq = iq_vap
    78 c
    7981      DO k = llm, 2, -1
    8082ccc      zx_abc = dpres(k) / dpres(k-1)
    8183        DO i = 1, ip1jmp1
    82           if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
     84          if ( seuil_vap - q(i,k,iq_vap) .gt. 0.d0 ) then
    8385
    84             if (niso > 0)
    85      &        zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 )
     86            if (niso > 0) zx_defau_diag(i,k,1)
     87     &           = AMAX1( seuil_vap - q(i,k,iq_vap), 0.0 )
    8688
    87             q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
    88      &                     deltap(i,k) / deltap(i,k-1)
    89             q(i,k,iq)   =  seuil_vap 
     89            q(i,k-1,iq_vap) = q(i,k-1,iq_vap) - (seuil_vap
     90     &           -q(i,k,iq_vap)) * deltap(i,k)/deltap(i,k-1)
     91            q(i,k,iq_vap)   =  seuil_vap 
     92
    9093          endif
    9194        ENDDO
    9295      ENDDO
     96
    9397c
    9498c Quand il s'agit de la premiere couche au-dessus du sol, on
    … …  
    96100c
    97101      DO i = 1, ip1jmp1
    98          zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )
    99          q(i,1,iq)  = AMAX1( q(i,1,iq), seuil_vap )
     102         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq_vap) )
     103         q(i,1,iq_vap)  = AMAX1( q(i,1,iq_vap), seuil_vap )
    100104      ENDDO
    101105      pompe = SSUM(ip1jmp1,zx_pump,1)
    … …  
    121125      DO i = 1,ip1jmp1
    122126        if (zx_pump(i).gt.0.0) then
    123           q_follow(i,1,iq_vap)=q_follow(i,1,iq_vap)+zx_pump(i)
     127          q_follow(i,1,1)=q_follow(i,1,1)+zx_pump(i)
    124128        endif !if (zx_pump(i).gt.0.0) then
    125129      enddo !DO i = 1,ip1jmp1
    … …  
    129133      do k=2,llm
    130134        DO i = 1,ip1jmp1
    131           if (zx_defau_diag(i,k,iq_vap).gt.0.0) then             
     135          if (zx_defau_diag(i,k,1).gt.0.0) then             
    132136              ! on ajoute la vapeur en k             
    133137              do ixt=1,ntiso
    134138               q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
    135      :           +zx_defau_diag(i,k,iq_vap)
    136      :           *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
     139     :           +zx_defau_diag(i,k,1)
     140     :           *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,1)
    137141               
    138142              ! et on la retranche en k-1
    139143               q(i,k-1,iqIsoPha(ixt,iq_vap))=
    140144     :            q(i,k-1,iqIsoPha(ixt,iq_vap))
    141      :              -zx_defau_diag(i,k,iq_vap)
     145     :              -zx_defau_diag(i,k,1)
    142146     :              *deltap(i,k)/deltap(i,k-1)
    143147     :              *q(i,k-1,iqIsoPha(ixt,iq_vap))
    144      :              /q_follow(i,k-1,iq_vap)
     148     :              /q_follow(i,k-1,1)
    145149
    146150              enddo !do ixt=1,niso
    147               q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
    148      :               +zx_defau_diag(i,k,iq_vap)
    149               q_follow(i,k-1,iq_vap)=   q_follow(i,k-1,iq_vap)
    150      :               -zx_defau_diag(i,k,iq_vap)
     151              q_follow(i,k,1)=   q_follow(i,k,1)
     152     :               +zx_defau_diag(i,k,1)
     153              q_follow(i,k-1,1)=   q_follow(i,k-1,1)
     154     :               -zx_defau_diag(i,k,1)
    151155     :              *deltap(i,k)/deltap(i,k-1)
    152           endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
     156          endif !if (zx_defau_diag(i,k,1).gt.0.0) then
    153157        enddo !DO i = 1, ip1jmp1       
    154158       enddo !do k=2,llm
    … …  
    161165        do k=1,llm
    162166        DO i = 1,ip1jmp1
    163           if (zx_defau_diag(i,k,iq_liq).gt.0.0) then
     167          if (zx_defau_diag(i,k,2).gt.0.0) then
    164168
    165169              ! on ajoute eau liquide en k en k             
    166170              do ixt=1,ntiso
    167171               q(i,k,iqIsoPha(ixt,iq_liq))=q(i,k,iqIsoPha(ixt,iq_liq))
    168      :              +zx_defau_diag(i,k,iq_liq)
    169      :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)
     172     :              +zx_defau_diag(i,k,2)
     173     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)
    170174              ! et on la retranche à la vapeur en k
    171175               q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
    172      :              -zx_defau_diag(i,k,iq_liq)
    173      :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)   
     176     :              -zx_defau_diag(i,k,2)
     177     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)   
    174178              enddo !do ixt=1,niso
    175               q_follow(i,k,iq_liq)=   q_follow(i,k,iq_liq)
    176      :               +zx_defau_diag(i,k,iq_liq)
    177               q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
    178      :               -zx_defau_diag(i,k,iq_liq)
    179           endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
     179              q_follow(i,k,2)=   q_follow(i,k,2)
     180     :               +zx_defau_diag(i,k,2)
     181              q_follow(i,k,1)=   q_follow(i,k,1)
     182     :               -zx_defau_diag(i,k,2)
     183          endif !if (zx_defau_diag(i,k,1).gt.0.0) then
    180184        enddo !DO i = 1, ip1jmp1
    181185       enddo !do k=2,llm 

  • LMDZ6/trunk/libf/dyn3d_common/infotrac.F90

    r4984 r5001  
    55   USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
    66   USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
    7         delPhase, niso, getKey, isot_type, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
    8         addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,   isoCheck, nbIso, ntiso, isoName
     7        delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
     8        addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,  iqWIsoPha, nbIso, ntiso, isoName, isoCheck
    99   IMPLICIT NONE
    1010
    … …  
    225225   ttp = type_trac; IF(fType /= 1) ttp = texp
    226226
    227    IF(readTracersFiles(ttp, type_trac == 'repr'))    CALL abort_gcm(modname, 'problem with tracers file(s)',1)
     227   IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
    228228   !---------------------------------------------------------------------------------------------------------------------------
    229229   IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
    … …  
    348348      IF(nm == 0) CYCLE                                              !--- No higher moments
    349349      ttr(jq+1:jq+nm)             = t1
    350       ttr(jq+1:jq+nm)%name        = [(TRIM(t1%name)    //'-'//TRIM(suff(im)), im=1, nm) ]
    351       ttr(jq+1:jq+nm)%parent      = [(TRIM(t1%parent)  //'-'//TRIM(suff(im)), im=1, nm) ]
    352       ttr(jq+1:jq+nm)%longName    = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
    353       ttr(jq+1:jq+nm)%iadv        = [(-iad,    im=1, nm) ]
    354       ttr(jq+1:jq+nm)%isAdvected  = [(.FALSE., im=1, nm) ]
     350      ttr(jq+1:jq+nm)%name        = [ (TRIM(t1%name)    //'-'//TRIM(suff(im)), im=1, nm) ]
     351      ttr(jq+1:jq+nm)%parent      = [ (TRIM(t1%parent)  //'-'//TRIM(suff(im)), im=1, nm) ]
     352      ttr(jq+1:jq+nm)%longName    = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
     353      ttr(jq+1:jq+nm)%iadv        = [ (-iad,    im=1, nm) ]
     354      ttr(jq+1:jq+nm)%isAdvected  = [ (.FALSE., im=1, nm) ]
    355355      jq = jq + nm
    356356   END DO
    … …  
    359359
    360360   !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
    361    CALL indexUpdate(tracers)
     361   IF(indexUpdate(tracers)) CALL abort_gcm(modname, 'problem with tracers indices update', 1)
    362362
    363363   !=== TEST ADVECTION SCHEME
    … …  
    384384   !=== READ PHYSICAL PARAMETERS FOR ISOTOPES ; DONE HERE BECAUSE dynetat0 AND iniacademic NEED "tnat" AND "alpha_ideal"
    385385   niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
    386    IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
     386   IF(processIsotopes()) CALL abort_gcm(modname, 'problem when processing isotopes parameters', 1)
    387387
    388388   !--- Convection / boundary layer activation for all tracers
    … …  
    393393   nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
    394394   IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
    395       CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1)
     395      CALL abort_gcm(modname, 'problem with the computation of nqtottr', 1)
    396396
    397397   !=== DISPLAY THE RESULTS
    … …  
    408408   t => tracers
    409409   CALL msg('Information stored in infotrac :', modname)
    410    IF(dispTable('isssssssssiiiiiiiii', &
    411       ['iq    ', 'name  ', 'lName ', 'gen0N ', 'parent', 'type  ', 'phase ', 'compon', 'isPhy ', 'isAdv ', &
    412        'iadv  ', 'iGen  ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'],          &
     410
     411   IF(dispTable('isssssssssiiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',    &
     412                'isPh', 'isAd', 'iadv', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],   &
    413413      cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics), &
    414414                                                                                  bool2str(t%isAdvected)), &

  • LMDZ6/trunk/libf/dyn3dmem/qminimum_loc.F

    r4469 r5001  
    3131c     .................................................................
    3232c
     33cDC iq_val and iq_liq are usable for q only, NOT for q_follow
     34c   and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid
     35c   water at hardcoded indices 1/2 in these variables
    3336      INTEGER i, k, iq
    3437      REAL zx_defau, zx_abc, zx_pump(ijb_u:ije_u), pompe
    … …  
    4952      INTEGER ixt
    5053      INTEGER iso_verif_noNaN_nostop
    51 c
    52 c Quand l'eau liquide est trop petite (ou negative), on prend
    53 c l'eau vapeur de la meme couche et la convertit en eau liquide
    54 c (sans changer la temperature !)
    55 c
    5654
    5755c$OMP BARRIER
    … …  
    6361         first = .FALSE.
    6462      END IF
     63c
     64c Quand l'eau liquide est trop petite (ou negative), on prend
     65c l'eau vapeur de la meme couche et la convertit en eau liquide
     66c (sans changer la temperature !)
     67c
     68
    6569      call check_isotopes(q,ij_begin,ij_end,'qminimum 52')   
    6670
    … …  
    7377          zx_defau_diag(i,k,1)=0.0
    7478          zx_defau_diag(i,k,2)=0.0
    75           q_follow(i,k,1)=q(i,k,1)
    76           q_follow(i,k,2)=q(i,k,2)
     79          q_follow(i,k,1)=q(i,k,iq_vap)
     80          q_follow(i,k,2)=q(i,k,iq_liq)
    7781        ENDDO
    7882c$OMP END DO NOWAIT
    … …  
    8084
    8185      !write(lunout,*) 'qminimum 57'
    82       DO 1000 k = 1, llm
     86      DO k = 1, llm
    8387c$OMP DO SCHEDULE(STATIC)       
    84       DO 1040 i = ijb, ije
    85             if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
    86 
    87               if (niso > 0) zx_defau_diag(i,k,iq_liq)=AMAX1
     88        DO i = ijb, ije
     89          if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
     90
     91            if (niso > 0) zx_defau_diag(i,k,2)=AMAX1
    8892     :               ( seuil_liq - q(i,k,iq_liq), 0.0 )
    8993
    90                q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
    91                q(i,k,iq_liq) = seuil_liq
    92             endif
    93  1040 CONTINUE
    94 c$OMP END DO NOWAIT
    95  1000 CONTINUE
     94            q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
     95            q(i,k,iq_liq) = seuil_liq
     96          endif
     97        END DO
     98c$OMP END DO NOWAIT
     99      END DO
    96100
    97101c
    … …  
    100104c
    101105      !write(lunout,*) 'qminimum 81'
    102       iq = iq_vap
    103 c
    104106      DO k = llm, 2, -1
    105107ccc      zx_abc = dpres(k) / dpres(k-1)
    106108c$OMP DO SCHEDULE(STATIC)
    107       DO i = ijb, ije
    108 
    109          if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
    110 
    111             if (niso > 0)
    112      &        zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 )
    113 
    114             q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
    115      &           deltap(i,k) / deltap(i,k-1)
    116             q(i,k,iq)   =  seuil_vap 
    117 
    118          endif
    119       ENDDO
     109        DO i = ijb, ije
     110
     111          if ( seuil_vap - q(i,k,iq_vap) .gt. 0.d0 ) then
     112
     113            if (niso > 0) zx_defau_diag(i,k,1)
     114     &           = AMAX1( seuil_vap - q(i,k,iq_vap), 0.0 )
     115
     116            q(i,k-1,iq_vap) = q(i,k-1,iq_vap) - (seuil_vap
     117     &           -q(i,k,iq_vap)) * deltap(i,k)/deltap(i,k-1)
     118            q(i,k,iq_vap)   =  seuil_vap 
     119
     120          endif
     121        ENDDO
    120122c$OMP END DO NOWAIT
    121123      ENDDO
    … …  
    129131c$OMP DO SCHEDULE(STATIC)
    130132      DO i = ijb, ije
    131          zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )
    132          q(i,1,iq)  = AMAX1( q(i,1,iq), seuil_vap )
     133         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq_vap) )
     134         q(i,1,iq_vap)  = AMAX1( q(i,1,iq_vap), seuil_vap )
    133135         IF (zx_pump(i) > 0.0) THEN
    134136            nb_pump = nb_pump+1
    … …  
    165167      DO i = ijb, ije
    166168        if (zx_pump(i).gt.0.0) then
    167           q_follow(i,1,iq_vap)=q_follow(i,1,iq_vap)+zx_pump(i)
     169          q_follow(i,1,1)=q_follow(i,1,1)+zx_pump(i)
    168170        endif !if (zx_pump(i).gt.0.0) then
    169171      enddo !DO i = ijb, ije 
    … …  
    175177c$OMP DO SCHEDULE(STATIC)     
    176178        DO i = ijb, ije
    177           if (zx_defau_diag(i,k,iq_vap).gt.0.0) then             
     179          if (zx_defau_diag(i,k,1).gt.0.0) then             
    178180              ! on ajoute la vapeur en k     
    179 !              write(lunout,*) 'i,k,q_follow(i,k-1,iq_vap)=',
    180 !     :                 i,k,q_follow(i,k-1,iq_vap)         
    181               if (q_follow(i,k-1,iq_vap).lt.min_qParent) then
     181!              write(lunout,*) 'i,k,q_follow(i,k-1,ivap)=',
     182!     :                 i,k,q_follow(i,k-1,1)         
     183              if (q_follow(i,k-1,1).lt.min_qParent) then
    182184                write(lunout,*) 'tmp qmin: on stoppe'
    183185                write(lunout,*) 'zx_pump(i)=',zx_pump(i)
    184                 write(lunout,*) 'q_follow(i,:,iq_vap)=',
    185      :                   q_follow(i,:,iq_vap)
     186                write(lunout,*) 'q_follow(i,:,ivap)=',
     187     :                   q_follow(i,:,1)
    186188                write(lunout,*) 'k=',k
    187189                call abort_gcm("qminimum","not enough vapor",1)
    … …  
    189191            do ixt=1,ntiso
    190192!                write(lunout,*) 'qmin 168: ixt=',ixt
    191 !                write(lunout,*) 'q(i,k,iqIsoPha(ixt,iq_vap)=',
     193!                write(lunout,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=',
    192194!     :             q(i,k,iqIsoPha(ixt,iq_vap))
    193 !                write(lunout,*) 'zx_defau_diag(i,k,iq_vap)=',
    194 !     :                  zx_defau_diag(i,k,iq_vap)
    195 !                write(lunout,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap)=',
     195!                write(lunout,*) 'zx_defau_diag(i,k,ivap)=',
     196!     :                  zx_defau_diag(i,k,1)
     197!                write(lunout,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=',
    196198!     :                   q(i,k-1,iqIsoPha(ixt,iq_vap))     
    197199
    198200               q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
    199      :           +zx_defau_diag(i,k,iq_vap)
    200      :           *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,iq_vap)
     201     :           +zx_defau_diag(i,k,1)
     202     :           *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,1)
    201203               
    202204              if (isoCheck) then
    … …  
    204206     :                   'qminimum 155').eq.1) then
    205207                   write(*,*) 'i,k,ixt=',i,k,ixt
    206                    write(*,*) 'q_follow(i,k-1,iq_vap)=',
    207      :                   q_follow(i,k-1,iq_vap)
     208                   write(*,*) 'q_follow(i,k-1,ivap)=',
     209     :                   q_follow(i,k-1,1)
    208210                   write(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=',
    209211     :                   q(i,k,iqIsoPha(ixt,iq_vap))
    210                    write(*,*) 'zx_defau_diag(i,k,iq_vap)=',
    211      :                   zx_defau_diag(i,k,iq_vap)
     212                   write(*,*) 'zx_defau_diag(i,k,ivap)=',
     213     :                   zx_defau_diag(i,k,1)
    212214                   write(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=',
    213215     :                   q(i,k-1,iqIsoPha(ixt,iq_vap))
    … …  
    219221               q(i,k-1,iqIsoPha(ixt,iq_vap)) =
    220222     :            q(i,k-1,iqIsoPha(ixt,iq_vap))
    221      :              -zx_defau_diag(i,k,iq_vap)
     223     :              -zx_defau_diag(i,k,1)
    222224     :              *deltap(i,k)/deltap(i,k-1)
    223225     :              *q(i,k-1,iqIsoPha(ixt,iq_vap))
    224      :              /q_follow(i,k-1,iq_vap)
     226     :              /q_follow(i,k-1,1)
    225227
    226228               if (isoCheck) then
    … …  
    229231     :                   'qminimum 175').eq.1) then
    230232                   write(*,*) 'k,i,ixt=',k,i,ixt
    231                    write(*,*) 'q_follow(i,k-1,iq_vap)=',
    232      :                   q_follow(i,k-1,iq_vap)
     233                   write(*,*) 'q_follow(i,k-1,ivap)=',
     234     :                   q_follow(i,k-1,1)
    233235                   write(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=',
    234236     :                   q(i,k,iqIsoPha(ixt,iq_vap))
    235                    write(*,*) 'zx_defau_diag(i,k,iq_vap)=',
    236      :                   zx_defau_diag(i,k,iq_vap)
     237                   write(*,*) 'zx_defau_diag(i,k,ivap)=',
     238     :                   zx_defau_diag(i,k,1)
    237239                   write(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=',
    238240     :                   q(i,k-1,iqIsoPha(ixt,iq_vap))
    … …  
    242244
    243245              enddo !do ixt=1,niso
    244               q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
    245      :               +zx_defau_diag(i,k,iq_vap)
    246               q_follow(i,k-1,iq_vap)=   q_follow(i,k-1,iq_vap)
    247      :               -zx_defau_diag(i,k,iq_vap)
     246              q_follow(i,k,1)=   q_follow(i,k,1)
     247     :               +zx_defau_diag(i,k,1)
     248              q_follow(i,k-1,1)=   q_follow(i,k-1,1)
     249     :               -zx_defau_diag(i,k,1)
    248250     :              *deltap(i,k)/deltap(i,k-1)
    249           endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
     251          endif !if (zx_defau_diag(i,k,1).gt.0.0) then
    250252        enddo !DO i = 1, ip1jmp1       
    251253c$OMP END DO NOWAIT
    … …  
    260262c$OMP DO SCHEDULE(STATIC)
    261263        DO i = ijb, ije
    262           if (zx_defau_diag(i,k,iq_liq).gt.0.0) then
     264          if (zx_defau_diag(i,k,2).gt.0.0) then
    263265
    264266              ! on ajoute eau liquide en k en k             
    265267              do ixt=1,ntiso
    266268               q(i,k,iqIsoPha(ixt,iq_liq))=q(i,k,iqIsoPha(ixt,iq_liq))
    267      :              +zx_defau_diag(i,k,iq_liq)
    268      :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)
     269     :              +zx_defau_diag(i,k,2)
     270     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)
    269271              ! et on la retranche à la vapeur en k
    270272               q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap))
    271      :              -zx_defau_diag(i,k,iq_liq)
    272      :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,iq_vap)   
     273     :              -zx_defau_diag(i,k,2)
     274     :              *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1)   
    273275              enddo !do ixt=1,niso
    274               q_follow(i,k,iq_liq)=   q_follow(i,k,iq_liq)
    275      :               +zx_defau_diag(i,k,iq_liq)
    276               q_follow(i,k,iq_vap)=   q_follow(i,k,iq_vap)
    277      :               -zx_defau_diag(i,k,iq_liq)
    278           endif !if (zx_defau_diag(i,k,iq_vap).gt.0.0) then
     276              q_follow(i,k,2)=   q_follow(i,k,2)
     277     :               +zx_defau_diag(i,k,2)
     278              q_follow(i,k,1)=   q_follow(i,k,1)
     279     :               -zx_defau_diag(i,k,2)
     280          endif !if (zx_defau_diag(i,k,1).gt.0.0) then
    279281        enddo !DO i = ijb, ije
    280282c$OMP END DO NOWAIT       

  • LMDZ6/trunk/libf/misc/readTracFiles_mod.f90

    r4987 r5001  
    22
    33  USE strings_mod,    ONLY: msg, find, get_in, dispTable, strHead,  strReduce,  strFind, strStack, strIdx, &
    4        test, removeComment, cat, fmsg, maxlen, checkList, strParse, strReplace, strTail, strCount, reduceExpr, &
    5        int2str, str2int, real2str, str2real, bool2str, str2bool
     4             removeComment, cat, fmsg, maxlen, checkList, strParse, strReplace, strTail, strCount, reduceExpr, &
     5             int2str, str2int, real2str, str2real, bool2str, str2bool
    66
    77  IMPLICIT NONE
    … …  
    1717  PUBLIC :: addPhase,  delPhase,  getPhase,  getiPhase,  &      !--- FUNCTIONS RELATED TO THE PHASES
    1818   nphases, old_phases, phases_sep, known_phases, phases_names  !--- + ASSOCIATED VARIABLES
    19   PUBLIC :: fGetKey, fGetKeys, setDirectKeys                    !--- TOOLS TO GET/SET KEYS FROM/TO  tracers & isotopes TO BE REMOVED
    2019
    2120  PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O        !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
    2221  PUBLIC :: oldHNO3,   newHNO3                                  !--- HNO3 REPRO   BACKWARD COMPATIBILITY (OLD start.nc)
    2322
    24   PUBLIC :: tran0, idxAncestor, ancestor                        !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
     23  PUBLIC :: tran0                                               !--- TRANSPORTING FLUID (USUALLY air)
    2524
    2625  !=== FOR ISOTOPES: GENERAL
    27   PUBLIC :: isot_type, readIsotopesFile, isoSelect, ixIso, nbIso!--- ISOTOPES READING ROUTINE + SELECTION + CLASS IDX & NUMBER
     26  PUBLIC :: isot_type, processIsotopes, isoSelect, ixIso, nbIso !--- PROCESS [AND READ] & SELECT ISOTOPES + CLASS IDX & NUMBER
    2827
    2928  !=== FOR ISOTOPES: H2O FAMILY ONLY
    … …  
    8180    INTEGER                            :: nzone = 0             !--- Number of geographic tagging zones
    8281    INTEGER                            :: nphas = 0             !--- Number of phases
    83     INTEGER,               ALLOCATABLE :: iqIsoPha(:,:)         !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
     82    INTEGER,               ALLOCATABLE :: iqIsoPha(:,:)         !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso),phas)
    8483                                                                !---        (former name: "iqiso"
    85     INTEGER,               ALLOCATABLE :: iqWIsoPha(:,:)        !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
    86                                                                 !---        (former name: "?????")
     84    INTEGER,               ALLOCATABLE :: iqWIsoPha(:,:)        !--- Idx in "tracers(1:nqtot)" = f([H2O,name(1:ntiso)],phas)
    8785    INTEGER,               ALLOCATABLE :: itZonIso(:,:)         !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
    8886  END TYPE isot_type                                            !---        (former name: "index_trac")
    … …  
    9492!------------------------------------------------------------------------------------------------------------------------------
    9593  INTERFACE getKey
    96     MODULE PROCEDURE getKeyByName_s1, getKeyByName_s1m, getKeyByName_sm, getKey_sm, &
    97                      getKeyByName_i1, getKeyByName_i1m, getKeyByName_im, getKey_im, &
    98                      getKeyByName_r1, getKeyByName_r1m, getKeyByName_rm, getKey_rm, &
    99                      getKeyByName_l1, getKeyByName_l1m, getKeyByName_lm, getKey_lm
     94    MODULE PROCEDURE &
     95       getKeyByIndex_s111, getKeyByIndex_sm11, getKeyByIndex_s1m1, getKeyByIndex_smm1, getKeyByIndex_s1mm, getKeyByIndex_smmm, &
     96       getKeyByIndex_i111, getKeyByIndex_im11, getKeyByIndex_i1m1, getKeyByIndex_imm1, getKeyByIndex_i1mm, getKeyByIndex_immm, &
     97       getKeyByIndex_r111, getKeyByIndex_rm11, getKeyByIndex_r1m1, getKeyByIndex_rmm1, getKeyByIndex_r1mm, getKeyByIndex_rmmm, &
     98       getKeyByIndex_l111, getKeyByIndex_lm11, getKeyByIndex_l1m1, getKeyByIndex_lmm1, getKeyByIndex_l1mm, getKeyByIndex_lmmm, &
     99        getKeyByName_s111,  getKeyByName_sm11,  getKeyByName_s1m1,  getKeyByName_smm1,  getKeyByName_s1mm,  getKeyByName_smmm, &
     100        getKeyByName_i111,  getKeyByName_im11,  getKeyByName_i1m1,  getKeyByName_imm1,  getKeyByName_i1mm,  getKeyByName_immm, &
     101        getKeyByName_r111,  getKeyByName_rm11,  getKeyByName_r1m1,  getKeyByName_rmm1,  getKeyByName_r1mm,  getKeyByName_rmmm, &
     102        getKeyByName_l111,  getKeyByName_lm11,  getKeyByName_l1m1,  getKeyByName_lmm1,  getKeyByName_l1mm,  getKeyByName_lmmm
    100103  END INTERFACE getKey
    101104!------------------------------------------------------------------------------------------------------------------------------
    … …  
    105108  END INTERFACE addKey
    106109!------------------------------------------------------------------------------------------------------------------------------
    107   INTERFACE    isoSelect;  MODULE PROCEDURE  isoSelectByIndex,  isoSelectByName; END INTERFACE isoSelect
    108   INTERFACE  old2newH2O;   MODULE PROCEDURE  old2newH2O_1,  old2newH2O_m;        END INTERFACE old2newH2O
    109   INTERFACE  new2oldH2O;   MODULE PROCEDURE  new2oldH2O_1,  new2oldH2O_m;        END INTERFACE new2oldH2O
    110   INTERFACE fGetKey;       MODULE PROCEDURE fgetKeyIdx_s1, fgetKeyNam_s1;        END INTERFACE fGetKey
    111   INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
    112   INTERFACE idxAncestor;   MODULE PROCEDURE idxAncestor_1, idxAncestor_m, idxAncestor_mt;    END INTERFACE idxAncestor
    113   INTERFACE    ancestor;   MODULE PROCEDURE    ancestor_1,    ancestor_m,    ancestor_mt;    END INTERFACE    ancestor
    114   INTERFACE        addTracer; MODULE PROCEDURE   addTracer_1, addTracer_1def;                   END INTERFACE addTracer
    115   INTERFACE        delTracer; MODULE PROCEDURE   delTracer_1, delTracer_1def;                   END INTERFACE delTracer
    116   INTERFACE    addPhase;   MODULE PROCEDURE   addPhase_s1,   addPhase_sm,   addPhase_i1,   addPhase_im; END INTERFACE addPhase
     110  INTERFACE     isoSelect; MODULE PROCEDURE  isoSelectByIndex,  isoSelectByName; END INTERFACE isoSelect
     111  INTERFACE    old2newH2O; MODULE PROCEDURE  old2newH2O_1,  old2newH2O_m;        END INTERFACE old2newH2O
     112  INTERFACE    new2oldH2O; MODULE PROCEDURE  new2oldH2O_1,  new2oldH2O_m;        END INTERFACE new2oldH2O
     113  INTERFACE     addTracer; MODULE PROCEDURE   addTracer_1, addTracer_1def;       END INTERFACE addTracer
     114  INTERFACE     delTracer; MODULE PROCEDURE   delTracer_1, delTracer_1def;       END INTERFACE delTracer
     115  INTERFACE      addPhase; MODULE PROCEDURE   addPhase_s1,  addPhase_sm,  addPhase_i1,  addPhase_im; END INTERFACE addPhase
     116  INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx,     trSubset_Name,     trSubset_gen0Name; END INTERFACE tracersSubset
    117117!------------------------------------------------------------------------------------------------------------------------------
    118118
    … …  
    154154                                            nphas, ntiso        !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
    155155  INTEGER,                 SAVE, POINTER ::itZonIso(:,:), &     !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
    156                                            iqIsoPha(:,:), &     !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
    157                                            iqWIsoPha(:,:)       !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
     156                                           iqIsoPha(:,:), &     !--- INDEX IN "qx" AS f(isotopic tracer idx, phase idx)
     157                                           iqWIsoPha(:,:)       !--- INDEX IN "qx" AS f(H2O + isotopic tracer idx, phase idx)
    158158
    159159  !=== PARAMETERS FOR DEFAULT BEHAVIOUR
    … …  
    190190!     * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
    191191!==============================================================================================================================
    192 LOGICAL FUNCTION readTracersFiles(type_trac, lRepr) RESULT(lerr)
    193 !------------------------------------------------------------------------------------------------------------------------------
    194   CHARACTER(LEN=*),  INTENT(IN)  :: type_trac                        !--- List of components used
    195   LOGICAL, OPTIONAL, INTENT(IN)  :: lRepr                            !--- Activate the HNNO3 exceptions for REPROBUS
     192LOGICAL FUNCTION readTracersFiles(type_trac, tracs, lRepr) RESULT(lerr)
     193!------------------------------------------------------------------------------------------------------------------------------
     194  CHARACTER(LEN=*),                               INTENT(IN)  :: type_trac     !--- List of components used
     195  TYPE(trac_type), ALLOCATABLE, TARGET, OPTIONAL, INTENT(OUT) :: tracs(:)      !--- Tracers descriptor for external storage
     196  LOGICAL,                              OPTIONAL, INTENT(IN)  :: lRepr         !--- Activate the HNO3 exceptions for REPROBUS
    196197  CHARACTER(LEN=maxlen),  ALLOCATABLE :: s(:), sections(:), trac_files(:)
    197198  CHARACTER(LEN=maxlen) :: str, fname, tname, pname, cname
    198199  INTEGER               :: nsec, ierr, it, ntrac, ns, ip, ix, fType
     200  INTEGER, ALLOCATABLE  :: iGen(:)
    199201  LOGICAL :: lRep
    200202  TYPE(keys_type), POINTER :: k
    … …  
    206208
    207209  !--- Required sections + corresponding files names (new style single section case) for tests
    208   IF(test(testTracersFiles(modname, type_trac, fType, .FALSE., trac_files, sections), lerr)) RETURN
     210  lerr = testTracersFiles(modname, type_trac, fType, .FALSE., trac_files, sections); IF(lerr) RETURN
    209211  nsec = SIZE(sections)
    210212
    211213  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    212   SELECT CASE(fType)                         !--- Set %name, %genOName, %parent, %type, %phase, %component, %iGeneration, %keys
     214  SELECT CASE(fType)                         !--- Set name, component, parent, phase, iGeneration, gen0Name, type
    213215  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    214216    CASE(1)                                                          !=== OLD FORMAT "traceur.def"
    215217    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    216218      !--- OPEN THE "traceur.def" FILE
    217       OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', IOSTAT=ierr)
     219      OPEN(90, FILE="traceur.def", FORM='formatted', STATUS='old', POSITION='REWIND', IOSTAT=ierr)
    218220
    219221      !--- GET THE TRACERS NUMBER
    220222      READ(90,'(i3)',IOSTAT=ierr)ntrac                               !--- Number of lines/tracers
    221       IF(test(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, ierr /= 0), lerr)) RETURN
     223      lerr = ierr/=0; IF(fmsg('Invalid format for "'//TRIM(fname)//'"', modname, lerr)) RETURN
    222224
    223225      !--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
    224       IF(ALLOCATED(tracers)) DEALLOCATE(tracers)
    225226      ALLOCATE(tracers(ntrac))
    226       DO it=1,ntrac                                                  !=== READ RAW DATA: loop on the line/tracer number
     227      DO it = 1, ntrac                                               !=== READ RAW DATA: loop on the line/tracer number
    227228        READ(90,'(a)',IOSTAT=ierr) str
    228         IF(test(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, ierr>0), lerr)) RETURN
    229         IF(test(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, ierr<0), lerr)) RETURN
     229        lerr = ierr>0; IF(fmsg('Invalid format for "' //TRIM(fname)//'"', modname, lerr)) RETURN
     230        lerr = ierr<0; IF(fmsg('Not enough lines in "'//TRIM(fname)//'"', modname, lerr)) RETURN
    230231        lerr = strParse(str, ' ', s, ns)
    231232        CALL msg('This file is for air tracers only',           modname, ns == 3 .AND. it == 1)
    … …  
    237238        ix = strIdx(oldHNO3, s(3))
    238239        IF(ix /= 0 .AND. lRep) tname = newHNO3(ix)                   !--- Exception for HNO3 (REPROBUS ONLY)
    239         tracers(it)%name = tname                                     !--- Set %name
    240         CALL addKey_s11('name', tname, k)                            !--- Set the name of the tracer
     240        tracers(it)%name = tname                                     !--- Set the name of the tracer
     241        CALL addKey('name', tname, k)                                !--- Set the name of the tracer
    241242        tracers(it)%keys%name = tname                                !--- Copy tracers names in keys components
    242243
    … …  
    244245        cname = type_trac                                            !--- Name of the model component
    245246        IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
    246         tracers(it)%component = cname                                !--- Set %component
    247         CALL addKey_s11('component', cname, k)                       !--- Set the name of the model component
     247        tracers(it)%component = cname                                !--- Set component
     248        CALL addKey('component', cname, k)                           !--- Set the name of the model component
    248249
    249250        !=== NAME OF THE PARENT
    … …  
    254255          IF(ix /= 0 .AND. lRep) pname = newHNO3(ix)                 !--- Exception for HNO3 (REPROBUS ONLY)
    255256        END IF
    256         tracers(it)%parent = pname                                   !--- Set %parent
    257         CALL addKey_s11('parent', pname, k)
     257        tracers(it)%parent = pname                                   !--- Set the parent name
     258        CALL addKey('parent', pname, k)
    258259
    259260        !=== PHASE AND ADVECTION SCHEMES NUMBERS
    260         tracers(it)%phase = known_phases(ip:ip)                      !--- Set %phase:  tracer phase (default: "g"azeous)
    261         CALL addKey_s11('phase', known_phases(ip:ip), k)             !--- Set the phase of the tracer (default: "g"azeous)
    262         CALL addKey_s11('hadv', s(1),  k)                            !--- Set the horizontal advection schemes number
    263         CALL addKey_s11('vadv', s(2),  k)                            !--- Set the vertical   advection schemes number
     261        tracers(it)%phase = known_phases(ip:ip)                      !--- Set the phase of the tracer (default: "g"azeous)
     262        CALL addKey('phase', known_phases(ip:ip), k)                 !--- Set the phase of the tracer (default: "g"azeous)
     263        CALL addKey('hadv', s(1),  k)                                !--- Set the horizontal advection schemes number
     264        CALL addKey('vadv', s(2),  k)                                !--- Set the vertical   advection schemes number
    264265      END DO
    265266      CLOSE(90)
    266       IF(test(setGeneration(tracers), lerr)) RETURN                  !--- Set %iGeneration and %gen0Name
    267       WHERE(tracers%iGeneration == 2) tracers(:)%type = 'tag'        !--- Set %type:        'tracer' or 'tag'
    268       DO it=1,ntrac
    269         CALL addKey_s11('type', tracers(it)%type, tracers(it)%keys)  !--- Set the type of tracer
    270       END DO
    271       IF(test(checkTracers(tracers, fname, fname), lerr)) RETURN     !--- Detect orphans and check phases
    272       IF(test(checkUnique (tracers, fname, fname), lerr)) RETURN     !--- Detect repeated tracers
    273       CALL sortTracers    (tracers)                                  !--- Sort the tracers
     267      lerr = setGeneration(tracers); IF(lerr) RETURN                 !--- Set iGeneration and gen0Name
     268      lerr = getKey('iGeneration', iGen, tracers(:)%keys)            !--- Generation number
     269      WHERE(iGen == 2) tracers(:)%type = 'tag'                       !--- Set type:      'tracer' or 'tag'
     270      CALL addKey('type', tracers(:)%type, tracers(:)%keys)          !--- Set the type of tracer
     271      lerr = checkTracers(tracers, fname, fname); IF(lerr) RETURN    !--- Detect orphans and check phases
     272      lerr = checkUnique (tracers, fname, fname); IF(lerr) RETURN    !--- Detect repeated tracers
     273      CALL sortTracers   (tracers)                                   !--- Sort the tracers
    274274    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    275     CASE(2); IF(test(feedDBase(["tracer.def"], [type_trac], modname), lerr)) RETURN !=== SINGLE   FILE, MULTIPLE SECTIONS
     275    CASE(2); lerr=feedDBase(["tracer.def"], [type_trac], modname); IF(lerr) RETURN !=== SINGLE   FILE, MULTIPLE SECTIONS
    276276    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    277     CASE(3); IF(test(feedDBase(  trac_files  ,  sections,   modname), lerr)) RETURN !=== MULTIPLE FILES, SINGLE  SECTION
     277    CASE(3); lerr=feedDBase(  trac_files  ,  sections,   modname); IF(lerr) RETURN !=== MULTIPLE FILES, SINGLE  SECTION
    278278  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    279279  END SELECT
    280280  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    281281  IF(ALL([2,3] /= fType)) RETURN
    282 
    283   IF(nsec  == 1) THEN;
    284     tracers = dBase(1)%trac
    285   ELSE IF(lTracsMerge) THEN
    286     CALL msg('The multiple required sections will be MERGED.',    modname)
    287     IF(test(mergeTracers(dBase, tracers), lerr)) RETURN
    288   ELSE
    289     CALL msg('The multiple required sections will be CUMULATED.', modname)
    290     IF(test(cumulTracers(dBase, tracers), lerr)) RETURN
     282  IF(nsec == 1) tracers = dBase(1)%trac
     283  IF(nsec /= 1) THEN
     284    CALL msg('Multiple sections are MERGED',    modname,      lTracsMerge)
     285    CALL msg('Multiple sections are CUMULATED', modname, .NOT.lTracsMerge)
     286    IF(     lTracsMerge) lerr = cumulTracers(dBase, tracers)
     287    IF(.NOT.lTracsMerge) lerr = cumulTracers(dBase, tracers)
     288    IF(lerr) RETURN
    291289  END IF
    292   CALL setDirectKeys(tracers)                                        !--- Set %iqParent, %iqDescen, %nqDescen, %nqChildren
     290  lerr = indexUpdate(tracers); IF(lerr) RETURN                       !--- Set iqParent, iqDescen, nqDescen, nqChildren
     291
     292  IF(PRESENT(tracs)) CALL MOVE_ALLOC(FROM=tracers, TO=tracs)
    293293END FUNCTION readTracersFiles
    294294!==============================================================================================================================
    … …  
    310310  !--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINGLE SECTION PER FILE)
    311311  !--- If type_trac is a scalar (case 1), "sections" and "trac_files" are not usable, but are meaningless for case 1 anyway.
    312   IF(test(strParse(type_trac, '|', sections,  n=nsec), lerr)) RETURN !--- Parse "type_trac" list
     312  lerr = strParse(type_trac, '|', sections, n=nsec); IF(lerr) RETURN !--- Parse "type_trac" list
    313313  IF(PRESENT(sects)) sects = sections
    314314  ALLOCATE(trac_files(nsec), ll(nsec))
    … …  
    324324  IF(.NOT.lD) RETURN                                                 !--- NO CHECKING/DISPLAY NEEDED: JUST GET type_trac,fType
    325325  IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
    326     IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
     326    lerr = checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'); IF(lerr) RETURN
    327327  END IF
    328328
    … …  
    355355  ll = strCount(snames, '|', ndb)                                    !--- Number of sections for each file
    356356  ALLOCATE(ixf(SUM(ndb)))
    357   DO i=1, SIZE(fnames)                                               !--- Set %name, %keys
    358     IF(test(readSections(fnames(i), snames(i), 'default'), lerr)) RETURN
     357  DO i=1, SIZE(fnames)                                               !--- Set name, keys
     358    lerr = readSections(fnames(i), snames(i), 'default'); IF(lerr) RETURN
    359359    ixf(1+SUM(ndb(1:i-1)):SUM(ndb(1:i))) = i                         !--- File index for each section of the expanded list
    360360  END DO
    … …  
    364364    fnm = fnames(ixf(idb)); snm = dBase(idb)%name                    !--- FILE AND SECTION NAMES
    365365    lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
    366     IF(test(expandSection(dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- EXPAND NAMES ;  set %parent, %type, %component
    367     IF(test(setGeneration(dBase(idb)%trac),           lerr)) RETURN  !---                 set %iGeneration,   %genOName
    368     IF(test(checkTracers (dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- CHECK ORPHANS AND PHASES
    369     IF(test(checkUnique  (dBase(idb)%trac, snm, fnm), lerr)) RETURN !--- CHECK TRACERS UNIQUENESS
    370     CALL expandPhases    (dBase(idb)%trac)                           !--- EXPAND PHASES ; set %phase
    371     CALL sortTracers     (dBase(idb)%trac)                           !--- SORT TRACERS
     366    lerr = expandSection(dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- EXPAND NAMES ;  SET parent, type, component
     367    lerr = setGeneration(dBase(idb)%trac);           IF(lerr) RETURN !---                 SET iGeneration,  genOName
     368    lerr = checkTracers (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK ORPHANS AND PHASES
     369    lerr = checkUnique  (dBase(idb)%trac, snm, fnm); IF(lerr) RETURN !--- CHECK TRACERS UNIQUENESS
     370    lerr = expandPhases (dBase(idb)%trac);           IF(lerr) RETURN !--- EXPAND PHASES ; set phase
     371    CALL sortTracers    (dBase(idb)%trac)                            !--- SORT TRACERS
    372372    lerr = ANY([(dispTraSection('EXPANDED CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
    373373  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    … …  
    398398  ll = strParse(snam, '|', keys = sec)                               !--- Requested sections names
    399399  ix = strIdx(dBase(:)%name, sec(:))                                 !--- Indexes of requested sections in database
    400   IF(test(checkList(sec, ix == 0, 'In file "'//TRIM(fnam)//'"','section(s)', 'missing'), lerr)) RETURN
     400  lerr = checkList(sec, ix == 0, 'In file "'//TRIM(fnam)//'"','section(s)', 'missing'); IF(lerr) RETURN
    401401  tdb = dBase(:); dBase = [tdb(1:n0-1),tdb(PACK(ix, MASK=ix/=0))]    !--- Keep requested sections only
    402402
    … …  
    414414!------------------------------------------------------------------------------------------------------------------------------
    415415  IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
    416   OPEN(90, FILE=fnam, FORM='formatted', STATUS='old')
     416  OPEN(90, FILE=fnam, FORM='formatted', POSITION='REWIND', STATUS='old')
    417417  DO; str=''
    418418    DO
    … …  
    427427    IF(str(1:1)=='#') CYCLE                                          !--- Skip comments lines
    428428    CALL removeComment(str)                                          !--- Skip comments at the end of a line
     429    IF(LEN_TRIM(str) == 0) CYCLE                                     !--- Empty line (probably end of file)
    429430    IF(str     == '') CYCLE                                          !--- Skip empty line (probably at the end of the file)
    430431    IF(str(1:1)=='&') THEN                                           !=== SECTION HEADER LINE
    … …  
    445446      tmp%name = v(1); tmp%keys = keys_type(v(1), s(:), v(:))        !--- Set %name and %keys
    446447      dBase(ndb)%trac = [tt(:), tmp]
    447       DEALLOCATE(tt)
     448      DEALLOCATE(tt, tmp%keys%key, tmp%keys%val)
    448449    END IF
    449450  END DO
    … …  
    471472  ky => t(jd)%keys
    472473  DO k = 1, SIZE(ky%key)                                             !--- Loop on the keys of the tracer named "defName"
    473 !   CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys, .FALSE.)           !--- Add key to all the tracers (no overwriting)
     474!   CALL addKey(ky%key(k), ky%val(k), t(:)%keys, .FALSE.)            !--- Add key to all the tracers (no overwriting)
    474475    DO it = 1, SIZE(t); CALL addKey_s11(ky%key(k), ky%val(k), t(it)%keys, .FALSE.); END DO
    475476  END DO
    … …  
    517518!------------------------------------------------------------------------------------------------------------------------------
    518519  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)                 !--- Tracer derived type vector
    519   CHARACTER(LEN=*),             INTENT(IN)    :: sname
    520   CHARACTER(LEN=*), OPTIONAL,   INTENT(IN)    :: fname
     520  CHARACTER(LEN=*),             INTENT(IN)    :: sname                 !--- Current section name
     521  CHARACTER(LEN=*), OPTIONAL,   INTENT(IN)    :: fname                 !--- Tracers description file name
    521522  TYPE(trac_type),       ALLOCATABLE :: ttr(:)
    522   CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:)
     523  CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:), tname(:), parent(:), dType(:)
    523524  CHARACTER(LEN=maxlen) :: msg1, modname
    524525  INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr
    … …  
    527528  lerr = .FALSE.
    528529  nt = SIZE(tr)
     530  lerr = getKey('name',   tname,  tr(:)%keys);                 IF(lerr) RETURN
     531  lerr = getKey('parent', parent, tr(:)%keys, def = tran0);    IF(lerr) RETURN
     532  lerr = getKey('type',   dType,  tr(:)%keys, def = 'tracer'); IF(lerr) RETURN
    529533  nq = 0
    530534  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    … …  
    532536  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    533537    !--- Extract useful keys: parent name, type, component name
    534     tr(it)%parent    = fgetKey(it, 'parent', tr(:)%keys,  tran0  )
    535     tr(it)%type      = fgetKey(it, 'type'  , tr(:)%keys, 'tracer')
    536538    tr(it)%component = sname
    537 !   CALL addKey_s1m('component', sname, tr(:)%keys)
    538     DO iq=1,SIZE(tr); CALL addKey_s11('component', sname, tr(iq)%keys); END DO
     539    CALL addKey('component', sname,  tr(it)%keys)
    539540
    540541    !--- Determine the number of tracers and parents ; coherence checking
    541     ll = strCount(tr(it)%name,  ',', ntr)
    542     ll = strCount(tr(it)%parent, ',', npr)
     542    ll = strCount( tname(it), ',', ntr)
     543    ll = strCount(parent(it), ',', npr)
    543544
    544545    !--- Tagging tracers only can have multiple parents
    545     IF(test(npr/=1 .AND. TRIM(tr(it)%type)/='tag', lerr)) THEN
     546    lerr = npr /=1 .AND. TRIM(dType(it)) /= 'tag'
     547    IF(lerr) THEN
    546548      msg1 = 'Check section "'//TRIM(sname)//'"'
    547       IF(PRESENT(fname)) msg1=TRIM(msg1)//' in file "'//TRIM(fname)//'"'
    548       CALL msg(TRIM(msg1)//': "'//TRIM(tr(it)%name)//'" has several parents but is not a tag', modname); RETURN
     549      IF(PRESENT(fname)) msg1 = TRIM(msg1)//' in file "'//TRIM(fname)//'"'
     550      CALL msg(TRIM(msg1)//': "'//TRIM(tname(it))//'" has several parents but is not a tag', modname); RETURN
    549551    END IF
    550552    nq = nq + ntr*npr                 
    … …  
    558560  DO it = 1, nt                                                      !=== EXPAND TRACERS AND PARENTS NAMES LISTS
    559561  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    560     ll = strParse(tr(it)%name,   ',', ta, ntr)                       !--- Number of tracers
    561     ll = strParse(tr(it)%parent, ',', pa, npr)                       !--- Number of parents
    562     DO ipr=1,npr                                                     !--- Loop on parents list elts
    563       DO itr=1,ntr                                                   !--- Loop on tracers list elts
     562    ll = strParse( tname(it), ',', ta, ntr)                          !--- Number of tracers
     563    ll = strParse(parent(it), ',', pa, npr)                          !--- Number of parents
     564    DO ipr = 1, npr                                                  !--- Loop on parents list elts
     565      DO itr = 1, ntr                                                !--- Loop on tracers list elts
     566        ttr(iq)%keys%name = TRIM(ta(itr))
    564567        ttr(iq)%keys%key  = tr(it)%keys%key
    565568        ttr(iq)%keys%val  = tr(it)%keys%val
    566         ttr(iq)%keys%name = ta(itr)
    567         ttr(iq)%name      = TRIM(ta(itr));    CALL addKey_s11('name',      ta(itr),          ttr(iq)%keys)
    568         ttr(iq)%parent    = TRIM(pa(ipr));    CALL addKey_s11('parent',    pa(ipr),          ttr(iq)%keys)
    569         ttr(iq)%type      = tr(it)%type;      CALL addKey_s11('type',      tr(it)%type,      ttr(iq)%keys)
    570         ttr(iq)%component = tr(it)%component; CALL addKey_s11('component', tr(it)%component, ttr(iq)%keys)
    571         iq = iq+1
     569        ttr(iq)%name      = TRIM(ta(itr))
     570        ttr(iq)%parent    = TRIM(pa(ipr))
     571        ttr(iq)%type      = dType(it)
     572        ttr(iq)%component = sname
     573        CALL addKey('name',      ta(itr),   ttr(iq)%keys)
     574        CALL addKey('parent',    pa(ipr),   ttr(iq)%keys)
     575        CALL addKey('type',      dType(it), ttr(iq)%keys)
     576        CALL addKey('component', sname,     ttr(iq)%keys)
     577        iq = iq + 1
    572578      END DO
    573579    END DO
    … …  
    586592!------------------------------------------------------------------------------------------------------------------------------
    587593! Purpose: Determine, for each tracer of "tr(:)":
    588 !   * %iGeneration: the generation number
    589 !   * %gen0Name:    the generation 0 ancestor name
    590 !          Check also for orphan tracers (tracers not descending on "tran0").
     594!   * iGeneration: the generation number
     595!   * gen0Name:    the generation 0 ancestor name
     596!          Check also for orphan tracers (tracers without parent).
    591597!------------------------------------------------------------------------------------------------------------------------------
    592598  TYPE(trac_type),     INTENT(INOUT) :: tr(:)                        !--- Tracer derived type vector
    593599  INTEGER                            :: iq, jq, ig
    594   CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:)
     600  CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:), name(:)
     601  CHARACTER(LEN=maxlen) :: gen0N
    595602!------------------------------------------------------------------------------------------------------------------------------
    596603  CHARACTER(LEN=maxlen) :: modname
    597604  modname = 'setGeneration'
    598   IF(test(fmsg('missing "parent" attribute', modname, getKey('parent', parent, ky=tr(:)%keys)), lerr)) RETURN
     605  lerr = getKey('name',   name,   ky=tr(:)%keys); IF(lerr) RETURN
     606  lerr = getKey('parent', parent, ky=tr(:)%keys); IF(lerr) RETURN
    599607  DO iq = 1, SIZE(tr)
    600608    jq = iq; ig = 0
    601609    DO WHILE(parent(jq) /= tran0)
    602       jq = strIdx(tr(:)%name, parent(jq))
    603       IF(test(fmsg('Orphan tracer "'//TRIM(tr(iq)%name)//'"', modname, jq == 0), lerr)) RETURN
     610      jq = strIdx(name(:), parent(jq))
     611      lerr = jq == 0
     612      IF(fmsg('Orphan tracer "'//TRIM(name(iq))//'"', modname, lerr)) RETURN
    604613      ig = ig + 1
    605614    END DO
    606     tr(iq)%gen0Name = tr(jq)%name; CALL addKey_s11('gen0Name',    tr(iq)%gen0Name,   tr(iq)%keys)
    607     tr(iq)%iGeneration = ig;       CALL addKey_s11('iGeneration', TRIM(int2str(ig)), tr(iq)%keys)
     615    tr(iq)%gen0Name = name(jq)
     616    tr(iq)%iGeneration = ig
     617    CALL addKey('iGeneration',   ig,  tr(iq)%keys)
     618    CALL addKey('gen0Name', name(jq), tr(iq)%keys)
    608619  END DO
    609620END FUNCTION setGeneration
    … …  
    615626!------------------------------------------------------------------------------------------------------------------------------
    616627! Purpose:
    617 !   * check for orphan tracers (without known parent)
    618 !   * check wether the phases are known or not ("g"aseous, "l"iquid or "s"olid so far)
     628!   * check for orphan tracers (without parent)
     629!   * check wether the phases are known or not (elements of "known_phases")
    619630!------------------------------------------------------------------------------------------------------------------------------
    620631  TYPE(trac_type),            INTENT(IN) :: tr(:)                    !--- Tracer derived type vector
    621632  CHARACTER(LEN=*),           INTENT(IN) :: sname                    !--- Section name
    622633  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname                    !--- File name
     634  CHARACTER(LEN=1) :: p
    623635  CHARACTER(LEN=maxlen) :: mesg
    624636  CHARACTER(LEN=maxlen) :: bp(SIZE(tr, DIM=1)), pha                  !--- Bad phases list, phases of current tracer
    625   CHARACTER(LEN=1) :: p
     637  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
     638  INTEGER,               ALLOCATABLE ::  iGen(:)
    626639  INTEGER :: ip, np, iq, nq
    627640!------------------------------------------------------------------------------------------------------------------------------
     641  CHARACTER(LEN=maxlen) :: modname
     642  modname = 'checkTracers'
    628643  nq = SIZE(tr,DIM=1)                                                !--- Number of tracers lines
    629644  mesg = 'Check section "'//TRIM(sname)//'"'
    630645  IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
     646  lerr = getKey('iGeneration', iGen, tr(:)%keys);               IF(lerr) RETURN
     647  lerr = getKey('name',       tname, tr(:)%keys);               IF(lerr) RETURN
    631648
    632649  !=== CHECK FOR ORPHAN TRACERS
    633   IF(test(checkList(tr%name, tr%iGeneration==-1, mesg, 'tracers', 'orphan'), lerr)) RETURN
     650  lerr = checkList(tname, iGen==-1, mesg, 'tracers', 'orphan'); IF(lerr) RETURN
    634651
    635652  !=== CHECK PHASES
    636   DO iq=1,nq; IF(tr(iq)%iGeneration/=0) CYCLE                        !--- Generation O only is checked
    637     pha = fgetKey(iq, 'phases', tr(:)%keys, 'g')                     !--- Phases
     653  DO iq = 1, nq; IF(iGen(iq) /= 0) CYCLE                             !--- Generation O only is checked
     654    IF(getKey(['phases','phase '], pha, iq, tr(:)%keys, lDisp=.FALSE.)) pha = 'g'   !--- Phase
    638655    np = LEN_TRIM(pha); bp(iq)=' '
    639     DO ip=1,np; p = pha(ip:ip); IF(INDEX(known_phases,p)==0) bp(iq) = TRIM(bp(iq))//p; END DO
    640     IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tr(iq)%name)//': '//TRIM(bp(iq))
     656    DO ip = 1, np; p = pha(ip:ip); IF(INDEX(known_phases, p) == 0) bp(iq) = TRIM(bp(iq))//p; END DO
     657    IF(TRIM(bp(iq)) /= '') bp(iq) = TRIM(tname(iq))//': '//TRIM(bp(iq))
    641658  END DO
    642   lerr = checkList(bp, tr%iGeneration==0 .AND. bp/='', mesg, 'tracers phases', 'unknown')
     659  lerr = checkList(bp, iGen == 0 .AND. bp /= '', mesg, 'tracers phases', 'unknown')
    643660END FUNCTION checkTracers
    644661!==============================================================================================================================
    … …  
    656673  INTEGER :: ip, np, iq, nq, k
    657674  LOGICAL, ALLOCATABLE  :: ll(:)
    658   CHARACTER(LEN=maxlen) :: mesg, tnam, tdup(SIZE(tr,DIM=1))
    659   CHARACTER(LEN=1)      :: p
    660 !------------------------------------------------------------------------------------------------------------------------------
     675  CHARACTER(LEN=maxlen) :: mesg, phase, tdup(SIZE(tr,DIM=1))
     676  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), dType(:)
     677  INTEGER,               ALLOCATABLE :: iGen(:)
     678  CHARACTER(LEN=1) :: p
     679!------------------------------------------------------------------------------------------------------------------------------
     680  CHARACTER(LEN=maxlen) :: modname
     681  modname = 'checkUnique'
    661682  mesg = 'Check section "'//TRIM(sname)//'"'
    662683  IF(PRESENT(fname)) mesg=TRIM(mesg)//' in file "'//TRIM(fname)//'"'
    663684  nq=SIZE(tr,DIM=1); lerr=.FALSE.                                    !--- Number of lines ; error flag
    664685  tdup(:) = ''
    665   DO iq=1,nq; IF(tr(iq)%type == 'tag') CYCLE                         !--- Tags can be repeated
    666     tnam = TRIM(tr(iq)%name)
    667     ll = tr(:)%name==TRIM(tnam)                                      !--- Mask for current tracer name
    668     IF(COUNT(ll)==1 ) CYCLE                                          !--- Tracer is not repeated
    669     IF(tr(iq)%iGeneration>0) THEN
    670       tdup(iq) = tnam                                                !--- gen>0: MUST be unique
     686  lerr = getKey('name',       tname, tr%keys); IF(lerr) RETURN
     687  lerr = getKey('type',       dType, tr%keys); IF(lerr) RETURN
     688  lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN
     689  DO iq = 1, nq
     690    IF(dType(iq) == 'tag') CYCLE                                     !--- Tags can be repeated
     691    ll = tname==TRIM(tname(iq))                                      !--- Mask for current tracer name
     692    IF(COUNT(ll) == 1) CYCLE                                         !--- Tracer is not repeated
     693    IF(iGen(iq) > 0) THEN
     694      tdup(iq) = tname(iq)                                           !--- gen>0: MUST be unique
    671695    ELSE
    672       DO ip=1,nphases; p=known_phases(ip:ip)                         !--- Loop on known phases
    673         !--- Number of appearances of the current tracer with known phase "p"
    674         np = COUNT( PACK( [(INDEX(fgetKey(k, 'phases', tr(:)%keys, 'g'),p), k=1, nq)] /=0 , MASK=ll ) )
    675         IF(np <=1) CYCLE
    676         tdup(iq) = TRIM(tdup(iq))//TRIM(phases_names(ip))
     696      DO ip = 1, nphases; p = known_phases(ip:ip)                    !--- Loop on known phases
     697        np = 0
     698        DO k = 1, nq
     699          IF(.NOT.ll(k)) CYCLE                                       !--- Skip tracers different from current one
     700          IF(getKey(['phases','phase '], phase, k, tr%keys, lDisp=.FALSE.)) phase='g'!--- Get current phases
     701          IF(INDEX(phase, p) /= 0) np = np + 1                       !--- One more appearance of current tracer with phase "p"
     702        END DO
     703        IF(np <= 1) CYCLE                                            !--- Regular case: no or a single appearance
     704        tdup(iq) = TRIM(tdup(iq))//TRIM(phases_names(ip))            !--- Repeated phase
    677705        IF(ANY(tdup(1:iq-1) == tdup(iq))) tdup(iq)=''                !--- Avoid repeating same messages
    678706      END DO
    679707    END IF
    680     IF(tdup(iq) /= '') tdup(iq)=TRIM(tnam)//' in '//TRIM(tdup(iq))//' phase(s)'
     708    IF(tdup(iq) /= '') tdup(iq)=TRIM(tname(iq))//' in '//TRIM(tdup(iq))//' phase(s)'
    681709  END DO
    682710  lerr = checkList(tdup, tdup/='', mesg, 'tracers', 'duplicated')
    … …  
    686714
    687715!==============================================================================================================================
    688 SUBROUTINE expandPhases(tr)
     716LOGICAL FUNCTION expandPhases(tr) RESULT(lerr)
    689717!------------------------------------------------------------------------------------------------------------------------------
    690718! Purpose: Expand the phases in the tracers descriptor "tr". Phases are not repeated for a tracer, thanks to "checkUnique".
    … …  
    692720  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)               !--- Tracer derived type vector
    693721!------------------------------------------------------------------------------------------------------------------------------
    694   TYPE(trac_type), ALLOCATABLE :: ttr(:)
    695   INTEGER,   ALLOCATABLE ::  i0(:)
    696   CHARACTER(LEN=maxlen)  :: nam, pha, tname
     722  TYPE(trac_type),       ALLOCATABLE :: ttr(:)
     723  INTEGER,               ALLOCATABLE ::  i0(:), iGen(:)
     724  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), gen0N(:), phase(:), parents(:), dType(:)
     725  CHARACTER(LEN=maxlen)              ::  nam,     gen0Nm,   pha,      parent,      typ
    697726  CHARACTER(LEN=1) :: p
    698727  INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
    699728  LOGICAL :: lTag, lExt
    700729!------------------------------------------------------------------------------------------------------------------------------
     730  CHARACTER(LEN=maxlen) :: modname
     731  modname = 'expandPhases'
    701732  nq = SIZE(tr, DIM=1)
    702733  nt = 0
     734  lerr = getKey('name',       tname, tr%keys); IF(lerr) RETURN       !--- Names of the tracers
     735  lerr = getKey('gen0Name',   gen0N, tr%keys); IF(lerr) RETURN       !--- Names of the tracers of first generation
     736  lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN       !--- Generation number
     737  lerr = getKey('phases',     phase, tr%keys); IF(lerr) RETURN       !--- Phases names
     738  lerr = getKey('parent',   parents, tr%keys); IF(lerr) RETURN       !--- Parents names
     739  lerr = getKey('type',       dType, tr%keys); IF(lerr) RETURN       !--- Tracers types ('tracer' or 'tag')
    703740  DO iq = 1, nq                                                      !--- GET THE NUMBER OF TRACERS
    704     IF(tr(iq)%iGeneration /= 0) CYCLE                                !--- Only deal with generation 0 tracers
    705     nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=0)  !--- Number of children of tr(iq)
    706     tr(iq)%phase = fgetKey(iq, 'phases', tr(:)%keys)                 !--- Phases list        of tr(iq)
    707     np = LEN_TRIM(tr(iq)%phase)                                      !--- Number of phases   of tr(iq)
     741    IF(iGen(iq) /= 0) CYCLE                                          !--- Only deal with generation 0 tracers
     742    nc = COUNT(gen0N == tname(iq) .AND. iGen /= 0)                   !--- Number of children of tr(iq)
     743    np = LEN_TRIM(phase(iq))                                         !--- Number of phases   of tr(iq)
    708744    nt = nt + (1+nc) * np                                            !--- Number of tracers after expansion
    709745  END DO
    … …  
    711747  it = 1                                                             !--- Current "ttr(:)" index
    712748  DO iq = 1, nq                                                      !--- Loop on "tr(:)" indexes
    713     lTag = tr(iq)%type=='tag'                                        !--- Current tracer is a tag
    714     i0 = strFind(tr(:)%name, TRIM(tr(iq)%gen0Name), n)               !--- Indexes of first generation ancestor copies
    715     np = SUM([( LEN_TRIM(tr(i0(i))%phase),i=1,n )], 1)               !--- Number of phases for current tracer tr(iq)
    716     lExt = np>1                                                      !--- Phase suffix only required if phases number is > 1
    717     IF(lTag) lExt = lExt .AND. tr(iq)%iGeneration>0                  !--- No phase suffix for generation 0 tags
    718     DO i=1,n                                                         !=== LOOP ON GENERATION 0 ANCESTORS
     749    lTag = dType(iq)=='tag'                                          !--- Current tracer is a tag
     750    i0 = strFind(tname, TRIM(gen0N(iq)), n)                          !--- Indexes of first generation ancestor copies
     751    np = SUM([( LEN_TRIM(phase(i0(i))), i = 1, n )], 1)              !--- Number of phases for current tracer tr(iq)
     752    lExt = np > 1                                                    !--- Phase suffix only required if phases number is > 1
     753    IF(lTag) lExt = lExt .AND. iGen(iq) > 0                          !--- No phase suffix for generation 0 tags
     754    DO i = 1, n                                                      !=== LOOP ON GENERATION 0 ANCESTORS
    719755      jq = i0(i)                                                     !--- tr(jq): ith tracer with same gen 0 ancestor as tr(iq)
    720       IF(tr(iq)%iGeneration==0) jq=iq                                !--- Generation 0: count the current tracer phases only
    721       pha = tr(jq)%phase                                             !--- Phases list for tr(jq)
     756      IF(iGen(iq) == 0) jq = iq                                      !--- Generation 0: count the current tracer phases only
     757      pha = phase(jq)                                                !--- Phases list for tr(jq)
    722758      DO ip = 1, LEN_TRIM(pha)                                       !=== LOOP ON PHASES LISTS
    723759        p = pha(ip:ip)
    724         tname = TRIM(tr(iq)%name); nam = tname                       !--- Tracer name (regular case)
    725         IF(lTag) nam = TRIM(tr(iq)%parent)                           !--- Parent name (tagging case)
     760        nam = tname(iq)                                              !--- Tracer name (regular case)
     761        IF(lTag) nam = TRIM(parents(iq))                             !--- Parent name (tagging case)
    726762        IF(lExt) nam = addPhase(nam, p )                             !--- Phase extension needed
    727         IF(lTag) nam = TRIM(nam)//'_'//TRIM(tname)                   !--- <parent>_<name> for tags
     763        IF(lTag) nam = TRIM(nam)//'_'//TRIM(tname(iq))               !--- <parent>_<name> for tags
    728764        ttr(it) = tr(iq)                                             !--- Same <key>=<val> pairs
    729765        ttr(it)%name      = TRIM(nam)                                !--- Name with possibly phase suffix
    730766        ttr(it)%keys%name = TRIM(nam)                                !--- Name inside the keys decriptor
    731767        ttr(it)%phase     = p                                        !--- Single phase entry
    732         CALL addKey_s11('name', nam, ttr(it)%keys)
    733         CALL addKey_s11('phase', p,  ttr(it)%keys)
    734         IF(lExt .AND. tr(iq)%iGeneration>0) THEN
    735           ttr(it)%parent   = addPhase(tr(iq)%parent,   p)
    736           ttr(it)%gen0Name = addPhase(tr(iq)%gen0Name, p)
    737           CALL addKey_s11('parent',   ttr(it)%parent,   ttr(it)%keys)
    738           CALL addKey_s11('gen0Name', ttr(it)%gen0Name, ttr(it)%keys)
     768        CALL addKey('name', nam, ttr(it)%keys)
     769        CALL addKey('phase', p,  ttr(it)%keys)
     770        IF(lExt) THEN
     771          parent = parents(iq); IF(iGen(iq) > 0) parent = addPhase(parent, p)
     772          gen0Nm =   gen0N(iq); IF(iGen(iq) > 0) gen0Nm = addPhase(gen0Nm, p)
     773          ttr(it)%parent   = parent
     774          ttr(it)%gen0Name = gen0Nm
     775          CALL addKey('parent',   parent, ttr(it)%keys)
     776          CALL addKey('gen0Name', gen0Nm, ttr(it)%keys)
    739777        END IF
    740778        it = it+1
    741779      END DO
    742       IF(tr(iq)%iGeneration==0) EXIT                                 !--- Break phase loop for gen 0
     780      IF(iGen(iq) == 0) EXIT                                         !--- Break phase loop for gen 0
    743781    END DO
    744782  END DO
    … …  
    746784  CALL delKey(['phases'],tr)                                         !--- Remove few keys entries
    747785
    748 END SUBROUTINE expandPhases
     786END FUNCTION expandPhases
    749787!==============================================================================================================================
    750788
    … …  
    759797!   TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
    760798!------------------------------------------------------------------------------------------------------------------------------
    761   TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tr(:)         !--- Tracer derived type vector
    762 !------------------------------------------------------------------------------------------------------------------------------
    763   TYPE(trac_type), ALLOCATABLE        :: tr2(:)
    764   INTEGER,         ALLOCATABLE        :: iy(:), iz(:)
    765   INTEGER                             :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
     799  TYPE(trac_type), INTENT(INOUT) :: tr(:)                            !--- Tracer derived type vector
     800!------------------------------------------------------------------------------------------------------------------------------
     801  TYPE(trac_type),       ALLOCATABLE :: tr2(:)
     802  INTEGER,               ALLOCATABLE :: iy(:), iz(:)
     803  INTEGER,               ALLOCATABLE ::  iGen(:)
     804  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), gen0N(:)
     805  INTEGER :: ig, ng, iq, jq, ip, nq, n, ix(SIZE(tr)), k
     806  LOGICAL :: lerr
    766807!  tr2 is introduced in order to cope with a bug in gfortran 4.8.5 compiler
    767808!------------------------------------------------------------------------------------------------------------------------------
     809  lerr = getKey('iGeneration', iGen, tr%keys); IF(lerr) RETURN       !--- Generation number
    768810  nq = SIZE(tr)
    769811  DO ip = nphases, 1, -1
    770     iq = strIdx(tr(:)%name, addPhase('H2O', ip))
     812    lerr = getKey('name',     tname, tr%keys); IF(lerr) RETURN       !--- Names of the tracers of first generation
     813    iq = strIdx(tname, addPhase('H2O', ip))
    771814    IF(iq == 0) CYCLE
    772815    tr2 = tr(:)
    … …  
    775818  IF(lSortByGen) THEN
    776819    iq = 1
    777     ng = MAXVAL(tr(:)%iGeneration, MASK=.TRUE., DIM=1)               !--- Number of generations
     820    ng = MAXVAL(iGen, MASK=.TRUE., DIM=1)                            !--- Number of generations
    778821    DO ig = 0, ng                                                    !--- Loop on generations
    779       iy = PACK([(k, k=1, nq)], MASK=tr(:)%iGeneration==ig)          !--- Generation ig tracers indexes
     822      iy = PACK([(k, k=1, nq)], MASK=iGen(:) == ig)                  !--- Generation ig tracers indexes
    780823      n = SIZE(iy)
    781824      ix(iq:iq+n-1) = iy                                             !--- Stack growing generations idxs
    … …  
    783826    END DO
    784827  ELSE
    785     iq = 1
     828    lerr = getKey('gen0Name',   gen0N, tr%keys); IF(lerr) RETURN     !--- Names of the tracers    iq = 1
    786829    DO jq = 1, nq                                                    !--- Loop on generation 0 tracers
    787       IF(tr(jq)%iGeneration /= 0) CYCLE                              !--- Skip generations /= 0
     830      IF(iGen(jq) /= 0) CYCLE                                        !--- Skip generations /= 0
    788831      ix(iq) = jq                                                    !--- Generation 0 ancestor index first
    789832      iq = iq + 1                                                    !--- Next "iq" for next generations tracers
    790       iy = strFind(tr(:)%gen0Name, TRIM(tr(jq)%name))                !--- Indexes of "tr(jq)" children in "tr(:)"
    791       ng = MAXVAL(tr(iy)%iGeneration, MASK=.TRUE., DIM=1)            !--- Number of generations of the "tr(jq)" family
     833      iy = strFind(gen0N(:), TRIM(tname(jq)))                        !--- Indices of "tr(jq)" children in "tr(:)"
     834      ng = MAXVAL(iGen(iy), MASK=.TRUE., DIM=1)                      !--- Number of generations of the "tr(jq)" family
    792835      DO ig = 1, ng                                                  !--- Loop   on generations of the "tr(jq)" family
    793         iz = find(tr(iy)%iGeneration, ig, n)                         !--- Indexes of the tracers "tr(iy(:))" of generation "ig"
     836        iz = find(iGen(iy), ig, n)                                   !--- Indices of the tracers "tr(iy(:))" of generation "ig"
    794837        ix(iq:iq+n-1) = iy(iz)                                       !--- Same indexes in "tr(:)"
    795838        iq = iq + n
    … …  
    807850  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) ::       tr(:)
    808851  TYPE(trac_type), POINTER ::   t1(:),   t2(:)
     852  TYPE(keys_type), POINTER ::   k1(:),   k2(:)
    809853  INTEGER,     ALLOCATABLE :: ixct(:), ixck(:)
    810   INTEGER :: is, k1, k2, nk2, i1, i2, nt2
     854  INTEGER :: is, ik, ik1, ik2, nk2, i1, i2, nt2
    811855  CHARACTER(LEN=maxlen) :: s1, v1, v2, tnam, knam, modname
     856  CHARACTER(LEN=maxlen), ALLOCATABLE :: keys(:), n1(:), n2(:)
    812857  modname = 'mergeTracers'
    813858  lerr = .FALSE.
    814   t1 => sections(1)%trac(:)                                          !--- Alias: first tracers section
     859  keys = ['parent     ', 'type       ', 'iGeneration']               !--- Mandatory keys
     860  t1 => sections(1)%trac(:); k1 => t1(:)%keys                        !--- Alias: first tracers section, corresponding keys
     861  lerr = getKey('name', n1, k1); IF(lerr) RETURN                     !--- Names of the tracers
    815862  tr = t1
    816863  !----------------------------------------------------------------------------------------------------------------------------
    … …  
    818865  !----------------------------------------------------------------------------------------------------------------------------
    819866    t2  => sections(is)%trac(:)                                      !--- Alias: current tracers section
     867    k2  => t2(:)%keys
     868    lerr = getKey('name', n2, k2); IF(lerr) RETURN                   !--- Names of the tracers
    820869    nt2  = SIZE(t2(:), DIM=1)                                        !--- Number of tracers in section
    821     ixct = strIdx(t1(:)%name, t2(:)%name)                            !--- Indexes of common tracers
     870    ixct = strIdx(n1(:), n2(:))                                      !--- Indexes of common tracers
    822871    tr = [tr, PACK(t2, MASK= ixct==0)]                               !--- Append with new tracers
    823872    IF( ALL(ixct == 0) ) CYCLE                                       !--- No common tracers => done
    824873    CALL msg('Tracers defined in previous sections and duplicated in "'//TRIM(sections(is)%name)//'":', modname)
    825     CALL msg(t1(PACK(ixct, MASK = ixct/=0))%name, modname, nmax=128) !--- Display duplicates (the 128 first at most)
     874    CALL msg(n1(PACK(ixct, MASK = ixct/=0)), modname, nmax=128)      !--- Display duplicates (the 128 first at most)
    826875    !--------------------------------------------------------------------------------------------------------------------------
    827876    DO i2=1,nt2; tnam = TRIM(t2(i2)%name)                            !=== LOOP ON COMMON TRACERS
    … …  
    831880      !=== CHECK WETHER ESSENTIAL KEYS ARE IDENTICAL OR NOT
    832881      s1=' of "'//TRIM(tnam)//'" in "'//TRIM(sections(is)%name)//'" not matching previous value'
    833      
    834       IF(test(fmsg('Parent name'//TRIM(s1), modname, t1(i1)%parent      /= t2(i2)%parent),      lerr)) RETURN
    835       IF(test(fmsg('Type'       //TRIM(s1), modname, t1(i1)%type        /= t2(i2)%type),        lerr)) RETURN
    836       IF(test(fmsg('Generation' //TRIM(s1), modname, t1(i1)%iGeneration /= t2(i2)%iGeneration), lerr)) RETURN
    837 
    838       !=== APPEND <key>=<val> PAIRS NOT PREVIOULSLY DEFINED
    839       nk2  = SIZE(t2(i2)%keys%key(:))                                !--- Keys number in current section
    840       ixck = strIdx(t1(i1)%keys%key(:), t2(i2)%keys%key(:))          !--- Common keys indexes
    841 
    842       !=== APPEND NEW KEYS
     882      DO ik = 1, SIZE(keys)
     883        lerr = getKey(keys(ik), v1, i1, k1)
     884        lerr = getKey(keys(ik), v2, i2, k2)
     885        lerr = v1 /= v2; IF(fmsg(TRIM(keys(ik))//TRIM(s1), modname, lerr)) RETURN
     886      END DO
     887
     888      !=== GET THE INDICES IN tr(i2)%keys%key(:) OF THE KEYS ALSO PRESENT IN tr(i1)%keys%key(:)
     889      nk2  =   SIZE(k2(i2)%key(:))                                   !--- Keys number in current section
     890      ixck = strIdx(k1(i1)%key(:), k2(i2)%key(:))                    !--- Common keys indexes
     891      !--- APPEND THE NEW KEYS PAIRS IN tr(i1)%keys%key(:)
    843892      tr(i1)%keys%key = [ tr(i1)%keys%key, PACK(tr(i2)%keys%key, MASK = ixck==0)]
    844893      tr(i1)%keys%val = [ tr(i1)%keys%val, PACK(tr(i2)%keys%val, MASK = ixck==0)]
    845894
    846       !--- KEEP TRACK OF THE COMPONENTS NAMES
    847       tr(i1)%component = TRIM(tr(i1)%component)//','//TRIM(tr(i2)%component)
    848 
    849       !--- SELECT COMMON TRACERS WITH DIFFERING KEYS VALUES (PREVIOUS VALUE IS KEPT)
    850       DO k2=1,nk2
    851         k1 = ixck(k2); IF(k1 == 0) CYCLE
    852         IF(t1(i1)%keys%val(k1) == t2(i2)%keys%val(k2)) ixck(k2)=0
     895      !=== KEEP TRACK OF THE COMPONENTS NAMES: COMA-SEPARATED LIST
     896      lerr = getKey('component', v1, i1, k1)
     897      lerr = getKey('component', v2, i2, k2)
     898      tr(i1)%component = TRIM(v1)//','//TRIM(v2)
     899      CALL addKey_s11('component', TRIM(v1)//','//TRIM(v2), tr(i1)%keys)
     900
     901      !=== FOR TRACERS COMMON TO PREVIOUS AND CURRENT SECTIONS: CHECK WETHER SOME KEYS HAVE DIFFERENT VALUES ; KEEP OLD ONE
     902      DO ik2 = 1, nk2                                                !--- Collect the corresponding indices
     903        ik1 = ixck(ik2); IF(ik1 == 0) CYCLE
     904        IF(k1(i1)%val(ik1) == k2(i2)%val(ik2)) ixck(ik2)=0
    853905      END DO
    854       IF(ALL(ixck==0)) CYCLE                                         !--- No identical keys with /=values
    855 
    856       !--- DISPLAY INFORMATION: OLD VALUES ARE KEPT FOR THE KEYS FOUND IN PREVIOUS AND CURRENT SECTIONS
    857       CALL msg('Key(s)'//TRIM(s1), modname)
    858       DO k2 = 1, nk2                                                 !--- Loop on keys found in both t1(:) and t2(:)
    859         knam = t2(i2)%keys%key(k2)                                   !--- Name of the current key
    860         k1 = ixck(k2)                                                !--- Corresponding index in t1(:)
    861         IF(k1 == 0) CYCLE                                            !--- New keys are skipped
    862         v1 = t1(i1)%keys%val(k1); v2 = t2(i2)%keys%val(k2)           !--- Key values in t1(:) and t2(:)
     906      IF(ALL(ixck==0)) CYCLE                                         !--- No identical keys with /=values => nothing to display
     907      CALL msg('Key(s)'//TRIM(s1), modname)                          !--- Display the  keys with /=values (names list)
     908      DO ik2 = 1, nk2                                                !--- Loop on keys found in both t1(:) and t2(:)
     909        knam = k2(i2)%key(ik2)                                       !--- Name of the current key
     910        ik1 = ixck(ik2)                                              !--- Corresponding index in t1(:)
     911        IF(ik1 == 0) CYCLE                                           !--- New keys are skipped
     912        v1 = k1(i1)%val(ik1); v2 = k2(i2)%val(ik2)                   !--- Key values in t1(:) and t2(:)
    863913        CALL msg(' * '//TRIM(knam)//'='//TRIM(v2)//' ; previous value kept:'//TRIM(v1), modname)
    864914      END DO
    … …  
    873923
    874924!==============================================================================================================================
    875 LOGICAL FUNCTION cumulTracers(sections, tr) RESULT(lerr)
     925LOGICAL FUNCTION cumulTracers(sections, tr, lRename) RESULT(lerr)
    876926  TYPE(dataBase_type),  TARGET, INTENT(IN)  :: sections(:)
    877927  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) ::       tr(:)
    878   TYPE(trac_type), POINTER     :: t(:)
    879   INTEGER,   ALLOCATABLE :: nt(:)
    880   CHARACTER(LEN=maxlen)  :: tnam, tnam_new
    881   INTEGER :: iq, nq, is, ns, nsec
    882   lerr = .FALSE.                                                     !--- Can't fail ; kept to match "mergeTracer" interface.
    883   nsec =  SIZE(sections)
    884   tr = [(      sections(is)%trac(:) , is=1, nsec )]                  !--- Concatenated tracers vector
    885   nt = [( SIZE(sections(is)%trac(:)), is=1, nsec )]                  !--- Number of tracers in each section
     928  LOGICAL,            OPTIONAL, INTENT(IN)  :: lRename               !--- .TRUE.: add a section suffix to identical names
     929  CHARACTER(LEN=maxlen)  :: tnam, tnam_new, modname
     930  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), parent(:), comp(:)
     931  INTEGER :: iq, jq, is
     932  modname = 'cumulTracers'
     933  lerr = .FALSE.
     934  tr = [( sections(is)%trac(:), is = 1, SIZE(sections) )]            !--- Concatenated tracers vector
     935  IF(PRESENT(lRename)) THEN; IF(lRename) RETURN; END IF              !--- No renaming: finished
     936  lerr = getKey('name',     tname, tr%keys); IF(lerr) RETURN         !--- Names
     937  lerr = getKey('parent',  parent, tr%keys); IF(lerr) RETURN         !--- Parents
     938  lerr = getKey('component', comp, tr%keys); IF(lerr) RETURN         !--- Component name
    886939  !----------------------------------------------------------------------------------------------------------------------------
    887   DO is=1, nsec                                                      !=== LOOP ON SECTIONS
     940  DO iq = 1, SIZE(tr); IF(COUNT(tname == tname(iq)) == 1) CYCLE      !=== LOOP ON TRACERS
    888941  !----------------------------------------------------------------------------------------------------------------------------
    889     t => sections(is)%trac(:)
     942    tnam_new = TRIM(tname(iq))//'_'//TRIM(comp(iq))                  !--- Same with section extension
     943    CALL addKey('name', tnam_new, tr(iq)%keys)                       !--- Modify tracer name
     944    tr(iq)%name = TRIM(tnam_new)                                     !--- Modify tracer name
    890945    !--------------------------------------------------------------------------------------------------------------------------
    891     DO iq=1, nt(is)                                                  !=== LOOP ON TRACERS
     946    DO jq = 1, SIZE(tr); IF(parent(jq) /= tname(iq)) CYCLE           !=== LOOP ON TRACERS PARENTS
    892947    !--------------------------------------------------------------------------------------------------------------------------
    893       tnam = TRIM(t(iq)%name)                                        !--- Original name
    894       IF(COUNT(t%name == tnam) == 1) CYCLE                           !--- Current tracer is not duplicated: finished
    895       tnam_new = TRIM(tnam)//'_'//TRIM(sections(is)%name)            !--- Same with section extension
    896       nq = SUM(nt(1:is-1))                                           !--- Number of tracers in previous sections
    897       ns = nt(is)                                                    !--- Number of tracers in the current section
    898       tr(iq + nq)%name = TRIM(tnam_new)                              !--- Modify tracer name
    899       WHERE(tr(1+nq:ns+nq)%parent==tnam) tr(1+nq:ns+nq)%parent=tnam_new  !--- Modify parent name
     948      CALL addKey('parent', tnam_new, tr(jq)%keys)                   !--- Modify tracer name
     949      tr(jq)%parent = TRIM(tnam_new)                                 !--- Modify tracer name
    900950    !--------------------------------------------------------------------------------------------------------------------------
    901951    END DO
    … …  
    907957!==============================================================================================================================
    908958
    909 !==============================================================================================================================
    910 SUBROUTINE setDirectKeys(tr)
     959
     960!==============================================================================================================================
     961LOGICAL  FUNCTION  dispTraSection(message, sname, modname) RESULT(lerr)
     962  CHARACTER(LEN=*), INTENT(IN) :: message, sname, modname
     963  CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:,:), n(:), tmp(:)
     964  CHARACTER(LEN=maxlen) :: p
     965  INTEGER :: idb, iq, nq
     966  idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
     967  nq = SIZE(dBase(idb)%trac)
     968  p = ''
     969  CALL append(['iq'],             .TRUE. ); IF(lerr) RETURN
     970  CALL append(['name'],           .TRUE. ); IF(lerr) RETURN
     971  CALL append(['phases','phase'], .FALSE., 'pha'); IF(lerr) RETURN
     972  CALL append(['hadv'],           .TRUE. ); IF(lerr) RETURN
     973  CALL append(['vadv'],           .TRUE. ); IF(lerr) RETURN
     974  CALL append(['parent'],         .FALSE.); IF(lerr) RETURN
     975  CALL append(['iGen'],           .FALSE.); IF(lerr) RETURN
     976  CALL msg(TRIM(message)//':', modname)
     977  lerr = dispTable(p, n, s, nColMax=maxTableWidth, nHead=2, sub=modname); IF(lerr) RETURN
     978
     979CONTAINS
     980
     981SUBROUTINE append(nam, lMandatory, snam)
     982! Test whether key named "nam(:)" is available.
     983!  * yes: - get its value for all species in "tmp(:)" and append table "s(:,:)" with it
     984!         - append titles list with "nam(1)" (or, if specified, "snam", usually a short name).
     985!  * no:  return to calling routine with an error flag if the required key is mandatory
     986  CHARACTER(LEN=*),           INTENT(IN) :: nam(:)
     987  LOGICAL,                    INTENT(IN) :: lMandatory
     988  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: snam
     989  INTEGER :: m
     990  CHARACTER(LEN=maxlen), ALLOCATABLE :: s0(:,:), n0(:)
     991  CHARACTER(LEN=maxlen) :: nm
     992  lerr = .FALSE.
     993  IF(nam(1) == 'iq') THEN
     994    tmp = int2str([(iq, iq=1, nq)])
     995  ELSE
     996    lerr = getKey(nam, tmp, dBase(idb)%trac(:)%keys, lDisp=lMandatory)
     997  END IF
     998  IF(lerr) THEN; lerr = lMandatory; RETURN; END IF
     999  nm = nam(1); IF(PRESENT(snam)) nm = snam
     1000  p = TRIM(p)//'s'
     1001  IF(ALLOCATED(s)) THEN; s = cat(s, tmp); ELSE; ALLOCATE(s(nq,1)); s(:,1) = tmp; END IF
     1002  IF(ALLOCATED(n)) THEN; m = SIZE(n); ALLOCATE(n0(m+1)); n0(1:m)=n; n0(m+1)=nm; CALL MOVE_ALLOC(FROM=n0, TO=n)
     1003  ELSE; n=nam(1:1); END IF
     1004END SUBROUTINE append
     1005
     1006END FUNCTION dispTraSection
     1007!==============================================================================================================================
     1008
     1009
     1010!==============================================================================================================================
     1011!=== CREATE TRACER(S) ALIAS: SCALAR/VECTOR FROM NAME(S) OR INDICE(S) ==========================================================
     1012!==============================================================================================================================
     1013LOGICAL FUNCTION aliasTracer(tname, trac, alias) RESULT(lerr)                  !=== TRACER NAMED "tname" - SCALAR
     1014  CHARACTER(LEN=*),         INTENT(IN)  :: tname
     1015  TYPE(trac_type), TARGET,  INTENT(IN)  :: trac(:)
     1016  TYPE(trac_type), POINTER, INTENT(OUT) :: alias
     1017  INTEGER :: it
     1018  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
     1019  alias => NULL()
     1020  lerr = getKey('name', tnames, trac(:)%keys)
     1021  it = strIdx(tnames, tname)
     1022  lerr = it /= 0; IF(.NOT.lerr) alias => trac(it)
     1023END FUNCTION aliasTracer
     1024!==============================================================================================================================
     1025LOGICAL FUNCTION trSubset_Indx(trac, idx, alias) RESULT(lerr)                  !=== TRACERS WITH INDICES "idx(:)" - VECTOR
     1026  TYPE(trac_type), ALLOCATABLE, INTENT(IN)  ::  trac(:)
     1027  INTEGER,                      INTENT(IN)  ::   idx(:)
     1028  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
     1029  alias = trac(idx)
     1030  lerr = indexUpdate(alias)
     1031END FUNCTION trSubset_Indx
     1032!------------------------------------------------------------------------------------------------------------------------------
     1033LOGICAL FUNCTION trSubset_Name(trac, tname, alias) RESULT(lerr)                !=== TRACERS NAMED "tname(:)" - VECTOR
     1034  TYPE(trac_type), ALLOCATABLE, INTENT(IN)  ::  trac(:)
     1035  CHARACTER(LEN=*),             INTENT(IN)  :: tname(:)
     1036  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
     1037  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
     1038  lerr = getKey('name', tnames, trac(:)%keys)
     1039  alias = trac(strIdx(tnames, tname))
     1040  lerr = indexUpdate(alias)
     1041END FUNCTION trSubset_Name
     1042!==============================================================================================================================
     1043LOGICAL FUNCTION trSubset_gen0Name(trac, gen0Nm, alias) RESULT(lerr)           !=== TRACERS OF COMMON 1st GENERATION ANCESTOR
     1044  TYPE(trac_type), ALLOCATABLE, INTENT(IN)  :: trac(:)
     1045  CHARACTER(LEN=*),             INTENT(IN)  :: gen0Nm
     1046  TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: alias(:)
     1047  CHARACTER(LEN=maxlen), ALLOCATABLE :: gen0N(:)
     1048  lerr = getKey('gen0Name', gen0N, trac(:)%keys)
     1049  alias = trac(strFind(delPhase(gen0N), gen0Nm))
     1050  lerr = indexUpdate(alias)
     1051END FUNCTION trSubset_gen0Name
     1052!==============================================================================================================================
     1053
     1054
     1055!==============================================================================================================================
     1056!=== UPDATE THE INDEXES iqParent, iqDescend AND iGeneration IN THE TRACERS DESCRIPTOR LIST "tr" (USEFULL FOR SUBSETS) =========
     1057!==============================================================================================================================
     1058LOGICAL FUNCTION indexUpdate(tr) RESULT(lerr)
    9111059  TYPE(trac_type), INTENT(INOUT) :: tr(:)
    912 
    913   !--- Update %iqParent, %iqDescen, %nqDescen, %nqChildren
    914   CALL indexUpdate(tr)
    915 
    916   !--- Extract some direct-access keys
    917 !  DO iq = 1, SIZE(tr)
    918 !    tr(iq)%keys%<key> = getKey_prv(it, "<key>", tr%keys, <default_value> )
    919 !  END DO
    920 END SUBROUTINE setDirectKeys
    921 !==============================================================================================================================
    922 
    923 !==============================================================================================================================
    924 LOGICAL FUNCTION dispTraSection(message, sname, modname) RESULT(lerr)
    925   CHARACTER(LEN=*), INTENT(IN) :: message, sname, modname
    926   INTEGER :: idb, iq, nq
    927   INTEGER, ALLOCATABLE :: hadv(:), vadv(:)
    928   CHARACTER(LEN=maxlen), ALLOCATABLE :: phas(:), prnt(:)
    929   TYPE(trac_type), POINTER :: tm(:)
    930   lerr = .FALSE.
    931   idb = strIdx(dBase(:)%name, sname); IF(idb == 0) RETURN
    932   tm => dBase(idb)%trac
    933   nq = SIZE(tm)
    934   !--- BEWARE ! Can't use the "getKeyByName" functions yet.
    935   !             Names must first include the phases for tracers defined on multiple lines.
    936   hadv = str2int(fgetKeys('hadv',  tm(:)%keys, '10'))
    937   vadv = str2int(fgetKeys('vadv',  tm(:)%keys, '10'))
    938   prnt =         fgetKeys('parent',tm(:)%keys,  '' )
    939   IF(getKey('phases', phas, ky=tm(:)%keys)) phas = fGetKeys('phase', tm(:)%keys, 'g')
    940   CALL msg(TRIM(message)//':', modname)
    941   IF(ALL(prnt == 'air')) THEN
    942     IF(test(dispTable('iiiss',   ['iq    ','hadv  ','vadv  ','name  ','phase '],                   cat(tm%name,       phas),  &
    943                  cat([(iq, iq=1, nq)], hadv, vadv),                 nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
    944   ELSE IF(ALL(tm%iGeneration == -1)) THEN
    945     IF(test(dispTable('iiisss', ['iq    ','hadv  ','vadv  ','name  ','parent','phase '],           cat(tm%name, prnt, phas),  &
    946                  cat([(iq, iq=1, nq)], hadv, vadv),                 nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
    947   ELSE
    948     IF(test(dispTable('iiissis', ['iq    ','hadv  ','vadv  ','name  ','parent','igen  ','phase '], cat(tm%name, prnt, phas),  &
    949                  cat([(iq, iq=1, nq)], hadv, vadv, tm%iGeneration), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
    950   END IF
    951 END FUNCTION dispTraSection
    952 !==============================================================================================================================
    953 
    954 
    955 !==============================================================================================================================
    956 !== CREATE A SCALAR ALIAS OF THE COMPONENT OF THE TRACERS DESCRIPTOR "t" NAMED "tname" ========================================
    957 !==============================================================================================================================
    958 FUNCTION aliasTracer(tname, t) RESULT(out)
    959   TYPE(trac_type),         POINTER    :: out
    960   CHARACTER(LEN=*),        INTENT(IN) :: tname
    961   TYPE(trac_type), TARGET, INTENT(IN) :: t(:)
    962   INTEGER :: it
    963   it = strIdx(t(:)%name, tname)
    964   out => NULL(); IF(it /= 0) out => t(it)
    965 END FUNCTION aliasTracer
    966 !==============================================================================================================================
    967 
    968 
    969 !==============================================================================================================================
    970 !=== FROM A LIST OF INDEXES OR NAMES, CREATE A SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" ==================================
    971 !==============================================================================================================================
    972 FUNCTION trSubset_Indx(trac,idx) RESULT(out)
    973   TYPE(trac_type), ALLOCATABLE             ::  out(:)
    974   TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
    975   INTEGER,                      INTENT(IN) ::  idx(:)
    976   out = trac(idx)
    977   CALL indexUpdate(out)
    978 END FUNCTION trSubset_Indx
    979 !------------------------------------------------------------------------------------------------------------------------------
    980 FUNCTION trSubset_Name(trac,nam) RESULT(out)
    981   TYPE(trac_type), ALLOCATABLE             ::  out(:)
    982   TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
    983   CHARACTER(LEN=*),             INTENT(IN) ::  nam(:)
    984   out = trac(strIdx(trac(:)%name, nam))
    985   CALL indexUpdate(out)
    986 END FUNCTION trSubset_Name
    987 !==============================================================================================================================
    988 
    989 
    990 !==============================================================================================================================
    991 !=== CREATE THE SUBSET OF THE TRACERS DESCRIPTORS LIST "trac" HAVING THE FIRST GENERATION ANCESTOR NAMED "nam" ================
    992 !==============================================================================================================================
    993 FUNCTION trSubset_gen0Name(trac,nam) RESULT(out)
    994   TYPE(trac_type), ALLOCATABLE             ::  out(:)
    995   TYPE(trac_type), ALLOCATABLE, INTENT(IN) :: trac(:)
    996   CHARACTER(LEN=*),             INTENT(IN) ::  nam
    997   out = trac(strFind(delPhase(trac(:)%gen0Name), nam))
    998   CALL indexUpdate(out)
    999 END FUNCTION trSubset_gen0Name
    1000 !==============================================================================================================================
    1001 
    1002 
    1003 !==============================================================================================================================
    1004 !=== UPDATE THE INDEXES iqParent, iqDescend AND iGeneration IN THE TRACERS DESCRIPTOR LIST "tr" (USEFULL FOR SUBSETS) =========
    1005 !==============================================================================================================================
    1006 SUBROUTINE indexUpdate(tr)
    1007   TYPE(trac_type), INTENT(INOUT) :: tr(:)
    1008   INTEGER :: iq, ig, igen, ngen, ix(SIZE(tr))
    1009   tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent )                !--- Parent index
    1010   DO iq = 1, SIZE(tr); CALL addKey_s11('iqParent', int2str(tr(iq)%iqParent), tr(iq)%keys); END DO
    1011   ngen = MAXVAL(tr(:)%iGeneration, MASK=.TRUE.)
    1012   DO iq = 1, SIZE(tr)
    1013     ig = tr(iq)%iGeneration
    1014     IF(ALLOCATED(tr(iq)%iqDescen)) DEALLOCATE(tr(iq)%iqDescen)
    1015     ALLOCATE(tr(iq)%iqDescen(0))
    1016     CALL idxAncestor(tr, ix, ig)                                     !--- Ancestor of generation "ng" for each tr
    1017     DO igen = ig+1, ngen
    1018       tr(iq)%iqDescen = [tr(iq)%iqDescen, find(ix==iq .AND. tr%iGeneration==igen)]
    1019       tr(iq)%nqDescen = SIZE(tr(iq)%iqDescen)
    1020       IF(igen == ig+1) THEN
    1021         tr(iq)%nqChildren = tr(iq)%nqDescen
    1022         CALL addKey_s11('nqChildren', int2str(tr(iq)%nqChildren), tr(iq)%keys)
    1023       END IF
     1060  INTEGER :: iq, jq, nq, ig, nGen
     1061  INTEGER,               ALLOCATABLE :: iqDescen(:), ix(:), iy(:)
     1062  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:), parent(:)
     1063  INTEGER,       DIMENSION(SIZE(tr)) :: iqParent, iGen, nqChildren, nqDescen
     1064  lerr = getKey('name',   tnames, tr%keys); IF(lerr) RETURN          !--- Names
     1065  lerr = getKey('parent', parent, tr%keys); IF(lerr) RETURN          !--- Parents
     1066  nq = SIZE(tr)
     1067
     1068  !=== iqParent
     1069  DO iq = 1, nq; iqParent(iq) = strIdx(tnames, parent(iq)); END DO
     1070  CALL addKey('iqParent', iqParent, tr(:)%keys)
     1071
     1072  !=== iGeneration
     1073  DO iq = 1, nq; iGen(iq) = 0; jq = iq
     1074    DO; jq = strIdx(tnames, parent(jq)); IF(jq == 0) EXIT; iGen(iq) = iGen(iq) + 1; END DO
     1075  END DO
     1076  CALL addKey('iGeneration', iGen, tr(:)%keys)
     1077
     1078  !=== iqDescen
     1079  nGen = MAXVAL(iGen, MASK=.TRUE.)
     1080  DO iq = 1, nq
     1081    ix = [iq]; ALLOCATE(iqDescen(0))
     1082    DO ig = iGen(iq)+1, nGen
     1083      iy = find(iqParent, ix); iqDescen = [iqDescen, iy]; ix = iy
     1084      IF(ig /= iGen(iq)+1) CYCLE
     1085      CALL addKey('nqChildren', SIZE(iqDescen), tr(iq)%keys)
     1086      tr(iq)%nqChildren = SIZE(iqDescen)
    10241087    END DO
    1025     CALL addKey_s11('iqDescen', strStack(int2str(tr(iq)%iqDescen)), tr(iq)%keys)
    1026     CALL addKey_s11('nqDescen',          int2str(tr(iq)%nqDescen) , tr(iq)%keys)
     1088    CALL addKey('iqDescen', strStack(int2str(iqDescen)), tr(iq)%keys)
     1089    CALL addKey('nqDescen',             SIZE(iqDescen),  tr(iq)%keys)
     1090    tr(iq)%iqDescen =      iqDescen
     1091    tr(iq)%nqDescen = SIZE(iqDescen)
     1092    DEALLOCATE(iqDescen)
    10271093  END DO
    1028 END SUBROUTINE indexUpdate
     1094END FUNCTION indexUpdate
    10291095!==============================================================================================================================
    10301096 
    … …  
    10351101!===  * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot"        ====
    10361102!=== NOTES:                                                                                                                ====
    1037 !===  * Most of the "isot" components have been defined in the calling routine (readIsotopes):                             ====
     1103!===  * Most of the "isot" components have been defined in the calling routine (processIsotopes):                          ====
    10381104!===      parent,  nzone, zone(:),  niso, keys(:)%name,  ntiso, trac(:),  nphas, phas,  iqIsoPha(:,:),  itZonPhi(:,:)      ====
    10391105!===  * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes       ====
    … …  
    10431109!===  * The routine gives an error if a required isotope is not available in the database stored in "fnam"                 ====
    10441110!==============================================================================================================================
    1045 LOGICAL FUNCTION readIsotopesFile_prv(fnam, isot) RESULT(lerr)
     1111LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
    10461112  CHARACTER(LEN=*),        INTENT(IN)    :: fnam                     !--- Input file name
    10471113  TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:)                  !--- Isotopes descriptors (field %parent must be defined!)
    … …  
    10601126  !--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
    10611127  nb0 = SIZE(dBase, DIM=1)+1                                         !--- Next database element index
    1062   IF(test(readSections(fnam,strStack(isot(:)%parent,'|')),lerr)) RETURN !--- Read sections, one each parent tracer
     1128  lerr = readSections(fnam,strStack(isot(:)%parent,'|')); IF(lerr) RETURN !--- Read sections, one each parent tracer
    10631129  ndb = SIZE(dBase, DIM=1)                                           !--- Current database size
    10641130  DO idb = nb0, ndb
    … …  
    10781144      is = strIdx(isot(iis)%keys(:)%name, t%name)                    !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name"
    10791145      IF(is == 0) CYCLE
    1080       IF(test(ANY(reduceExpr(t%keys%val, vals)), lerr)) RETURN       !--- Reduce expressions ; detect non-numerical elements
     1146      lerr = ANY(reduceExpr(t%keys%val, vals)); IF(lerr) RETURN      !--- Reduce expressions ; detect non-numerical elements
    10811147      isot(iis)%keys(is)%key = t%keys%key
    10821148      isot(iis)%keys(is)%val = vals
    … …  
    10841150
    10851151    !--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
    1086     IF(test(checkList(isot(iis)%keys(:)%name, .NOT.[( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )], &
    1087       'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'), lerr)) RETURN
     1152    lerr = checkList(isot(iis)%keys(:)%name, .NOT.[( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )], &
     1153                     'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing')
     1154    IF(lerr) RETURN
    10881155  END DO
    10891156
    … …  
    11201187      END DO
    11211188    END DO
    1122     IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, &
    1123             cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)), lerr)) RETURN
     1189    lerr = dispTable(prf, ttl, val, cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)
     1190    IF(fmsg('Problem with the table content', modname, lerr)) RETURN
    11241191    DEALLOCATE(ttl, val)
    11251192  END DO       
    … …  
    11271194!------------------------------------------------------------------------------------------------------------------------------
    11281195
    1129 END FUNCTION readIsotopesFile_prv
     1196END FUNCTION readIsotopesFile
    11301197!==============================================================================================================================
    11311198
    … …  
    11351202!===    * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS).                                                       ===
    11361203!===    * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS                                                                  ===
    1137 !===    * CALL readIsotopesFile_prv TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS)                                          ===
     1204!===    * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS)                                              ===
    11381205!===      NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS.  ===
    11391206!==============================================================================================================================
    1140 LOGICAL FUNCTION readIsotopesFile(iNames) RESULT(lerr)
     1207LOGICAL FUNCTION processIsotopes(iNames) RESULT(lerr)
    11411208  CHARACTER(LEN=maxlen), TARGET, OPTIONAL, INTENT(IN)  :: iNames(:)
    11421209  CHARACTER(LEN=maxlen), ALLOCATABLE :: p(:), str(:)                 !--- Temporary storage
     1210  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:), parent(:), dType(:), phase(:), gen0N(:)
    11431211  CHARACTER(LEN=maxlen) :: iName, modname
    11441212  CHARACTER(LEN=1)   :: ph                                           !--- Phase
     1213  INTEGER, ALLOCATABLE ::  iGen(:)
    11451214  INTEGER :: ic, ip, iq, it, iz
    11461215  LOGICAL, ALLOCATABLE :: ll(:)                                      !--- Mask
    11471216  TYPE(trac_type), POINTER   ::  t(:), t1
    11481217  TYPE(isot_type), POINTER   ::  i
     1218
    11491219  lerr = .FALSE.
    11501220  modname = 'readIsotopesFile'
    … …  
    11521222  t => tracers
    11531223
     1224  lerr = getKey('name',       tname, t%keys); IF(lerr) RETURN       !--- Names
     1225  lerr = getKey('parent',    parent, t%keys); IF(lerr) RETURN       !--- Parents
     1226  lerr = getKey('type',       dType, t%keys); IF(lerr) RETURN       !--- Tracer type
     1227  lerr = getKey('phase',      phase, t%keys); IF(lerr) RETURN       !--- Phase
     1228  lerr = getKey('gen0Name',   gen0N, t%keys); IF(lerr) RETURN       !--- 1st generation ancestor name
     1229  lerr = getKey('iGeneration', iGen, t%keys); IF(lerr) RETURN       !--- Generation number
     1230
    11541231  !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
    1155   p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1)
     1232  p = PACK(delPhase(parent), MASK = dType=='tracer' .AND. iGen==1)
    11561233  CALL strReduce(p, nbIso)
    11571234
    … …  
    11591236  IF(PRESENT(iNames)) THEN
    11601237    DO it = 1, SIZE(iNames)
    1161       IF(test(fmsg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, ALL(p /= iNames(it))), lerr)) RETURN
     1238      lerr = ALL(p /= iNames(it))
     1239      IF(fmsg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, lerr)) RETURN
    11621240    END DO
    11631241    p = iNames; nbIso = SIZE(p)
    … …  
    11751253
    11761254    !=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname")
    1177     ll = t(:)%type=='tracer' .AND. delPhase(t(:)%parent) == iname .AND. t(:)%phase == 'g'
    1178     str = PACK(delPhase(t(:)%name), MASK = ll)                       !--- Effectively found isotopes of "iname"
     1255    ll = dType=='tracer' .AND. delPhase(parent) == iname .AND. phase == 'g'
     1256    str = PACK(delPhase(tname), MASK = ll)                           !--- Effectively found isotopes of "iname"
    11791257    i%niso = SIZE(str)                                               !--- Number of "effectively found isotopes of "iname"
    11801258    ALLOCATE(i%keys(i%niso))
    … …  
    11821260
    11831261    !=== Geographic tagging tracers descending on tracer "iname": mask, names, number
    1184     ll = t(:)%type=='tag'    .AND. delPhase(t(:)%gen0Name) == iname .AND. t(:)%iGeneration == 2
    1185     i%zone = PACK(strTail(t(:)%name,'_',.TRUE.), MASK = ll)          !--- Tagging zones names  for isotopes category "iname"
     1262    ll = dType=='tag'    .AND. delPhase(gen0N) == iname .AND. iGen == 2
     1263    i%zone = PACK(strTail(tname,'_',.TRUE.), MASK = ll)              !--- Tagging zones names  for isotopes category "iname"
    11861264    CALL strReduce(i%zone)
    11871265    i%nzone = SIZE(i%zone)                                           !--- Tagging zones number for isotopes category "iname"
    … …  
    11891267    !=== Geographic tracers of the isotopes children of tracer "iname" (same for each phase of "iname")
    11901268    !    NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
    1191     str = PACK(delPhase(t(:)%name), MASK=ll)
     1269    str = PACK(delPhase(tname), MASK=ll)
    11921270    CALL strReduce(str)
    11931271    i%ntiso = i%niso + SIZE(str)                                     !--- Number of isotopes + their geographic tracers [ntiso]
    … …  
    12261304
    12271305  !=== READ PHYSICAL PARAMETERS FROM isoFile FILE
    1228 !  IF(test(readIsotopesFile_prv(isoFile, isotopes), lerr)) RETURN! on commente pour ne pas chercher isotopes_params.def
     1306!  lerr = readIsotopesFile(isoFile, isotopes); IF(lerr) RETURN! on commente pour ne pas chercher isotopes_params.def
     1307
     1308  !--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
     1309  CALL get_in('ok_iso_verif', isoCheck, .TRUE.)
    12291310
    12301311  !=== CHECK CONSISTENCY
    1231   IF(test(testIsotopes(), lerr)) RETURN
    1232 
    1233   !=== SELECT FIRST ISOTOPES CLASS OR, IF POSSIBLE, WATER CLASS
    1234   IF(.NOT.test(isoSelect(1, .TRUE.), lerr)) THEN; IF(isotope%parent == 'H2O') iH2O = ixIso; END IF
     1312  lerr = testIsotopes(); IF(lerr) RETURN
     1313
     1314  !=== SELECT WATER ISOTOPES CLASS OR, IF UNFOUND, THE FIRST ISOTOPES CLASS
     1315  IF(isoSelect('H2O', .TRUE.)) THEN; iH2O = ixIso; ELSE; lerr = isoSelect(1, .TRUE.); END IF
    12351316
    12361317CONTAINS
    … …  
    12391320LOGICAL FUNCTION testIsotopes() RESULT(lerr)     !--- MAKE SURE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
    12401321!------------------------------------------------------------------------------------------------------------------------------
    1241   INTEGER :: ix, it, ip, np, iz, nz
     1322  INTEGER :: ix, it, ip, np, iz, nz, npha, nzon
     1323  CHARACTER(LEN=maxlen) :: s
    12421324  TYPE(isot_type), POINTER :: i
    12431325  DO ix = 1, nbIso
    12441326    i => isotopes(ix)
    12451327    !--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
    1246     DO it = 1, i%ntiso
    1247       np = SUM([(COUNT(tracers(:)%name == addPhase(i%trac(it), i%phase(ip:ip))), ip=1, i%nphas)])
    1248       IF(test(fmsg(TRIM(int2str(np))//' phases instead of '//TRIM(int2str(i%nphas))//' for '//TRIM(i%trac(it)), &
    1249         modname, np /= i%nphas), lerr)) RETURN
     1328    DO it = 1, i%ntiso; npha = i%nphas
     1329      np = SUM([(COUNT(tracers(:)%name == addPhase(i%trac(it), i%phase(ip:ip))), ip=1, npha)])
     1330      lerr = np /= npha
     1331      CALL msg(TRIM(int2str(np))//' phases instead of '//TRIM(int2str(npha))//' for '//TRIM(i%trac(it)), modname, lerr)
     1332      IF(lerr) RETURN
    12501333    END DO
    1251     DO it = 1, i%niso
    1252       nz = SUM([(COUNT(i%trac == TRIM(i%trac(it))//'_'//i%zone(iz)), iz=1, i%nzone)])
    1253       IF(test(fmsg(TRIM(int2str(nz))//' tagging zones instead of '//TRIM(int2str(i%nzone))//' for '//TRIM(i%trac(it)), &
    1254         modname, nz /= i%nzone), lerr)) RETURN
     1334    DO it = 1, i%niso; nzon = i%nzone
     1335      nz = SUM([(COUNT(i%trac == TRIM(i%trac(it))//'_'//i%zone(iz)), iz=1, nzon)])
     1336      lerr = nz /= nzon
     1337      CALL msg(TRIM(int2str(nz))//' tagging zones instead of '//TRIM(int2str(nzon))//' for '//TRIM(i%trac(it)), modname, lerr)
     1338      IF(lerr) RETURN
    12551339    END DO
    12561340  END DO
    … …  
    12581342!------------------------------------------------------------------------------------------------------------------------------
    12591343
    1260 END FUNCTION readIsotopesFile
     1344END FUNCTION processIsotopes
    12611345!==============================================================================================================================
    12621346
    … …  
    12741358   lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
    12751359   iIso = strIdx(isotopes(:)%parent, iName)
    1276    IF(test(iIso == 0, lerr)) THEN
     1360   lerr = iIso == 0
     1361   IF(lerr) THEN
    12771362      niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck=.FALSE.
    12781363      CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV)
    … …  
    13681453!------------------------------------------------------------------------------------------------------------------------------
    13691454  INTEGER :: itr
    1370   DO itr = 1, SIZE(ky)
    1371     CALL addKey_s11(key, sval, ky(itr), lOverWrite)
    1372   END DO
     1455  DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval, ky(itr), lOverWrite); END DO
    13731456END SUBROUTINE addKey_s1m
    13741457!==============================================================================================================================
    … …  
    13801463!------------------------------------------------------------------------------------------------------------------------------
    13811464  INTEGER :: itr
    1382   DO itr = 1, SIZE(ky)
    1383     CALL addKey_s11(key, int2str(ival), ky(itr), lOverWrite)
    1384   END DO
     1465  DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival), ky(itr), lOverWrite); END DO
    13851466END SUBROUTINE addKey_i1m
    13861467!==============================================================================================================================
    … …  
    13921473!------------------------------------------------------------------------------------------------------------------------------
    13931474  INTEGER :: itr
    1394   DO itr = 1, SIZE(ky)
    1395     CALL addKey_s11(key, real2str(rval), ky(itr), lOverWrite)
    1396   END DO
     1475  DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval), ky(itr), lOverWrite); END DO
    13971476END SUBROUTINE addKey_r1m
    13981477!==============================================================================================================================
    … …  
    14041483!------------------------------------------------------------------------------------------------------------------------------
    14051484  INTEGER :: itr
    1406   DO itr = 1, SIZE(ky)
    1407     CALL addKey_s11(key, bool2str(lval), ky(itr), lOverWrite)
    1408   END DO
     1485  DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval), ky(itr), lOverWrite); END DO
    14091486END SUBROUTINE addKey_l1m
    14101487!==============================================================================================================================
    … …  
    14981575
    14991576!==============================================================================================================================
    1500 !================ GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RESULT IS THE RETURNED VALUE ===================
    1501 !==============================================================================================================================
    1502 CHARACTER(LEN=maxlen) FUNCTION fgetKeyIdx_s1(itr, keyn, ky, def_val, lerr) RESULT(val)
     1577!===   INTERNAL FUNCTION: GET THE VALUE OF A KEY FOR "itr"th TRACER FROM A "keys_type" DERIVED TYPE AND RETURN THE RESULT   ===
     1578!===   IF keyn CONTAINS SEVERAL ELEMENTS, TRY WITH EACH ELEMENT ONE AFTER THE OTHER                                         ===
     1579!==============================================================================================================================
     1580CHARACTER(LEN=maxlen) FUNCTION fgetKeyIdx(itr, keyn, ky, lerr) RESULT(val)
    15031581  INTEGER,                    INTENT(IN)  :: itr
    1504   CHARACTER(LEN=*),           INTENT(IN)  :: keyn
     1582  CHARACTER(LEN=*),           INTENT(IN)  :: keyn(:)
    15051583  TYPE(keys_type),            INTENT(IN)  :: ky(:)
    1506   CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: def_val
    15071584  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
    15081585!------------------------------------------------------------------------------------------------------------------------------
     1586  INTEGER :: ik
     1587  LOGICAL :: ler
     1588  ler = .TRUE.
     1589  DO ik = 1, SIZE(keyn)
     1590    CALL getKeyIdx(keyn(ik)); IF(.NOT.ler) EXIT
     1591  END DO
     1592  IF(PRESENT(lerr)) lerr = ler
     1593
     1594CONTAINS
     1595
     1596SUBROUTINE getKeyIdx(keyn)
     1597  CHARACTER(LEN=*), INTENT(IN) :: keyn
     1598!------------------------------------------------------------------------------------------------------------------------------
    15091599  INTEGER :: iky
    1510   LOGICAL :: ler
    15111600  iky = 0; val = ''
    1512   IF(.NOT.test(itr <= 0 .OR. itr > SIZE(ky), ler)) iky = strIdx(ky(itr)%key(:), keyn)    !--- Correct index
    1513   IF(.NOT.test(iky == 0, ler))                     val = ky(itr)%val(iky)                !--- Found key
    1514   IF(iky == 0) THEN
    1515     IF(.NOT.test(.NOT.PRESENT(def_val), ler))      val = def_val                         !--- Default value
    1516   END IF
    1517   IF(PRESENT(lerr)) lerr = ler
    1518 END FUNCTION fgetKeyIdx_s1
    1519 !==============================================================================================================================
    1520 CHARACTER(LEN=maxlen) FUNCTION fgetKeyNam_s1(tname, keyn, ky, def_val, lerr) RESULT(val)
    1521   CHARACTER(LEN=*),           INTENT(IN)  :: tname, keyn
    1522   TYPE(keys_type),            INTENT(IN)  :: ky(:)
    1523   CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: def_val
    1524   LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
    1525 !------------------------------------------------------------------------------------------------------------------------------
    1526   val = fgetKeyIdx_s1(strIdx(ky(:)%name, tname), keyn, ky, def_val, lerr)
    1527 END FUNCTION fgetKeyNam_s1
    1528 !==============================================================================================================================
    1529 FUNCTION fgetKeys(keyn, ky, def_val, lerr) RESULT(val)
    1530 CHARACTER(LEN=maxlen),        ALLOCATABLE :: val(:)
    1531   CHARACTER(LEN=*),           INTENT(IN)  :: keyn
    1532   TYPE(keys_type),            INTENT(IN)  :: ky(:)
    1533   CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: def_val
    1534   LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
    1535 !------------------------------------------------------------------------------------------------------------------------------
    1536   LOGICAL :: ler(SIZE(ky))
    1537   INTEGER :: it
    1538   val = [(fgetKeyIdx_s1(it, keyn, ky, def_val, ler(it)), it = 1, SIZE(ky))]
    1539   IF(PRESENT(lerr)) lerr = ANY(ler)
    1540 END FUNCTION fgetKeys
    1541 !==============================================================================================================================
    1542 
    1543 
    1544 !==============================================================================================================================
    1545 !========== GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RETURNED VALUE IS THE ERROR CODE        ==============
    1546 !==========  The key "keyn" is searched in: 1)           "ky(:)%name" (if given)                                 ==============
    1547 !==========                                 2)      "tracers(:)%name"                                            ==============
    1548 !==========                                 3) "isotope%keys(:)%name"                                            ==============
    1549 !==========  for the tracer[s] "tname[(:)]" (if given) or all the available tracers from the used set otherwise. ==============
    1550 !==========  The type of the returned value(s) can be string, integer or real, scalar or vector                  ==============
    1551 !==============================================================================================================================
    1552 LOGICAL FUNCTION getKeyByName_s1(keyn, val, tname, ky) RESULT(lerr)
     1601  ler = itr <= 0 .OR. itr > SIZE(ky); IF(ler) RETURN
     1602  iky = strIdx(ky(itr)%key(:), keyn)
     1603  ler = iky == 0;                     IF(ler) RETURN
     1604  val = ky(itr)%val(iky)
     1605END SUBROUTINE getKeyIdx
     1606
     1607END FUNCTION fgetKeyIdx
     1608!==============================================================================================================================
     1609
     1610
     1611!==============================================================================================================================
     1612!===                                          GET KEYS VALUES FROM TRACERS INDICES                                          ===
     1613!==============================================================================================================================
     1614!=== TRY TO GET THE KEY NAMED "key" FOR THE "itr"th TRACER IN:                                                              ===
     1615!===  * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE:                                                                    ===
     1616!===  * IN INTERNAL TRACERS DATABASE "tracers(:)%keys" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)")        ===
     1617!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER:                                            ===
     1618!===  * A SCALAR                                                                                                            ===
     1619!===  * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR ","                                                    ===
     1620!===                                                                                                                        ===
     1621!=== SYNTAX:       lerr = getKeyByIndex_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], itr[, ky(:)]          [, def][, lDisp])        ===
     1622!==============================================================================================================================
     1623!=== IF "itr" IS NOT PRESENT, VALUES FOR ALL THE TRACERS OF THE SELECTED DATABASE ARE STORED IN THE VECTOR "val(:)"         ===
     1624!=== THE NAME OF THE TRACERS FOUND IN THE EFFECTIVELY USED DATABASE CAN BE RETURNED OPTIONALLY IN "nam(:)"                  ===
     1625!=== SYNTAX        lerr = getKeyByIndex_{sirl}{1m}mm   (keyn[(:)], val (:)      [, ky(:)][, nam(:)][, def][, lDisp])        ===
     1626!==============================================================================================================================
     1627LOGICAL FUNCTION getKeyByIndex_s111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
    15531628  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
    15541629  CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
    1555   CHARACTER(LEN=*),          INTENT(IN)  :: tname
     1630  INTEGER,                   INTENT(IN)  :: itr
    15561631  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
    1557 !------------------------------------------------------------------------------------------------------------------------------
    1558   CHARACTER(LEN=maxlen) :: tnam
    1559   tnam = strHead(delPhase(tname),'_',.TRUE.)                                             !--- Remove phase and tag
    1560   IF(PRESENT(ky)) THEN                                                                   !=== KEY FROM "ky"
    1561                val = fgetKeyNam_s1(tname, keyn, ky,           lerr=lerr)                 !--- "ky" and "tname"
    1562     IF( lerr ) val = fgetKeyNam_s1(tnam,  keyn, ky,           lerr=lerr)                 !--- "ky" and "tnam"
    1563   ELSE
    1564     IF(         .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0    !=== KEY FROM "tracers"
    1565     IF(.NOT.lerr) THEN
    1566                val = fgetKeyNam_s1(tname, keyn, tracers%keys, lerr=lerr)                 !--- "ky" and "tname"
    1567       IF(lerr) val = fgetKeyNam_s1(tnam,  keyn, tracers%keys, lerr=lerr)                 !--- "ky" and "tnam"
    1568     END IF
    1569     IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0    !=== KEY FROM "isotope"
    1570     IF(.NOT.lerr) THEN
    1571                val = fgetKeyNam_s1(tname, keyn, isotope%keys, lerr=lerr)                 !--- "ky" and "tname"
    1572       IF(lerr) val = fgetKeyNam_s1(tnam,  keyn, isotope%keys, lerr=lerr)                 !--- "ky" and "tnam"
    1573     END IF
     1632  CHARACTER(LEN=*),OPTIONAL, INTENT(IN)  :: def
     1633  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1634  lerr = getKeyByIndex_sm11([keyn], val, itr, ky, def, lDisp)
     1635END FUNCTION getKeyByIndex_s111
     1636!==============================================================================================================================
     1637LOGICAL FUNCTION getKeyByIndex_i111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1638  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
     1639  INTEGER,                   INTENT(OUT) :: val
     1640  INTEGER,                   INTENT(IN)  :: itr
     1641  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1642  INTEGER,         OPTIONAL, INTENT(IN)  :: def
     1643  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1644  lerr = getKeyByIndex_im11([keyn], val, itr, ky, def, lDisp)
     1645END FUNCTION getKeyByIndex_i111
     1646!==============================================================================================================================
     1647LOGICAL FUNCTION getKeyByIndex_r111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1648  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
     1649  REAL   ,                   INTENT(OUT) :: val
     1650  INTEGER,                   INTENT(IN)  :: itr
     1651  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1652  REAL,            OPTIONAL, INTENT(IN)  :: def
     1653  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1654  lerr = getKeyByIndex_rm11([keyn], val, itr, ky, def, lDisp)
     1655END FUNCTION getKeyByIndex_r111
     1656!==============================================================================================================================
     1657LOGICAL FUNCTION getKeyByIndex_l111(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1658  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
     1659  LOGICAL,                   INTENT(OUT) :: val
     1660  INTEGER,                   INTENT(IN)  :: itr
     1661  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1662  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
     1663  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1664  lerr = getKeyByIndex_lm11([keyn], val, itr, ky, def, lDisp)
     1665END FUNCTION getKeyByIndex_l111
     1666!==============================================================================================================================
     1667!==============================================================================================================================
     1668LOGICAL FUNCTION getKeyByIndex_sm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1669  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
     1670  CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
     1671  INTEGER,                   INTENT(IN)  :: itr
     1672  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1673  CHARACTER(LEN=*),OPTIONAL, INTENT(IN)  :: def
     1674  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1675!------------------------------------------------------------------------------------------------------------------------------
     1676  CHARACTER(LEN=maxlen) :: s
     1677  LOGICAL :: lD
     1678  lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
     1679  s = 'key "'//TRIM(strStack(keyn, '/'))//'" for tracer nr. '//TRIM(int2str(itr))
     1680  lerr = .TRUE.
     1681  IF(lerr .AND. PRESENT(ky))         val = fgetKey(ky)                                   !--- "ky"
     1682  IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)%keys)                      !--- "tracers"
     1683  IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                      !--- "isotope"
     1684  IF(lerr .AND. PRESENT(def)) THEN
     1685     val = def; lerr = .NOT.PRESENT(def)
     1686     CALL msg('Using defaut value of '//TRIM(s)//': '//TRIM(def), modname, lD)
    15741687  END IF
    1575 END FUNCTION getKeyByName_s1
    1576 !==============================================================================================================================
    1577 LOGICAL FUNCTION getKeyByName_s1m(keyn, val, tname, ky) RESULT(lerr)
     1688  CALL msg('No '//TRIM(s)//' or out of bounds index', modname, lD .AND. lerr)
     1689
     1690CONTAINS
     1691
     1692CHARACTER(LEN=maxlen) FUNCTION fgetKey(ky) RESULT(val)
     1693  TYPE(keys_type),  INTENT(IN)  :: ky(:)
     1694  lerr = SIZE(ky) == 0; IF(lerr) RETURN
     1695  val = fgetKeyIdx(itr, keyn(:), ky, lerr)
     1696END FUNCTION fgetKey
     1697
     1698END FUNCTION getKeyByIndex_sm11
     1699!==============================================================================================================================
     1700LOGICAL FUNCTION getKeyByIndex_im11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1701  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
     1702  INTEGER,                   INTENT(OUT) :: val
     1703  INTEGER,                   INTENT(IN)  :: itr
     1704  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1705  INTEGER,         OPTIONAL, INTENT(IN)  :: def
     1706  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1707!------------------------------------------------------------------------------------------------------------------------------
     1708  CHARACTER(LEN=maxlen) :: sval, s
     1709  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
     1710  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
     1711  IF(lerr) RETURN
     1712  val = str2int(sval)
     1713  lerr = val == -HUGE(1)
     1714  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
     1715  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
     1716END FUNCTION getKeyByIndex_im11
     1717!==============================================================================================================================
     1718LOGICAL FUNCTION getKeyByIndex_rm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1719  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
     1720  REAL   ,                   INTENT(OUT) :: val
     1721  INTEGER,                   INTENT(IN)  :: itr
     1722  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1723  REAL,            OPTIONAL, INTENT(IN)  :: def
     1724  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1725!------------------------------------------------------------------------------------------------------------------------------
     1726  CHARACTER(LEN=maxlen) :: sval, s
     1727  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
     1728  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
     1729  IF(lerr) RETURN
     1730  val = str2real(sval)
     1731  lerr = val == -HUGE(1.)
     1732  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
     1733  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
     1734END FUNCTION getKeyByIndex_rm11
     1735!==============================================================================================================================
     1736LOGICAL FUNCTION getKeyByIndex_lm11(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1737  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
     1738  LOGICAL,                   INTENT(OUT) :: val
     1739  INTEGER,                   INTENT(IN)  :: itr
     1740  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1741  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
     1742  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1743!------------------------------------------------------------------------------------------------------------------------------
     1744  CHARACTER(LEN=maxlen) :: sval, s
     1745  INTEGER               :: ival
     1746  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
     1747  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
     1748  IF(lerr) RETURN
     1749  ival = str2bool(sval)
     1750  lerr = ival == -1
     1751  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
     1752  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
     1753  IF(.NOT.lerr) val = ival == 1
     1754END FUNCTION getKeyByIndex_lm11
     1755!==============================================================================================================================
     1756!==============================================================================================================================
     1757LOGICAL FUNCTION getKeyByIndex_s1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
    15781758  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn
    15791759  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
    1580   CHARACTER(LEN=*),                   INTENT(IN)  :: tname
     1760  INTEGER,                            INTENT(IN)  :: itr
    15811761  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
    1582 !------------------------------------------------------------------------------------------------------------------------------
    1583   CHARACTER(LEN=maxlen) :: sval
    1584   lerr = getKeyByName_s1(keyn, sval, tname, ky)
    1585   IF(test(fmsg('missing key "'//TRIM(keyn)//'" for tracer "'//TRIM(tname)//'"', modname, lerr), lerr)) RETURN
     1762  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: def
     1763  LOGICAL,                  OPTIONAL, INTENT(IN)  :: lDisp
     1764!------------------------------------------------------------------------------------------------------------------------------
     1765  CHARACTER(LEN=maxlen)              :: sval
     1766  lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, def, lDisp); IF(lerr) RETURN
    15861767  lerr = strParse(sval, ',', val)
    1587 END FUNCTION getKeyByName_s1m
    1588 !==============================================================================================================================
    1589 LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky, nam) RESULT(lerr)
     1768  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1769END FUNCTION getKeyByIndex_s1m1
     1770!==============================================================================================================================
     1771LOGICAL FUNCTION getKeyByIndex_i1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1772  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
     1773  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
     1774  INTEGER,                   INTENT(IN)  :: itr
     1775  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1776  INTEGER,         OPTIONAL, INTENT(IN)  :: def
     1777  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1778!------------------------------------------------------------------------------------------------------------------------------
     1779  CHARACTER(LEN=maxlen)              :: sval, s
     1780  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     1781  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, int2str(def), lDisp)
     1782  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
     1783  IF(lerr) RETURN
     1784  lerr = strParse(sval, ',', svals)
     1785  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1786  val = str2int(svals)
     1787  lerr = ANY(val == -HUGE(1))
     1788  s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
     1789  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
     1790END FUNCTION getKeyByIndex_i1m1
     1791!==============================================================================================================================
     1792LOGICAL FUNCTION getKeyByIndex_r1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1793  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
     1794  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
     1795  INTEGER,                   INTENT(IN)  :: itr
     1796  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1797  REAL,            OPTIONAL, INTENT(IN)  :: def
     1798  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1799!------------------------------------------------------------------------------------------------------------------------------
     1800  CHARACTER(LEN=maxlen)              :: sval, s
     1801  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     1802  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, real2str(def), lDisp)
     1803  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
     1804  lerr = strParse(sval, ',', svals)
     1805  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1806  val = str2real(svals)
     1807  lerr = ANY(val == -HUGE(1.))
     1808  s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
     1809  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
     1810END FUNCTION getKeyByIndex_r1m1
     1811!==============================================================================================================================
     1812LOGICAL FUNCTION getKeyByIndex_l1m1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1813  CHARACTER(LEN=*),          INTENT(IN)  :: keyn
     1814  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
     1815  INTEGER,                   INTENT(IN)  :: itr
     1816  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1817  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
     1818  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1819!------------------------------------------------------------------------------------------------------------------------------
     1820  CHARACTER(LEN=maxlen)              :: sval, s
     1821  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     1822  INTEGER,               ALLOCATABLE :: ivals(:)
     1823  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, bool2str(def), lDisp)
     1824  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11([keyn], sval, itr, ky, lDisp=lDisp)
     1825  lerr = strParse(sval, ',', svals)
     1826  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1827  ivals = str2bool(svals)
     1828  lerr = ANY(ivals == -1)
     1829  s = 'key "'//TRIM(keyn)//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
     1830  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
     1831  IF(.NOT.lerr) val = ivals == 1
     1832END FUNCTION getKeyByIndex_l1m1
     1833!==============================================================================================================================
     1834!==============================================================================================================================
     1835LOGICAL FUNCTION getKeyByIndex_smm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1836  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn(:)
     1837  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
     1838  INTEGER,                            INTENT(IN)  :: itr
     1839  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
     1840  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: def
     1841  LOGICAL,                  OPTIONAL, INTENT(IN)  :: lDisp
     1842!------------------------------------------------------------------------------------------------------------------------------
     1843  CHARACTER(LEN=maxlen)              :: sval
     1844  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     1845  lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, def, lDisp); IF(lerr) RETURN
     1846  lerr = strParse(sval, ',', val)
     1847  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1848END FUNCTION getKeyByIndex_smm1
     1849!==============================================================================================================================
     1850LOGICAL FUNCTION getKeyByIndex_imm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1851  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
     1852  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
     1853  INTEGER,                   INTENT(IN)  :: itr
     1854  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1855  INTEGER,         OPTIONAL, INTENT(IN)  :: def
     1856  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1857!------------------------------------------------------------------------------------------------------------------------------
     1858  CHARACTER(LEN=maxlen)              :: sval, s
     1859  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     1860  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, int2str(def), lDisp)
     1861  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
     1862  IF(lerr) RETURN
     1863  lerr = strParse(sval, ',', svals)
     1864  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1865  val = str2int(svals)
     1866  lerr = ANY(val == -HUGE(1))
     1867  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
     1868  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
     1869END FUNCTION getKeyByIndex_imm1
     1870!==============================================================================================================================
     1871LOGICAL FUNCTION getKeyByIndex_rmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1872  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
     1873  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
     1874  INTEGER,                   INTENT(IN)  :: itr
     1875  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1876  REAL,            OPTIONAL, INTENT(IN)  :: def
     1877  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1878!------------------------------------------------------------------------------------------------------------------------------
     1879  CHARACTER(LEN=maxlen)              :: sval, s
     1880  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     1881  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, real2str(def), lDisp)
     1882  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
     1883  IF(lerr) RETURN
     1884  lerr = strParse(sval, ',', svals)
     1885  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1886  val = str2real(svals)
     1887  lerr = ANY(val == -HUGE(1.))
     1888  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
     1889  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
     1890END FUNCTION getKeyByIndex_rmm1
     1891!==============================================================================================================================
     1892LOGICAL FUNCTION getKeyByIndex_lmm1(keyn, val, itr, ky, def, lDisp) RESULT(lerr)
     1893  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:)
     1894  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
     1895  INTEGER,                   INTENT(IN)  :: itr
     1896  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     1897  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
     1898  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     1899!------------------------------------------------------------------------------------------------------------------------------
     1900  CHARACTER(LEN=maxlen)              :: sval, s
     1901  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     1902  INTEGER,               ALLOCATABLE :: ivals(:)
     1903  IF(     PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, bool2str(def), lDisp)
     1904  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_sm11(keyn, sval, itr, ky, lDisp=lDisp)
     1905  IF(lerr) RETURN
     1906  lerr = strParse(sval, ',', svals)
     1907  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     1908  ivals = str2bool(svals)
     1909  lerr = ANY(ivals == -1)
     1910  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of tracer nr. '//TRIM(int2str(itr))//' is not'
     1911  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
     1912  IF(.NOT.lerr) val = ivals == 1
     1913END FUNCTION getKeyByIndex_lmm1
     1914!==============================================================================================================================
     1915!==============================================================================================================================
     1916LOGICAL FUNCTION getKeyByIndex_s1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
    15901917  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
    15911918  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: val(:)
    1592   CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
    1593   TYPE(keys_type),       OPTIONAL, TARGET,      INTENT(IN)  :: ky(:)
     1919  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::  ky(:)
    15941920  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
    1595 !------------------------------------------------------------------------------------------------------------------------------
    1596   TYPE(keys_type), POINTER ::  keys(:)
    1597   LOGICAL :: lk, lt, li
    1598   INTEGER :: iq, nq
    1599 
    1600   !--- DETERMINE THE DATABASE TO BE USED (ky, tracers or isotope)
    1601   lk = PRESENT(ky)
    1602   lt = .NOT.lk .AND. ALLOCATED(tracers);  IF(lt) lt = SIZE(tracers)  /= 0; IF(lt) lt = ANY(tracers(1)%keys%key(:) == keyn)
    1603   li = .NOT.lt .AND. ALLOCATED(isotopes); IF(li) li = SIZE(isotopes) /= 0; IF(li) li = ANY(isotope%keys(1)%key(:) == keyn)
    1604 
    1605   !--- LINK "keys" TO THE RIGHT DATABASE
    1606   IF(test(.NOT.ANY([lk,lt,li]), lerr)) RETURN
    1607   IF(lk) keys => ky(:)
    1608   IF(lt) keys => tracers(:)%keys
    1609   IF(li) keys => isotope%keys(:)
    1610 
    1611   !--- GET THE DATA
    1612   nq = SIZE(tname)
    1613   ALLOCATE(val(nq))
    1614   lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq), keys(:)), iq=1, nq)])
    1615   IF(PRESENT(nam)) nam = tname(:)
    1616 
    1617 END FUNCTION getKeyByName_sm
    1618 !==============================================================================================================================
    1619 LOGICAL FUNCTION getKey_sm(keyn, val, ky, nam) RESULT(lerr)
     1921  CHARACTER(LEN=*),      OPTIONAL,              INTENT(IN)  :: def
     1922  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
     1923  lerr = getKeyByIndex_smmm([keyn], val, ky, nam, def, lDisp)
     1924END FUNCTION getKeyByIndex_s1mm
     1925!==============================================================================================================================
     1926LOGICAL FUNCTION getKeyByIndex_i1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
    16201927  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
    1621   CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: val(:)
    1622   TYPE(keys_type),       OPTIONAL,              INTENT(IN)  :: ky(:)
     1928  INTEGER,                         ALLOCATABLE, INTENT(OUT) :: val(:)
     1929  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::  ky(:)
    16231930  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
    1624 !------------------------------------------------------------------------------------------------------------------------------
    1625 ! Note: if names are repeated, getKeyByName_sm can't be used ; this routine, using indexes, must be used instead.
    1626   IF(PRESENT(ky)) THEN                                                                   !=== KEY FROM "ky"
    1627     val = fgetKeys(keyn, ky, lerr=lerr)
    1628     IF(PRESENT(nam)) nam = ky(:)%name
    1629   ELSE
    1630     IF(         .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0    !=== KEY FROM "tracers"
    1631     IF(.NOT.lerr) val = fgetKeys(keyn, tracers%keys, lerr=lerr)
    1632     IF(.NOT.lerr.AND.PRESENT(nam)) nam = tracers(:)%keys%name
    1633     IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0    !=== KEY FROM "isotope"
    1634     IF(.NOT.lerr) val = fgetKeys(keyn, isotope%keys, lerr=lerr)
    1635     IF(.NOT.lerr.AND.PRESENT(nam)) nam = isotope%keys(:)%name
     1931  INTEGER,               OPTIONAL,              INTENT(IN)  :: def
     1932  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
     1933  lerr = getKeyByIndex_immm([keyn], val, ky, nam, def, lDisp)
     1934END FUNCTION getKeyByIndex_i1mm
     1935!==============================================================================================================================
     1936LOGICAL FUNCTION getKeyByIndex_r1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
     1937  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1938  REAL,                            ALLOCATABLE, INTENT(OUT) :: val(:)
     1939  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::  ky(:)
     1940  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
     1941  REAL,                  OPTIONAL,              INTENT(IN)  :: def
     1942  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
     1943  lerr = getKeyByIndex_rmmm([keyn], val, ky, nam, def, lDisp)
     1944END FUNCTION getKeyByIndex_r1mm
     1945!==============================================================================================================================
     1946LOGICAL FUNCTION getKeyByIndex_l1mm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
     1947  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1948  LOGICAL,                         ALLOCATABLE, INTENT(OUT) :: val(:)
     1949  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::  ky(:)
     1950  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: nam(:)
     1951  LOGICAL,               OPTIONAL,              INTENT(IN)  :: def
     1952  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
     1953  lerr = getKeyByIndex_lmmm([keyn], val, ky, nam, def, lDisp)
     1954END FUNCTION getKeyByIndex_l1mm
     1955!==============================================================================================================================
     1956!==============================================================================================================================
     1957LOGICAL FUNCTION getKeyByIndex_smmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
     1958  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn(:)
     1959  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) ::  val(:)
     1960  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
     1961  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
     1962  CHARACTER(LEN=*),      OPTIONAL,              INTENT(IN)  ::  def
     1963  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
     1964!------------------------------------------------------------------------------------------------------------------------------
     1965  CHARACTER(LEN=maxlen) :: s
     1966  CHARACTER(LEN=maxlen), ALLOCATABLE :: tname(:)
     1967  INTEGER :: iq, nq(3), k
     1968  LOGICAL :: lD, l(3)
     1969  lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
     1970  s = 'key "'//TRIM(strStack(keyn, '/'))//'"'
     1971  lerr = .TRUE.
     1972  IF(PRESENT(ky)) THEN;                 val = fgetKey(ky)                                !--- "ky"
     1973  ELSE IF(ALLOCATED(tracers)) THEN;     val = fgetKey(tracers(:)%keys)                   !--- "tracers"
     1974     IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                   !--- "isotope"
    16361975  END IF
    1637 END FUNCTION getKey_sm
    1638 !==============================================================================================================================
    1639 LOGICAL FUNCTION getKeyByName_i1(keyn, val, tname, ky) RESULT(lerr)
    1640   CHARACTER(LEN=*),          INTENT(IN)  :: keyn
    1641   INTEGER,                   INTENT(OUT) :: val
    1642   CHARACTER(LEN=*),          INTENT(IN)  :: tname
    1643   TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
    1644 !------------------------------------------------------------------------------------------------------------------------------
    1645   CHARACTER(LEN=maxlen) :: sval
    1646   INTEGER :: ierr
    1647   lerr = getKeyByName_s1(keyn, sval, tname, ky)
    1648   IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
    1649   READ(sval, *, IOSTAT=ierr) val
    1650   IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, ierr/=0), lerr)) RETURN
    1651 END FUNCTION getKeyByName_i1
    1652 !==============================================================================================================================
    1653 LOGICAL FUNCTION getKeyByName_i1m(keyn, val, tname, ky) RESULT(lerr)
    1654   CHARACTER(LEN=*),          INTENT(IN)  :: keyn
    1655   INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
    1656   CHARACTER(LEN=*),          INTENT(IN)  :: tname
    1657   TYPE(keys_type), OPTIONAL, INTENT(IN)  ::  ky(:)
    1658 !------------------------------------------------------------------------------------------------------------------------------
    1659   CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
    1660   INTEGER :: ierr, iq, nq
    1661   IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
    1662   nq = SIZE(sval); ALLOCATE(val(nq))
    1663   lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
    1664   IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, lerr), lerr)) RETURN
    1665 END FUNCTION getKeyByName_i1m
    1666 !==============================================================================================================================
    1667 LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky, nam) RESULT(lerr)
    1668   CHARACTER(LEN=*),                             INTENT(IN)  ::  keyn
    1669   INTEGER,                         ALLOCATABLE, INTENT(OUT) ::   val(:)
    1670   CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
    1671   TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::    ky(:)
    1672   CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::   nam(:)
    1673 !------------------------------------------------------------------------------------------------------------------------------
    1674   CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
    1675   INTEGER :: ierr, iq, nq
    1676   IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN
    1677   nq = SIZE(sval); ALLOCATE(val(nq))
    1678   DO iq = 1, nq                                                      !--- CONVERT THE KEYS TO INTEGERS
    1679     READ(sval(iq), *, IOSTAT=ierr) val(iq)
    1680     IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
    1681   END DO
    1682   IF(PRESENT(nam)) nam = names(:)
    1683 END FUNCTION getKeyByName_im
    1684 !==============================================================================================================================
    1685 LOGICAL FUNCTION getKey_im(keyn, val, ky, nam) RESULT(lerr)
    1686   CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1976  IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN; END IF
     1977  IF(.NOT.PRESENT(def)) THEN; CALL msg('No '//TRIM(s)//' found', modname, lD); RETURN; END IF
     1978
     1979  !--- DEFAULT VALUE
     1980  l = [PRESENT(ky), ALLOCATED(tracers), ASSOCIATED(isotope)]; nq(:) = 0
     1981  IF(l(1)) nq(1) = SIZE(ky)
     1982  IF(l(2)) nq(2) = SIZE(tracers)
     1983  IF(l(3)) nq(3) = SIZE(isotope%keys)
     1984  DO k = 1, 3; IF(l(k) .AND. nq(k) /= 0) THEN; val = [(def, iq = 1, nq(k))]; EXIT; END IF; END DO
     1985  lerr = k == 4
     1986  CALL msg('Using defaut value for '//TRIM(s)//': '//TRIM(def), modname, lD .AND. .NOT.lerr)
     1987  CALL msg('No '//TRIM(s), modname, lD .AND. lerr)
     1988
     1989CONTAINS
     1990
     1991FUNCTION fgetKey(ky) RESULT(val)
     1992  CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
     1993  TYPE(keys_type),       INTENT(IN)  :: ky(:)
     1994  LOGICAL :: ler(SIZE(ky))
     1995  INTEGER :: iq
     1996  lerr = SIZE(ky) == 0; IF(lerr) RETURN
     1997  tname = ky%name
     1998  val = [(fgetKeyIdx(iq, keyn(:), ky, ler(iq)), iq = 1, SIZE(ky))]
     1999  lerr = ANY(ler)
     2000END FUNCTION fgetKey
     2001
     2002END FUNCTION getKeyByIndex_smmm
     2003!==============================================================================================================================
     2004LOGICAL FUNCTION getKeyByIndex_immm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
     2005  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn(:)
    16872006  INTEGER,                         ALLOCATABLE, INTENT(OUT) ::  val(:)
    16882007  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
    16892008  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
    1690 !------------------------------------------------------------------------------------------------------------------------------
    1691   CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
    1692   INTEGER :: ierr, iq, nq
    1693   IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN
    1694   nq = SIZE(sval); ALLOCATE(val(nq))
    1695   DO iq = 1, nq
    1696     READ(sval(iq), *, IOSTAT=ierr) val(iq)
    1697     IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
    1698   END DO
    1699   IF(PRESENT(nam)) nam = names
    1700 END FUNCTION getKey_im
    1701 !==============================================================================================================================
    1702 LOGICAL FUNCTION getKeyByName_r1(keyn, val, tname, ky) RESULT(lerr)
    1703   CHARACTER(LEN=*),          INTENT(IN)  :: keyn
    1704   REAL,                      INTENT(OUT) :: val
    1705   CHARACTER(LEN=*),          INTENT(IN)  :: tname
    1706   TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
    1707 !------------------------------------------------------------------------------------------------------------------------------
    1708   CHARACTER(LEN=maxlen) :: sval
    1709   INTEGER :: ierr
    1710   lerr = getKeyByName_s1(keyn, sval, tname, ky)
    1711   IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing',    modname, lerr), lerr)) RETURN
    1712   READ(sval, *, IOSTAT=ierr) val
    1713   IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, ierr/=0), lerr)) RETURN
    1714 END FUNCTION getKeyByName_r1
    1715 !==============================================================================================================================
    1716 LOGICAL FUNCTION getKeyByName_r1m(keyn, val, tname, ky) RESULT(lerr)
    1717   CHARACTER(LEN=*),           INTENT(IN)  :: keyn
    1718   REAL,          ALLOCATABLE, INTENT(OUT) :: val(:)
    1719   CHARACTER(LEN=*),           INTENT(IN)  :: tname
    1720   TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::  ky(:)
    1721 !------------------------------------------------------------------------------------------------------------------------------
    1722   CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
    1723   INTEGER :: ierr, iq, nq
    1724   IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
    1725   nq = SIZE(sval); ALLOCATE(val(nq))
    1726   lerr = .FALSE.; DO iq=1, nq; READ(sval(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
    1727   IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a vector of reals', modname, lerr), lerr)) RETURN
    1728 END FUNCTION getKeyByName_r1m
    1729 !==============================================================================================================================
    1730 LOGICAL FUNCTION getKeyByName_rm(keyn, val, tname, ky, nam) RESULT(lerr)
    1731   CHARACTER(LEN=*),                             INTENT(IN)  ::  keyn
    1732   REAL,                            ALLOCATABLE, INTENT(OUT) ::   val(:)
    1733   CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
    1734   TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::    ky(:)
    1735   CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::   nam(:)
    1736 !------------------------------------------------------------------------------------------------------------------------------
    1737   CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
    1738   INTEGER :: ierr, iq, nq
    1739   IF(test(getKeyByName_sm(keyn, sval, tname, ky, names), lerr)) RETURN
    1740   nq = SIZE(sval); ALLOCATE(val(nq))
    1741   DO iq = 1, nq                                                      !--- CONVERT THE KEYS TO INTEGERS
    1742     READ(sval(iq), *, IOSTAT=ierr) val(iq)
    1743     IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
    1744   END DO
    1745   IF(PRESENT(nam)) nam = names
    1746 END FUNCTION getKeyByName_rm
    1747 !==============================================================================================================================
    1748 LOGICAL FUNCTION getKey_rm(keyn, val, ky, nam) RESULT(lerr)
    1749   CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     2009  INTEGER,               OPTIONAL,              INTENT(IN)  ::  def
     2010  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
     2011!------------------------------------------------------------------------------------------------------------------------------
     2012  CHARACTER(LEN=maxlen) :: s
     2013  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
     2014  LOGICAL,               ALLOCATABLE ::    ll(:)
     2015  IF(     PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, int2str(def), lDisp)
     2016  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp=lDisp)
     2017  IF(lerr) RETURN
     2018  val = str2int(svals)
     2019  ll = val == -HUGE(1)
     2020  lerr = ANY(ll); IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN; END IF
     2021  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(PACK(tname, MASK=ll)))//' is not'
     2022  CALL msg(TRIM(s)//' an integer: '//TRIM(strStack(svals, MASK=ll)), modname, lerr)
     2023  IF(.NOT.lerr .AND. PRESENT(nam)) nam = tname
     2024END FUNCTION getKeyByIndex_immm
     2025!==============================================================================================================================
     2026LOGICAL FUNCTION getKeyByIndex_rmmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
     2027  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn(:)
    17502028  REAL,                            ALLOCATABLE, INTENT(OUT) ::  val(:)
    17512029  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
    17522030  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
    1753 !------------------------------------------------------------------------------------------------------------------------------
    1754   CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), names(:)
    1755   INTEGER :: ierr, iq, nq
    1756   IF(test(getKey_sm(keyn, sval, ky, names), lerr)) RETURN
    1757   nq = SIZE(sval); ALLOCATE(val(nq))
    1758   DO iq = 1, nq                                                      !--- CONVERT THE KEYS TO INTEGERS
    1759     READ(sval(iq), *, IOSTAT=ierr) val(iq)
    1760     IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(names(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
    1761   END DO
    1762   IF(PRESENT(nam)) nam = names
    1763 END FUNCTION getKey_rm
    1764 !==============================================================================================================================
    1765 LOGICAL FUNCTION getKeyByName_l1(keyn, val, tname, ky) RESULT(lerr)
    1766   USE strings_mod, ONLY: str2bool
    1767   CHARACTER(LEN=*),          INTENT(IN)  :: keyn
    1768   LOGICAL,                   INTENT(OUT) :: val
    1769   CHARACTER(LEN=*),          INTENT(IN)  :: tname
    1770   TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
    1771 !------------------------------------------------------------------------------------------------------------------------------
    1772   CHARACTER(LEN=maxlen) :: sval
    1773   lerr = getKeyByName_s1(keyn, sval, tname, ky)
    1774   IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
    1775   val = str2bool(sval)
    1776 END FUNCTION getKeyByName_l1
    1777 !==============================================================================================================================
    1778 LOGICAL FUNCTION getKeyByName_l1m(keyn, val, tname, ky) RESULT(lerr)
    1779   USE strings_mod, ONLY: str2bool
    1780   CHARACTER(LEN=*),           INTENT(IN)  :: keyn
    1781   LOGICAL,       ALLOCATABLE, INTENT(OUT) :: val(:)
    1782   CHARACTER(LEN=*),           INTENT(IN)  :: tname
    1783   TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::  ky(:)
    1784 !------------------------------------------------------------------------------------------------------------------------------
    1785   CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
    1786   INTEGER :: iq, nq
    1787   IF(test(getKeyByName_s1m(keyn, sval, tname, ky), lerr)) RETURN
    1788   nq = SIZE(sval); ALLOCATE(val(nq))
    1789   lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
    1790 END FUNCTION getKeyByName_l1m
    1791 !==============================================================================================================================
    1792 LOGICAL FUNCTION getKeyByName_lm(keyn, val, tname, ky, nam) RESULT(lerr)
    1793   USE strings_mod, ONLY: str2bool
    1794   CHARACTER(LEN=*),                             INTENT(IN)  ::  keyn
    1795   LOGICAL,                         ALLOCATABLE, INTENT(OUT) ::   val(:)
    1796   CHARACTER(LEN=*),                             INTENT(IN)  :: tname(:)
    1797   TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::    ky(:)
    1798   CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::   nam(:)
    1799 !------------------------------------------------------------------------------------------------------------------------------
    1800   CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
    1801   INTEGER :: iq, nq
    1802   IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN
    1803   nq = SIZE(sval); ALLOCATE(val(nq))
    1804   lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
    1805 END FUNCTION getKeyByName_lm
    1806 !==============================================================================================================================
    1807 LOGICAL FUNCTION getKey_lm(keyn, val, ky, nam) RESULT(lerr)
    1808   USE strings_mod, ONLY: str2bool
    1809   CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     2031  REAL,                  OPTIONAL,              INTENT(IN)  ::  def
     2032  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
     2033!------------------------------------------------------------------------------------------------------------------------------
     2034  CHARACTER(LEN=maxlen) :: s
     2035  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
     2036  LOGICAL,               ALLOCATABLE ::    ll(:)
     2037  IF(     PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, real2str(def), lDisp)
     2038  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp=lDisp)
     2039  IF(lerr) RETURN
     2040  val = str2real(svals)
     2041  ll = val == -HUGE(1.)
     2042  lerr = ANY(ll); IF(.NOT.lerr) THEN; IF(PRESENT(nam)) nam = tname; RETURN; END IF
     2043  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(PACK(tname, MASK=ll)))//' is not a'
     2044  CALL msg(TRIM(s)//' a real: '//TRIM(strStack(svals, MASK=ll)), modname)
     2045END FUNCTION getKeyByIndex_rmmm
     2046!==============================================================================================================================
     2047LOGICAL FUNCTION getKeyByIndex_lmmm(keyn, val, ky, nam, def, lDisp) RESULT(lerr)
     2048  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn(:)
    18102049  LOGICAL,                         ALLOCATABLE, INTENT(OUT) ::  val(:)
    18112050  TYPE(keys_type),       OPTIONAL,              INTENT(IN)  ::   ky(:)
    18122051  CHARACTER(LEN=maxlen), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  nam(:)
    1813 !------------------------------------------------------------------------------------------------------------------------------
    1814   CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:)
     2052  LOGICAL,               OPTIONAL,              INTENT(IN)  ::  def
     2053  LOGICAL,               OPTIONAL,              INTENT(IN)  :: lDisp
     2054!------------------------------------------------------------------------------------------------------------------------------
     2055  CHARACTER(LEN=maxlen) :: s
     2056  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:), tname(:)
     2057  LOGICAL,               ALLOCATABLE ::    ll(:)
     2058  INTEGER,               ALLOCATABLE :: ivals(:)
     2059  IF(     PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, bool2str(def), lDisp)
     2060  IF(.NOT.PRESENT(def)) lerr = getKeyByIndex_smmm(keyn, svals, ky, tname, lDisp=lDisp)
     2061  IF(lerr) RETURN
     2062  ivals = str2bool(svals)
     2063  ll = ivals == -1
     2064  lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; IF(PRESENT(nam)) nam = tname; RETURN; END IF
     2065  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
     2066  CALL msg(TRIM(s)//' a boolean: '//TRIM(strStack(svals, MASK=ll)), modname)
     2067END FUNCTION getKeyByIndex_lmmm
     2068!==============================================================================================================================
     2069
     2070
     2071
     2072!==============================================================================================================================
     2073!===                                           GET KEYS VALUES FROM TRACERS NAMES                                           ===
     2074!==============================================================================================================================
     2075!=== TRY TO GET THE KEY NAMED "key" FOR THE TRACER NAMED "tname" IN:                                                        ===
     2076!===  * ARGUMENT "ky" DATABASE IF SPECIFIED ; OTHERWISE:                                                                    ===
     2077!===  * IN INTERNAL TRACERS DATABASE "tracers(:)%keys" (IF UNFOUND, IN INTERNAL ISOTOPES DATABASE "isotope%keys(:)")        ===
     2078!=== THE RETURNED VALUE (STRING, AN INTEGER, A REAL OR A LOGICAL) CAN BE EITHER:                                            ===
     2079!===  * A SCALAR                                                                                                            ===
     2080!===  * A VECTOR, WHICH IS THE FOUND VALUE PARSED WITH THE SEPARATOR ","                                                    ===
     2081!===                                                                                                                        ===
     2082!=== SYNTAX:       lerr = getKeyByName_{sirl}{1m}{1m}1(keyn[(:)], val[(:)], tname  [, ky(:)][, def][, lDisp])               ===
     2083!==============================================================================================================================
     2084!=== IF "tname(:)" IS A VECTOR, THE RETURNED VALUES (ONE EACH "tname(:)" ELEMENT) ARE STORED IN THE VECTOR "val(:)"         ===
     2085!===                                                                                                                        ===
     2086!=== SYNTAX        lerr = getKeyByName_{sirl}{1m}mm   (keyn[(:)], val (:), tname(:)[, ky(:)][, def][, lDisp])               ===
     2087!==============================================================================================================================
     2088LOGICAL FUNCTION getKeyByName_s111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2089  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
     2090  CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
     2091  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2092  CHARACTER(LEN=*),OPTIONAL, INTENT(IN)  :: def
     2093  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2094  lerr = getKeyByName_sm11([keyn], val, tname, ky, def, lDisp)
     2095END FUNCTION getKeyByName_s111
     2096!==============================================================================================================================
     2097LOGICAL FUNCTION getKeyByName_i111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2098  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
     2099  INTEGER,                   INTENT(OUT) :: val
     2100  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2101  INTEGER,         OPTIONAL, INTENT(IN)  :: def
     2102  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2103  lerr = getKeyByName_im11([keyn], val, tname, ky, def, lDisp)
     2104END FUNCTION getKeyByName_i111
     2105!==============================================================================================================================
     2106LOGICAL FUNCTION getKeyByName_r111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2107  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
     2108  REAL   ,                   INTENT(OUT) :: val
     2109  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2110  REAL,            OPTIONAL, INTENT(IN)  :: def
     2111  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2112  lerr = getKeyByName_rm11([keyn], val, tname, ky, def, lDisp)
     2113END FUNCTION getKeyByName_r111
     2114!==============================================================================================================================
     2115LOGICAL FUNCTION getKeyByName_l111(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2116  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
     2117  LOGICAL,                   INTENT(OUT) :: val
     2118  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2119  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
     2120  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2121  lerr = getKeyByName_lm11([keyn], val, tname, ky, def, lDisp)
     2122END FUNCTION getKeyByName_l111
     2123!==============================================================================================================================
     2124!==============================================================================================================================
     2125LOGICAL FUNCTION getKeyByName_sm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2126  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
     2127  CHARACTER(LEN=maxlen),     INTENT(OUT) :: val
     2128  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2129  CHARACTER(LEN=*),OPTIONAL, INTENT(IN)  :: def
     2130  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2131!------------------------------------------------------------------------------------------------------------------------------
     2132  CHARACTER(LEN=maxlen) :: s, tnam
     2133  LOGICAL :: lD
     2134  lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
     2135  s = 'key "'//TRIM(strStack(keyn, '/'))//'" for "'//TRIM(tname)//'"'
     2136  lerr = .TRUE.
     2137  tnam = strHead(delPhase(tname),'_',.TRUE.)                                             !--- Remove phase and tag
     2138  IF(lerr .AND. PRESENT(ky))         val = fgetKey(ky)                                   !--- "ky"
     2139  IF(lerr .AND. ALLOCATED (tracers)) val = fgetKey(tracers(:)%keys)                      !--- "tracers"
     2140  IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                      !--- "isotope"
     2141  IF(lerr .AND. PRESENT(def)) THEN
     2142     val = def; lerr = .NOT.PRESENT(def)
     2143     CALL msg('Using defaut value of '//TRIM(s)//': '//TRIM(def), modname, lD)
     2144  END IF
     2145  CALL msg('No '//TRIM(s)//' or out of bounds index', modname, lD .AND. lerr)
     2146
     2147CONTAINS
     2148
     2149 CHARACTER(LEN=maxlen) FUNCTION fgetKey(ky) RESULT(val)
     2150  TYPE(keys_type),  INTENT(IN)  :: ky(:)
     2151  lerr = SIZE(ky) == 0
     2152  IF(lerr) RETURN
     2153           val = fgetKeyIdx(strIdx(ky%name, tname), [keyn], ky, lerr)
     2154  IF(lerr) val = fgetKeyIdx(strIdx(ky%name, tnam ), [keyn], ky, lerr)
     2155
     2156END FUNCTION fgetKey
     2157
     2158END FUNCTION getKeyByName_sm11
     2159!==============================================================================================================================
     2160LOGICAL FUNCTION getKeyByName_im11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2161  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
     2162  INTEGER,                   INTENT(OUT) :: val
     2163  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2164  INTEGER,         OPTIONAL, INTENT(IN)  :: def
     2165  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2166!------------------------------------------------------------------------------------------------------------------------------
     2167  CHARACTER(LEN=maxlen) :: sval, s
     2168  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
     2169  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
     2170  IF(lerr) RETURN
     2171  val = str2int(sval)
     2172  lerr = val == -HUGE(1)
     2173  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
     2174  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
     2175END FUNCTION getKeyByName_im11
     2176!==============================================================================================================================
     2177LOGICAL FUNCTION getKeyByName_rm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2178  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
     2179  REAL   ,                   INTENT(OUT) :: val
     2180  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2181  REAL,            OPTIONAL, INTENT(IN)  :: def
     2182  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2183!------------------------------------------------------------------------------------------------------------------------------
     2184  CHARACTER(LEN=maxlen) :: sval, s
     2185  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
     2186  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
     2187  IF(lerr) RETURN
     2188  val = str2real(sval)
     2189  lerr = val == -HUGE(1.)
     2190  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
     2191  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
     2192END FUNCTION getKeyByName_rm11
     2193!==============================================================================================================================
     2194LOGICAL FUNCTION getKeyByName_lm11(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2195  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
     2196  LOGICAL,                   INTENT(OUT) :: val
     2197  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2198  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
     2199  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2200!------------------------------------------------------------------------------------------------------------------------------
     2201  CHARACTER(LEN=maxlen) :: sval, s
     2202  INTEGER               :: ival
     2203  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
     2204  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
     2205  IF(lerr) RETURN
     2206  ival = str2bool(sval)
     2207  lerr = ival == -1
     2208  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
     2209  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
     2210  IF(.NOT.lerr) val = ival == 1
     2211END FUNCTION getKeyByName_lm11
     2212!==============================================================================================================================
     2213!==============================================================================================================================
     2214LOGICAL FUNCTION getKeyByName_s1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2215  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn, tname
     2216  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
     2217  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
     2218  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: def
     2219  LOGICAL,                  OPTIONAL, INTENT(IN)  :: lDisp
     2220!------------------------------------------------------------------------------------------------------------------------------
     2221  CHARACTER(LEN=maxlen)              :: sval
     2222  lerr = getKeyByName_sm11([keyn], sval, tname, ky, def, lDisp); IF(lerr) RETURN
     2223  lerr = strParse(sval, ',', val)
     2224  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2225END FUNCTION getKeyByName_s1m1
     2226!==============================================================================================================================
     2227LOGICAL FUNCTION getKeyByName_i1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2228  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
     2229  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
     2230  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2231  INTEGER,         OPTIONAL, INTENT(IN)  :: def
     2232  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2233!------------------------------------------------------------------------------------------------------------------------------
     2234  CHARACTER(LEN=maxlen)              :: sval, s
     2235  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     2236  IF(     PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, int2str(def), lDisp)
     2237  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
     2238  IF(lerr) RETURN
     2239  lerr = strParse(sval, ',', svals)
     2240  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2241  val = str2int(svals)
     2242  lerr = ANY(val == -HUGE(1))
     2243  s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
     2244  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
     2245END FUNCTION getKeyByName_i1m1
     2246!==============================================================================================================================
     2247LOGICAL FUNCTION getKeyByName_r1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2248  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
     2249  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
     2250  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2251  REAL,            OPTIONAL, INTENT(IN)  :: def
     2252  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2253!------------------------------------------------------------------------------------------------------------------------------
     2254  CHARACTER(LEN=maxlen)              :: sval, s
     2255  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     2256  IF(     PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, real2str(def), lDisp)
     2257  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
     2258  IF(lerr) RETURN
     2259  lerr = strParse(sval, ',', svals)
     2260  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2261  val = str2real(svals)
     2262  lerr = ANY(val == -HUGE(1.))
     2263  s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
     2264  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
     2265END FUNCTION getKeyByName_r1m1
     2266!==============================================================================================================================
     2267LOGICAL FUNCTION getKeyByName_l1m1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2268  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname
     2269  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
     2270  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2271  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
     2272  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2273!------------------------------------------------------------------------------------------------------------------------------
     2274  CHARACTER(LEN=maxlen)              :: sval, s
     2275  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     2276  INTEGER,               ALLOCATABLE :: ivals(:)
     2277  IF(     PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, bool2str(def), lDisp)
     2278  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11([keyn], sval, tname, ky, lDisp=lDisp)
     2279  IF(lerr) RETURN
     2280  lerr = strParse(sval, ',', svals)
     2281  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2282  ivals = str2bool(svals)
     2283  lerr = ANY(ivals == -1)
     2284  s = 'key "'//TRIM(keyn)//'" of '//TRIM(tname)//' is not'
     2285  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
     2286  IF(.NOT.lerr) val = ivals == 1
     2287END FUNCTION getKeyByName_l1m1
     2288!==============================================================================================================================
     2289!==============================================================================================================================
     2290LOGICAL FUNCTION getKeyByName_smm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2291  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn(:), tname
     2292  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
     2293  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
     2294  CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: def
     2295  LOGICAL,                  OPTIONAL, INTENT(IN)  :: lDisp
     2296!------------------------------------------------------------------------------------------------------------------------------
     2297  CHARACTER(LEN=maxlen)              :: sval
     2298  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     2299  lerr = getKeyByName_sm11(keyn, sval, tname, ky, def, lDisp); IF(lerr) RETURN
     2300  lerr = strParse(sval, ',', val)
     2301  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2302END FUNCTION getKeyByName_smm1
     2303!==============================================================================================================================
     2304LOGICAL FUNCTION getKeyByName_imm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2305  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
     2306  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
     2307  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2308  INTEGER,         OPTIONAL, INTENT(IN)  :: def
     2309  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2310!------------------------------------------------------------------------------------------------------------------------------
     2311  CHARACTER(LEN=maxlen)              :: sval, s
     2312  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     2313  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, int2str(def), lDisp)
     2314  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
     2315  IF(lerr) RETURN
     2316  lerr = strParse(sval, ',', svals)
     2317  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2318  val = str2int(svals)
     2319  lerr = ANY(val == -HUGE(1))
     2320  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
     2321  CALL msg(TRIM(s)//' an integer: '//TRIM(sval), modname, lerr)
     2322END FUNCTION getKeyByName_imm1
     2323!==============================================================================================================================
     2324LOGICAL FUNCTION getKeyByName_rmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2325  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
     2326  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
     2327  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2328  REAL,            OPTIONAL, INTENT(IN)  :: def
     2329  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2330!------------------------------------------------------------------------------------------------------------------------------
     2331  CHARACTER(LEN=maxlen)              :: sval, s
     2332  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     2333  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, real2str(def), lDisp)
     2334  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
     2335  IF(lerr) RETURN
     2336  lerr = strParse(sval, ',', svals)
     2337  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2338  val = str2real(svals)
     2339  lerr = ANY(val == -HUGE(1.))
     2340  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
     2341  CALL msg(TRIM(s)//' a real: '//TRIM(sval), modname, lerr)
     2342END FUNCTION getKeyByName_rmm1
     2343!==============================================================================================================================
     2344LOGICAL FUNCTION getKeyByName_lmm1(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2345  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname
     2346  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
     2347  TYPE(keys_type), OPTIONAL, INTENT(IN)  :: ky(:)
     2348  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
     2349  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2350!------------------------------------------------------------------------------------------------------------------------------
     2351  CHARACTER(LEN=maxlen)              :: sval, s
     2352  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     2353  INTEGER,               ALLOCATABLE :: ivals(:)
     2354  IF(     PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, bool2str(def), lDisp)
     2355  IF(.NOT.PRESENT(def)) lerr = getKeyByName_sm11(keyn, sval, tname, ky, lDisp=lDisp)
     2356  IF(lerr) RETURN
     2357  lerr = strParse(sval, ',', svals)
     2358  IF(fmsg('can''t parse '//TRIM(sval), modname, lerr)) RETURN
     2359  ivals = str2bool(svals)
     2360  lerr = ANY(ivals == -1)
     2361  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(tname)//' is not'
     2362  CALL msg(TRIM(s)//' a boolean: '//TRIM(sval), modname, lerr)
     2363  IF(.NOT.lerr) val = ivals == 1
     2364END FUNCTION getKeyByName_lmm1
     2365!==============================================================================================================================
     2366!==============================================================================================================================
     2367LOGICAL FUNCTION getKeyByName_s1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2368  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn, tname(:)
     2369  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
     2370  TYPE(keys_type),       OPTIONAL,    INTENT(IN)  ::  ky(:)
     2371  CHARACTER(LEN=*),      OPTIONAL,    INTENT(IN)  :: def
     2372  LOGICAL,               OPTIONAL,    INTENT(IN)  :: lDisp
     2373  lerr = getKeyByName_smmm([keyn], val, tname, ky, def, lDisp)
     2374END FUNCTION getKeyByName_s1mm
     2375!==============================================================================================================================
     2376LOGICAL FUNCTION getKeyByName_i1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2377  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname(:)
     2378  INTEGER,      ALLOCATABLE, INTENT(OUT) :: val(:)
     2379  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::  ky(:)
     2380  INTEGER,         OPTIONAL, INTENT(IN)  :: def
     2381  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2382  lerr = getKeyByName_immm([keyn], val, tname, ky, def, lDisp)
     2383END FUNCTION getKeyByName_i1mm
     2384!==============================================================================================================================
     2385LOGICAL FUNCTION getKeyByName_r1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2386  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname(:)
     2387  REAL,         ALLOCATABLE, INTENT(OUT) :: val(:)
     2388  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::  ky(:)
     2389  REAL,            OPTIONAL, INTENT(IN)  :: def
     2390  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2391  lerr = getKeyByName_rmmm([keyn], val, tname, ky, def, lDisp)
     2392END FUNCTION getKeyByName_r1mm
     2393!==============================================================================================================================
     2394LOGICAL FUNCTION getKeyByName_l1mm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2395  CHARACTER(LEN=*),          INTENT(IN)  :: keyn, tname(:)
     2396  LOGICAL,      ALLOCATABLE, INTENT(OUT) :: val(:)
     2397  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::  ky(:)
     2398  LOGICAL,         OPTIONAL, INTENT(IN)  :: def
     2399  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2400  lerr = getKeyByName_lmmm([keyn], val, tname, ky, def, lDisp)
     2401END FUNCTION getKeyByName_l1mm
     2402!==============================================================================================================================
     2403!==============================================================================================================================
     2404LOGICAL FUNCTION getKeyByName_smmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2405  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn(:), tname(:)
     2406  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) ::  val(:)
     2407  TYPE(keys_type),       OPTIONAL,    INTENT(IN)  ::   ky(:)
     2408  CHARACTER(LEN=*),      OPTIONAL,    INTENT(IN)  ::   def
     2409  LOGICAL,               OPTIONAL,    INTENT(IN)  :: lDisp
     2410!------------------------------------------------------------------------------------------------------------------------------
     2411  CHARACTER(LEN=maxlen) :: s
    18152412  INTEGER :: iq, nq
    1816   IF(test(getKey_sm(keyn, sval, ky, nam), lerr)) RETURN
    1817   nq = SIZE(sval); ALLOCATE(val(nq))
    1818   lerr = .FALSE.; DO iq=1, nq; val(iq)=str2bool(sval(iq)); END DO
    1819 END FUNCTION getKey_lm
     2413  LOGICAL :: lD
     2414  nq = SIZE(tname); ALLOCATE(val(nq))
     2415  lD = .TRUE.; IF(PRESENT(lDisp)) lD = lDisp
     2416  s = 'key "'//TRIM(strStack(keyn, '/'))//'"'
     2417  lerr = .TRUE.
     2418  IF(PRESENT(ky)) THEN;                 val = fgetKey(ky)                                !--- "ky"
     2419  ELSE IF(ALLOCATED(tracers)) THEN;     val = fgetKey(tracers(:)%keys)                   !--- "tracers"
     2420     IF(lerr .AND. ASSOCIATED(isotope)) val = fgetKey(isotope%keys(:))                   !--- "isotope"
     2421  END IF
     2422  IF(.NOT.PRESENT(def)) THEN; CALL msg('No '//TRIM(s)//' found', modname, lD); RETURN; END IF
     2423
     2424  !--- DEFAULT VALUE
     2425  val = [(def, iq = 1, SIZE(tname))]
     2426  CALL msg('Using defaut value for '//TRIM(s)//': '//TRIM(def), modname, lD)
     2427
     2428CONTAINS
     2429
     2430FUNCTION fgetKey(ky) RESULT(val)
     2431  CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)
     2432  TYPE(keys_type),       INTENT(IN)  :: ky(:)
     2433  LOGICAL,               ALLOCATABLE :: ler(:)
     2434  lerr = SIZE(ky) == 0; IF(lerr) RETURN
     2435  ALLOCATE(ler(SIZE(tname)))
     2436  val = [(fgetKeyIdx(strIdx(ky(:)%name, tname(iq)), keyn, ky, ler(iq)), iq = 1, SIZE(tname))]
     2437  lerr = ANY(ler)
     2438END FUNCTION fgetKey
     2439
     2440END FUNCTION getKeyByName_smmm
     2441!==============================================================================================================================
     2442LOGICAL FUNCTION getKeyByName_immm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2443  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname(:)
     2444  INTEGER,      ALLOCATABLE, INTENT(OUT) ::  val(:)
     2445  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::   ky(:)
     2446  INTEGER,         OPTIONAL, INTENT(IN)  ::  def
     2447  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2448!------------------------------------------------------------------------------------------------------------------------------
     2449  CHARACTER(LEN=maxlen) :: s
     2450  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     2451  LOGICAL,               ALLOCATABLE ::    ll(:)
     2452  IF(     PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, int2str(def), lDisp)
     2453  IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
     2454  IF(lerr) RETURN
     2455  val = str2int(svals)
     2456  ll = val == -HUGE(1)
     2457  lerr = ANY(ll); IF(.NOT.lerr) RETURN
     2458  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
     2459  CALL msg(TRIM(s)//' an integer: '//TRIM(strStack(svals, MASK=ll)), modname)
     2460END FUNCTION getKeyByName_immm
     2461!==============================================================================================================================
     2462LOGICAL FUNCTION getKeyByName_rmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2463  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname(:)
     2464  REAL,         ALLOCATABLE, INTENT(OUT) ::  val(:)
     2465  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::   ky(:)
     2466  REAL,            OPTIONAL, INTENT(IN)  ::  def
     2467  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2468!------------------------------------------------------------------------------------------------------------------------------
     2469  CHARACTER(LEN=maxlen) :: s
     2470  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     2471  LOGICAL,               ALLOCATABLE ::    ll(:)
     2472  IF(     PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, real2str(def), lDisp)
     2473  IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
     2474  IF(lerr) RETURN
     2475  val = str2real(svals)
     2476  ll = val == -HUGE(1.)
     2477  lerr = ANY(ll); IF(.NOT.lerr) RETURN
     2478  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
     2479  CALL msg(TRIM(s)//' a real: '//TRIM(strStack(svals, MASK=ll)), modname)
     2480END FUNCTION getKeyByName_rmmm
     2481!==============================================================================================================================
     2482LOGICAL FUNCTION getKeyByName_lmmm(keyn, val, tname, ky, def, lDisp) RESULT(lerr)
     2483  CHARACTER(LEN=*),          INTENT(IN)  :: keyn(:), tname(:)
     2484  LOGICAL,      ALLOCATABLE, INTENT(OUT) ::  val(:)
     2485  TYPE(keys_type), OPTIONAL, INTENT(IN)  ::   ky(:)
     2486  LOGICAL,         OPTIONAL, INTENT(IN)  ::  def
     2487  LOGICAL,         OPTIONAL, INTENT(IN)  :: lDisp
     2488!------------------------------------------------------------------------------------------------------------------------------
     2489  CHARACTER(LEN=maxlen) :: s, sval
     2490  CHARACTER(LEN=maxlen), ALLOCATABLE :: svals(:)
     2491  LOGICAL,               ALLOCATABLE ::    ll(:)
     2492  INTEGER,               ALLOCATABLE :: ivals(:)
     2493  IF(     PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, bool2str(def), lDisp)
     2494  IF(.NOT.PRESENT(def)) lerr = getKeyByName_smmm(keyn, svals, tname, ky, lDisp=lDisp)
     2495  IF(lerr) RETURN
     2496  ivals = str2bool(svals)
     2497  ll = ivals == -1
     2498  lerr = ANY(ll); IF(.NOT.lerr) THEN; val = ivals == 1; RETURN; END IF
     2499  s = 'key "'//TRIM(strStack(keyn, '/'))//'" of '//TRIM(strStack(tname, MASK=ll))//' is not'
     2500  CALL msg(TRIM(s)//' a boolean: '//TRIM(strStack(svals, MASK=ll)), modname)
     2501END FUNCTION getKeyByName_lmmm
    18202502!==============================================================================================================================
    18212503
    … …  
    19252607!=== APPEND TRACERS DATABASE "tracs" WITH TRACERS/KEYS "tname"/"keys" ; SAME FOR INTERNAL DATABASE "tracers" ==================
    19262608!==============================================================================================================================
    1927 SUBROUTINE addTracer_1(tname, keys, tracs)
     2609LOGICAL FUNCTION addTracer_1(tname, keys, tracs) RESULT(lerr)
    19282610  CHARACTER(LEN=*),             INTENT(IN)    :: tname
    19292611  TYPE(keys_type),              INTENT(IN)    ::  keys
    19302612  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tracs(:)
    19312613  TYPE(trac_type), ALLOCATABLE :: tr(:)
     2614  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
    19322615  INTEGER :: nt, ix
    19332616  IF(ALLOCATED(tracs)) THEN
     2617     lerr = getKey('name', tnames, ky=tracs(:)%keys); IF(lerr) RETURN
    19342618     nt = SIZE(tracs)
    1935      ix = strIdx(tracs(:)%name, tname)
     2619     ix = strIdx(tnames, tname)
    19362620     CALL msg('Modifying existing tracer "'//TRIM(tname)//'"', modname, ix /= 0)
    19372621     CALL msg('Appending with tracer "'    //TRIM(tname)//'"', modname, ix == 0)
    … …  
    19432627     ix = 1; ALLOCATE(tracs(1))
    19442628  END IF
     2629  CALL addKey('name', tname, tracs(ix)%keys)
    19452630  tracs(ix)%name = tname
    19462631  tracs(ix)%keys = keys
    1947 END SUBROUTINE addTracer_1
    1948 !==============================================================================================================================
    1949 SUBROUTINE addTracer_1def(tname, keys)
     2632
     2633END FUNCTION addTracer_1
     2634!==============================================================================================================================
     2635LOGICAL FUNCTION addTracer_1def(tname, keys) RESULT(lerr)
    19502636  CHARACTER(LEN=*),             INTENT(IN)    :: tname
    19512637  TYPE(keys_type),              INTENT(IN)    ::  keys
    1952   CALL addTracer_1(tname, keys, tracers)
    1953 END SUBROUTINE addTracer_1def
    1954 !==============================================================================================================================
    1955 
    1956 
    1957 !==============================================================================================================================
    1958 LOGICAL FUNCTION delTracer_1(tname, tracs)  RESULT(lerr)
     2638  lerr = addTracer_1(tname, keys, tracers)
     2639END FUNCTION addTracer_1def
     2640!==============================================================================================================================
     2641
     2642
     2643!==============================================================================================================================
     2644LOGICAL FUNCTION delTracer_1(tname, tracs) RESULT(lerr)
    19592645  CHARACTER(LEN=*),                     INTENT(IN)    :: tname
    19602646  TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: tracs(:)
    19612647  TYPE(trac_type), ALLOCATABLE :: tr(:)
     2648  CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
    19622649  INTEGER :: nt, ix
    19632650  lerr = .NOT.ALLOCATED(tracs)
    19642651  IF(fmsg('Can''t remove tracer "'//TRIM(tname)//'" from an empty tracers descriptor', modname, lerr)) RETURN
    19652652  nt = SIZE(tracs)
    1966   ix = strIdx(tracs(:)%name, tname)
     2653  lerr = getKey('name', tnames, ky=tracs(:)%keys); IF(lerr) RETURN
     2654  ix = strIdx(tnames, tname)
    19672655  CALL msg('Removing tracer "'             //TRIM(tname)//'"', modname, ix /= 0)
    19682656  CALL msg('Can''t remove unknown tracer "'//TRIM(tname)//'"', modname, ix == 0)
    … …  
    20762764!==============================================================================================================================
    20772765
    2078 
    2079 !==============================================================================================================================
    2080 !=== GET THE NAME(S) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen"  IN THE TRACERS DESCRIPTORS LIST "tr" =======
    2081 !==============================================================================================================================
    2082 SUBROUTINE ancestor_1(t, out, tname, igen)
    2083   TYPE(trac_type),       INTENT(IN)  :: t(:)
    2084   CHARACTER(LEN=maxlen), INTENT(OUT) :: out
    2085   CHARACTER(LEN=*),      INTENT(IN)  :: tname
    2086   INTEGER,     OPTIONAL, INTENT(IN)  :: igen
    2087 !------------------------------------------------------------------------------------------------------------------------------
    2088   INTEGER :: ix
    2089   CALL idxAncestor_1(t, ix, tname, igen)
    2090   out = ''; IF(ix /= 0) out = t(ix)%name
    2091 END SUBROUTINE ancestor_1
    2092 !==============================================================================================================================
    2093 SUBROUTINE ancestor_mt(t, out, tname, igen)
    2094   TYPE(trac_type),       INTENT(IN)  :: t(:)
    2095   CHARACTER(LEN=*),      INTENT(IN)  :: tname(:)
    2096   CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(tname))
    2097   INTEGER,     OPTIONAL, INTENT(IN)  :: igen
    2098 !------------------------------------------------------------------------------------------------------------------------------
    2099   INTEGER :: ix(SIZE(tname))
    2100   CALL idxAncestor_mt(t, ix, tname, igen)
    2101   out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
    2102 END SUBROUTINE ancestor_mt
    2103 !==============================================================================================================================
    2104 SUBROUTINE ancestor_m(t, out, igen)
    2105   TYPE(trac_type),       INTENT(IN)  :: t(:)
    2106   CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(t))
    2107   INTEGER,     OPTIONAL, INTENT(IN)  :: igen
    2108 !------------------------------------------------------------------------------------------------------------------------------
    2109   INTEGER :: ix(SIZE(t))
    2110   CALL idxAncestor_m(t, ix, igen)
    2111   out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
    2112 END SUBROUTINE ancestor_m
    2113 !==============================================================================================================================
    2114 
    2115 
    2116 !==============================================================================================================================
    2117 !=== GET THE INDEX(ES) OF THE GENERATION "igen" ANCESTOR(S) OF "tname" (t%name IF UNSPECIFIED) IN THE "t" LIST ================
    2118 !==============================================================================================================================
    2119 SUBROUTINE idxAncestor_1(t, idx, tname, igen)
    2120   TYPE(trac_type),   INTENT(IN)  :: t(:)
    2121   INTEGER,           INTENT(OUT) :: idx
    2122   CHARACTER(LEN=*),  INTENT(IN)  :: tname
    2123   INTEGER, OPTIONAL, INTENT(IN)  :: igen
    2124   INTEGER :: ig
    2125   ig = 0; IF(PRESENT(igen)) ig = igen
    2126   idx = strIdx(t(:)%name, tname)
    2127   IF(idx == 0)                 RETURN            !--- Tracer not found
    2128   IF(t(idx)%iGeneration <= ig) RETURN            !--- Tracer has a lower generation number than asked generation 'igen"
    2129   DO WHILE(t(idx)%iGeneration > ig); idx = strIdx(t(:)%name, t(idx)%parent); END DO
    2130 END SUBROUTINE idxAncestor_1
    2131 !------------------------------------------------------------------------------------------------------------------------------
    2132 SUBROUTINE idxAncestor_mt(t, idx, tname, igen)
    2133   TYPE(trac_type),   INTENT(IN)  :: t(:)
    2134   CHARACTER(LEN=*),  INTENT(IN)  :: tname(:)
    2135   INTEGER,           INTENT(OUT) :: idx(SIZE(tname))
    2136   INTEGER, OPTIONAL, INTENT(IN)  :: igen
    2137   INTEGER :: ix
    2138   DO ix = 1, SIZE(tname); CALL idxAncestor_1(t, idx(ix), tname(ix), igen); END DO
    2139 END SUBROUTINE idxAncestor_mt
    2140 !------------------------------------------------------------------------------------------------------------------------------
    2141 SUBROUTINE idxAncestor_m(t, idx, igen)
    2142   TYPE(trac_type),   INTENT(IN)  :: t(:)
    2143   INTEGER,           INTENT(OUT) :: idx(SIZE(t))
    2144   INTEGER, OPTIONAL, INTENT(IN)  :: igen
    2145   INTEGER :: ix
    2146   DO ix = 1, SIZE(t); CALL idxAncestor_1(t, idx(ix), t(ix)%name, igen); END DO
    2147 END SUBROUTINE idxAncestor_m
    2148 !==============================================================================================================================
    2149 
    2150 
    21512766END MODULE readTracFiles_mod

  • LMDZ6/trunk/libf/misc/strings_mod.F90

    r4987 r5001  
    1010  PUBLIC :: is_numeric, bool2str, int2str, real2str, dble2str
    1111  PUBLIC :: reduceExpr, str2bool, str2int, str2real, str2dble
    12   PUBLIC :: addQuotes, checkList, removeComment, test
     12  PUBLIC :: addQuotes, checkList, removeComment
    1313
    1414  INTERFACE get_in;     MODULE PROCEDURE getin_s,  getin_i,  getin_r,  getin_l;  END INTERFACE get_in
    … …  
    2222  INTERFACE strCount;   MODULE PROCEDURE  strCount_m1, strCount_11, strCount_1m; END INTERFACE strCount
    2323  INTERFACE strReplace; MODULE PROCEDURE strReplace_1,             strReplace_m; END INTERFACE strReplace
    24   INTERFACE cat;        MODULE PROCEDURE   horzcat_s1,  horzcat_i1,  horzcat_r1, &
    25 !                 horzcat_d1,  horzcat_dm,
    26                                            horzcat_sm,  horzcat_im,  horzcat_rm; END INTERFACE cat
    27   INTERFACE find;         MODULE PROCEDURE    strFind,    find_int,    find_boo; END INTERFACE find
     24  INTERFACE cat;        MODULE PROCEDURE  horzcat_s00, horzcat_i00, horzcat_r00,  & !horzcat_d00, &
     25                                          horzcat_s10, horzcat_i10, horzcat_r10,  & !horzcat_d10, &
     26                                          horzcat_s11, horzcat_i11, horzcat_r11,  & !horzcat_d11, &
     27                                          horzcat_s21, horzcat_i21, horzcat_r21; END INTERFACE cat !horzcat_d21
     28  INTERFACE strFind;      MODULE PROCEDURE strFind_1, strFind_m;                 END INTERFACE strFind
     29  INTERFACE find;         MODULE PROCEDURE strFind_1, strFind_m, intFind_1, intFind_m, booFind; END INTERFACE find
    2830  INTERFACE dispOutliers; MODULE PROCEDURE dispOutliers_1, dispOutliers_2; END INTERFACE dispOutliers
    2931  INTERFACE reduceExpr;   MODULE PROCEDURE   reduceExpr_1,   reduceExpr_m; END INTERFACE reduceExpr
    … …  
    3638CONTAINS
    3739
    38 !==============================================================================================================================
    39 LOGICAL FUNCTION test(lcond, lout) RESULT(lerr)
    40   LOGICAL, INTENT(IN)  :: lcond
    41   LOGICAL, INTENT(OUT) :: lout
    42   lerr = lcond; lout = lcond
    43 END FUNCTION test
    44 !==============================================================================================================================
    45 
    4640
    4741!==============================================================================================================================
    4842SUBROUTINE init_printout(lunout_, prt_level_)
     43  IMPLICIT NONE
    4944  INTEGER, INTENT(IN) :: lunout_, prt_level_
    5045  lunout    = lunout_
    … …  
    5853!==============================================================================================================================
    5954SUBROUTINE getin_s(nam, val, def)
    60 USE ioipsl_getincom, ONLY: getin
     55  USE ioipsl_getincom, ONLY: getin
     56  IMPLICIT NONE
    6157  CHARACTER(LEN=*), INTENT(IN)    :: nam
    6258  CHARACTER(LEN=*), INTENT(INOUT) :: val
    … …  
    6763!==============================================================================================================================
    6864SUBROUTINE getin_i(nam, val, def)
    69 USE ioipsl_getincom, ONLY: getin
     65  USE ioipsl_getincom, ONLY: getin
     66  IMPLICIT NONE
    7067  CHARACTER(LEN=*), INTENT(IN)    :: nam
    7168  INTEGER,          INTENT(INOUT) :: val
    … …  
    7673!==============================================================================================================================
    7774SUBROUTINE getin_r(nam, val, def)
    78 USE ioipsl_getincom, ONLY: getin
     75  USE ioipsl_getincom, ONLY: getin
     76  IMPLICIT NONE
    7977  CHARACTER(LEN=*), INTENT(IN)    :: nam
    8078  REAL,             INTENT(INOUT) :: val
    … …  
    8583!==============================================================================================================================
    8684SUBROUTINE getin_l(nam, val, def)
    87 USE ioipsl_getincom, ONLY: getin
     85  USE ioipsl_getincom, ONLY: getin
     86  IMPLICIT NONE
    8887  CHARACTER(LEN=*), INTENT(IN)    :: nam
    8988  LOGICAL,          INTENT(INOUT) :: val
    … …  
    9998!==============================================================================================================================
    10099SUBROUTINE msg_1(str, modname, ll, unit)
     100  IMPLICIT NONE
    101101  !--- Display a simple message "str". Optional parameters:
    102102  !    * "modname": module name, displayed in front of the message (with ": " separator) if present.
    … …  
    118118!==============================================================================================================================
    119119SUBROUTINE msg_m(str, modname, ll, unit, nmax)
     120  IMPLICIT NONE
    120121  !--- Same as msg_1 with multiple strings that are stacked (separator: coma) on up to "nmax" full lines.
    121122  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    … …  
    138139!==============================================================================================================================
    139140LOGICAL FUNCTION fmsg_1(str, modname, ll, unit) RESULT(l)
     141  IMPLICIT NONE
    140142  CHARACTER(LEN=*),           INTENT(IN) :: str
    141143  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
    … …  
    152154!==============================================================================================================================
    153155LOGICAL FUNCTION fmsg_m(str, modname, ll, unit, nmax) RESULT(l)
     156  IMPLICIT NONE
    154157  CHARACTER(LEN=*),           INTENT(IN)  :: str(:)
    155158  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: modname
    … …  
    173176!==============================================================================================================================
    174177ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strLower(str) RESULT(out)
     178  IMPLICIT NONE
    175179  CHARACTER(LEN=*), INTENT(IN) :: str
    176180  INTEGER :: k
    … …  
    182186!==============================================================================================================================
    183187ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strUpper(str) RESULT(out)
     188  IMPLICIT NONE
    184189  CHARACTER(LEN=*), INTENT(IN) :: str
    185190  INTEGER :: k
    … …  
    199204!==============================================================================================================================
    200205CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep, lBackward) RESULT(out)
     206  IMPLICIT NONE
    201207  CHARACTER(LEN=*),           INTENT(IN) :: str
    202208  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    … …  
    214220!==============================================================================================================================
    215221FUNCTION strHead_m(str, sep, lBackward) RESULT(out)
     222  IMPLICIT NONE
    216223  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    217224  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    … …  
    235242!==============================================================================================================================
    236243CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep, lBackWard) RESULT(out)
     244  IMPLICIT NONE
    237245  CHARACTER(LEN=*),           INTENT(IN) :: str
    238246  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
    … …  
    250258!==============================================================================================================================
    251259FUNCTION strTail_m(str, sep, lBackWard) RESULT(out)
     260  IMPLICIT NONE
    252261  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    253262  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    … …  
    271280!==============================================================================================================================
    272281FUNCTION strStack(str, sep, mask) RESULT(out)
     282  IMPLICIT NONE
    273283  CHARACTER(LEN=:),          ALLOCATABLE :: out
    274284  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    … …  
    292302!==============================================================================================================================
    293303FUNCTION strStackm(str, sep, nmax) RESULT(out)
     304  IMPLICIT NONE
    294305  CHARACTER(LEN=maxlen),     ALLOCATABLE :: out(:)
    295306  CHARACTER(LEN=*),           INTENT(IN) :: str(:)
    … …  
    324335!==============================================================================================================================
    325336SUBROUTINE strClean_1(str)
     337  IMPLICIT NONE
    326338  CHARACTER(LEN=*), INTENT(INOUT) :: str
    327339  INTEGER :: k, n, m
    … …  
    337349!==============================================================================================================================
    338350SUBROUTINE strClean_m(str)
     351  IMPLICIT NONE
    339352  CHARACTER(LEN=*), INTENT(INOUT) :: str(:)
    340353  INTEGER :: k
    … …  
    349362!==============================================================================================================================
    350363SUBROUTINE strReduce_1(str, nb)
     364  IMPLICIT NONE
    351365  CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
    352366  INTEGER,          OPTIONAL,    INTENT(OUT)   :: nb
    … …  
    366380!==============================================================================================================================
    367381SUBROUTINE strReduce_2(str1, str2)
     382  IMPLICIT NONE
    368383  CHARACTER(LEN=*),   ALLOCATABLE, INTENT(INOUT) :: str1(:)
    369384  CHARACTER(LEN=*),                INTENT(IN)    :: str2(:)
    … …  
    392407!==============================================================================================================================
    393408INTEGER FUNCTION strIdx_1(str, s) RESULT(out)
     409  IMPLICIT NONE
    394410  CHARACTER(LEN=*), INTENT(IN) :: str(:), s
    395411  DO out = 1, SIZE(str); IF(str(out) == s) EXIT; END DO
    … …  
    398414!==============================================================================================================================
    399415FUNCTION strIdx_m(str, s, n) RESULT(out)
     416  IMPLICIT NONE
    400417  CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
    401418  INTEGER, OPTIONAL, INTENT(OUT) :: n
    … …  
    412429!=== GET THE INDEX LIST OF THE ELEMENTS OF "str(:)" EQUAL TO "s" AND OPTIONALY, ITS LENGTH "n" ================================
    413430!==============================================================================================================================
    414 FUNCTION strFind(str, s, n) RESULT(out)
     431FUNCTION strFind_1(str, s, n) RESULT(out)
     432  IMPLICIT NONE
    415433  CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s
    416434  INTEGER, OPTIONAL, INTENT(OUT) :: n
    … …  
    420438  out = PACK( [(k, k=1, SIZE(str(:), DIM=1))], MASK = str(:) == s )
    421439  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
    422 END FUNCTION strFind
    423 !==============================================================================================================================
    424 FUNCTION find_int(i,j,n) RESULT(out)
     440END FUNCTION strFind_1
     441!==============================================================================================================================
     442FUNCTION strFind_m(str, s, n) RESULT(out)
     443  IMPLICIT NONE
     444  CHARACTER(LEN=*),  INTENT(IN)  :: str(:), s(:)
     445  INTEGER, OPTIONAL, INTENT(OUT) :: n
     446  INTEGER,           ALLOCATABLE :: out(:)
     447!------------------------------------------------------------------------------------------------------------------------------
     448  INTEGER :: k
     449  out = [(strFind_1(str, s(k)), k=1, SIZE(s))]
     450  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
     451END FUNCTION strFind_m
     452!==============================================================================================================================
     453FUNCTION intFind_1(i,j,n) RESULT(out)
     454  IMPLICIT NONE
    425455  INTEGER,           INTENT(IN)  :: i(:), j
    426456  INTEGER, OPTIONAL, INTENT(OUT) :: n
    … …  
    430460  out = PACK( [(k, k=1, SIZE(i(:), DIM=1))], MASK = i(:) == j )
    431461  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
    432 END FUNCTION find_int
    433 !==============================================================================================================================
    434 FUNCTION find_boo(l,n) RESULT(out)
    435   LOGICAL,           INTENT(IN)  :: l(:)
     462END FUNCTION intFind_1
     463!==============================================================================================================================
     464FUNCTION intFind_m(i,j,n) RESULT(out)
     465  IMPLICIT NONE
     466  INTEGER,           INTENT(IN)  :: i(:), j(:)
     467  INTEGER, OPTIONAL, INTENT(OUT) :: n
     468  INTEGER,           ALLOCATABLE :: out(:)
     469!------------------------------------------------------------------------------------------------------------------------------
     470  INTEGER :: k
     471  out = [(intFind_1(i, j(k)), k=1, SIZE(j))]
     472  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
     473END FUNCTION intFind_m
     474!==============================================================================================================================
     475FUNCTION booFind(l,n) RESULT(out)
     476   IMPLICIT NONE
     477 LOGICAL,           INTENT(IN)  :: l(:)
    436478  INTEGER, OPTIONAL, INTENT(OUT) :: n
    437479  INTEGER,           ALLOCATABLE :: out(:)
    … …  
    440482  out = PACK( [(k, k=1, SIZE(l(:), DIM=1))], MASK = l(:) )
    441483  IF(PRESENT(n)) n = SIZE(out(:), DIM=1)
    442 END FUNCTION find_boo
     484END FUNCTION booFind
    443485!==============================================================================================================================
    444486
    … …  
    450492!==============================================================================================================================
    451493LOGICAL FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr)
     494  IMPLICIT NONE
    452495  CHARACTER(LEN=*),  INTENT(IN)  :: rawList                          !--- String in which delimiters have to be identified
    453496  CHARACTER(LEN=*),  INTENT(IN)  :: del(:)                           !--- List of delimiters
    … …  
    469512  END IF
    470513
    471   IF(test(idx == 1 .AND. INDEX('+-',del(idel)) /= 0, lerr)) RETURN   !--- The front delimiter is different from +/-: error
    472   IF(     idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1)))   RETURN   !--- The input string head is a valid number
     514  lerr = idx == 1 .AND. INDEX('+-',del(idel)) /= 0; IF(lerr) RETURN  !--- The front delimiter is different from +/-: error
     515  IF(    idx /= 1 .AND. is_numeric(rawList(ibeg:idx-1)))     RETURN  !--- The input string head is a valid number
    473516
    474517  !=== The string part in front of the 1st delimiter is not a valid number: search for next delimiter index "idx"
    … …  
    503546!==============================================================================================================================
    504547LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
     548  IMPLICIT NONE
    505549  CHARACTER(LEN=*),  INTENT(IN)  :: rawList
    506550  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter
    … …  
    514558!==============================================================================================================================
    515559LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
     560  IMPLICIT NONE
    516561  CHARACTER(LEN=*),     INTENT(IN)  :: rawList(:)
    517562  CHARACTER(LEN=*),     INTENT(IN)  :: delimiter
    … …  
    530575!==============================================================================================================================
    531576LOGICAL FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr)
     577  IMPLICIT NONE
    532578  CHARACTER(LEN=*),  INTENT(IN)  :: rawList
    533579  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter(:)
    … …  
    560606!==============================================================================================================================
    561607LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr)
     608  IMPLICIT NONE
    562609  CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter
    563610  CHARACTER(LEN=maxlen), ALLOCATABLE,           INTENT(OUT) :: keys(:)
    … …  
    570617  r  = TRIM(ADJUSTL(rawList))
    571618  nr = LEN_TRIM(r); IF(nr == 0) THEN; keys = ['']; RETURN; END IF
    572   CALL strParse_prv(nk)                                              !--- COUNT THE ELEMENTS
    573   ALLOCATE(keys(nk))
    574   IF(PRESENT(vals)) THEN
    575     ALLOCATE(vals(nk)); CALL strParse_prv(nk, keys, vals)            !--- PARSE THE KEYS
    576   ELSE
    577     CALL strParse_prv(nk, keys)                                      !--- PARSE THE KEYS
    578   END IF
    579   IF(PRESENT(n)) n = nk
     619  nk = countK()                                                      !--- COUNT THE ELEMENTS
     620  CALL parseK(keys)                                                  !--- PARSE THE KEYS
     621  IF(PRESENT(vals)) CALL parseV(vals)                                !--- PARSE <key>=<val> PAIRS
     622  IF(PRESENT(n)) n = nk                                              !--- RETURN THE NUMBER OF KEYS
     623  IF(PRESENT(vals)) &
     624print*,'key ; val = '//TRIM(strStack(keys))//' ; '//TRIM(strStack(vals))
    580625
    581626CONTAINS
    582627
    583628!------------------------------------------------------------------------------------------------------------------------------
    584 SUBROUTINE strParse_prv(nkeys, keys, vals)
    585 !--- * Get the number of elements after parsing ("nkeys" only is present)
    586 !--- * Parse the <key>=<val> pairs and store result in "keys" and "vals" (already allocated)
    587   IMPLICIT NONE
    588   INTEGER,                         INTENT(OUT) :: nkeys
    589   CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: keys(:)
    590   CHARACTER(LEN=maxlen), OPTIONAL, INTENT(OUT) :: vals(:)
    591 !------------------------------------------------------------------------------------------------------------------------------
    592   INTEGER :: ib, ie
    593   nkeys = 1; ib = 1
     629INTEGER FUNCTION countK() RESULT(nkeys)
     630!--- Get the number of elements after parsing.
     631  IMPLICIT NONE
     632!------------------------------------------------------------------------------------------------------------------------------
     633  INTEGER :: ib, ie, nl
     634  nkeys = 1; ib = 1; nl = LEN(delimiter)
    594635  DO
    595636    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
    596637    IF(ie == ib-1) EXIT
    597     IF(PRESENT(keys)) keys(nkeys) = r(ib:ie-1)                       !--- Get the ikth key
    598     IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys))       !--- Parse the ikth <key>=<val> pair
     638    ib = ie + nl
     639    DO WHILE(ANY([0, 9, 32] == IACHAR(r(ib:ib))) .AND. ib < nr)      !--- Skip blanks (ascii): NULL (0), TAB (9), SPACE (32)
     640      ib = ib + 1
     641    END DO     !--- Skip spaces before next chain
     642    nkeys = nkeys+1
     643  END DO
     644END FUNCTION countK
     645
     646!------------------------------------------------------------------------------------------------------------------------------
     647SUBROUTINE parseK(keys)
     648!--- Parse the string separated by "delimiter" from "rawList" into "keys(:)"
     649  IMPLICIT NONE
     650  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: keys(:)
     651!------------------------------------------------------------------------------------------------------------------------------
     652  INTEGER :: ib, ie, ik
     653  ALLOCATE(keys(nk))
     654  ib = 1
     655  DO ik = 1, nk
     656    ie = INDEX(rawList(ib:nr), delimiter)+ib-1                       !--- Determine the next separator start index
     657    IF(ie == ib-1) EXIT
     658    keys(ik) = r(ib:ie-1)                                            !--- Get the ikth key
    599659    ib = ie + LEN(delimiter)
    600660    DO WHILE(r(ib:ib) == ' ' .AND. ib < nr); ib = ib + 1; END DO     !--- Skip spaces before next chain
    601     nkeys = nkeys+1
    602   END DO
    603   IF(PRESENT(keys)) keys(nkeys) = r(ib:nr)                           !--- Get the last key
    604   IF(PRESENT(vals)) CALL parseKeys(keys(nkeys), vals(nkeys))         !--- Parse the last <key>=<val> pair
    605 END SUBROUTINE strParse_prv
    606 
    607 !------------------------------------------------------------------------------------------------------------------------------
    608 SUBROUTINE parseKeys(key, val)
    609   CHARACTER(LEN=*), INTENT(INOUT) :: key
    610   CHARACTER(LEN=*), INTENT(OUT)   :: val
    611 !------------------------------------------------------------------------------------------------------------------------------
    612   INTEGER :: ix
    613   ix = INDEX(key, '='); IF(ix == 0) RETURN                           !--- First "=" index in "key"
    614   val = ADJUSTL(key(ix+1:LEN_TRIM(key)))
    615   key = ADJUSTL(key(1:ix-1))
    616 END SUBROUTINE parseKeys
     661  END DO
     662  keys(ik) = r(ib:nr)                                                !--- Get the last key
     663END SUBROUTINE parseK
     664
     665!------------------------------------------------------------------------------------------------------------------------------
     666SUBROUTINE parseV(vals)
     667!--- Parse the <key>=<val> pairs in "keys(:)" into "keys" and "vals"
     668  IMPLICIT NONE
     669  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: vals(:)
     670!------------------------------------------------------------------------------------------------------------------------------
     671  CHARACTER(LEN=maxlen) :: key
     672  INTEGER :: ik, ix
     673  ALLOCATE(vals(nk))
     674  DO ik = 1, nk; key = keys(ik)
     675    vals(ik) = ''
     676    ix = INDEX(key, '='); IF(ix == 0) CYCLE                          !--- First "=" index in "key"
     677    vals(ik) = ADJUSTL(key(ix+1:LEN_TRIM(key)))
     678    keys(ik) = ADJUSTL(key(1:ix-1))
     679  END DO
     680END SUBROUTINE parseV
    617681
    618682END FUNCTION strParse
    619683!==============================================================================================================================
    620684LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr)
     685  IMPLICIT NONE
    621686  CHARACTER(LEN=*),                             INTENT(IN)  :: rawList, delimiter(:)
    622687  CHARACTER(LEN=maxlen),           ALLOCATABLE, INTENT(OUT) :: keys(:)  !--- Parsed keys vector
    … …  
    630695  LOGICAL :: ll
    631696  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    632   IF(test(fmsg("Couldn't parse list: non-numerical strings were found", ll=strCount_1m(rawList, delimiter, nk, ll)),lerr)) RETURN
     697  lerr = strCount_1m(rawList, delimiter, nk, ll)
     698  CALL msg("Couldn't parse list: non-numerical strings were found", ll=lerr); IF(lerr) RETURN
    633699
    634700  !--- FEW ALLOCATIONS
    … …  
    643709  ib = 1
    644710  DO ik = 1, nk-1
    645     IF(test(fmsg('Non-numeric values found', ll=strIdx_prv(r, delimiter, ib, ie, jd, ll)),lerr)) RETURN
     711    lerr = strIdx_prv(r, delimiter, ib, ie, jd, ll)
     712    CALL msg('Non-numeric values found', ll=lerr); IF(lerr) RETURN
    646713    keys(ik) = r(ib:ie-1)
    647714    IF(PRESENT(vals)) CALL parseKeys(keys(ik), vals(ik))             !--- Parse a <key>=<val> pair
    … …  
    657724!------------------------------------------------------------------------------------------------------------------------------
    658725SUBROUTINE parseKeys(key, val)
     726  IMPLICIT NONE
    659727  CHARACTER(LEN=*), INTENT(INOUT) :: key
    660728  CHARACTER(LEN=*), INTENT(OUT)   :: val
    … …  
    674742!==============================================================================================================================
    675743SUBROUTINE strReplace_1(str, key, val, lsurr)
     744  IMPLICIT NONE
    676745  CHARACTER(LEN=*),  INTENT(INOUT) :: str        !--- Main string
    677746  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
    … …  
    700769!==============================================================================================================================
    701770SUBROUTINE strReplace_m(str, key, val, lsurr)
     771  IMPLICIT NONE
    702772  CHARACTER(LEN=*),  INTENT(INOUT) :: str(:)     !--- Main strings vector
    703773  CHARACTER(LEN=*),  INTENT(IN)    :: key, val   !--- "key" will be replaced by "val"
    … …  
    714784!=== Contatenate horizontally scalars/vectors of strings/integers/reals into a vector/array ===================================
    715785!==============================================================================================================================
    716 FUNCTION horzcat_s1(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
    717   CHARACTER(LEN=*),           TARGET, INTENT(IN) :: s0
     786FUNCTION horzcat_s00(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
     787  IMPLICIT NONE
     788  CHARACTER(LEN=*),                   INTENT(IN) :: s0
    718789  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
    719790  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
    720 !------------------------------------------------------------------------------------------------------------------------------
    721791  CHARACTER(LEN=maxlen), POINTER     :: s
    722   LOGICAL :: lv(10)
    723   INTEGER :: iv
    724   lv = [   .TRUE.   , PRESENT(s1), PRESENT(s2), PRESENT(s3), PRESENT(s4) , &
    725          PRESENT(s5), PRESENT(s6), PRESENT(s7), PRESENT(s8), PRESENT(s9) ]
    726   ALLOCATE(out(COUNT(lv)))
    727   DO iv=1, COUNT(lv)
    728     SELECT CASE(iv)
    729       CASE(1); s=> s0; CASE(2); s=> s1; CASE(3); s=> s2; CASE(4); s=> s3; CASE(5); s=> s4
    730       CASE(6); s=> s5; CASE(7); s=> s6; CASE(8); s=> s7; CASE(9); s=> s8; CASE(10);s=> s9
     792  INTEGER                            :: nrow, iv
     793  LOGICAL                            :: pre(9)
     794!------------------------------------------------------------------------------------------------------------------------------
     795  pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)]
     796  nrow = 1+COUNT(pre)
     797  ALLOCATE(out(nrow))
     798  out(1) = s0
     799  DO iv = 2, nrow; IF(.NOT.pre(iv-1)) CYCLE
     800    SELECT CASE(iv-1)
     801      CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5
     802      CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9
    731803    END SELECT
    732804    out(iv) = s
    733805  END DO
    734 END FUNCTION horzcat_s1
    735 !==============================================================================================================================
    736 FUNCTION horzcat_sm(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
    737   CHARACTER(LEN=*),           TARGET, DIMENSION(:), INTENT(IN) :: s0
    738   CHARACTER(LEN=*), OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
     806END FUNCTION horzcat_s00
     807!==============================================================================================================================
     808FUNCTION horzcat_s10(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
     809  IMPLICIT NONE
     810  CHARACTER(LEN=*),           INTENT(IN) :: s0(:), s1
     811  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2, s3, s4, s5, s6, s7, s8, s9
     812  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:), tmp(:)
     813  INTEGER :: nc
     814  nc = SIZE(s0)
     815  tmp = horzcat_s00(s0(nc), s1, s2, s3, s4, s5, s6, s7, s8, s9)
     816  out = [s0(1:nc-1), tmp]
     817END FUNCTION horzcat_s10
     818!==============================================================================================================================
     819FUNCTION horzcat_s11(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
     820  IMPLICIT NONE
     821  CHARACTER(LEN=*),                   INTENT(IN) :: s0(:)
     822  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1(:), s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
    739823  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:)
    740 !------------------------------------------------------------------------------------------------------------------------------
    741824  CHARACTER(LEN=maxlen), POINTER     :: s(:)
    742   LOGICAL :: lv(10)
    743   INTEGER :: nrow, ncol, iv, n
    744   lv = [   .TRUE.   , PRESENT(s1), PRESENT(s2), PRESENT(s3), PRESENT(s4) , &
    745          PRESENT(s5), PRESENT(s6), PRESENT(s7), PRESENT(s8), PRESENT(s9) ]
    746   nrow = SIZE(s0); ncol=COUNT(lv)
     825  INTEGER                            :: nrow, ncol, iv, n
     826  LOGICAL                            :: pre(9)
     827!------------------------------------------------------------------------------------------------------------------------------
     828  pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)]
     829  nrow = SIZE(s0)
     830  ncol = 1+COUNT(pre)
    747831  ALLOCATE(out(nrow, ncol))
    748   DO iv=1, ncol
    749     SELECT CASE(iv)
    750       CASE(1); s=> s0; CASE(2); s=> s1; CASE(3); s=> s2; CASE(4); s=> s3; CASE(5); s=> s4
    751       CASE(6); s=> s5; CASE(7); s=> s6; CASE(8); s=> s7; CASE(9); s=> s8; CASE(10);s=> s9
     832  out(:,1) = s0
     833  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     834    SELECT CASE(iv-1)
     835      CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5
     836      CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9
    752837    END SELECT
    753838    n = SIZE(s, DIM=1)
    754     IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     839    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
    755840    out(:,iv) = s(:)
    756841  END DO
    757 END FUNCTION horzcat_sm
    758 !==============================================================================================================================
    759 FUNCTION horzcat_i1(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
    760   INTEGER,           TARGET, INTENT(IN) :: i0
     842END FUNCTION horzcat_s11
     843!==============================================================================================================================
     844FUNCTION horzcat_s21(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
     845  IMPLICIT NONE
     846  CHARACTER(LEN=*),           INTENT(IN) :: s0(:,:), s1(:)
     847  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
     848  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), tmp(:,:)
     849  INTEGER :: nc
     850  nc  = SIZE(s0, 2)
     851  tmp = horzcat_s11(s0(:,nc), s1, s2, s3, s4, s5, s6, s7, s8, s9)
     852  out = RESHAPE([PACK(s0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(s0, 1), nc + SIZE(tmp, 2)-1])
     853END FUNCTION horzcat_s21
     854!==============================================================================================================================
     855FUNCTION horzcat_i00(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
     856  IMPLICIT NONE
     857  INTEGER,                   INTENT(IN) :: i0
    761858  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
    762859  INTEGER, ALLOCATABLE :: out(:)
    763 !------------------------------------------------------------------------------------------------------------------------------
    764860  INTEGER, POINTER     :: i
    765   LOGICAL :: lv(10)
    766   INTEGER :: iv
    767   lv = [   .TRUE.   , PRESENT(i1), PRESENT(i2), PRESENT(i3), PRESENT(i4) , &
    768          PRESENT(i5), PRESENT(i6), PRESENT(i7), PRESENT(i8), PRESENT(i9) ]
    769   ALLOCATE(out(COUNT(lv)))
    770   DO iv=1, COUNT(lv)
    771     SELECT CASE(iv)
    772       CASE(1); i=> i0; CASE(2); i=> i1; CASE(3); i=> i2; CASE(4); i=> i3; CASE(5); i=> i4
    773       CASE(6); i=> i5; CASE(7); i=> i6; CASE(8); i=> i7; CASE(9); i=> i8; CASE(10);i=> i9
     861  INTEGER              :: ncol, iv
     862  LOGICAL              :: pre(9)
     863!------------------------------------------------------------------------------------------------------------------------------
     864  pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)]
     865  ncol = SIZE(pre)
     866  ALLOCATE(out(ncol))
     867  out(1) = i0
     868  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     869    SELECT CASE(iv-1)
     870      CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5
     871      CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9
    774872    END SELECT
    775873    out(iv) = i
    776874  END DO
    777 END FUNCTION horzcat_i1
    778 !==============================================================================================================================
    779 FUNCTION horzcat_im(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
    780   INTEGER,           TARGET, DIMENSION(:), INTENT(IN) :: i0
    781   INTEGER, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
     875END FUNCTION horzcat_i00
     876!==============================================================================================================================
     877FUNCTION horzcat_i10(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
     878  IMPLICIT NONE
     879  INTEGER,           INTENT(IN) :: i0(:), i1
     880  INTEGER, OPTIONAL, INTENT(IN) :: i2, i3, i4, i5, i6, i7, i8, i9
     881  INTEGER, ALLOCATABLE :: out(:), tmp(:)
     882  INTEGER :: nc
     883  nc = SIZE(i0)
     884  tmp = horzcat_i00(i0(nc), i1, i2, i3, i4, i5, i6, i7, i8, i9)
     885  out = [i0(1:nc-1), tmp]
     886END FUNCTION horzcat_i10
     887!==============================================================================================================================
     888FUNCTION horzcat_i11(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
     889  IMPLICIT NONE
     890  INTEGER,                   INTENT(IN) :: i0(:)
     891  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1(:), i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
    782892  INTEGER, ALLOCATABLE :: out(:,:)
    783 !------------------------------------------------------------------------------------------------------------------------------
    784893  INTEGER, POINTER     :: i(:)
    785   LOGICAL :: lv(10)
    786   INTEGER :: nrow, ncol, iv, n
    787   lv = [   .TRUE.   , PRESENT(i1), PRESENT(i2), PRESENT(i3), PRESENT(i4) , &
    788          PRESENT(i5), PRESENT(i6), PRESENT(i7), PRESENT(i8), PRESENT(i9) ]
    789   nrow = SIZE(i0); ncol=COUNT(lv)
     894  INTEGER              :: nrow, ncol, iv, n
     895  LOGICAL              :: pre(9)
     896!------------------------------------------------------------------------------------------------------------------------------
     897  pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)]
     898  nrow = SIZE(i0)
     899  ncol = 1+COUNT(pre)
    790900  ALLOCATE(out(nrow, ncol))
    791   DO iv=1, ncol
    792     SELECT CASE(iv)
    793       CASE(1); i=> i0; CASE(2); i=> i1; CASE(3); i=> i2; CASE(4); i=> i3; CASE(5); i=> i4
    794       CASE(6); i=> i5; CASE(7); i=> i6; CASE(8); i=> i7; CASE(9); i=> i8; CASE(10);i=> i9
     901  out(:,1) = i0
     902  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     903    SELECT CASE(iv-1)
     904      CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5
     905      CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9
    795906    END SELECT
    796907    n = SIZE(i, DIM=1)
    797     IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     908    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
    798909    out(:,iv) = i(:)
    799910  END DO
    800 END FUNCTION horzcat_im
    801 !==============================================================================================================================
    802 FUNCTION horzcat_r1(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    803   REAL,           TARGET, INTENT(IN) :: r0
     911END FUNCTION horzcat_i11
     912!==============================================================================================================================
     913FUNCTION horzcat_i21(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
     914  IMPLICIT NONE
     915  INTEGER,           INTENT(IN) :: i0(:,:), i1(:)
     916  INTEGER, OPTIONAL, INTENT(IN) :: i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
     917  INTEGER, ALLOCATABLE :: out(:,:), tmp(:,:)
     918  INTEGER :: nc
     919  nc  = SIZE(i0, 2)
     920  tmp = horzcat_i11(i0(:,nc), i1, i2, i3, i4, i5, i6, i7, i8, i9)
     921  out = RESHAPE([PACK(i0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(i0, 1), nc + SIZE(tmp, 2)-1])
     922END FUNCTION horzcat_i21
     923!==============================================================================================================================
     924FUNCTION horzcat_r00(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
     925  IMPLICIT NONE
     926  REAL,                   INTENT(IN) :: r0
    804927  REAL, OPTIONAL, TARGET, INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
    805928  REAL, ALLOCATABLE :: out(:)
    806 !------------------------------------------------------------------------------------------------------------------------------
    807929  REAL, POINTER     :: r
    808   LOGICAL :: lv(10)
    809   INTEGER :: iv
    810   lv = [   .TRUE.   , PRESENT(r1), PRESENT(r2), PRESENT(r3), PRESENT(r4) , &
    811          PRESENT(r5), PRESENT(r6), PRESENT(r7), PRESENT(r8), PRESENT(r9) ]
    812   ALLOCATE(out(COUNT(lv)))
    813   DO iv=1, COUNT(lv)
    814     SELECT CASE(iv)
    815       CASE(1); r=> r0; CASE(2); r=> r1; CASE(3); r=> r2; CASE(4); r=> r3; CASE(5); r=> r4
    816       CASE(6); r=> r5; CASE(7); r=> r6; CASE(8); r=> r7; CASE(9); r=> r8; CASE(10);r=> r9
     930  INTEGER           :: ncol, iv
     931  LOGICAL           :: pre(9)
     932!------------------------------------------------------------------------------------------------------------------------------
     933  pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)]
     934  ncol = 1+COUNT(pre)
     935  ALLOCATE(out(ncol))
     936  out(1) = r0
     937  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     938    SELECT CASE(iv-1)
     939      CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5
     940      CASE(6); r=> r6; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9
    817941    END SELECT
    818942    out(iv) = r
    819943  END DO
    820 END FUNCTION horzcat_r1
    821 !==============================================================================================================================
    822 FUNCTION horzcat_rm(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    823   REAL,           TARGET, DIMENSION(:), INTENT(IN) :: r0
    824   REAL, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
     944END FUNCTION horzcat_r00
     945!==============================================================================================================================
     946FUNCTION horzcat_r10(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
     947  IMPLICIT NONE
     948  REAL,           INTENT(IN) :: r0(:), r1
     949  REAL, OPTIONAL, INTENT(IN) :: r2, r3, r4, r5, r6, r7, r8, r9
     950  REAL, ALLOCATABLE :: out(:), tmp(:)
     951  INTEGER :: nc
     952  nc  = SIZE(r0)
     953  tmp = horzcat_r00(r0(nc), r1, r2, r3, r4, r5, r6, r7, r8, r9)
     954  out = [r0(1:nc-1), tmp]
     955END FUNCTION horzcat_r10
     956!==============================================================================================================================
     957FUNCTION horzcat_r11(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
     958  IMPLICIT NONE
     959  REAL,                   INTENT(IN) :: r0(:)
     960  REAL, OPTIONAL, TARGET, INTENT(IN) :: r1(:), r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
    825961  REAL, ALLOCATABLE :: out(:,:)
    826 !------------------------------------------------------------------------------------------------------------------------------
    827962  REAL, POINTER     :: r(:)
    828   LOGICAL :: lv(10)
    829   INTEGER :: nrow, ncol, iv, n
    830   lv = [   .TRUE.   , PRESENT(r1), PRESENT(r2), PRESENT(r3), PRESENT(r4) , &
    831          PRESENT(r5), PRESENT(r6), PRESENT(r7), PRESENT(r8), PRESENT(r9) ]
    832   nrow = SIZE(r0); ncol=COUNT(lv)
     963  INTEGER           :: nrow, ncol, iv, n
     964  LOGICAL           :: pre(9)
     965!------------------------------------------------------------------------------------------------------------------------------
     966  pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)]
     967  nrow = SIZE(r0)
     968  ncol = 1+COUNT(pre)
    833969  ALLOCATE(out(nrow, ncol))
    834   DO iv=1, ncol
    835     SELECT CASE(iv)
    836       CASE(1); r=> r0; CASE(2); r=> r1; CASE(3); r=> r2; CASE(4); r=> r3; CASE(5); r=> r4
    837       CASE(6); r=> r5; CASE(7); r=> r6; CASE(8); r=> r7; CASE(9); r=> r8; CASE(10);r=> r9
     970  out(:,1) = r0
     971  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     972    SELECT CASE(iv-1)
     973      CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5
     974      CASE(6); r=> r5; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9
    838975    END SELECT
    839976    n = SIZE(r, DIM=1)
    840     IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     977    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
    841978    out(:,iv) = r(:)
    842979  END DO
    843 END FUNCTION horzcat_rm
    844 !==============================================================================================================================
    845 FUNCTION horzcat_d1(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    846   DOUBLE PRECISION,           TARGET, INTENT(IN) :: d0
     980END FUNCTION horzcat_r11
     981!==============================================================================================================================
     982FUNCTION horzcat_r21(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
     983  IMPLICIT NONE
     984  REAL,           INTENT(IN) :: r0(:,:), r1(:)
     985  REAL, OPTIONAL, INTENT(IN) :: r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
     986  REAL, ALLOCATABLE :: out(:,:), tmp(:,:)
     987  INTEGER :: nc
     988  nc  = SIZE(r0, 2)
     989  tmp = horzcat_r11(r0(:,nc), r1, r2, r3, r4, r5, r6, r7, r8, r9)
     990  out = RESHAPE([PACK(r0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(r0, 1), nc + SIZE(tmp, 2)-1])
     991END FUNCTION horzcat_r21
     992!==============================================================================================================================
     993FUNCTION horzcat_d00(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
     994  IMPLICIT NONE
     995  DOUBLE PRECISION,                   INTENT(IN) :: d0
    847996  DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
    848997  DOUBLE PRECISION, ALLOCATABLE :: out(:)
    849 !------------------------------------------------------------------------------------------------------------------------------
    850998  DOUBLE PRECISION, POINTER     :: d
    851   LOGICAL :: lv(10)
    852   INTEGER :: iv
    853   lv = [   .TRUE.   , PRESENT(d1), PRESENT(d2), PRESENT(d3), PRESENT(d4) , &
    854          PRESENT(d5), PRESENT(d6), PRESENT(d7), PRESENT(d8), PRESENT(d9) ]
    855   ALLOCATE(out(COUNT(lv)))
    856   DO iv=1, COUNT(lv)
    857     SELECT CASE(iv)
    858       CASE(1); d=> d0; CASE(2); d=> d1; CASE(3); d=> d2; CASE(4); d=> d3; CASE(5); d=> d4
    859       CASE(6); d=> d5; CASE(7); d=> d6; CASE(8); d=> d7; CASE(9); d=> d8; CASE(10);d=> d9
     999  INTEGER                       :: ncol, iv
     1000  LOGICAL                       :: pre(9)
     1001!------------------------------------------------------------------------------------------------------------------------------
     1002  pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)]
     1003  ncol = 1+COUNT(pre)
     1004  ALLOCATE(out(ncol))
     1005  out(1) = d0
     1006  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     1007    SELECT CASE(iv-1)
     1008      CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5
     1009      CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9
    8601010    END SELECT
    8611011    out(iv) = d
    8621012  END DO
    863 END FUNCTION horzcat_d1
    864 !==============================================================================================================================
    865 FUNCTION horzcat_dm(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    866   DOUBLE PRECISION,           TARGET, DIMENSION(:), INTENT(IN) :: d0
    867   DOUBLE PRECISION, OPTIONAL, TARGET, DIMENSION(:), INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
     1013END FUNCTION horzcat_d00
     1014!==============================================================================================================================
     1015FUNCTION horzcat_d10(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
     1016  IMPLICIT NONE
     1017  DOUBLE PRECISION,           INTENT(IN) :: d0(:), d1
     1018  DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2, d3, d4, d5, d6, d7, d8, d9
     1019  DOUBLE PRECISION, ALLOCATABLE :: out(:), tmp(:)
     1020  INTEGER :: nc
     1021  nc = SIZE(d0)
     1022  tmp = horzcat_d00(d0(nc), d1, d2, d3, d4, d5, d6, d7, d8, d9)
     1023  out = [d0(1:nc-1), tmp]
     1024END FUNCTION horzcat_d10
     1025!==============================================================================================================================
     1026FUNCTION horzcat_d11(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
     1027  IMPLICIT NONE
     1028  DOUBLE PRECISION,                   INTENT(IN) :: d0(:)
     1029  DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1(:), d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
    8681030  DOUBLE PRECISION, ALLOCATABLE :: out(:,:)
    869 !------------------------------------------------------------------------------------------------------------------------------
    8701031  DOUBLE PRECISION, POINTER     :: d(:)
    871   LOGICAL :: lv(10)
    872   INTEGER :: nrow, ncol, iv, n
    873   lv = [   .TRUE.   , PRESENT(d1), PRESENT(d2), PRESENT(d3), PRESENT(d4) , &
    874          PRESENT(d5), PRESENT(d6), PRESENT(d7), PRESENT(d8), PRESENT(d9) ]
    875   nrow = SIZE(d0); ncol=COUNT(lv)
     1032  INTEGER                       :: nrow, ncol, iv, n
     1033  LOGICAL                       :: pre(9)
     1034!------------------------------------------------------------------------------------------------------------------------------
     1035  nrow = SIZE(d0)
     1036  pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)]
     1037  ncol = 1+COUNT(pre)
    8761038  ALLOCATE(out(nrow, ncol))
    877   DO iv=1, ncol
    878     SELECT CASE(iv)
    879       CASE(1); d=> d0; CASE(2); d=> d1; CASE(3); d=> d2; CASE(4); d=> d3; CASE(5); d=> d4
    880       CASE(6); d=> d5; CASE(7); d=> d6; CASE(8); d=> d7; CASE(9); d=> d8; CASE(10);d=> d9
     1039  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     1040    SELECT CASE(iv-1)
     1041      CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5
     1042      CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9
    8811043    END SELECT
    8821044    n = SIZE(d, DIM=1)
    883     IF(n/=nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     1045    IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
    8841046    out(:,iv) = d(:)
    8851047  END DO
    886 END FUNCTION horzcat_dm
     1048END FUNCTION horzcat_d11
     1049!==============================================================================================================================
     1050FUNCTION horzcat_d21(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
     1051  IMPLICIT NONE
     1052  DOUBLE PRECISION,           INTENT(IN) :: d0(:,:), d1(:)
     1053  DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
     1054  DOUBLE PRECISION, ALLOCATABLE :: out(:,:), tmp(:,:)
     1055  INTEGER :: nc
     1056  nc  = SIZE(d0, 2)
     1057  tmp = horzcat_d11(d0(:,nc), d1, d2, d3, d4, d5, d6, d7, d8, d9)
     1058  out = RESHAPE([PACK(d0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(d0, 1), nc + SIZE(tmp, 2)-1])
     1059END FUNCTION horzcat_d21
    8871060!==============================================================================================================================
    8881061
    … …  
    8961069!==============================================================================================================================
    8971070LOGICAL FUNCTION dispTable(p, titles, s, i, r, rFmt, nRowMax, nColMax, nHead, unit, sub) RESULT(lerr)
     1071  IMPLICIT NONE
    8981072  CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
    8991073  CHARACTER(LEN=*),           INTENT(IN)  :: titles(:)     !--- TITLES (ONE EACH COLUMN)
    … …  
    10041178!==============================================================================================================================
    10051179LOGICAL FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr)
     1180  IMPLICIT NONE
    10061181  INTEGER,                    INTENT(IN)  :: unt           !--- Output unit
    10071182  CHARACTER(LEN=*),           INTENT(IN)  :: p             !--- DISPLAY MAP: s/i/r
    … …  
    10861261!==============================================================================================================================
    10871262LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr)
     1263  IMPLICIT NONE
    10881264! Display outliers list in tables
    10891265! If "nam" is supplied, it means the last index is for tracers => one table each tracer for rank > 2.
    … …  
    11151291
    11161292  rk = SIZE(n); nv = SIZE(vnm)
    1117   IF(test(fmsg('SIZE(nam) /= 1 and /= last "n" element', sub, nv /= 1 .AND. nv /= n(rk), unt),lerr)) RETURN
    1118   IF(test(fmsg('ll" and "a" sizes mismatch',             sub, SIZE(a) /= SIZE(ll),       unt),lerr)) RETURN
    1119   IF(test(fmsg('profile "n" does not match "a" and "ll', sub, SIZE(a) /= PRODUCT(n),     unt),lerr)) RETURN
     1293  lerr = nv/=1 .AND. nv/=n(rk); CALL msg('SIZE(nam) /= 1 and /= last "n" element', sub, lerr); IF(lerr) RETURN
     1294  lerr = SIZE(a) /=   SIZE(ll); CALL msg('ll" and "a" sizes mismatch',             sub, lerr); IF(lerr) RETURN
     1295  lerr = SIZE(a) /= PRODUCT(n); CALL msg('profile "n" does not match "a" and "ll', sub, lerr); IF(lerr) RETURN
    11201296  CALL msg(mes, sub, unit=unt)
    11211297
    … …  
    11641340!==============================================================================================================================
    11651341LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr)
     1342  IMPLICIT NONE
    11661343! Display outliers list in tables
    11671344! If "nam" is supplied and, it means the last index is for tracers => one table each tracer for rank > 2.
    … …  
    12211398!==============================================================================================================================
    12221399LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(lerr)
     1400  IMPLICIT NONE
    12231401  CHARACTER(LEN=*),      INTENT(IN)  :: str
    12241402  CHARACTER(LEN=maxlen), INTENT(OUT) :: val
    … …  
    12541432  DO WHILE(nl > 1)
    12551433    i = 1; DO WHILE(ip(i) /= 1 .OR. ip(i+1) /= 2); i = i + 1; END DO !IF(i > SIZE(ip)+1) EXIT;END DO
    1256     IF(test(reduceExpr_basic(vl(i+1), v), lerr)) RETURN
     1434    lerr = reduceExpr_basic(vl(i+1), v); IF(lerr) RETURN
    12571435    v = TRIM(vl(i))//TRIM(v); IF(i+2<=nl) v=TRIM(v)//TRIM(vl(i+2))
    12581436    vv = v//REPEAT(' ',768)
    … …  
    12701448!==============================================================================================================================
    12711449LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(lerr)
     1450  IMPLICIT NONE
    12721451  CHARACTER(LEN=*),      INTENT(IN)  :: str
    12731452  CHARACTER(LEN=*),      INTENT(OUT) :: val
    … …  
    12841463  op = ['^','/','*','+','-']                                                   !--- List of recognized operations
    12851464  s = str
    1286   IF(test(strParse_m(s, op, ky, lSc=.TRUE., id = id), lerr)) RETURN            !--- Parse the values
     1465  lerr = strParse_m(s, op, ky, lSc=.TRUE., id = id)                            !--- Parse the values
     1466  IF(lerr) RETURN                                                              !--- Problem with the parsing
    12871467  vl = str2dble(ky)                                                            !--- Conversion to doubles
    12881468  lerr = ANY(vl >= HUGE(1.d0))
    1289   IF(fmsg('Some values are non-numeric in: '//TRIM(s), ll=lerr)) RETURN        !--- Non-numerical values found
     1469  CALL msg('Some values are non-numeric in: '//TRIM(s), ll=lerr)
     1470  IF(lerr) RETURN                                                              !--- Non-numerical values found
    12901471  DO io = 1, SIZE(op)                                                          !--- Loop on known operators (order matters !)
    12911472    DO i = SIZE(id), 1, -1                                                     !--- Loop on found operators
    … …  
    12931474      IF(id(i) /= io) CYCLE                                                    !--- Current found operator is not op(io)
    12941475      vm = vl(i); vp = vl(i+1)                                                 !--- Couple of values used for current operation
    1295       SELECT CASE(op(io))                                                          !--- Perform operation on the two values
     1476      SELECT CASE(op(io))                                                      !--- Perform operation on the two values
    12961477        CASE('^'); v = vm**vp
    12971478        CASE('/'); v = vm/vp
    … …  
    13111492!==============================================================================================================================
    13121493FUNCTION reduceExpr_m(str, val) RESULT(lerr)
     1494  IMPLICIT NONE
    13131495  LOGICAL,               ALLOCATABLE              :: lerr(:)
    13141496  CHARACTER(LEN=*),                   INTENT(IN)  :: str(:)
    … …  
    13261508!==============================================================================================================================
    13271509ELEMENTAL LOGICAL FUNCTION is_numeric(str) RESULT(out)
     1510  IMPLICIT NONE
    13281511  CHARACTER(LEN=*), INTENT(IN) :: str
    13291512  REAL    :: x
    … …  
    13571540!==============================================================================================================================
    13581541ELEMENTAL INTEGER FUNCTION str2int(str) RESULT(out)
     1542  IMPLICIT NONE
    13591543  CHARACTER(LEN=*), INTENT(IN) :: str
    13601544  INTEGER :: ierr
    … …  
    13641548!==============================================================================================================================
    13651549ELEMENTAL REAL FUNCTION str2real(str) RESULT(out)
     1550  IMPLICIT NONE
    13661551  CHARACTER(LEN=*), INTENT(IN) :: str
    13671552  INTEGER :: ierr
    … …  
    13711556!==============================================================================================================================
    13721557ELEMENTAL DOUBLE PRECISION FUNCTION str2dble(str) RESULT(out)
     1558  IMPLICIT NONE
    13731559  CHARACTER(LEN=*), INTENT(IN) :: str
    13741560  INTEGER :: ierr
    … …  
    13781564!==============================================================================================================================
    13791565ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION bool2str(b) RESULT(out)
     1566  IMPLICIT NONE
    13801567  LOGICAL, INTENT(IN) :: b
    13811568  WRITE(out,*)b
    … …  
    13841571!==============================================================================================================================
    13851572ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION int2str(i, nDigits) RESULT(out)
     1573  IMPLICIT NONE
    13861574  INTEGER,           INTENT(IN) :: i
    13871575  INTEGER, OPTIONAL, INTENT(IN) :: nDigits
    … …  
    13941582!==============================================================================================================================
    13951583ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION real2str(r,fmt) RESULT(out)
     1584  IMPLICIT NONE
    13961585  REAL,                       INTENT(IN) :: r
    13971586  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
    … …  
    14031592!==============================================================================================================================
    14041593ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION dble2str(d,fmt) RESULT(out)
     1594  IMPLICIT NONE
    14051595  DOUBLE PRECISION,           INTENT(IN) :: d
    14061596  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
    … …  
    14121602!==============================================================================================================================
    14131603ELEMENTAL SUBROUTINE cleanZeros(s)
     1604  IMPLICIT NONE
    14141605  CHARACTER(LEN=*), INTENT(INOUT) :: s
    14151606  INTEGER :: ls, ix, i
    … …  
    14291620!==============================================================================================================================
    14301621FUNCTION addQuotes_1(s) RESULT(out)
     1622  IMPLICIT NONE
    14311623  CHARACTER(LEN=*), INTENT(IN)  :: s
    14321624  CHARACTER(LEN=:), ALLOCATABLE :: out
    … …  
    14351627!==============================================================================================================================
    14361628FUNCTION addQuotes_m(s) RESULT(out)
     1629  IMPLICIT NONE
    14371630  CHARACTER(LEN=*), INTENT(IN)  :: s(:)
    14381631  CHARACTER(LEN=:), ALLOCATABLE :: out(:)
    … …  
    14471640!==============================================================================================================================
    14481641ELEMENTAL LOGICAL FUNCTION needQuotes(s) RESULT(out)
     1642  IMPLICIT NONE
    14491643  CHARACTER(LEN=*), INTENT(IN) :: s
    14501644  CHARACTER(LEN=1) :: b, e
    … …  
    14611655!==============================================================================================================================
    14621656LOGICAL FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out)
     1657  IMPLICIT NONE
    14631658! Purpose: Messages in case a list contains wrong elements (indicated by lerr boolean vector).
    14641659! Note:    Return value "out" is .TRUE. if there are errors (ie at least one element of "lerr" is TRUE).
    … …  
    14831678!==============================================================================================================================
    14841679SUBROUTINE removeComment(str)
     1680  IMPLICIT NONE
    14851681  CHARACTER(LEN=*), INTENT(INOUT) :: str
    14861682  INTEGER :: ix

  • LMDZ6/trunk/libf/phylmd/infotrac_phy.F90

    r4984 r5001  
    55   USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx
    66   USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
    7         delPhase, niso, getKey, isot_type, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, iqWIsoPha, nphas, ixIso, &
    8         isoPhas, addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,   isoCheck, nbIso, ntiso, isoName
     7        delPhase, niso, getKey, isot_type, processIsotopes,  isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
     8        addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,  iqWIsoPha, nbIso, ntiso, isoName, isoCheck
    99   IMPLICIT NONE
    1010
    … …  
    258258!##############################################################################################################################
    259259   IF(lInit) THEN
    260       IF(readTracersFiles(ttp, type_trac == 'repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1)
     260      IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1)
    261261   ELSE
    262262      CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname)
    … …  
    384384
    385385   !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
    386    CALL indexUpdate(tracers)
     386   IF(indexUpdate(tracers)) CALL abort_gcm(modname, 'problem when processing isotopes parameters', 1)
    387387
    388388!##############################################################################################################################
    … …  
    400400   !=== READ PHYSICAL PARAMETERS FOR ISOTOPES
    401401   niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
    402    IF(readIsotopesFile()) CALL abort_physic(modname, 'Problem when reading isotopes parameters', 1)
     402   IF(processIsotopes()) CALL abort_physic(modname, 'Problem when processing isotopes parameters', 1)
    403403
    404404!##############################################################################################################################
    … …  
    412412   nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
    413413   IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
    414       CALL abort_physic(modname, 'pb dans le calcul de nqtottr', 1)
     414      CALL abort_physic(modname, 'problem with the computation of nqtottr', 1)
    415415
    416416   !=== DISPLAY THE RESULTS
    … …  
    427427   t => tracers
    428428   CALL msg('Information stored in infotrac_phy :', modname)
    429    IF(dispTable('issssssssiiiiiiii', &
    430       ['iq    ', 'name  ', 'lName ', 'gen0N ', 'parent', 'type  ', 'phase ', 'compon', 'isPhy ',           &
    431                  'iGen  ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'],          &
     429   IF(dispTable('issssssssiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',      &
     430                              'isPh', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],     &
    432431      cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),&
    433432      cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,          &
Note: See TracChangeset for help on using the changeset viewer.