Changeset 3957 for LMDZ6/branches/LMDZ-tracers/libf/misc

Timestamp:

Jul 11, 2021, 11:39:01 PM (3 years ago)

Author:

dcugnet

Message:

In readTracFiles: the separator between the tracer name and its phase is no longer hardcoded and equal to "-",
but is a parameter ("phases_sep") which default value is "_".
Few more fixes.

Location:

LMDZ6/branches/LMDZ-tracers/libf/misc

Files:

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

LMDZ6/branches/LMDZ-tracers/libf/misc/readTracFiles_mod.f90

@@ -14 +14 @@
   PUBLIC :: getKey_init, getKey, setDirectKeys                            !--- FUNCTIONS TO GET KEYS FROM tracers & isotopes
 
-  PUBLIC :: known_phases, nphases, phases_names, delPhase, addPhase       !--- PHASES RELATED VARIABLES AND ROUTINES
+  PUBLIC :: known_phases, old_phases, nphases, phases_names, phases_sep, &!--- VARIABLES RELATED TO THE PHASES
+            delPhase, addPhase                                            !--- ROUTINES TO ADD/REMOVE PHASE TO/FROM A NAME
 
   PUBLIC :: tran0, idxAncestor, ancestor                                  !--- GEN 0 TRACER + TOOLS FOR GENERATIONS
@@ -34 +35 @@
   !--- SOME PARAMETERS THAT ARE NOT LIKELY TO CHANGE OFTEN
   CHARACTER(LEN=256), SAVE      :: tran0        = 'air'              !--- Default transporting fluid
+  CHARACTER(LEN=256), PARAMETER :: old_phases   = 'vli'              !--- Old phases for water (no separator)
   CHARACTER(LEN=256), PARAMETER :: known_phases = 'gls'              !--- Known phases initials
   INTEGER,            PARAMETER :: nphases = LEN_TRIM(known_phases)  !--- Number of phases
   CHARACTER(LEN=256), SAVE      :: phases_names(nphases) &           !--- Known phases names
                                  = ['gaseous', 'liquid ', 'solid  ']
+  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
@@ -79 +82 @@
   CHARACTER(LEN=256),     ALLOCATABLE ::  s(:), sections(:), trac_files(:)
   CHARACTER(LEN=256)   :: str, fname, mesg
-  INTEGER              :: is, nsec, ierr, it, ntrac, ns
+  INTEGER              :: is, nsec, ierr, it, ntrac, ns, ip
   LOGICAL, ALLOCATABLE :: ll(:), lGen3(:)
 !------------------------------------------------------------------------------------------------------------------------------
@@ -97 +100 @@
   IF(.NOT.testFile('traceur.def') .AND. nsec==1) fType = 1           !--- OLD STYLE FILE
   IF(.NOT.testFile('tracer.def'))                fType = 2           !--- NEW STYLE ; SINGLE  FILE, SEVERAL SECTIONS
-  IF(ALL(ll))                               fType = 3                !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
+  IF(ALL(ll))                                    fType = 3           !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
   IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
     IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
@@ -129 +132 @@
       CALL msg(ns == 3 .AND. it == 1, 'This file is for air tracers only')
       CALL msg(ns == 4 .AND. it == 1, 'This files specifies the transporting fluid')
