Changeset 4987 for LMDZ6/trunk/libf/misc

Timestamp:

Jun 17, 2024, 8:46:00 PM (7 months ago)

Author:

dcugnet

Message:

• new functions to add/remove a phase: addPhase, delPhase
• "str2bool" function is modified: result is O/1 for .FALSE./.TRUE. and -1 if the string was not a boolean.
• "addKey(key[(:)], val[(:)], ky(:), [lOverWrite])" function is now more general:
  • input argument "val" can be string/integer/real/logical
  • key, val, key: add the <key> =<val> pair to ky
  • key, val(:), key(:): add the <key> =<val(i)> pair to ky(i) for 1<=i<=SIZE(ky)
  • key(:), val(:), key(:): add the <key(i)>=<val(i)> pair to ky(i) for 1<=i<=SIZE(ky)
• few cosmetic changes

Location:

LMDZ6/trunk/libf/misc

Files:

• readTracFiles_mod.f90 (modified) (29 diffs)
• strings_mod.F90 (modified) (1 diff)

LMDZ6/trunk/libf/misc/readTracFiles_mod.f90

@@ -1 +1 @@
 MODULE readTracFiles_mod
 
-  USE strings_mod,    ONLY: msg, find, get_in, str2int, dispTable, strHead,  strReduce,  strFind, strStack, strIdx, &
-       test, removeComment, cat, fmsg, maxlen, int2str, checkList, strParse, strReplace, strTail, strCount, reduceExpr
+  USE strings_mod,    ONLY: msg, find, get_in, dispTable, strHead,  strReduce,  strFind, strStack, strIdx, &
+       test, removeComment, cat, fmsg, maxlen, checkList, strParse, strReplace, strTail, strCount, reduceExpr, &
+       int2str, str2int, real2str, str2real, bool2str, str2bool
 
   IMPLICIT NONE
@@ -9 +10 @@
 
   PUBLIC :: maxlen                                              !--- PARAMETER FOR CASUAL STRING LENGTH
-  PUBLIC :: tracers                                             !--- TRACERS  DESCRIPTION DATABASE
-  PUBLIC :: trac_type, setGeneration, indexUpdate               !--- TRACERS  DESCRIPTION ASSOCIATED TOOLS
+  PUBLIC :: trac_type, tracers, setGeneration, indexUpdate      !--- TRACERS  DESCRIPTION DATABASE + ASSOCIATED TOOLS
   PUBLIC :: testTracersFiles, readTracersFiles                  !--- TRACERS FILES READING ROUTINES
-  PUBLIC :: getKey, fGetKey, fGetKeys, addKey, setDirectKeys    !--- TOOLS TO GET/SET KEYS FROM/TO  tracers & isotopes
-  PUBLIC :: getKeysDBase,    setKeysDBase                       !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
-
-  PUBLIC :: addPhase, getiPhase,  old_phases, phases_sep, &     !--- FUNCTIONS RELATED TO THE PHASES
-   nphases, delPhase, getPhase, known_phases, phases_names      !--- + ASSOCIATED VARIABLES
+  PUBLIC :: getKeysDBase, setKeysDBase                          !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
+  PUBLIC :: addTracer, delTracer                                !--- ADD/REMOVE A TRACER FROM
+  PUBLIC :: addKey,    delKey,    getKey,    keys_type          !--- TOOLS TO SET/DEL/GET KEYS FROM/TO  tracers & isotopes
+  PUBLIC :: addPhase,  delPhase,  getPhase,  getiPhase,  &      !--- FUNCTIONS RELATED TO THE PHASES
+   nphases, old_phases, phases_sep, known_phases, phases_names  !--- + ASSOCIATED VARIABLES
+  PUBLIC :: fGetKey, fGetKeys, setDirectKeys                    !--- TOOLS TO GET/SET KEYS FROM/TO  tracers & isotopes TO BE REMOVED
 
   PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O        !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
@@ -24 +25 @@
 
   !=== FOR ISOTOPES: GENERAL
-  PUBLIC :: isot_type, readIsotopesFile, isoSelect              !--- ISOTOPES DESCRIPTION TYPE + READING ROUTINE
-  PUBLIC :: ixIso, nbIso                                        !--- INDEX OF SELECTED ISOTOPES CLASS + NUMBER OF CLASSES
+  PUBLIC :: isot_type, readIsotopesFile, isoSelect, ixIso, nbIso!--- ISOTOPES READING ROUTINE + SELECTION + CLASS IDX & NUMBER
 
   !=== FOR ISOTOPES: H2O FAMILY ONLY
@@ -41 +41 @@
   PUBLIC :: maxTableWidth
 !------------------------------------------------------------------------------------------------------------------------------
-  TYPE :: keys_type                                        !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
-    CHARACTER(LEN=maxlen)              :: name             !--- Tracer name
-    CHARACTER(LEN=maxlen), ALLOCATABLE :: key(:)           !--- Keys string list
-    CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)           !--- Corresponding values string list
+  TYPE :: keys_type                                             !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
+    CHARACTER(LEN=maxlen)              :: name                  !--- Tracer name
+    CHARACTER(LEN=maxlen), ALLOCATABLE :: key(:)                !--- Keys string list
+    CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)                !--- Corresponding values string list
   END TYPE keys_type
 !------------------------------------------------------------------------------------------------------------------------------
