Changeset 4068

Timestamp:

Jan 29, 2022, 7:22:11 PM (2 years ago)

Author:

dcugnet

Message:

FIx for last version: function version of strReduce crashes with gfortran (but not for ifort) => back to subroutine version.

Location:

LMDZ6/trunk/libf

Files:

• dyn3d_common/infotrac.F90 (modified) (2 diffs)
• misc/strings_mod.F90 (modified) (3 diffs)

LMDZ6/trunk/libf/dyn3d_common/infotrac.F90

@@ -3 +3 @@
 MODULE infotrac
 
-   USE       strings_mod, ONLY: msg, find, strIdx,  strFind, strParse, dispTable,  int2str,  reduceExpr, &
-                          cat, fmsg, test, strTail, strHead, strStack, strReducef, bool2str, maxlen, testFile
+   USE       strings_mod, ONLY: msg, find, strIdx,  strFind, strParse, dispTable, int2str,  reduceExpr,  &
+                          cat, fmsg, test, strTail, strHead, strStack, strReduce, bool2str, maxlen, testFile
    USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, addPhase,  phases_sep,  nphases, ancestor,  &
                                 isot_type, readIsotopesFile, delPhase,   old_phases, getKey_init, tran0, &
@@ -823 +823 @@
    ALLOCATE(i%keys(i%niso))
    mask = t%type=='tracer' .AND. delPhase(t%gen0Name)=='H2O' .AND. t%phase == 'g' .AND. t%iGeneration==1
-   i%keys(:)%name = strReducef(strTail(PACK(delPhase(t%name), MASK = mask), '_'))
+   str = strTail(PACK(delPhase(t%name), MASK=mask), '_')
+   CALL strReduce(str)
+   i%keys(:)%name = str
 
    !--- Full isotopes list, with isotopes tagging tracers (if any) following the previous list
-   i%ntiso = ntiso; ALLOCATE(i%trac(i%ntiso))
+   i%ntiso = ntiso
+   ALLOCATE(i%trac(i%ntiso))
    mask = t%type=='tag'    .AND. delPhase(t%gen0Name)=='H2O' .AND. t%phase == 'g' .AND. t%iGeneration==2
-   i%trac(:) = [i%keys(:)%name, strReducef(PACK(delPhase(t%name), MASK = mask))]
+   str = PACK(delPhase(t%name), MASK=mask)
+   CALL strReduce(str)
+   i%trac(:) = [i%keys(:)%name, str]
 
    !--- Tagging zones names list

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,  strReduce,  strClean, strFind,  strIdx, find
-  PUBLIC :: strUpper, strTail, strStackm, strReducef, strParse, strCount, strReplace, cat
+  PUBLIC :: strLower, strHead, strStack,  strCount, strReduce,  strClean, strIdx
+  PUBLIC :: strUpper, strTail, strStackm, strParse, strReplace, strFind, find, cat
   PUBLIC :: dispTable, dispOutliers, dispNameList
   PUBLIC :: is_numeric, bool2str, int2str, real2str, dble2str
@@ -347 +347 @@
   INTEGER,          OPTIONAL,    INTENT(OUT)   :: nb
   CHARACTER(LEN=maxlen), ALLOCATABLE :: s1(:)
-  INTEGER :: n
-  s1 = strReducef(str, n); CALL MOVE_ALLOC(FROM=s1, TO=str)
-  IF(PRESENT(nb)) nb = n
+  INTEGER :: k, n, n1
+  IF(PRESENT(nb)) nb = 0
+  CALL MOVE_ALLOC(FROM=str, 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(str(n))
+  IF(n==0) RETURN
+  str(1) = s1(1)
+  n=1; DO k=1,n1; IF(ANY(s1(1:k-1)==s1(k))) CYCLE; n=n+1; str(n)=s1(k); END DO
+  IF(PRESENT(nb)) nb=n
 END SUBROUTINE strReduce_1
 !==============================================================================================================================
@@ -370 +377 @@
   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
 !==============================================================================================================================