-      SELECT CASE(s(3))                                              !--- name and phase of the tracer
-        CASE('H2Ov'); tracs(it)%name = 'H2O-g'; tracs(it)%phas = 'g'
-        CASE('H2Ol'); tracs(it)%name = 'H2O-l'; tracs(it)%phas = 'l'
-        CASE('H2Oi'); tracs(it)%name = 'H2O-s'; tracs(it)%phas = 's'
-        CASE DEFAULT; tracs(it)%name = s(3)   ; tracs(it)%phas = 'g'
-      END SELECT
+      tracs(it)%name = s(3); tracs(it)%phas = known_phases(1:1)      !--- Default: name, gazeous phase "g"
+      DO ip = 1, nphases                                             !--- Deal with old water names
+        IF(s(3) /= 'H2O'//old_phases(ip:ip)) CYCLE
+        tracs(it)%phas = known_phases(ip:ip); tracs(it)%name = 'H2O'//phases_sep//TRIM(tracs(it)%phas)
+      END DO
       tracs(it)%prnt = tran0                                         !--- Default transporting fluid: Air
       IF(ns == 4) tracs(it)%prnt = s(4)                              !--- Transporting fluid name
@@ -549 +551 @@
         trn=TRIM(tr(iq)%name); nam=trn                               !--- Tracer name (regular case)
         IF(lTg) nam = TRIM(tr(iq)%prnt)                              !--- Parent name (tagging case)
-        IF(lEx) nam = TRIM(nam)//'-'//pha(ip:ip)                     !--- Phase extension needed
+        IF(lEx) nam = TRIM(nam)//phases_sep//pha(ip:ip)              !--- Phase extension needed
         IF(lTg) nam = TRIM(nam)//'_'//TRIM(trn)                      !--- <parent>_<name> for tags
         ttr(it) = tr(iq)                                             !--- Same <key>=<val> pairs
@@ -556 +558 @@
         ttr(it)%phas = pha(ip:ip)                                    !--- Single phase entry
         IF(lEx.AND.tr(iq)%igen>1) THEN
-          ttr(it)%prnt = TRIM(ttr(it)%prnt)//'-'//pha(ip:ip)
-          ttr(it)%nam1 = TRIM(ttr(it)%nam1)//'-'//pha(ip:ip)
+          ttr(it)%prnt = TRIM(ttr(it)%prnt)//phases_sep//pha(ip:ip)
+          ttr(it)%nam1 = TRIM(ttr(it)%nam1)//phases_sep//pha(ip:ip)
         END IF
         it=it+1
@@ -698 +700 @@
       tnam = t1(iq)%name                                             !--- Original name
       IF(COUNT(t1%name == tnam) == 1) CYCLE                          !--- Current tracer is not duplicated: finished
-      tnam_new = TRIM(tnam)//'-'//TRIM(sections(is)%name)            !--- Same with section extension
+      tnam_new = TRIM(tnam)//phases_sep//TRIM(sections(is)%name)     !--- Same with section extension
       nq = SUM(nt(1:is-1))                                           !--- Number of tracers in previous sections
       ns = nt(is)                                                    !--- Number of tracers in the current section
@@ -1231 +1233 @@
   i = INDEX(s, '_'); l = LEN_TRIM(s)
   IF(i == 0) THEN
-    IF(s(l-1:l-1)=='-' .AND. INDEX(known_phases,s(l:l)) /= 0) out = s(1:l-2)
+    IF(s(l-1:l-1)==phases_sep .AND. INDEX(known_phases,s(l:l)) /= 0) out = s(1:l-2)
   ELSE; i=i-1
-    IF(s(i-1:i-1)=='-' .AND. INDEX(known_phases,s(i:i)) /= 0) out = s(1:i-2)//s(i+1:l)
+    IF(s(i-1:i-1)==phases_sep .AND. INDEX(known_phases,s(i:i)) /= 0) out = s(1:i-2)//s(i+1:l)
   END IF
 END FUNCTION delPhase
@@ -1244 +1246 @@
   IF(s == '') RETURN
   i = INDEX(s, '_'); l = LEN_TRIM(s)
-  IF(i == 0) out =  TRIM(s)//'-'//pha
-  IF(i /= 0) out = s(1:i-1)//'-'//pha//'_'//s(i+1:l)
+  IF(i == 0) out =  TRIM(s)//phases_sep//pha
+  IF(i /= 0) out = s(1:i-1)//phases_sep//pha//'_'//s(i+1:l)
 END FUNCTION addPhase_1
 !------------------------------------------------------------------------------------------------------------------------------

LMDZ6/branches/LMDZ-tracers/libf/misc/strings_mod.F90

@@ -186 +186 @@
 
 !==============================================================================================================================
-!=== Extract first or last element of a string "str" delimited by separator "sep" =============================================
-!==============================================================================================================================
-CHARACTER(LEN=256) FUNCTION strHead_1(str,sep) RESULT(out)
+!=== Extract the substring in front of the last (first if lFirst==TRUE) occurrence of separator "sep" in "str" ================
+!==============================================================================================================================
+CHARACTER(LEN=256) FUNCTION strHead_1(str,sep,lFirst) RESULT(out)
   CHARACTER(LEN=*),           INTENT(IN) :: str
   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
+  LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
+  LOGICAL :: lf
+  lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
   IF(PRESENT(sep)) THEN
-    out = str(1:INDEX(str,sep,.TRUE.)-1)
+    out = str(1:INDEX(str,sep,.NOT.lf)-1)
   ELSE
-    out = str(1:INDEX(str,'/',.TRUE.)-1)
+    out = str(1:INDEX(str,'/',.NOT.lf)-1)
   END IF
   IF(out == '') out = str
 END FUNCTION strHead_1
 !==============================================================================================================================
-CHARACTER(LEN=256) FUNCTION strTail_1(str,sep) RESULT(out)
-  CHARACTER(LEN=*),           INTENT(IN) :: str
-  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
-  IF(PRESENT(sep)) THEN
-    out = str(INDEX(str,sep,.TRUE.)+LEN(sep):LEN_TRIM(str))
-  ELSE
-    out = str(INDEX(str,'/',.TRUE.)+1:LEN_TRIM(str))
-  END IF
-  IF(out == '') out = str
-END FUNCTION strTail_1
-!==============================================================================================================================
-FUNCTION strHead_m(str,sep) RESULT(out)
+FUNCTION strHead_m(str,sep,lFirst) RESULT(out)
   CHARACTER(LEN=256),        ALLOCATABLE :: out(:)
   CHARACTER(LEN=*),           INTENT(IN) :: str(:)
   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
+  LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
+  LOGICAL :: lf
   INTEGER :: k
+  lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
   IF(PRESENT(sep)) THEN
-    out = [(strHead_1(str(k),sep), k=1, SIZE(str))]
+    out = [(strHead_1(str(k),sep,.NOT.lf),    k=1, SIZE(str))]
   ELSE
-    out = [(strHead_1(str(k)),     k=1, SIZE(str))]
+    out = [(strHead_1(str(k),lFirst=.NOT.lf), k=1, SIZE(str))]
   END IF
 
 END FUNCTION strHead_m
 !==============================================================================================================================
-FUNCTION strTail_m(str,sep) RESULT(out)
+!=== Extract the substring following the last (first if lFirst==TRUE) occurrence of separator "sep" in "str" ==================
+!==============================================================================================================================
+CHARACTER(LEN=256) FUNCTION strTail_1(str,sep,lFirst) RESULT(out)
+  CHARACTER(LEN=*),           INTENT(IN) :: str
+  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
+  LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
+  LOGICAL :: lf
+  lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
+  IF(PRESENT(sep)) THEN
+    out = str(INDEX(str,sep,.NOT.lf)+LEN(sep):LEN_TRIM(str))
+  ELSE
+    out = str(INDEX(str,'/',.NOT.lf)+1:LEN_TRIM(str))
+  END IF
+  IF(out == '') out = str
+END FUNCTION strTail_1
+!==============================================================================================================================
+FUNCTION strTail_m(str,sep,lFirst) RESULT(out)
   CHARACTER(LEN=256),        ALLOCATABLE :: out(:)
   CHARACTER(LEN=*),           INTENT(IN) :: str(:)
   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep
+  LOGICAL,          OPTIONAL, INTENT(IN) :: lFirst
+  LOGICAL :: lf
   INTEGER :: k
+  lf = .FALSE.; IF(PRESENT(lFirst)) lf=lFirst
   IF(PRESENT(sep)) THEN
-    out = [(strTail_1(str(k),sep), k=1, SIZE(str))]
+    out = [(strTail_1(str(k),sep,.NOT.lf),    k=1, SIZE(str))]
   ELSE
-    out = [(strTail_1(str(k)),     k=1, SIZE(str))]
+    out = [(strTail_1(str(k),lFirst=.NOT.lf), k=1, SIZE(str))]
   END IF
 END FUNCTION strTail_m