-  TYPE :: trac_type                                        !=== TYPE FOR A SINGLE TRACER NAMED "name"
-    CHARACTER(LEN=maxlen) :: name        = ''              !--- Name of the tracer
-    CHARACTER(LEN=maxlen) :: gen0Name    = ''              !--- First generation ancestor name
-    CHARACTER(LEN=maxlen) :: parent      = ''              !--- Parent name
-    CHARACTER(LEN=maxlen) :: longName    = ''              !--- Long name (with advection scheme suffix)
-    CHARACTER(LEN=maxlen) :: type        = 'tracer'        !--- Type  (so far: 'tracer' / 'tag')
-    CHARACTER(LEN=maxlen) :: phase       = 'g'             !--- Phase ('g'as / 'l'iquid / 's'olid)
-    CHARACTER(LEN=maxlen) :: component   = ''              !--- Coma-separated list of components (Ex: lmdz,inca)
-    INTEGER               :: iGeneration = -1              !--- Generation number (>=0)
-    INTEGER               :: iqParent    = 0               !--- Parent index
-    INTEGER,  ALLOCATABLE :: iqDescen(:)                   !--- Descendants index (in growing generation order)
-    INTEGER               :: nqDescen    = 0               !--- Number of descendants (all generations)
-    INTEGER               :: nqChildren  = 0               !--- Number of children  (first generation)
-    TYPE(keys_type)       :: keys                          !--- <key>=<val> pairs vector
-    INTEGER               :: iadv        = 10              !--- Advection scheme used
-    LOGICAL               :: isAdvected  = .FALSE.         !--- "true" tracers: iadv > 0.   COUNT(isAdvected )=nqtrue
-    LOGICAL               :: isInPhysics = .TRUE.          !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
-    INTEGER               :: iso_iGroup  = 0               !--- Isotopes group index in isotopes(:)
-    INTEGER               :: iso_iName   = 0               !--- Isotope  name  index in isotopes(iso_iGroup)%trac(:)
-    INTEGER               :: iso_iZone   = 0               !--- Isotope  zone  index in isotopes(iso_iGroup)%zone(:)
-    INTEGER               :: iso_iPhase  = 0               !--- Isotope  phase index in isotopes(iso_iGroup)%phase
+  TYPE :: trac_type                                             !=== TYPE FOR A SINGLE TRACER NAMED "name"
+    CHARACTER(LEN=maxlen) :: name        = ''                   !--- Name of the tracer
+    TYPE(keys_type)       :: keys                               !--- <key>=<val> pairs vector
+    CHARACTER(LEN=maxlen) :: gen0Name    = ''                   !--- First generation ancestor name
+    CHARACTER(LEN=maxlen) :: parent      = ''                   !--- Parent name
+    CHARACTER(LEN=maxlen) :: longName    = ''                   !--- Long name (with advection scheme suffix)
+    CHARACTER(LEN=maxlen) :: type        = 'tracer'             !--- Type  (so far: 'tracer' / 'tag')
+    CHARACTER(LEN=maxlen) :: phase       = 'g'                  !--- Phase ('g'as / 'l'iquid / 's'olid)
+    CHARACTER(LEN=maxlen) :: component   = ''                   !--- Coma-separated list of components (Ex: lmdz,inca)
+    INTEGER               :: iGeneration = -1                   !--- Generation number (>=0)
+    INTEGER               :: iqParent    = 0                    !--- Parent index
+    INTEGER,  ALLOCATABLE :: iqDescen(:)                        !--- Descendants index (in growing generation order)
+    INTEGER               :: nqDescen    = 0                    !--- Number of descendants (all generations)
+    INTEGER               :: nqChildren  = 0                    !--- Number of children  (first generation)
+    INTEGER               :: iadv        = 10                   !--- Advection scheme used
+    LOGICAL               :: isAdvected  = .FALSE.              !--- "true" tracers: iadv > 0.   COUNT(isAdvected )=nqtrue
+    LOGICAL               :: isInPhysics = .TRUE.               !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
+    INTEGER               :: iso_iGroup  = 0                    !--- Isotopes group index in isotopes(:)
+    INTEGER               :: iso_iName   = 0                    !--- Isotope  name  index in isotopes(iso_iGroup)%trac(:)
+    INTEGER               :: iso_iZone   = 0                    !--- Isotope  zone  index in isotopes(iso_iGroup)%zone(:)
+    INTEGER               :: iso_iPhase  = 0                    !--- Isotope  phase index in isotopes(iso_iGroup)%phase
   END TYPE trac_type
 !------------------------------------------------------------------------------------------------------------------------------
