Index: LMDZ6/trunk/libf/misc/strings_mod.f90 =================================================================== --- LMDZ6/trunk/libf/misc/strings_mod.f90 (revision 5744) +++ LMDZ6/trunk/libf/misc/strings_mod.f90 (revision 5745) @@ -38,5 +38,4 @@ CONTAINS - !============================================================================================================================== SUBROUTINE init_printout(lunout_, prt_level_) @@ -177,9 +176,8 @@ !=== Lower/upper case conversion function. ==================================================================================== !============================================================================================================================== -ELEMENTAL FUNCTION strLower(str) RESULT(out) +ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strLower(str) RESULT(out) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: str INTEGER :: k - CHARACTER(LEN=maxlen) :: out out = str DO k=1,LEN_TRIM(str) @@ -188,9 +186,8 @@ END FUNCTION strLower !============================================================================================================================== -ELEMENTAL FUNCTION strUpper(str) RESULT(out) +ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION strUpper(str) RESULT(out) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: str INTEGER :: k - CHARACTER(LEN=maxlen) :: out out = str DO k=1,LEN_TRIM(str) @@ -207,10 +204,9 @@ !=== * strHead(..,.TRUE.) = 'a_b' ${str%$sep*} ================ !============================================================================================================================== - FUNCTION strHead_1(str, sep, lBackward) RESULT(out) +CHARACTER(LEN=maxlen) FUNCTION strHead_1(str, sep, lBackward) RESULT(out) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: str CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep LOGICAL, OPTIONAL, INTENT(IN) :: lBackward - CHARACTER(LEN=maxlen) :: out !------------------------------------------------------------------------------------------------------------------------------ IF(PRESENT(sep)) THEN @@ -246,10 +242,9 @@ !=== * strTail(str, '_', .TRUE.) = 'c' ${str##*$sep} ================ !============================================================================================================================== - FUNCTION strTail_1(str, sep, lBackWard) RESULT(out) +CHARACTER(LEN=maxlen) FUNCTION strTail_1(str, sep, lBackWard) RESULT(out) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: str CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: sep LOGICAL, OPTIONAL, INTENT(IN) :: lBackWard - CHARACTER(LEN=maxlen) :: out !------------------------------------------------------------------------------------------------------------------------------ IF(PRESENT(sep)) THEN @@ -412,8 +407,7 @@ !=== OPTIONALY: GET THE NUMBER OF FOUND ELEMENTS "n". NB: UNFOUND => INDEX=0 ============================ !============================================================================================================================== - FUNCTION strIdx_1(str, s) RESULT(out) +INTEGER FUNCTION strIdx_1(str, s) RESULT(out) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: str(:), s - INTEGER :: out DO out = 1, SIZE(str); IF(str(out) == s) EXIT; END DO IF(out == 1+SIZE(str) .OR. SIZE(str)==0) out = 0 @@ -482,5 +476,5 @@ FUNCTION booFind(l,n) RESULT(out) IMPLICIT NONE - LOGICAL, INTENT(IN) :: l(:) + LOGICAL, INTENT(IN) :: l(:) INTEGER, OPTIONAL, INTENT(OUT) :: n INTEGER, ALLOCATABLE :: out(:) @@ -498,5 +492,5 @@ !=== * THEN TEST WHETHER THE STRING FROM START TO THE FOUND SEPARATOR IS A CORRECTLY FORMATTED NUMBER !============================================================================================================================== - FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr) +LOGICAL FUNCTION strIdx_prv(rawList, del, ibeg, idx, idel, lSc) RESULT(lerr) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: rawList !--- String in which delimiters have to be identified @@ -505,7 +499,5 @@ INTEGER, INTENT(OUT) :: idx !--- Index of the first identified delimiter in "rawList" INTEGER, INTENT(OUT) :: idel !--- Index of the identified delimiter (0 if idx==0) - LOGICAL, OPTIONAL, INTENT(IN) :: lSc - LOGICAL :: lerr -!--- Care about nbs with front sign or in scient. notation + LOGICAL, OPTIONAL, INTENT(IN) :: lSc !--- Care about nbs with front sign or in scient. notation !------------------------------------------------------------------------------------------------------------------------------ INTEGER :: idx0 !--- Used to display an identified non-numeric string @@ -535,5 +527,5 @@ !------------------------------------------------------------------------------------------------------------------------------ - FUNCTION strIdx1(str, del, ib, id) RESULT(i) +INTEGER FUNCTION strIdx1(str, del, ib, id) RESULT(i) !--- Get the index of the first appereance of one of the delimiters "del(:)" in "str" starting from position "ib". !--- "id" is the index in "del(:)" of the first delimiter found. @@ -542,5 +534,4 @@ INTEGER, INTENT(IN) :: ib INTEGER, INTENT(OUT) :: id - INTEGER :: i !------------------------------------------------------------------------------------------------------------------------------ DO i = ib, LEN_TRIM(str); id = strIdx(del, str(i:i)); IF(id /= 0) EXIT; END DO @@ -555,5 +546,5 @@ !=== Count the number of elements separated by "delimiter" in list "rawList". ================================================= !============================================================================================================================== - FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr) +LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: rawList @@ -561,5 +552,4 @@ INTEGER, INTENT(OUT) :: nb LOGICAL, OPTIONAL, INTENT(IN) :: lSc - LOGICAL :: lerr !------------------------------------------------------------------------------------------------------------------------------ LOGICAL :: ll @@ -568,5 +558,5 @@ END FUNCTION strCount_11 !============================================================================================================================== - FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr) +LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: rawList(:) @@ -574,5 +564,4 @@ INTEGER, ALLOCATABLE, INTENT(OUT) :: nb(:) LOGICAL, OPTIONAL, INTENT(IN) :: lSc - LOGICAL :: lerr !------------------------------------------------------------------------------------------------------------------------------ LOGICAL :: ll @@ -586,5 +575,5 @@ END FUNCTION strCount_m1 !============================================================================================================================== - FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr) +LOGICAL FUNCTION strCount_1m(rawList, delimiter, nb, lSc) RESULT(lerr) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: rawList @@ -596,6 +585,4 @@ LOGICAL :: ll CHARACTER(LEN=1024) :: r - LOGICAL :: lerr - lerr = .FALSE. ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc @@ -619,5 +606,5 @@ !=== Corresponding "vals" remains empty if the element does not contain "=" sign. ==================================== !============================================================================================================================== - FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr) +LOGICAL FUNCTION strParse(rawList, delimiter, keys, n, vals) RESULT(lerr) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: rawList, delimiter @@ -625,5 +612,4 @@ INTEGER, OPTIONAL, INTENT(OUT) :: n CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: vals(:) - LOGICAL :: lerr !------------------------------------------------------------------------------------------------------------------------------ CHARACTER(LEN=1024) :: r @@ -640,8 +626,7 @@ !------------------------------------------------------------------------------------------------------------------------------ - FUNCTION countK() RESULT(nkeys) +INTEGER FUNCTION countK() RESULT(nkeys) !--- Get the number of elements after parsing. IMPLICIT NONE - INTEGER :: nkeys !------------------------------------------------------------------------------------------------------------------------------ INTEGER :: ib, ie, nl @@ -696,5 +681,5 @@ END FUNCTION strParse !============================================================================================================================== - FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr) +LOGICAL FUNCTION strParse_m(rawList, delimiter, keys, n, vals, lSc, id) RESULT(lerr) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: rawList, delimiter(:) @@ -704,5 +689,4 @@ LOGICAL, OPTIONAL, INTENT(IN) :: lSc !--- Take care about numbers in scientific notation INTEGER, OPTIONAL, ALLOCATABLE, INTENT(OUT) :: id(:) !--- Indexes of the separators in "delimiter(:)" vector - LOGICAL :: lerr !------------------------------------------------------------------------------------------------------------------------------ CHARACTER(LEN=1024) :: r @@ -1212,5 +1196,5 @@ !============================================================================================================================== - FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr) +LOGICAL FUNCTION dispNamelist(unt, p, titles, s, i, r, rFmt, llast) RESULT(lerr) IMPLICIT NONE INTEGER, INTENT(IN) :: unt !--- Output unit @@ -1222,5 +1206,4 @@ CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: rFmt !--- Format for reals LOGICAL, OPTIONAL, INTENT(IN) :: llast !--- Last variable: no final ',' - LOGICAL :: lerr !------------------------------------------------------------------------------------------------------------------------------ CHARACTER(LEN=maxlen) :: rFm, el @@ -1296,5 +1279,5 @@ !============================================================================================================================== - FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr) +LOGICAL FUNCTION dispOutliers_1(ll, a, n, err_msg, nam, subn, nRowmax, nColMax, nHead, unit) RESULT(lerr) IMPLICIT NONE ! Display outliers list in tables @@ -1308,5 +1291,4 @@ INTEGER, OPTIONAL, INTENT(IN) :: nHead !--- Number of front columns to duplicate (default: 1) INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (def: lunout) - LOGICAL :: lerr !------------------------------------------------------------------------------------------------------------------------------ CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:) @@ -1376,5 +1358,5 @@ END FUNCTION dispOutliers_1 !============================================================================================================================== - FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr) +LOGICAL FUNCTION dispOutliers_2(ll, a, n, err_msg, nam, subn, nRowMax, nColMax, nHead, unit) RESULT(lerr) IMPLICIT NONE ! Display outliers list in tables @@ -1388,5 +1370,4 @@ INTEGER, OPTIONAL, INTENT(IN) :: nHead !--- Number of front columns to duplicate (default: 1) INTEGER, OPTIONAL, INTENT(IN) :: unit !--- Output unit (def: lunout) - LOGICAL :: lerr !------------------------------------------------------------------------------------------------------------------------------ CHARACTER(LEN=maxlen) :: mes, sub, fm='(f12.9)', prf @@ -1435,9 +1416,8 @@ !=== Reduce an algebrical expression (basic operations and parenthesis) to a single number (string format) ==================== !============================================================================================================================== - FUNCTION reduceExpr_1(str, val) RESULT(lerr) +LOGICAL FUNCTION reduceExpr_1(str, val) RESULT(lerr) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: str CHARACTER(LEN=maxlen), INTENT(OUT) :: val - LOGICAL :: lerr !------------------------------------------------------------------------------------------------------------------------------ CHARACTER(LEN=maxlen) :: v @@ -1486,5 +1466,5 @@ !=== Reduce a simple algebrical expression (basic operations, no parenthesis) to a single number (string format) ============== !============================================================================================================================== - FUNCTION reduceExpr_basic(str, val) RESULT(lerr) +LOGICAL FUNCTION reduceExpr_basic(str, val) RESULT(lerr) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: str @@ -1494,5 +1474,4 @@ CHARACTER(LEN=maxlen), ALLOCATABLE :: ky(:) CHARACTER(LEN=1), ALLOCATABLE :: op(:) - LOGICAL :: lerr !------------------------------------------------------------------------------------------------------------------------------ CHARACTER(LEN=1024) :: s @@ -1547,5 +1526,5 @@ !=== Check whether a string is a number or not ================================================================================ !============================================================================================================================== -ELEMENTAL FUNCTION is_numeric(str) RESULT(out) +ELEMENTAL LOGICAL FUNCTION is_numeric(str) RESULT(out) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: str @@ -1553,6 +1532,4 @@ INTEGER :: e CHARACTER(LEN=12) :: fmt - LOGICAL :: out - IF(TRIM(str) == '') THEN; out = .FALSE.; RETURN; END IF WRITE(fmt,'("(f",i0,".0)")') LEN_TRIM(str) @@ -1566,13 +1543,10 @@ !=== Convert a string into a logical/integer integer or an integer/real into a string ========================================= !============================================================================================================================== -ELEMENTAL FUNCTION str2bool(str) RESULT(out) !--- Result: 0/1 for .FALSE./.TRUE., -1 if not a valid boolean +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 LOGICAL :: lout - INTEGER :: out - READ(str,*,IOSTAT=ierr) lout - out = -HUGE(1) IF(ierr /= 0) THEN @@ -1584,47 +1558,39 @@ END FUNCTION str2bool !============================================================================================================================== -ELEMENTAL FUNCTION str2int(str) RESULT(out) +ELEMENTAL INTEGER FUNCTION str2int(str) RESULT(out) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: str INTEGER :: ierr - INTEGER :: out - READ(str,*,IOSTAT=ierr) out IF(ierr/=0) out = -HUGE(1) END FUNCTION str2int !============================================================================================================================== -ELEMENTAL FUNCTION str2real(str) RESULT(out) +ELEMENTAL REAL FUNCTION str2real(str) RESULT(out) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: str INTEGER :: ierr - REAL :: out - READ(str,*,IOSTAT=ierr) out IF(ierr/=0) out = -HUGE(1.) END FUNCTION str2real !============================================================================================================================== -ELEMENTAL FUNCTION str2dble(str) RESULT(out) +ELEMENTAL DOUBLE PRECISION FUNCTION str2dble(str) RESULT(out) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: str INTEGER :: ierr - DOUBLE PRECISION :: out - READ(str,*,IOSTAT=ierr) out IF(ierr/=0) out = -HUGE(1.d0) END FUNCTION str2dble !============================================================================================================================== -ELEMENTAL FUNCTION bool2str(b) RESULT(out) +ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION bool2str(b) RESULT(out) IMPLICIT NONE LOGICAL, INTENT(IN) :: b - CHARACTER(LEN=maxlen) :: out WRITE(out,*)b out = ADJUSTL(out) END FUNCTION bool2str !============================================================================================================================== -ELEMENTAL FUNCTION int2str(i, nDigits) RESULT(out) +ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION int2str(i, nDigits) RESULT(out) IMPLICIT NONE INTEGER, INTENT(IN) :: i INTEGER, OPTIONAL, INTENT(IN) :: nDigits - CHARACTER(LEN=maxlen) :: out !------------------------------------------------------------------------------------------------------------------------------ WRITE(out,*)i @@ -1634,9 +1600,8 @@ END FUNCTION int2str !============================================================================================================================== -ELEMENTAL FUNCTION real2str(r,fmt) RESULT(out) +ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION real2str(r,fmt) RESULT(out) IMPLICIT NONE REAL, INTENT(IN) :: r CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt - CHARACTER(LEN=maxlen) :: out !------------------------------------------------------------------------------------------------------------------------------ IF( PRESENT(fmt)) WRITE(out,fmt)r @@ -1645,9 +1610,8 @@ END FUNCTION real2str !============================================================================================================================== -ELEMENTAL FUNCTION dble2str(d,fmt) RESULT(out) +ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION dble2str(d,fmt) RESULT(out) IMPLICIT NONE DOUBLE PRECISION, INTENT(IN) :: d CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt - CHARACTER(LEN=maxlen) :: out !------------------------------------------------------------------------------------------------------------------------------ IF( PRESENT(fmt)) WRITE(out,fmt)d @@ -1694,9 +1658,8 @@ END FUNCTION addQuotes_m !============================================================================================================================== -ELEMENTAL FUNCTION needQuotes(s) RESULT(out) +ELEMENTAL LOGICAL FUNCTION needQuotes(s) RESULT(out) IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: s CHARACTER(LEN=1) :: b, e - LOGICAL :: out !------------------------------------------------------------------------------------------------------------------------------ out = .TRUE.; IF(TRIM(s) == '') RETURN @@ -1710,5 +1673,5 @@ !=== DISPLAY ": the following are " FOLLOWED BY THE LIST OF FOR WHICH ==T. =============== !============================================================================================================================== - FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out) +LOGICAL FUNCTION checkList(str, lerr, message, items, reason, nmax) RESULT(out) IMPLICIT NONE ! Purpose: Messages in case a list contains wrong elements (indicated by lerr boolean vector). @@ -1718,5 +1681,4 @@ CHARACTER(LEN=*), INTENT(IN) :: message, items, reason INTEGER, OPTIONAL, INTENT(IN) :: nmax - LOGICAL :: out !------------------------------------------------------------------------------------------------------------------------------ CHARACTER(LEN=maxlen), ALLOCATABLE :: s(:)