Changeset 4067 for LMDZ6/trunk/libf/misc

Timestamp:

Jan 27, 2022, 8:47:29 PM (2 years ago)

Author:

dcugnet

Message:

Fixes mainly for isotopes (more to be done).
Fix (to be confirmed) in physiq to avoid attempting to send a non-transported (iadv==0) tracer to the physics.

Location:

LMDZ6/trunk/libf/misc

Files:

• readTracFiles_mod.f90 (modified) (3 diffs)
• strings_mod.F90 (modified) (3 diffs)

LMDZ6/trunk/libf/misc/readTracFiles_mod.f90

@@ -15 +15 @@
 
   PUBLIC :: known_phases, old_phases, nphases, phases_names, &       !--- VARIABLES RELATED TO THE PHASES
-            phases_sep, delPhase, addPhase                           !--- + ROUTINES TO ADD/REMOVE PHASE TO/FROM A NAME
+            phases_sep, delPhase, addPhase, &                        !--- + ROUTINES TO ADD/REMOVE PHASE TO/FROM A NAME
+            old2newPhase, new2oldPhase
 
   PUBLIC :: tran0, idxAncestor, ancestor                             !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
@@ -1255 +1256 @@
   CHARACTER(LEN=*), INTENT(IN) :: s
   INTEGER :: l, i, ix
+  CHARACTER(LEN=maxlen) :: sh, st
   out = s
   IF(s == '') RETURN                                                           !--- Empty string: nothing to do
 
   !--- Special case: old phases for water, no phases separator
-  IF(ANY([('H2O'//old_phases(ix:ix), ix=1, nphases)] == s)) THEN; out='H2O'; RETURN; END IF
+  i = INDEX(s,'_'); sh = s; IF(i/=0) sh=s(1:i-1); st='H2O'; IF(i/=0) st='H2O_'//s(i+1:LEN_TRIM(s))
+  IF(ANY([('H2O'//old_phases(ix:ix), ix=1, nphases)] == sh)) THEN; out=st; RETURN; END IF
 
   !--- Index of found phase in "known_phases"
@@ -1300 +1303 @@
 !------------------------------------------------------------------------------------------------------------------------------
 
+CHARACTER(LEN=1) FUNCTION old2newPhase(op) RESULT(np)
+  CHARACTER(LEN=1), INTENT(IN) :: op
+  np = known_phases(INDEX(old_phases,op):INDEX(old_phases,op))
+END FUNCTION old2newPhase
+
+CHARACTER(LEN=1) FUNCTION new2oldPhase(np) RESULT(op)
+  CHARACTER(LEN=1), INTENT(IN) :: np
+  op = old_phases(INDEX(known_phases,np):INDEX(known_phases,np))
+END FUNCTION new2oldPhase
 
 !==============================================================================================================================

LMDZ6/trunk/libf/misc/strings_mod.F90

@@ -5 +5 @@
   PRIVATE
   PUBLIC :: maxlen, init_printout, msg, fmsg, get_in, lunout, prt_level
-  PUBLIC :: strLower, strHead, strStack,  strClean,  strIdx,  strCount, strReplace
-  PUBLIC :: strUpper, strTail, strStackm, strReduce, strFind, strParse, cat, find
+  PUBLIC :: strLower, strHead, strStack,  strReduce,  strClean, strFind,  strIdx, find
+  PUBLIC :: strUpper, strTail, strStackm, strReducef, strParse, strCount, strReplace, cat
   PUBLIC :: dispTable, dispOutliers, dispNameList
   PUBLIC :: is_numeric, bool2str, int2str, real2str, dble2str
@@ -343 +343 @@
 !=== strReduce_2(str1,str2): Append str1 with new elements of str2. ===========================================================
 !==============================================================================================================================
-SUBROUTINE strReduce_1(str1, nb)
-  CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str1(:)
+SUBROUTINE strReduce_1(str, nb)
+  CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: str(:)
   INTEGER,          OPTIONAL,    INTENT(OUT)   :: nb
   CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:)
-  INTEGER :: k, n, n1
-  IF(PRESENT(nb)) nb = 0
-  CALL MOVE_ALLOC(FROM = str1, TO = s1); CALL strClean(s1)
-  n1 = SIZE(s1, DIM=1)                                     !--- Total nb of  elements in "s1"
-  n  = COUNT( [( ALL(s1(1:k-1)/=s1(k)), k=1, n1 )] )       !--- Nb of unique elements in "s1"
-  ALLOCATE(str1(n)); IF(n==0) RETURN; str1(1) = s1(1)
-  n=1; DO k=2,n1; IF(ANY(s1(1:k-1)==s1(k))) CYCLE; n=n+1; str1(n)=s1(k); END DO
+  INTEGER :: n
+  s1 = strReducef(str, n); CALL MOVE_ALLOC(FROM=s1, TO=str)
   IF(PRESENT(nb)) nb = n
 END SUBROUTINE strReduce_1
@@ -375 +370 @@
   END IF
 END SUBROUTINE strReduce_2
+!==============================================================================================================================
+FUNCTION strReducef(str_in, nb) RESULT(str_ou)
+  CHARACTER(LEN=*),           INTENT(IN)  :: str_in(:)
+  INTEGER,          OPTIONAL, INTENT(OUT) :: nb
+  CHARACTER(LEN=LEN(str_in)), ALLOCATABLE :: str_ou(:)
+  CHARACTER(LEN=LEN(str_in)), ALLOCATABLE :: s1(:)
+  INTEGER :: k, n, n1
+  IF(PRESENT(nb)) nb = 0
+  s1 = str_in; CALL strClean(s1)
+  n1 = SIZE(s1, DIM=1)                                     !--- Total nb of  elements in "s1"
+  n  = COUNT( [( ALL(s1(1:k-1)/=s1(k)), k=1, n1 )] )       !--- Nb of unique elements in "s1"
+  ALLOCATE(str_ou(n)); IF(n==0) RETURN; str_ou(1) = s1(1)
+  n=1; DO k=2,n1; IF(ANY(s1(1:k-1)==s1(k))) CYCLE; n=n+1; str_ou(n)=s1(k); END DO
+  IF(PRESENT(nb)) nb = n
+END FUNCTION strReducef
 !==============================================================================================================================