-  TYPE :: isot_type                                        !=== TYPE FOR AN ISOTOPES FAMILY DESCENDING ON TRACER "parent"
-    CHARACTER(LEN=maxlen)              :: parent           !--- Isotopes family name (parent tracer name ; ex: H2O)
-    LOGICAL                            :: check=.FALSE.    !--- Triggering of the checking routines
-    TYPE(keys_type),       ALLOCATABLE :: keys(:)          !--- Isotopes keys/values pairs list     (length: niso)
-    CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:)          !--- Isotopes + tagging tracers list     (length: ntiso)
-    CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:)          !--- Geographic tagging zones names list (length: nzone)
-    CHARACTER(LEN=maxlen)              :: phase = 'g'      !--- Phases list: [g][l][s]              (length: nphas)
-    INTEGER                            :: niso  = 0        !--- Number of isotopes, excluding tagging tracers
-    INTEGER                            :: nzone = 0        !--- Number of geographic tagging zones
-    INTEGER                            :: ntiso = 0        !--- Number of isotopes, including tagging tracers
-    INTEGER                            :: nphas = 0        !--- Number phases
-    INTEGER,               ALLOCATABLE :: iqIsoPha(:,:)    !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
-                                                           !---        "iqIsoPha" former name: "iqiso"
-    INTEGER,               ALLOCATABLE :: iqWIsoPha(:,:)   !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
-                                                           !---        "iqIsoPha" former name: "iqiso"
-    INTEGER,               ALLOCATABLE :: itZonIso(:,:)    !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
-                                                           !---        "itZonIso" former name: "index_trac"
-  END TYPE isot_type
+  TYPE :: isot_type                                             !=== TYPE FOR AN ISOTOPES FAMILY DESCENDING ON TRACER "parent"
+    CHARACTER(LEN=maxlen)              :: parent                !--- Isotopes family name (parent tracer name ; ex: H2O)
+    TYPE(keys_type),       ALLOCATABLE :: keys(:)               !--- Isotopes keys/values pairs list     (length: niso)
+    LOGICAL                            :: check=.FALSE.         !--- Flag for checking routines triggering
+    CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:)               !--- Isotopes + tagging tracers list     (length: ntiso)
+    CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:)               !--- Geographic tagging zones names list (length: nzone)
+    CHARACTER(LEN=maxlen)              :: phase = 'g'           !--- Phases list: [g][l][s]              (length: nphas)
+    INTEGER                            :: niso  = 0             !--- Number of isotopes, excluding tagging tracers
+    INTEGER                            :: ntiso = 0             !--- Number of isotopes, including tagging tracers
+    INTEGER                            :: nzone = 0             !--- Number of geographic tagging zones
+    INTEGER                            :: nphas = 0             !--- Number of phases
+    INTEGER,               ALLOCATABLE :: iqIsoPha(:,:)         !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
+                                                                !---        (former name: "iqiso"
+    INTEGER,               ALLOCATABLE :: iqWIsoPha(:,:)        !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
+                                                                !---        (former name: "?????")
+    INTEGER,               ALLOCATABLE :: itZonIso(:,:)         !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
+  END TYPE isot_type                                            !---        (former name: "index_trac")
 !------------------------------------------------------------------------------------------------------------------------------
   TYPE :: dataBase_type                                         !=== TYPE FOR TRACERS SECTION
-    CHARACTER(LEN=maxlen)  :: name                              !--- Section name
+    CHARACTER(LEN=maxlen) :: name                               !--- Section name
     TYPE(trac_type), ALLOCATABLE :: trac(:)                     !--- Tracers descriptors
   END TYPE dataBase_type
@@ -100 +99 @@
                      getKeyByName_l1, getKeyByName_l1m, getKeyByName_lm, getKey_lm
   END INTERFACE getKey
+!------------------------------------------------------------------------------------------------------------------------------
+  INTERFACE addKey
+    MODULE PROCEDURE addKey_s11, addKey_s1m, addKey_smm, addKey_i11, addKey_i1m, addKey_imm, &
+                     addKey_r11, addKey_r1m, addKey_rmm, addKey_l11, addKey_l1m, addKey_lmm
+  END INTERFACE addKey
 !------------------------------------------------------------------------------------------------------------------------------
   INTERFACE    isoSelect;  MODULE PROCEDURE  isoSelectByIndex,  isoSelectByName; END INTERFACE isoSelect
@@ -108 +112 @@
   INTERFACE idxAncestor;   MODULE PROCEDURE idxAncestor_1, idxAncestor_m, idxAncestor_mt;    END INTERFACE idxAncestor
   INTERFACE    ancestor;   MODULE PROCEDURE    ancestor_1,    ancestor_m,    ancestor_mt;    END INTERFACE    ancestor
-  INTERFACE      addKey;   MODULE PROCEDURE      addKey_1; END INTERFACE addKey!,      addKey_m,     addKey_mm;     END INTERFACE addKey
+  INTERFACE        addTracer; MODULE PROCEDURE   addTracer_1, addTracer_1def;                   END INTERFACE addTracer
+  INTERFACE        delTracer; MODULE PROCEDURE   delTracer_1, delTracer_1def;                   END INTERFACE delTracer
   INTERFACE    addPhase;   MODULE PROCEDURE   addPhase_s1,   addPhase_sm,   addPhase_i1,   addPhase_im; END INTERFACE addPhase
 !------------------------------------------------------------------------------------------------------------------------------
@@ -117 +122 @@
   !--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
   CHARACTER(LEN=maxlen), SAVE      :: tran0        = 'air'      !--- Default transporting fluid
-  CHARACTER(LEN=maxlen), PARAMETER :: old_phases   = 'vlirb'     !--- Old phases for water (no separator)
-  CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsrb'     !--- Known phases initials
+  CHARACTER(LEN=maxlen), PARAMETER :: old_phases   = 'vlirb'    !--- Old phases for water (no separator)
+  CHARACTER(LEN=maxlen), PARAMETER :: known_phases = 'glsrb'    !--- Known phases initials
   INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases)        !--- Number of phases
   CHARACTER(LEN=maxlen), SAVE      :: phases_names(nphases) &   !--- Known phases names
