Ignore:
Timestamp:
Jul 2, 2025, 12:00:08 PM (38 hours ago)
Author:
dcugnet
Message:
  • Use REAL(KIND=REAL32) and REAL(KIND=REAL64) Iinstead of REAL and DOUBLE PRECISION

to avoid ambiguity problems in generic procedure when reals are promoted to doubles.

  • generic "num2str" replaces "str2int", "str2real", "str2dble" and "str2bool" functions.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/misc/strings_mod.f90

    r5747 r5748  
    11MODULE strings_mod
     2
     3  USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: REAL64, REAL32
    24
    35  IMPLICIT NONE
    … …  
    810  PUBLIC :: strUpper, strTail, strStackm, strParse, strReplace, strFind, find, duplicate, cat
    911  PUBLIC :: dispTable, dispOutliers, dispNameList
    10   PUBLIC :: is_numeric, bool2str, int2str, real2str, dble2str
    11   PUBLIC :: reduceExpr, str2bool, str2int, str2real, str2dble
    12   PUBLIC :: addQuotes, checkList, removeComment
     12  PUBLIC :: is_numeric, num2str, str2bool, str2int, str2real, str2dble
     13  PUBLIC :: reduceExpr, addQuotes, checkList, removeComment
    1314
    1415  INTERFACE get_in;     MODULE PROCEDURE getin_s,  getin_i,  getin_r,  getin_l;  END INTERFACE get_in
     16  INTERFACE num2str;    MODULE PROCEDURE bool2str, int2str, real2str, dble2str;  END INTERFACE num2str
    1517  INTERFACE  msg;       MODULE PROCEDURE        msg_1,                    msg_m; END INTERFACE  msg
    1618  INTERFACE strHead;    MODULE PROCEDURE    strHead_1,                strHead_m; END INTERFACE strHead
    … …  
    2123  INTERFACE strCount;   MODULE PROCEDURE  strCount_m1, strCount_11, strCount_1m; END INTERFACE strCount
    2224  INTERFACE strReplace; MODULE PROCEDURE strReplace_1,             strReplace_m; END INTERFACE strReplace
    23   INTERFACE cat;        MODULE PROCEDURE  horzcat_s00, horzcat_i00, horzcat_r00,  & !horzcat_d00, &
    24                                           horzcat_s10, horzcat_i10, horzcat_r10,  & !horzcat_d10, &
    25                                           horzcat_s11, horzcat_i11, horzcat_r11,  & !horzcat_d11, &
    26                                           horzcat_s21, horzcat_i21, horzcat_r21; END INTERFACE cat !horzcat_d21
    27   INTERFACE strFind;      MODULE PROCEDURE strFind_1, strFind_m;                 END INTERFACE strFind
     25  INTERFACE cat; MODULE PROCEDURE  horzcat_s00, horzcat_i00, horzcat_r00, horzcat_d00, &
     26                                   horzcat_s10, horzcat_i10, horzcat_r10, horzcat_d10, &
     27                                   horzcat_s11, horzcat_i11, horzcat_r11, horzcat_d11, &
     28                                   horzcat_s21, horzcat_i21, horzcat_r21; END INTERFACE cat !horzcat_d21
     29  INTERFACE strFind;      MODULE PROCEDURE strFind_1, strFind_m;           END INTERFACE strFind
    2830  INTERFACE find;         MODULE PROCEDURE strFind_1, strFind_m, intFind_1, intFind_m, booFind; END INTERFACE find
    2931  INTERFACE duplicate;    MODULE PROCEDURE dupl_s, dupl_i, dupl_r, dupl_l; END INTERFACE duplicate
    … …  
    6870  INTEGER,          INTENT(IN)    :: def
    6971  val = def; CALL getin(nam, val)
    70   IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(int2str(val))
     72  IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(num2str(val))
    7173END SUBROUTINE getin_i
    7274!==============================================================================================================================
    … …  
    7880  REAL,             INTENT(IN)    :: def
    7981  val = def; CALL getin(nam, val)
    80   IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(real2str(val))
     82  IF(val/=def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(num2str(val))
    8183END SUBROUTINE getin_r
    8284!==============================================================================================================================
    … …  
    8890  LOGICAL,          INTENT(IN)    :: def
    8991  val = def; CALL getin(nam, val)
    90   IF(val.NEQV.def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(bool2str(val))
     92  IF(val.NEQV.def) WRITE(lunout,*)TRIM(nam)//' = '//TRIM(num2str(val))
    9193END SUBROUTINE getin_l
    9294!==============================================================================================================================
    … …  
    953955FUNCTION horzcat_r00(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    954956  IMPLICIT NONE
    955   REAL,                   INTENT(IN) :: r0
    956   REAL, OPTIONAL, TARGET, INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
    957   REAL, ALLOCATABLE :: out(:)
    958   REAL, POINTER    :: r
     957  REAL(KIND=REAL32),                   INTENT(IN) :: r0
     958  REAL(KIND=REAL32), OPTIONAL, TARGET, INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
     959  REAL(KIND=REAL32), ALLOCATABLE :: out(:)
     960  REAL(KIND=REAL32), POINTER :: r
    959961  INTEGER           :: ncol, iv
    960962  LOGICAL           :: pre(9)
    … …  
    975977FUNCTION horzcat_r10(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    976978  IMPLICIT NONE
    977   REAL,           INTENT(IN) :: r0(:), r1
    978   REAL, OPTIONAL, INTENT(IN) :: r2, r3, r4, r5, r6, r7, r8, r9
    979   REAL, ALLOCATABLE :: out(:), tmp(:)
     979  REAL(KIND=REAL32),           INTENT(IN) :: r0(:), r1
     980  REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: r2, r3, r4, r5, r6, r7, r8, r9
     981  REAL(KIND=REAL32), ALLOCATABLE :: out(:), tmp(:)
    980982  INTEGER :: nc
    981983  nc  = SIZE(r0)
    … …  
    987989FUNCTION horzcat_r11(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    988990  IMPLICIT NONE
    989   REAL,                   INTENT(IN) :: r0(:)
    990   REAL, OPTIONAL, TARGET, INTENT(IN) :: r1(:), r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
    991   REAL, ALLOCATABLE :: out(:,:)
    992   REAL, POINTER     :: r(:)
    993   INTEGER           :: nrow, ncol, iv, n
    994   LOGICAL           :: pre(9)
     991  REAL(KIND=REAL32),                   INTENT(IN) :: r0(:)
     992  REAL(KIND=REAL32), OPTIONAL, TARGET, INTENT(IN) :: r1(:), r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
     993  REAL(KIND=REAL32), ALLOCATABLE :: out(:,:)
     994  REAL(KIND=REAL32), POINTER     :: r(:)
     995  INTEGER :: nrow, ncol, iv, n
     996  LOGICAL :: pre(9)
    995997!------------------------------------------------------------------------------------------------------------------------------
    996998  pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)]
    … …  
    10121014FUNCTION horzcat_r21(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    10131015  IMPLICIT NONE
    1014   REAL,           INTENT(IN) :: r0(:,:), r1(:)
    1015   REAL, OPTIONAL, INTENT(IN) :: r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
    1016   REAL, ALLOCATABLE :: out(:,:), tmp(:,:)
     1016  REAL(KIND=REAL32),           INTENT(IN) :: r0(:,:), r1(:)
     1017  REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
     1018  REAL(KIND=REAL32), ALLOCATABLE :: out(:,:), tmp(:,:)
    10171019  INTEGER :: nc
    10181020  nc  = SIZE(r0, 2)
    … …  
    10241026FUNCTION horzcat_d00(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    10251027  IMPLICIT NONE
    1026   DOUBLE PRECISION,                   INTENT(IN) :: d0
    1027   DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
    1028   DOUBLE PRECISION, ALLOCATABLE :: out(:)
    1029   DOUBLE PRECISION, POINTER     :: d
     1028  REAL(KIND=REAL64),                   INTENT(IN) :: d0
     1029  REAL(KIND=REAL64), OPTIONAL, TARGET, INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
     1030  REAL(KIND=REAL64), ALLOCATABLE :: out(:)
     1031  REAL(KIND=REAL64), POINTER     :: d
    10301032  INTEGER                       :: ncol, iv
    10311033  LOGICAL                       :: pre(9)
    … …  
    10461048FUNCTION horzcat_d10(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    10471049  IMPLICIT NONE
    1048   DOUBLE PRECISION,           INTENT(IN) :: d0(:), d1
    1049   DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2, d3, d4, d5, d6, d7, d8, d9
    1050   DOUBLE PRECISION, ALLOCATABLE :: out(:), tmp(:)
     1050  REAL(KIND=REAL64),           INTENT(IN) :: d0(:), d1
     1051  REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: d2, d3, d4, d5, d6, d7, d8, d9
     1052  REAL(KIND=REAL64), ALLOCATABLE :: out(:), tmp(:)
    10511053  INTEGER :: nc
    10521054  nc = SIZE(d0)
    … …  
    10581060FUNCTION horzcat_d11(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    10591061  IMPLICIT NONE
    1060   DOUBLE PRECISION,                   INTENT(IN) :: d0(:)
    1061   DOUBLE PRECISION, OPTIONAL, TARGET, INTENT(IN) :: d1(:), d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
    1062   DOUBLE PRECISION, ALLOCATABLE :: out(:,:)
    1063   DOUBLE PRECISION, POINTER     :: d(:)
     1062  REAL(KIND=REAL64),                   INTENT(IN) :: d0(:)
     1063  REAL(KIND=REAL64), OPTIONAL, TARGET, INTENT(IN) :: d1(:), d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
     1064  REAL(KIND=REAL64), ALLOCATABLE :: out(:,:)
     1065  REAL(KIND=REAL64), POINTER     :: d(:)
    10641066  INTEGER                       :: nrow, ncol, iv, n
    10651067  LOGICAL                       :: pre(9)
    … …  
    10821084FUNCTION horzcat_d21(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    10831085  IMPLICIT NONE
    1084   DOUBLE PRECISION,           INTENT(IN) :: d0(:,:), d1(:)
    1085   DOUBLE PRECISION, OPTIONAL, INTENT(IN) :: d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
    1086   DOUBLE PRECISION, ALLOCATABLE :: out(:,:), tmp(:,:)
     1086  REAL(KIND=REAL64),           INTENT(IN) :: d0(:,:), d1(:)
     1087  REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
     1088  REAL(KIND=REAL64), ALLOCATABLE :: out(:,:), tmp(:,:)
    10871089  INTEGER :: nc
    10881090  nc  = SIZE(d0, 2)
    … …  
    11591161    d(1,ic) = TRIM(titles(ic))
    11601162    SELECT CASE(p(ic:ic))
    1161       CASE('s'); d(2:nmx,ic) =          s(:,is)     ; is = is + 1
    1162       CASE('i'); d(2:nmx,ic) =  int2str(i(:,ii)    ); ii = ii + 1
    1163       CASE('r'); d(2:nmx,ic) = real2str(r(:,ir),rFm); ir = ir + 1
     1163      CASE('s'); d(2:nmx,ic) =         s(:,is)     ; is = is + 1
     1164      CASE('i'); d(2:nmx,ic) = num2str(i(:,ii)    ); ii = ii + 1
     1165      CASE('r'); d(2:nmx,ic) = num2str(r(:,ir),rFm); ir = ir + 1
    11641166    END SELECT
    11651167  END DO
    … …  
    12601262    d(1,ic) = TRIM(titles(ic))
    12611263    SELECT CASE(p(ic:ic))
    1262       CASE('s'); d(2:nrow,ic) =          s(:,is)     ; is = is + 1
    1263       CASE('i'); d(2:nrow,ic) =  int2str(i(:,ii)    ); ii = ii + 1
    1264       CASE('r'); d(2:nrow,ic) = real2str(r(:,ir),rFm); ir = ir + 1
     1264      CASE('s'); d(2:nrow,ic) =         s(:,is)     ; is = is + 1
     1265      CASE('i'); d(2:nrow,ic) = num2str(i(:,ii)    ); ii = ii + 1
     1266      CASE('r'); d(2:nrow,ic) = num2str(r(:,ir),rFm); ir = ir + 1
    12651267    END SELECT
    12661268  END DO
    … …  
    13621364    IF(.NOT.ANY(m)) CYCLE                                            !--- no outlayers for tracer "itr"
    13631365    v = TRIM(vnm(MIN(itr,SIZE(vnm))))//'('//TRIM(s)                  !--- "<name>("
    1364     IF(nv == 1) ttl(rk) = TRIM(v)//','//int2str(itr)//')'            !--- "<name>(i,j,itr)" (single name)
     1366    IF(nv == 1) ttl(rk) = TRIM(v)//','//num2str(itr)//')'            !--- "<name>(i,j,itr)" (single name)
    13651367    IF(nv /= 1) ttl(rk) = TRIM(v)//')'                               !--- "<nam(itr)>(i,j)" (one name each table/itr index)
    13661368    IF(rk==2) lerr = dispTable('ir',  ttl, i=cat(PACK(ki,m)),            r=cat(PACK(a(ib:ie),m)), &
    … …  
    14851487  CHARACTER(LEN=*),      INTENT(IN)  :: str
    14861488  CHARACTER(LEN=*),      INTENT(OUT) :: val
    1487   DOUBLE PRECISION,      ALLOCATABLE :: vl(:)
     1489  REAL(KIND=REAL64),     ALLOCATABLE :: vl(:)
    14881490  INTEGER,               ALLOCATABLE :: id(:)
    14891491  CHARACTER(LEN=maxlen), ALLOCATABLE :: ky(:)
    … …  
    14911493!------------------------------------------------------------------------------------------------------------------------------
    14921494  CHARACTER(LEN=1024) :: s
    1493   DOUBLE PRECISION :: v, vm, vp
     1495  REAL(KIND=REAL64) :: v, vm, vp
    14941496  INTEGER      :: i, ni, io
    14951497  lerr = .FALSE.
    … …  
    15001502  IF(lerr) RETURN                                                              !--- Problem with the parsing
    15011503  vl = str2dble(ky)                                                            !--- Conversion to doubles
    1502   lerr = ANY(vl >= HUGE(1.d0))
     1504  lerr = ANY(vl >= HUGE(1._REAL64))
    15031505  CALL msg('Some values are non-numeric in: '//TRIM(s), ll=lerr)
    15041506  IF(lerr) RETURN                                                              !--- Non-numerical values found
    … …  
    15191521    END DO
    15201522  END DO
    1521   val = dble2str(vl(1))
     1523  val = num2str(vl(1))
    15221524
    15231525END FUNCTION reduceExpr_basic
    … …  
    15811583END FUNCTION str2int
    15821584!==============================================================================================================================
    1583 ELEMENTAL REAL FUNCTION str2real(str) RESULT(out)
     1585ELEMENTAL REAL(KIND=REAL32) FUNCTION str2real(str) RESULT(out)
    15841586  IMPLICIT NONE
    15851587  CHARACTER(LEN=*), INTENT(IN) :: str
    15861588  INTEGER :: ierr
    15871589  READ(str,*,IOSTAT=ierr) out
    1588   IF(ierr/=0) out = -HUGE(1.)
     1590  IF(ierr/=0) out = -HUGE(1._REAL32)
    15891591END FUNCTION str2real
    15901592!==============================================================================================================================
    1591 ELEMENTAL DOUBLE PRECISION FUNCTION str2dble(str) RESULT(out)
     1593ELEMENTAL REAL(KIND=REAL64) FUNCTION str2dble(str) RESULT(out)
    15921594  IMPLICIT NONE
    15931595  CHARACTER(LEN=*), INTENT(IN) :: str
    15941596  INTEGER :: ierr
    15951597  READ(str,*,IOSTAT=ierr) out
    1596   IF(ierr/=0) out = -HUGE(1.d0)
     1598  IF(ierr/=0) out = -HUGE(1._REAL64)
    15971599END FUNCTION str2dble
    15981600!==============================================================================================================================
    … …  
    16171619ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION real2str(r,fmt) RESULT(out)
    16181620  IMPLICIT NONE
    1619   REAL,                       INTENT(IN) :: r
     1621  REAL(KIND=REAL32),          INTENT(IN) :: r
    16201622  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
    16211623!------------------------------------------------------------------------------------------------------------------------------
    … …  
    16271629ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION dble2str(d,fmt) RESULT(out)
    16281630  IMPLICIT NONE
    1629   DOUBLE PRECISION,           INTENT(IN) :: d
     1631  REAL(KIND=REAL64),          INTENT(IN) :: d
    16301632  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
    16311633!------------------------------------------------------------------------------------------------------------------------------
Note: See TracChangeset for help on using the changeset viewer.