Changeset 5749 for LMDZ6


Ignore:
Timestamp:
Jul 2, 2025, 1:07:48 PM (5 days ago)
Author:
dcugnet
Message:

Avoid using type-dependent variables names in the many variants of the routine "cat"

-> less "copy/paste" errors risks

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r5748 r5749  
    800800!=== Contatenate horizontally scalars/vectors of strings/integers/reals into a vector/array ===================================
    801801!==============================================================================================================================
    802 FUNCTION horzcat_s00(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
    803   IMPLICIT NONE
    804   CHARACTER(LEN=*),                   INTENT(IN) :: s0
    805   CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9
     802FUNCTION horzcat_s00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     803  IMPLICIT NONE
     804  CHARACTER(LEN=*),                   INTENT(IN) :: v0
     805  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
    806806  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
    807   CHARACTER(LEN=maxlen), POINTER     :: s
    808   INTEGER                            :: nrow, iv
     807  CHARACTER(LEN=maxlen), POINTER     :: v
     808  INTEGER                            :: ncol, iv
    809809  LOGICAL                            :: pre(9)
    810810!------------------------------------------------------------------------------------------------------------------------------
    811   pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)]
    812   nrow = 1+COUNT(pre)
    813   ALLOCATE(out(nrow))
    814   out(1) = s0
    815   DO iv = 2, nrow; IF(.NOT.pre(iv-1)) CYCLE
    816     SELECT CASE(iv-1)
    817       CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5
    818       CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9
    819     END SELECT
    820     out(iv) = s
     811  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
     812  ncol = 1+COUNT(pre)
     813  ALLOCATE(out(ncol))
     814  out(1) = v0
     815  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     816     SELECT CASE(iv-1)
     817        CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5
     818        CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9
     819     END SELECT
     820     out(iv) = v
    821821  END DO
    822822END FUNCTION horzcat_s00
    823823!==============================================================================================================================
    824 FUNCTION horzcat_s10(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
    825   IMPLICIT NONE
    826   CHARACTER(LEN=*),           INTENT(IN) :: s0(:), s1
    827   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2, s3, s4, s5, s6, s7, s8, s9
     824FUNCTION horzcat_s10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     825  IMPLICIT NONE
     826  CHARACTER(LEN=*),           INTENT(IN) :: v0(:), v1
     827  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
    828828  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:), tmp(:)
    829829  INTEGER :: nc
    830   nc = SIZE(s0)
    831   tmp = horzcat_s00(s0(nc), s1, s2, s3, s4, s5, s6, s7, s8, s9)
     830  nc = SIZE(v0)
     831  tmp = horzcat_s00(v0(nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    832832  IF(nc == 1) out = tmp
    833833  IF(nc /= 1) THEN
    834834!ym fix for nvidia compiler
    835 !ym out = [s0(1:nc-1), tmp]
    836     out = s0(1:nc-1)
    837     out = [out , tmp]
     835!ym out = [v0(1:nc-1), tmp]
     836     out = v0(1:nc-1)
     837     out = [out , tmp]
    838838  ENDIF
    839839END FUNCTION horzcat_s10
    840840!==============================================================================================================================
    841 FUNCTION horzcat_s11(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
    842   IMPLICIT NONE
    843   CHARACTER(LEN=*),                   INTENT(IN) :: s0(:)
    844   CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1(:), s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
     841FUNCTION horzcat_s11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     842  IMPLICIT NONE
     843  CHARACTER(LEN=*),                   INTENT(IN) :: v0(:)
     844  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
    845845  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:)
    846   CHARACTER(LEN=maxlen), POINTER     :: s(:)
    847   INTEGER                            :: nrow, ncol, iv, n
    848   LOGICAL                            :: pre(9)
    849 !------------------------------------------------------------------------------------------------------------------------------
    850   pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)]
    851   nrow = SIZE(s0)
     846  CHARACTER(LEN=maxlen), POINTER     :: v(:)
     847  INTEGER :: nrow, ncol, iv, n
     848  LOGICAL :: pre(9)
     849!------------------------------------------------------------------------------------------------------------------------------
     850  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
     851  nrow = SIZE(v0)
    852852  ncol = 1+COUNT(pre)
    853853  ALLOCATE(out(nrow, ncol))
    854   out(:,1) = s0
     854  out(:,1) = v0
    855855  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
    856     SELECT CASE(iv-1)
    857       CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5
    858       CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9
    859     END SELECT
    860     n = SIZE(s, DIM=1)
    861     IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
    862     out(:,iv) = s(:)
     856     SELECT CASE(iv-1)
     857        CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5
     858        CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9
     859     END SELECT
     860     n = SIZE(v, DIM=1)
     861     IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     862     out(:,iv) = v(:)
    863863  END DO
    864864END FUNCTION horzcat_s11
    865865!==============================================================================================================================
    866 FUNCTION horzcat_s21(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out)
    867   IMPLICIT NONE
    868   CHARACTER(LEN=*),           INTENT(IN) :: s0(:,:), s1(:)
    869   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:)
     866FUNCTION horzcat_s21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     867  IMPLICIT NONE
     868  CHARACTER(LEN=*),           INTENT(IN) :: v0(:,:), v1(:)
     869  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
    870870  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), tmp(:,:), pk(:)
    871871  INTEGER :: nc
    872   nc  = SIZE(s0, 2)
    873   tmp = horzcat_s11(s0(:,nc), s1, s2, s3, s4, s5, s6, s7, s8, s9)
     872  nc  = SIZE(v0, 2)
     873  tmp = horzcat_s11(v0(:,nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    874874  IF(nc == 1) out = tmp
    875875!ym fix for nvidia compiler
    876 !ym  IF(nc /= 1) out = RESHAPE([PACK(s0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(s0, 1), nc + SIZE(tmp, 2)-1])
     876!ym  IF(nc /= 1) out = RESHAPE([PACK(v0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(s0, 1), nc + SIZE(tmp, 2)-1])
    877877  IF(nc /= 1) THEN
    878     pk = PACK(s0(:,1:nc-1), .TRUE.)
    879     pk = [ pk, PACK(tmp, .TRUE.)]
    880     out = RESHAPE(pk, SHAPE=[SIZE(s0, 1), nc + SIZE(tmp, 2)-1])
     878     pk = PACK(v0(:,1:nc-1), .TRUE.)
     879     pk = [ pk, PACK(tmp, .TRUE.)]
     880     out = RESHAPE(pk, SHAPE=[SIZE(v0, 1), nc + SIZE(tmp, 2)-1])
    881881  ENDIF
    882882END FUNCTION horzcat_s21
    883883!==============================================================================================================================
    884 FUNCTION horzcat_i00(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
    885   IMPLICIT NONE
    886   INTEGER,                   INTENT(IN) :: i0
    887   INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9
     884FUNCTION horzcat_i00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     885  IMPLICIT NONE
     886  INTEGER,                   INTENT(IN) :: v0
     887  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
    888888  INTEGER, ALLOCATABLE :: out(:)
    889   INTEGER, POINTER     :: i
     889  INTEGER, POINTER     :: v
    890890  INTEGER              :: ncol, iv
    891891  LOGICAL              :: pre(9)
    892892!------------------------------------------------------------------------------------------------------------------------------
    893   pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)]
     893  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
    894894  ncol = SIZE(pre)
    895895  ALLOCATE(out(ncol))
    896   out(1) = i0
     896  out(1) = v0
    897897  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
    898     SELECT CASE(iv-1)
    899       CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5
    900       CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9
    901     END SELECT
    902     out(iv) = i
     898     SELECT CASE(iv-1)
     899        CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5
     900        CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9
     901     END SELECT
     902     out(iv) = v
    903903  END DO
    904904END FUNCTION horzcat_i00
    905905!==============================================================================================================================
    906 FUNCTION horzcat_i10(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
    907   IMPLICIT NONE
    908   INTEGER,           INTENT(IN) :: i0(:), i1
    909   INTEGER, OPTIONAL, INTENT(IN) :: i2, i3, i4, i5, i6, i7, i8, i9
     906FUNCTION horzcat_i10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     907  IMPLICIT NONE
     908  INTEGER,           INTENT(IN) :: v0(:), v1
     909  INTEGER, OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
    910910  INTEGER, ALLOCATABLE :: out(:), tmp(:)
    911911  INTEGER :: nc
    912   nc = SIZE(i0)
    913   tmp = horzcat_i00(i0(nc), i1, i2, i3, i4, i5, i6, i7, i8, i9)
     912  nc = SIZE(v0)
     913  tmp = horzcat_i00(v0(nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    914914  IF(nc == 1) out = tmp
    915   IF(nc /= 1) out = [i0(1:nc-1), tmp]
     915  IF(nc /= 1) out = [v0(1:nc-1), tmp]
    916916END FUNCTION horzcat_i10
    917917!==============================================================================================================================
    918 FUNCTION horzcat_i11(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
    919   IMPLICIT NONE
    920   INTEGER,                   INTENT(IN) :: i0(:)
    921   INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1(:), i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
     918FUNCTION horzcat_i11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     919  IMPLICIT NONE
     920  INTEGER,                   INTENT(IN) :: v0(:)
     921  INTEGER, OPTIONAL, TARGET, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
    922922  INTEGER, ALLOCATABLE :: out(:,:)
    923   INTEGER, POINTER     :: i(:)
     923  INTEGER, POINTER     :: v(:)
    924924  INTEGER              :: nrow, ncol, iv, n
    925925  LOGICAL              :: pre(9)
    926926!------------------------------------------------------------------------------------------------------------------------------
    927   pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)]
    928   nrow = SIZE(i0)
     927  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
     928  nrow = SIZE(v0)
    929929  ncol = 1+COUNT(pre)
    930930  ALLOCATE(out(nrow, ncol))
    931   out(:,1) = i0
     931  out(:,1) = v0
    932932  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
    933     SELECT CASE(iv-1)
    934       CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5
    935       CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9
    936     END SELECT
    937     n = SIZE(i, DIM=1)
    938     IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
    939     out(:,iv) = i(:)
     933     SELECT CASE(iv-1)
     934        CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5
     935        CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9
     936     END SELECT
     937     n = SIZE(v, DIM=1)
     938     IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     939     out(:,iv) = v(:)
    940940  END DO
    941941END FUNCTION horzcat_i11
    942942!==============================================================================================================================
    943 FUNCTION horzcat_i21(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out)
    944   IMPLICIT NONE
    945   INTEGER,           INTENT(IN) :: i0(:,:), i1(:)
    946   INTEGER, OPTIONAL, INTENT(IN) :: i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:)
     943FUNCTION horzcat_i21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     944  IMPLICIT NONE
     945  INTEGER,           INTENT(IN) :: v0(:,:), v1(:)
     946  INTEGER, OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
    947947  INTEGER, ALLOCATABLE :: out(:,:), tmp(:,:)
    948948  INTEGER :: nc
    949   nc  = SIZE(i0, 2)
    950   tmp = horzcat_i11(i0(:,nc), i1, i2, i3, i4, i5, i6, i7, i8, i9)
     949  nc  = SIZE(v0, 2)
     950  tmp = horzcat_i11(v0(:,nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    951951  IF(nc == 1) out = tmp
    952   IF(nc /= 1) out = RESHAPE([PACK(i0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(i0, 1), nc + SIZE(tmp, 2)-1])
     952  IF(nc /= 1) out = RESHAPE([PACK(v0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(v0, 1), nc + SIZE(tmp, 2)-1])
    953953END FUNCTION horzcat_i21
    954954!==============================================================================================================================
    955 FUNCTION horzcat_r00(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    956   IMPLICIT NONE
    957   REAL(KIND=REAL32),                   INTENT(IN) :: r0
    958   REAL(KIND=REAL32), OPTIONAL, TARGET, INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9
     955FUNCTION horzcat_r00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     956  IMPLICIT NONE
     957  REAL(KIND=REAL32),                   INTENT(IN) :: v0
     958  REAL(KIND=REAL32), OPTIONAL, TARGET, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
    959959  REAL(KIND=REAL32), ALLOCATABLE :: out(:)
    960   REAL(KIND=REAL32), POINTER :: r
     960  REAL(KIND=REAL32), POINTER :: v
    961961  INTEGER           :: ncol, iv
    962962  LOGICAL           :: pre(9)
    963963!------------------------------------------------------------------------------------------------------------------------------
    964   pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)]
     964  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
    965965  ncol = 1+COUNT(pre)
    966966  ALLOCATE(out(ncol))
    967   out(1) = r0
     967  out(1) = v0
    968968  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
    969     SELECT CASE(iv-1)
    970       CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5
    971       CASE(6); r=> r6; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9
    972     END SELECT
    973     out(iv) = r
     969     SELECT CASE(iv-1)
     970        CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5
     971        CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9
     972     END SELECT
     973     out(iv) = v
    974974  END DO
    975975END FUNCTION horzcat_r00
    976976!==============================================================================================================================
    977 FUNCTION horzcat_r10(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    978   IMPLICIT NONE
    979   REAL(KIND=REAL32),           INTENT(IN) :: r0(:), r1
    980   REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: r2, r3, r4, r5, r6, r7, r8, r9
     977FUNCTION horzcat_r10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     978  IMPLICIT NONE
     979  REAL(KIND=REAL32),           INTENT(IN) :: v0(:), v1
     980  REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
    981981  REAL(KIND=REAL32), ALLOCATABLE :: out(:), tmp(:)
    982982  INTEGER :: nc
    983   nc  = SIZE(r0)
    984   tmp = horzcat_r00(r0(nc), r1, r2, r3, r4, r5, r6, r7, r8, r9)
     983  nc  = SIZE(v0)
     984  tmp = horzcat_r00(v0(nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    985985  IF(nc == 1) out = tmp
    986   IF(nc /= 1) out = [r0(1:nc-1), tmp]
     986  IF(nc /= 1) out = [v0(1:nc-1), tmp]
    987987END FUNCTION horzcat_r10
    988988!==============================================================================================================================
    989 FUNCTION horzcat_r11(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    990   IMPLICIT NONE
    991   REAL(KIND=REAL32),                   INTENT(IN) :: r0(:)
    992   REAL(KIND=REAL32), OPTIONAL, TARGET, INTENT(IN) :: r1(:), r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
     989FUNCTION horzcat_r11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     990  IMPLICIT NONE
     991  REAL(KIND=REAL32),                   INTENT(IN) :: v0(:)
     992  REAL(KIND=REAL32), OPTIONAL, TARGET, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
    993993  REAL(KIND=REAL32), ALLOCATABLE :: out(:,:)
    994   REAL(KIND=REAL32), POINTER     :: r(:)
     994  REAL(KIND=REAL32), POINTER     :: v(:)
    995995  INTEGER :: nrow, ncol, iv, n
    996996  LOGICAL :: pre(9)
    997997!------------------------------------------------------------------------------------------------------------------------------
    998   pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)]
    999   nrow = SIZE(r0)
     998  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
     999  nrow = SIZE(v0)
    10001000  ncol = 1+COUNT(pre)
    10011001  ALLOCATE(out(nrow, ncol))
    1002   out(:,1) = r0
     1002  out(:,1) = v0
    10031003  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
    1004     SELECT CASE(iv-1)
    1005       CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5
    1006       CASE(6); r=> r5; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9
    1007     END SELECT
    1008     n = SIZE(r, DIM=1)
    1009     IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
    1010     out(:,iv) = r(:)
     1004     SELECT CASE(iv-1)
     1005        CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5
     1006        CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9
     1007     END SELECT
     1008     n = SIZE(v, DIM=1)
     1009     IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     1010     out(:,iv) = v(:)
    10111011  END DO
    10121012END FUNCTION horzcat_r11
    10131013!==============================================================================================================================
    1014 FUNCTION horzcat_r21(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out)
    1015   IMPLICIT NONE
    1016   REAL(KIND=REAL32),           INTENT(IN) :: r0(:,:), r1(:)
    1017   REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:)
     1014FUNCTION horzcat_r21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1015  IMPLICIT NONE
     1016  REAL(KIND=REAL32),           INTENT(IN) :: v0(:,:), v1(:)
     1017  REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
    10181018  REAL(KIND=REAL32), ALLOCATABLE :: out(:,:), tmp(:,:)
    10191019  INTEGER :: nc
    1020   nc  = SIZE(r0, 2)
    1021   tmp = horzcat_r11(r0(:,nc), r1, r2, r3, r4, r5, r6, r7, r8, r9)
     1020  nc  = SIZE(v0, 2)
     1021  tmp = horzcat_r11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
    10221022  IF(nc == 1) out = tmp
    1023   IF(nc /= 1) out = RESHAPE([PACK(r0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(r0, 1), nc + SIZE(tmp, 2)-1])
     1023  IF(nc /= 1) out = RESHAPE([PACK(v0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(v0, 1), nc + SIZE(tmp, 2)-1])
    10241024END FUNCTION horzcat_r21
    10251025!==============================================================================================================================
    1026 FUNCTION horzcat_d00(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    1027   IMPLICIT NONE
    1028   REAL(KIND=REAL64),                   INTENT(IN) :: d0
    1029   REAL(KIND=REAL64), OPTIONAL, TARGET, INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9
     1026FUNCTION horzcat_d00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1027  IMPLICIT NONE
     1028  REAL(KIND=REAL64),                   INTENT(IN) :: v0
     1029  REAL(KIND=REAL64), OPTIONAL, TARGET, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
    10301030  REAL(KIND=REAL64), ALLOCATABLE :: out(:)
    1031   REAL(KIND=REAL64), POINTER     :: d
    1032   INTEGER                       :: ncol, iv
    1033   LOGICAL                       :: pre(9)
    1034 !------------------------------------------------------------------------------------------------------------------------------
    1035   pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)]
     1031  REAL(KIND=REAL64), POINTER     :: v
     1032  INTEGER                        :: ncol, iv
     1033  LOGICAL                        :: pre(9)
     1034!------------------------------------------------------------------------------------------------------------------------------
     1035  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
    10361036  ncol = 1+COUNT(pre)
    10371037  ALLOCATE(out(ncol))
    1038   out(1) = d0
     1038  out(1) = v0
    10391039  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
    1040     SELECT CASE(iv-1)
    1041       CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5
    1042       CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9
    1043     END SELECT
    1044     out(iv) = d
     1040     SELECT CASE(iv-1)
     1041        CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5
     1042        CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9
     1043     END SELECT
     1044     out(iv) = v
    10451045  END DO
    10461046END FUNCTION horzcat_d00
    10471047!==============================================================================================================================
    1048 FUNCTION horzcat_d10(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    1049   IMPLICIT NONE
    1050   REAL(KIND=REAL64),           INTENT(IN) :: d0(:), d1
    1051   REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: d2, d3, d4, d5, d6, d7, d8, d9
     1048FUNCTION horzcat_d10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1049  IMPLICIT NONE
     1050  REAL(KIND=REAL64),           INTENT(IN) :: v0(:), v1
     1051  REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
    10521052  REAL(KIND=REAL64), ALLOCATABLE :: out(:), tmp(:)
    10531053  INTEGER :: nc
    1054   nc = SIZE(d0)
    1055   tmp = horzcat_d00(d0(nc), d1, d2, d3, d4, d5, d6, d7, d8, d9)
     1054  nc = SIZE(v0)
     1055  tmp = horzcat_d00(v0(nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    10561056  IF(nc == 1) out = tmp
    1057   IF(nc /= 1) out = [d0(1:nc-1), tmp]
     1057  IF(nc /= 1) out = [v0(1:nc-1), tmp]
    10581058END FUNCTION horzcat_d10
    10591059!==============================================================================================================================
    1060 FUNCTION horzcat_d11(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    1061   IMPLICIT NONE
    1062   REAL(KIND=REAL64),                   INTENT(IN) :: d0(:)
    1063   REAL(KIND=REAL64), OPTIONAL, TARGET, INTENT(IN) :: d1(:), d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
     1060FUNCTION horzcat_d11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1061  IMPLICIT NONE
     1062  REAL(KIND=REAL64),                   INTENT(IN) :: v0(:)
     1063  REAL(KIND=REAL64), OPTIONAL, TARGET, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
    10641064  REAL(KIND=REAL64), ALLOCATABLE :: out(:,:)
    1065   REAL(KIND=REAL64), POINTER     :: d(:)
    1066   INTEGER                       :: nrow, ncol, iv, n
    1067   LOGICAL                       :: pre(9)
    1068 !------------------------------------------------------------------------------------------------------------------------------
    1069   nrow = SIZE(d0)
    1070   pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)]
     1065  REAL(KIND=REAL64), POINTER     :: v(:)
     1066  INTEGER :: nrow, ncol, iv, n
     1067  LOGICAL :: pre(9)
     1068!------------------------------------------------------------------------------------------------------------------------------
     1069  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
     1070  nrow = SIZE(v0)
    10711071  ncol = 1+COUNT(pre)
    10721072  ALLOCATE(out(nrow, ncol))
    10731073  DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
    1074     SELECT CASE(iv-1)
    1075       CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5
    1076       CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9
    1077     END SELECT
    1078     n = SIZE(d, DIM=1)
    1079     IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
    1080     out(:,iv) = d(:)
     1074     SELECT CASE(iv-1)
     1075       CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5
     1076       CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9
     1077     END SELECT
     1078     n = SIZE(v, DIM=1)
     1079     IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF
     1080     out(:,iv) = v(:)
    10811081  END DO
    10821082END FUNCTION horzcat_d11
    10831083!==============================================================================================================================
    1084 FUNCTION horzcat_d21(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out)
    1085   IMPLICIT NONE
    1086   REAL(KIND=REAL64),           INTENT(IN) :: d0(:,:), d1(:)
    1087   REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:)
     1084FUNCTION horzcat_d21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1085  IMPLICIT NONE
     1086  REAL(KIND=REAL64),           INTENT(IN) :: v0(:,:), v1(:)
     1087  REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
    10881088  REAL(KIND=REAL64), ALLOCATABLE :: out(:,:), tmp(:,:)
    10891089  INTEGER :: nc
    1090   nc  = SIZE(d0, 2)
    1091   tmp = horzcat_d11(d0(:,nc), d1, d2, d3, d4, d5, d6, d7, d8, d9)
     1090  nc  = SIZE(v0, 2)
     1091  tmp = horzcat_d11(v0(:,nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    10921092  IF(nc == 1) out = tmp
    1093   IF(nc /= 1) out = RESHAPE([PACK(d0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(d0, 1), nc + SIZE(tmp, 2)-1])
     1093  IF(nc /= 1) out = RESHAPE([PACK(v0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(v0, 1), nc + SIZE(tmp, 2)-1])
    10941094END FUNCTION horzcat_d21
    10951095!==============================================================================================================================
Note: See TracChangeset for help on using the changeset viewer.