-                                = ['gaseous', 'liquid ', 'solid  ', 'cloud  ','blosno ']
-  CHARACTER(LEN=1), SAVE :: phases_sep  =  '_'                  !--- Phase separator
-  LOGICAL,          SAVE :: tracs_merge = .TRUE.                !--- Merge/stack tracers lists
-  LOGICAL,          SAVE :: lSortByGen  = .TRUE.                !--- Sort by growing generation
+                                = ['gaseous  ', 'liquid   ', 'solid    ', 'cloud    ','blownSnow']
+  CHARACTER(LEN=1),      SAVE :: phases_sep  =  '_'             !--- Phase separator
   CHARACTER(LEN=maxlen), SAVE :: isoFile = 'isotopes_params.def'!--- Name of the isotopes parameters file
 
@@ -131 +134 @@
   CHARACTER(LEN=maxlen), SAVE :: newH2OIso(5) = ['H216O', 'HDO  ', 'H218O', 'H217O', 'HTO  ']
 
-  !--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES
+  !--- CORRESPONDANCE BETWEEN OLD AND NEW HNO3 RELATED SPECIES NAMES (FOR REPROBUS)
   CHARACTER(LEN=maxlen), SAVE ::   oldHNO3(2) = ['HNO3_g ', 'HNO3   ']
   CHARACTER(LEN=maxlen), SAVE ::   newHNO3(2) = ['HNO3   ', 'HNO3tot']
@@ -141 +144 @@
   !=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso))
   TYPE(isot_type),         SAVE, POINTER :: isotope             !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
-  INTEGER,                 SAVE          :: ixIso, iH2O         !--- Index of the selected isotopes family and H2O family
+  INTEGER,                 SAVE          :: ixIso, iH2O=0       !--- Index of the selected isotopes family and H2O family
   INTEGER,                 SAVE          :: nbIso               !--- Number of isotopes classes
   LOGICAL,                 SAVE          :: isoCheck            !--- Flag to trigger the checking routines
@@ -151 +154 @@
                                             nphas, ntiso        !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
   INTEGER,                 SAVE, POINTER ::itZonIso(:,:), &     !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
-                                           iqIsoPha(:,:), &        !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
+                                           iqIsoPha(:,:), &     !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
                                            iqWIsoPha(:,:)       !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
+
+  !=== PARAMETERS FOR DEFAULT BEHAVIOUR
+  LOGICAL, PARAMETER :: lTracsMerge = .FALSE.                   !--- Merge/stack tracers lists
+  LOGICAL, PARAMETER :: lSortByGen  = .TRUE.                    !--- Sort by growing generation
 
   INTEGER,    PARAMETER :: maxTableWidth = 192                  !--- Maximum width of a table displayed with "dispTable"
@@ -231 +238 @@
         IF(ix /= 0 .AND. lRep) tname = newHNO3(ix)                   !--- Exception for HNO3 (REPROBUS ONLY)
         tracers(it)%name = tname                                     !--- Set %name
-        CALL addKey_1('name', tname, k)                              !--- Set the name of the tracer
+        CALL addKey_s11('name', tname, k)                            !--- Set the name of the tracer
         tracers(it)%keys%name = tname                                !--- Copy tracers names in keys components
 
@@ -238 +245 @@
         IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
         tracers(it)%component = cname                                !--- Set %component
-        CALL addKey_1('component', cname, k)                         !--- Set the name of the model component
+        CALL addKey_s11('component', cname, k)                       !--- Set the name of the model component
 
         !=== NAME OF THE PARENT
@@ -248 +255 @@
         END IF
         tracers(it)%parent = pname                                   !--- Set %parent
-        CALL addKey_1('parent', pname, k)
+        CALL addKey_s11('parent', pname, k)
 
         !=== PHASE AND ADVECTION SCHEMES NUMBERS
         tracers(it)%phase = known_phases(ip:ip)                      !--- Set %phase:  tracer phase (default: "g"azeous)
-        CALL addKey_1('phase', known_phases(ip:ip), k)               !--- Set the phase  of the tracer (default: "g"azeous)
-        CALL addKey_1('hadv', s(1),  k)                              !--- Set the horizontal advection schemes number
-        CALL addKey_1('vadv', s(2),  k)                              !--- Set the vertical   advection schemes number
+        CALL addKey_s11('phase', known_phases(ip:ip), k)             !--- Set the phase  of the tracer (default: "g"azeous)
+        CALL addKey_s11('hadv', s(1),  k)                            !--- Set the horizontal advection schemes number
+        CALL addKey_s11('vadv', s(2),  k)                            !--- Set the vertical   advection schemes number
       END DO
       CLOSE(90)
@@ -260 +267 @@
       WHERE(tracers%iGeneration == 2) tracers(:)%type = 'tag'        !--- Set %type:        'tracer' or 'tag'
       DO it=1,ntrac
-        CALL addKey_1('type', tracers(it)%type, tracers(it)%keys)    !--- Set the type of tracer
+        CALL addKey_s11('type', tracers(it)%type, tracers(it)%keys)  !--- Set the type of tracer
       END DO
       IF(test(checkTracers(tracers, fname, fname), lerr)) RETURN     !--- Detect orphans and check phases
@@ -276 +283 @@
   IF(nsec  == 1) THEN; 
     tracers = dBase(1)%trac
-  ELSE IF(tracs_merge) THEN
+  ELSE IF(lTracsMerge) THEN
     CALL msg('The multiple required sections will be MERGED.',    modname)
     IF(test(mergeTracers(dBase, tracers), lerr)) RETURN
@@ -435 +442 @@
       ll = strParse(str,' ', s, n, v)                                !--- Parse <key>=<val> pairs
       tt = dBase(ndb)%trac(:)
-      tmp%name = s(1); tmp%keys = keys_type(s(1), s(2:n), v(2:n))    !--- Set %name and %keys
+      v(1) = s(1); s(1) = 'name'                                     !--- Convert "name" into a regular key
+      tmp%name = v(1); tmp%keys = keys_type(v(1), s(:), v(:))        !--- Set %name and %keys
       dBase(ndb)%trac = [tt(:), tmp]
       DEALLOCATE(tt)
-!      dBase(ndb)%trac = [dBase(ndb)%trac(:), tra(name=s(1), keys=keys_type(s(1), s(2:n), v(2:n)))]
     END IF
   END DO
@@ -465 +472 @@
   DO k = 1, SIZE(ky%key)                                             !--- Loop on the keys of the tracer named "defName"
 !   CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys, .FALSE.)           !--- Add key to all the tracers (no overwriting)
-    DO it = 1, SIZE(t); CALL addKey_1(ky%key(k), ky%val(k), t(it)%keys, .FALSE.); END DO
+    DO it = 1, SIZE(t); CALL addKey_s11(ky%key(k), ky%val(k), t(it)%keys, .FALSE.); END DO
   END DO
   tt = [t(1:jd-1),t(jd+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t)   !--- Remove the virtual tracer named "defName"
@@ -528 +535 @@
     tr(it)%type      = fgetKey(it, 'type'  , tr(:)%keys, 'tracer')
     tr(it)%component = sname
-!   CALL addKey_m('component', sname, tr(:)%keys)
-    DO iq=1,SIZE(tr); CALL addKey_1('component', sname, tr(iq)%keys); END DO
+!   CALL addKey_s1m('component', sname, tr(:)%keys)
+    DO iq=1,SIZE(tr); CALL addKey_s11('component', sname, tr(iq)%keys); END DO
 
     !--- Determine the number of tracers and parents ; coherence checking
@@ -558 +565 @@
         ttr(iq)%keys%val  = tr(it)%keys%val
         ttr(iq)%keys%name = ta(itr)
-        ttr(iq)%name      = TRIM(ta(itr));    CALL addKey_1('name',      ta(itr),          ttr(iq)%keys)
-        ttr(iq)%parent    = TRIM(pa(ipr));    CALL addKey_1('parent',    pa(ipr),          ttr(iq)%keys)
-        ttr(iq)%type      = tr(it)%type;      CALL addKey_1('type',      tr(it)%type,      ttr(iq)%keys)
-        ttr(iq)%component = tr(it)%component; CALL addKey_1('component', tr(it)%component, ttr(iq)%keys)
+        ttr(iq)%name      = TRIM(ta(itr));    CALL addKey_s11('name',      ta(itr),          ttr(iq)%keys)
+        ttr(iq)%parent    = TRIM(pa(ipr));    CALL addKey_s11('parent',    pa(ipr),          ttr(iq)%keys)
+        ttr(iq)%type      = tr(it)%type;      CALL addKey_s11('type',      tr(it)%type,      ttr(iq)%keys)
+        ttr(iq)%component = tr(it)%component; CALL addKey_s11('component', tr(it)%component, ttr(iq)%keys)
         iq = iq+1
       END DO
@@ -597 +604 @@
       ig = ig + 1
     END DO
-    tr(iq)%gen0Name = tr(jq)%name; CALL addKey_1('gen0Name',    tr(iq)%gen0Name,   tr(iq)%keys)
-    tr(iq)%iGeneration = ig;       CALL addKey_1('iGeneration', TRIM(int2str(ig)), tr(iq)%keys)
+    tr(iq)%gen0Name = tr(jq)%name; CALL addKey_s11('gen0Name',    tr(iq)%gen0Name,   tr(iq)%keys)
+    tr(iq)%iGeneration = ig;       CALL addKey_s11('iGeneration', TRIM(int2str(ig)), tr(iq)%keys)
   END DO
 END FUNCTION setGeneration
@@ -723 +730 @@
         ttr(it)%keys%name = TRIM(nam)                                !--- Name inside the keys decriptor
         ttr(it)%phase     = p                                        !--- Single phase entry
-        CALL addKey_1('name', nam, ttr(it)%keys)
-        CALL addKey_1('phase', p,  ttr(it)%keys)
+        CALL addKey_s11('name', nam, ttr(it)%keys)
+        CALL addKey_s11('phase', p,  ttr(it)%keys)
         IF(lExt .AND. tr(iq)%iGeneration>0) THEN
           ttr(it)%parent   = addPhase(tr(iq)%parent,   p)
           ttr(it)%gen0Name = addPhase(tr(iq)%gen0Name, p)
-          CALL addKey_1('parent',   ttr(it)%parent,   ttr(it)%keys)
-          CALL addKey_1('gen0Name', ttr(it)%gen0Name, ttr(it)%keys)
+          CALL addKey_s11('parent',   ttr(it)%parent,   ttr(it)%keys)
+          CALL addKey_s11('gen0Name', ttr(it)%gen0Name, ttr(it)%keys)
         END IF
         it = it+1
@@ -1001 +1008 @@
   INTEGER :: iq, ig, igen, ngen, ix(SIZE(tr))
   tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent )                !--- Parent index
-  DO iq = 1, SIZE(tr); CALL addKey_1('iqParent', int2str(tr(iq)%iqParent), tr(iq)%keys); END DO
+  DO iq = 1, SIZE(tr); CALL addKey_s11('iqParent', int2str(tr(iq)%iqParent), tr(iq)%keys); END DO
   ngen = MAXVAL(tr(:)%iGeneration, MASK=.TRUE.)
   DO iq = 1, SIZE(tr)
@@ -1013 +1020 @@
       IF(igen == ig+1) THEN
         tr(iq)%nqChildren = tr(iq)%nqDescen
-        CALL addKey_1('nqChildren', int2str(tr(iq)%nqChildren), tr(iq)%keys)
+        CALL addKey_s11('nqChildren', int2str(tr(iq)%nqChildren), tr(iq)%keys)
       END IF
     END DO
-    CALL addKey_1('iqDescen', strStack(int2str(tr(iq)%iqDescen)), tr(iq)%keys)
-    CALL addKey_1('nqDescen',          int2str(tr(iq)%nqDescen) , tr(iq)%keys)
+    CALL addKey_s11('iqDescen', strStack(int2str(tr(iq)%iqDescen)), tr(iq)%keys)
+    CALL addKey_s11('nqDescen',          int2str(tr(iq)%nqDescen) , tr(iq)%keys)
   END DO
 END SUBROUTINE indexUpdate
@@ -1303 +1310 @@
 !=== ADD THE <key>=<val> PAIR TO THE "ky[(:)]" KEY[S] DESCRIPTOR[S] OR THE <key>=<val(:)> PAIRS TO THE "ky(:)" KEYS DESCRIPTORS
 !==============================================================================================================================
-SUBROUTINE addKey_1(key, val, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key, val
+SUBROUTINE addKey_s11(key, sval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key, sval
   TYPE(keys_type),   INTENT(INOUT) :: ky
   LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
@@ -1314 +1321 @@
   IF(.NOT.ALLOCATED(ky%key)) THEN
     ALLOCATE(ky%key(1)); ky%key(1)=key
-    ALLOCATE(ky%val(1)); ky%val(1)=val
+    ALLOCATE(ky%val(1)); ky%val(1)=sval
     RETURN
   END IF
@@ -1320 +1327 @@
   IF(iky == 0) THEN
     nky = SIZE(ky%key)
-    ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key; ky%key = k
-    ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = val; ky%val = v
+    ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = key;  ky%key = k
+    ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = sval; ky%val = v
   ELSE IF(lo) THEN
-    ky%key(iky) = key; ky%val(iky) = val
+    ky%key(iky) = key; ky%val(iky) = sval
   END IF
-END SUBROUTINE addKey_1
-!==============================================================================================================================
-SUBROUTINE addKey_m(key, val, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key, val
+END SUBROUTINE addKey_s11
+!==============================================================================================================================
+SUBROUTINE addKey_i11(key, ival, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  INTEGER,           INTENT(IN)    :: ival
+  TYPE(keys_type),   INTENT(INOUT) :: ky
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  CALL addKey_s11(key, int2str(ival), ky, lOverWrite)
+END SUBROUTINE addKey_i11
+!==============================================================================================================================
+SUBROUTINE addKey_r11(key, rval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  REAL,              INTENT(IN)    :: rval
+  TYPE(keys_type),   INTENT(INOUT) :: ky
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  CALL addKey_s11(key, real2str(rval), ky, lOverWrite)
+END SUBROUTINE addKey_r11
+!==============================================================================================================================
+SUBROUTINE addKey_l11(key, lval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  LOGICAL,           INTENT(IN)    :: lval
+  TYPE(keys_type),   INTENT(INOUT) :: ky
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  CALL addKey_s11(key, bool2str(lval), ky, lOverWrite)
+END SUBROUTINE addKey_l11
+!==============================================================================================================================
+!==============================================================================================================================
+SUBROUTINE addKey_s1m(key, sval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key, sval
   TYPE(keys_type),   INTENT(INOUT) :: ky(:)
   LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
@@ -1334 +1369 @@
   INTEGER :: itr
   DO itr = 1, SIZE(ky)
-    CALL addKey_1(key, val, ky(itr), lOverWrite)
-  END DO
-END SUBROUTINE addKey_m
-!==============================================================================================================================
-SUBROUTINE addKey_mm(key, val, ky, lOverWrite)
-  CHARACTER(LEN=*),  INTENT(IN)    :: key, val(:)
+    CALL addKey_s11(key, sval, ky(itr), lOverWrite)
+  END DO
+END SUBROUTINE addKey_s1m
+!==============================================================================================================================
+SUBROUTINE addKey_i1m(key, ival, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  INTEGER,           INTENT(IN)    :: ival
   TYPE(keys_type),   INTENT(INOUT) :: ky(:)
   LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
 !------------------------------------------------------------------------------------------------------------------------------
   INTEGER :: itr
-  DO itr = 1, SIZE(ky); CALL addKey_1(key, val(itr), ky(itr), lOverWrite); END DO
-END SUBROUTINE addKey_mm
+  DO itr = 1, SIZE(ky)
+    CALL addKey_s11(key, int2str(ival), ky(itr), lOverWrite)
+  END DO
+END SUBROUTINE addKey_i1m
+!==============================================================================================================================
+SUBROUTINE addKey_r1m(key, rval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  REAL,              INTENT(IN)    :: rval
+  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: itr
+  DO itr = 1, SIZE(ky)
+    CALL addKey_s11(key, real2str(rval), ky(itr), lOverWrite)
+  END DO
+END SUBROUTINE addKey_r1m
+!==============================================================================================================================
+SUBROUTINE addKey_l1m(key, lval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  LOGICAL,           INTENT(IN)    :: lval
+  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: itr
+  DO itr = 1, SIZE(ky)
+    CALL addKey_s11(key, bool2str(lval), ky(itr), lOverWrite)
+  END DO
+END SUBROUTINE addKey_l1m
+!==============================================================================================================================
+!==============================================================================================================================
+SUBROUTINE addKey_smm(key, sval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key, sval(:)
+  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: itr
+  DO itr = 1, SIZE(ky); CALL addKey_s11(key, sval(itr), ky(itr), lOverWrite); END DO
+END SUBROUTINE addKey_smm
+!==============================================================================================================================
+SUBROUTINE addKey_imm(key, ival, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  INTEGER,           INTENT(IN)    :: ival(:)
+  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: itr
+  DO itr = 1, SIZE(ky); CALL addKey_s11(key, int2str(ival(itr)), ky(itr), lOverWrite); END DO
+END SUBROUTINE addKey_imm
+!==============================================================================================================================
+SUBROUTINE addKey_rmm(key, rval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  REAL,              INTENT(IN)    :: rval(:)
+  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: itr
+  DO itr = 1, SIZE(ky); CALL addKey_s11(key, real2str(rval(itr)), ky(itr), lOverWrite); END DO
+END SUBROUTINE addKey_rmm
+!==============================================================================================================================
+SUBROUTINE addKey_lmm(key, lval, ky, lOverWrite)
+  CHARACTER(LEN=*),  INTENT(IN)    :: key
+  LOGICAL,           INTENT(IN)    :: lval(:)
+  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
+  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
+!------------------------------------------------------------------------------------------------------------------------------
+  INTEGER :: itr
+  DO itr = 1, SIZE(ky); CALL addKey_s11(key, bool2str(lval(itr)), ky(itr), lOverWrite); END DO
+END SUBROUTINE addKey_lmm
 !==============================================================================================================================
 
@@ -1362 +1464 @@
   DO ik = 1, SIZE(t(jd)%keys%key)
     CALL get_in(t(jd)%keys%key(ik), val, '*none*')
-    IF(val /= '*none*') CALL addKey_1(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
+    IF(val /= '*none*') CALL addKey_s11(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
   END DO
 END SUBROUTINE addKeysFromDef
@@ -1821 +1923 @@
 
 !==============================================================================================================================
+!=== APPEND TRACERS DATABASE "tracs" WITH TRACERS/KEYS "tname"/"keys" ; SAME FOR INTERNAL DATABASE "tracers" ==================
+!==============================================================================================================================
+SUBROUTINE addTracer_1(tname, keys, tracs)
+  CHARACTER(LEN=*),             INTENT(IN)    :: tname
+  TYPE(keys_type),              INTENT(IN)    ::  keys
+  TYPE(trac_type), ALLOCATABLE, INTENT(INOUT) :: tracs(:)
+  TYPE(trac_type), ALLOCATABLE :: tr(:)
+  INTEGER :: nt, ix
+  IF(ALLOCATED(tracs)) THEN
+     nt = SIZE(tracs)
+     ix = strIdx(tracs(:)%name, tname)
+     CALL msg('Modifying existing tracer "'//TRIM(tname)//'"', modname, ix /= 0)
+     CALL msg('Appending with tracer "'    //TRIM(tname)//'"', modname, ix == 0)
+     IF(ix == 0) THEN
+        ix = nt+1; ALLOCATE(tr(nt+1)); tr(1:nt) = tracs(1:nt); CALL MOVE_ALLOC(FROM=tr, TO=tracs)
+     END IF
+  ELSE
+     CALL msg('Creating a tracer descriptor with tracer "'//TRIM(tname)//'"', modname)
+     ix = 1; ALLOCATE(tracs(1))
+  END IF
+  tracs(ix)%name = tname
+  tracs(ix)%keys = keys
+END SUBROUTINE addTracer_1
+!==============================================================================================================================
+SUBROUTINE addTracer_1def(tname, keys)
+  CHARACTER(LEN=*),             INTENT(IN)    :: tname
+  TYPE(keys_type),              INTENT(IN)    ::  keys
+  CALL addTracer_1(tname, keys, tracers)
+END SUBROUTINE addTracer_1def
+!==============================================================================================================================
+
+
+!==============================================================================================================================
+LOGICAL FUNCTION delTracer_1(tname, tracs)  RESULT(lerr)
+  CHARACTER(LEN=*),                     INTENT(IN)    :: tname
+  TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: tracs(:)
+  TYPE(trac_type), ALLOCATABLE :: tr(:)
+  INTEGER :: nt, ix
+  lerr = .NOT.ALLOCATED(tracs)
+  IF(fmsg('Can''t remove tracer "'//TRIM(tname)//'" from an empty tracers descriptor', modname, lerr)) RETURN
+  nt = SIZE(tracs)
+  ix = strIdx(tracs(:)%name, tname)
+  CALL msg('Removing tracer "'             //TRIM(tname)//'"', modname, ix /= 0)
+  CALL msg('Can''t remove unknown tracer "'//TRIM(tname)//'"', modname, ix == 0)
+  IF(ix /= 0) THEN
+     ALLOCATE(tr(nt-1)); tr(1:ix-1) = tracs(1:ix-1); tr(ix:nt-1) = tracs(ix+1:nt); CALL MOVE_ALLOC(FROM=tr, TO=tracs)
+  END IF
+END FUNCTION delTracer_1
+!==============================================================================================================================
+LOGICAL FUNCTION delTracer_1def(tname) RESULT(lerr)
+  CHARACTER(LEN=*), INTENT(IN) :: tname
+  lerr = delTracer(tname, tracers)
+END FUNCTION delTracer_1def
+!==============================================================================================================================
+
+
+!==============================================================================================================================
 !=== GET PHASE INDEX IN THE POSSIBLE PHASES LIST OR IN A SPECIFIED LIST ("phases") ============================================
 !==============================================================================================================================

LMDZ6/trunk/libf/misc/strings_mod.F90

@@ -1341 +1341 @@
 !=== Convert a string into a logical/integer integer or an integer/real into a string =========================================
 !==============================================================================================================================
-ELEMENTAL LOGICAL FUNCTION str2bool(str) RESULT(out)
+ELEMENTAL INTEGER FUNCTION str2bool(str) RESULT(out)  !--- Result: 0/1 for .FALSE./.TRUE., -1 if not a valid boolean
+  IMPLICIT NONE
   CHARACTER(LEN=*), INTENT(IN) :: str
   INTEGER :: ierr
-  READ(str,*,IOSTAT=ierr) out
-  IF(ierr==0) RETURN
-  out = ANY(['t     ','true  ','.true.','y     ','yes   ']==strLower(str))
+  LOGICAL :: lout
+  READ(str,*,IOSTAT=ierr) lout
+  out = -HUGE(1)
+  IF(ierr /= 0) THEN
+    IF(ANY(['.false.', 'false  ', 'no     ', 'f      ', 'n      '] == strLower(str))) out = 0
+    IF(ANY(['.true. ', 'true   ', 'yes    ', 't      ', 'y      '] == strLower(str))) out = 1
+  ELSE
+    out = 0; IF(lout) out = 1
+  END IF
 END FUNCTION str2bool
 !==============================================================================================================================