Changeset 5750


Ignore:
Timestamp:
Jul 2, 2025, 2:33:24 PM (30 hours ago)
Author:
dcugnet
Message:

Improvements of the "cat" function:

  • manage unspecified arguments and vectors of different lengths for strings to allow tables with empty cells
  • one more syntax available (concatenation of two 2D arrays: horzcat_?22 variants)
  • add a version for logicals (horzcat_l?? variants)
File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r5749 r5750  
    802802FUNCTION horzcat_s00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
    803803  IMPLICIT NONE
    804   CHARACTER(LEN=*),                   INTENT(IN) :: v0
    805   CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
     804  CHARACTER(LEN=*),           INTENT(IN) :: v0
     805  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
    806806  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:)
    807   CHARACTER(LEN=maxlen), POINTER     :: v
    808   INTEGER                            :: ncol, iv
     807  INTEGER                            :: ncol, iv, i
    809808  LOGICAL                            :: pre(9)
    810809!------------------------------------------------------------------------------------------------------------------------------
    … …  
    813812  ALLOCATE(out(ncol))
    814813  out(1) = v0
    815   DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     814  i = 2
     815  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
    816816     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
     817        CASE(1); out(i) = v1; CASE(2); out(i) = v2; CASE(3); out(i) = v3; CASE(4); out(i) = v4; CASE(5); out(i) = v5
     818        CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
    819819     END SELECT
    820      out(iv) = v
     820     i = i+1
    821821  END DO
    822822END FUNCTION horzcat_s00
    … …  
    827827  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
    828828  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:), tmp(:)
    829   INTEGER :: nc
    830   nc = SIZE(v0)
    831   tmp = horzcat_s00(v0(nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    832   IF(nc == 1) out = tmp
    833   IF(nc /= 1) THEN
    834 !ym fix for nvidia compiler
    835 !ym out = [v0(1:nc-1), tmp]
    836      out = v0(1:nc-1)
    837      out = [out , tmp]
    838   ENDIF
     829  tmp = horzcat_s00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
     830  out = [v0 , tmp]
    839831END FUNCTION horzcat_s10
    840832!==============================================================================================================================
    841833FUNCTION horzcat_s11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
    842834  IMPLICIT NONE
    843   CHARACTER(LEN=*),                   INTENT(IN) :: v0(:)
    844   CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
     835  CHARACTER(LEN=*),           INTENT(IN) :: v0(:)
     836  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
    845837  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:)
    846   CHARACTER(LEN=maxlen), POINTER     :: v(:)
    847   INTEGER :: nrow, ncol, iv, n
     838  INTEGER :: nrow, ncol, iv, i
     839  LOGICAL :: pre(9)
     840!------------------------------------------------------------------------------------------------------------------------------
     841  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
     842  nrow = SIZE(v0)
     843  ncol = 1+COUNT(pre)
     844  IF(pre(1)) nrow = MAX(nrow,SIZE(v1)); IF(pre(2)) nrow = MAX(nrow,SIZE(v2)); IF(pre(3)) nrow = MAX(nrow,SIZE(v3))
     845  IF(pre(4)) nrow = MAX(nrow,SIZE(v4)); IF(pre(5)) nrow = MAX(nrow,SIZE(v5)); IF(pre(6)) nrow = MAX(nrow,SIZE(v6))
     846  IF(pre(7)) nrow = MAX(nrow,SIZE(v7)); IF(pre(8)) nrow = MAX(nrow,SIZE(v8)); IF(pre(9)) nrow = MAX(nrow,SIZE(v9))
     847  ALLOCATE(out(nrow, ncol)); out(:,:) = ''
     848  out(1:SIZE(v0),1) = v0
     849  i = 2
     850  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
     851     SELECT CASE(iv-1)
     852        CASE(1); out(1:SIZE(v1),i) = v1; CASE(2); out(1:SIZE(v2),i) = v2; CASE(3); out(1:SIZE(v3),i) = v3
     853        CASE(4); out(1:SIZE(v4),i) = v4; CASE(5); out(1:SIZE(v5),i) = v5; CASE(6); out(1:SIZE(v5),i) = v6
     854        CASE(7); out(1:SIZE(v7),i) = v7; CASE(8); out(1:SIZE(v8),i) = v8; CASE(9); out(1:SIZE(v9),i) = v9
     855     END SELECT
     856     i = i+1
     857  END DO
     858END FUNCTION horzcat_s11
     859!==============================================================================================================================
     860FUNCTION horzcat_s21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     861  IMPLICIT NONE
     862  CHARACTER(LEN=*),           INTENT(IN) :: v0(:,:), v1(:)
     863  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
     864  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), tmp(:,:)
     865  tmp = horzcat_s11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
     866  out = horzcat_s22(v0, tmp)
     867END FUNCTION horzcat_s21
     868!==============================================================================================================================
     869FUNCTION horzcat_s22(v0, v1) RESULT(out)
     870  IMPLICIT NONE
     871  CHARACTER(LEN=*), INTENT(IN) :: v0(:,:), v1(:,:)
     872  CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), pk(:), tmp(:,:)
     873  INTEGER :: n0, n1, nrow
     874  n0 = SIZE(v0,1)
     875  n1 = SIZE(v1,1)
     876  nrow = MAX(n0, n1)
     877  IF(n0 == n1) THEN
     878     pk = PACK(v0, .TRUE.); pk = [pk, PACK(v1, .TRUE.)]
     879  ELSE IF(n0 /= nrow) THEN
     880     ALLOCATE(tmp(nrow,SIZE(v0,2))); tmp(:,:) = ''; tmp(1:n0,:) = v0(:,:); pk = PACK(tmp, .TRUE.); pk = [pk, PACK(v1, .TRUE.)]
     881  ELSE
     882     ALLOCATE(tmp(nrow,SIZE(v1,2))); tmp(:,:) = ''; tmp(1:n1,:) = v1(:,:); pk = PACK(tmp, .TRUE.); pk = [PACK(v0, .TRUE.), pk]
     883  END IF
     884  out = RESHAPE(pk, SHAPE=[nrow, SIZE(v0, 2) + SIZE(v1, 2)])
     885END FUNCTION horzcat_s22
     886!==============================================================================================================================
     887FUNCTION horzcat_i00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     888  IMPLICIT NONE
     889  INTEGER,           INTENT(IN) :: v0
     890  INTEGER, OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
     891  INTEGER, ALLOCATABLE :: out(:)
     892  INTEGER              :: ncol, iv, i
     893  LOGICAL              :: pre(9)
     894!------------------------------------------------------------------------------------------------------------------------------
     895  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
     896  ncol = 1+COUNT(pre)
     897  ALLOCATE(out(ncol))
     898  out(1) = v0
     899  i = 2
     900  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
     901     SELECT CASE(iv-1)
     902        CASE(1); out(i) = v1; CASE(2); out(i) = v2; CASE(3); out(i) = v3; CASE(4); out(i) = v4; CASE(5); out(i) = v5
     903        CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
     904     END SELECT
     905     i = i+1
     906  END DO
     907END FUNCTION horzcat_i00
     908!==============================================================================================================================
     909FUNCTION horzcat_i10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     910  IMPLICIT NONE
     911  INTEGER,           INTENT(IN) :: v0(:), v1
     912  INTEGER, OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
     913  INTEGER, ALLOCATABLE :: out(:), tmp(:)
     914  tmp = horzcat_i00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
     915  out = [v0, tmp]
     916END FUNCTION horzcat_i10
     917!==============================================================================================================================
     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, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
     922  INTEGER, ALLOCATABLE :: out(:,:)
     923  INTEGER :: siz(9), nrow, ncol, iv, i, n
    848924  LOGICAL :: pre(9)
    849925!------------------------------------------------------------------------------------------------------------------------------
    … …  
    853929  ALLOCATE(out(nrow, ncol))
    854930  out(:,1) = v0
    855   DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     931  i = 2
     932  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
    856933     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
     934        CASE(1); n = SIZE(v1); CASE(2); n = SIZE(v2); CASE(3); n = SIZE(v3); CASE(4); n = SIZE(v4); CASE(5); n = SIZE(v5)
     935        CASE(6); n = SIZE(v6); CASE(7); n = SIZE(v7); CASE(8); n = SIZE(v8); CASE(9); n = SIZE(v9)
    859936     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(:)
    863   END DO
    864 END FUNCTION horzcat_s11
    865 !==============================================================================================================================
    866 FUNCTION 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(:)
    870   CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), tmp(:,:), pk(:)
    871   INTEGER :: nc
    872   nc  = SIZE(v0, 2)
    873   tmp = horzcat_s11(v0(:,nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    874   IF(nc == 1) out = tmp
    875 !ym fix for nvidia compiler
    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])
    877   IF(nc /= 1) THEN
    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])
    881   ENDIF
    882 END FUNCTION horzcat_s21
    883 !==============================================================================================================================
    884 FUNCTION 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
    888   INTEGER, ALLOCATABLE :: out(:)
    889   INTEGER, POINTER     :: v
    890   INTEGER              :: ncol, iv
    891   LOGICAL              :: pre(9)
     937     IF(n /= nrow) THEN; CALL msg("Can't concatenate integer vectors of differing lengths"); STOP; END IF
     938     SELECT CASE(iv-1)
     939        CASE(1); out(:,i) = v1; CASE(2); out(:,i) = v2; CASE(3); out(:,i) = v3; CASE(4); out(:,i) = v4; CASE(5); out(:,i) = v5
     940        CASE(6); out(:,i) = v6; CASE(7); out(:,i) = v7; CASE(8); out(:,i) = v8; CASE(9); out(:,i) = v9
     941     END SELECT
     942     i = i+1
     943  END DO
     944END FUNCTION horzcat_i11
     945!==============================================================================================================================
     946FUNCTION horzcat_i21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     947  IMPLICIT NONE
     948  INTEGER,           INTENT(IN) :: v0(:,:), v1(:)
     949  INTEGER, OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
     950  INTEGER, ALLOCATABLE :: out(:,:), tmp(:,:)
     951  tmp = horzcat_i11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
     952  out = horzcat_i22(v0, tmp)
     953END FUNCTION horzcat_i21
     954!==============================================================================================================================
     955FUNCTION horzcat_i22(v0, v1) RESULT(out)
     956  IMPLICIT NONE
     957  INTEGER, INTENT(IN) :: v0(:,:), v1(:,:)
     958  INTEGER, ALLOCATABLE :: out(:,:), pk(:)
     959  INTEGER :: nrow, ncol
     960  nrow = SIZE(v0,1)
     961  ncol = SIZE(v0,2)+SIZE(v1,2)
     962  IF(nrow /= SIZE(v1,1)) THEN; CALL msg("Can't concatenate integer arrays of differing rows numbers"); STOP; END IF
     963  ALLOCATE(out(nrow, ncol))
     964  pk =      PACK(v0, .TRUE.)
     965  pk = [pk, PACK(v1, .TRUE.)]
     966  out = RESHAPE(pk, SHAPE=[nrow, ncol])
     967END FUNCTION horzcat_i22
     968!==============================================================================================================================
     969FUNCTION horzcat_r00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     970  IMPLICIT NONE
     971  REAL(KIND=REAL32),           INTENT(IN) :: v0
     972  REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
     973  REAL(KIND=REAL32), ALLOCATABLE :: out(:)
     974  INTEGER           :: ncol, iv, i
     975  LOGICAL           :: pre(9)
    892976!------------------------------------------------------------------------------------------------------------------------------
    893977  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
    894   ncol = SIZE(pre)
     978  ncol = 1+COUNT(pre)
    895979  ALLOCATE(out(ncol))
    896980  out(1) = v0
    897   DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     981  i = 2
     982  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
    898983     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
     984        CASE(1); out(i) = v1; CASE(2); out(i) = v2; CASE(3); out(i) = v3; CASE(4); out(i) = v4; CASE(5); out(i) = v5
     985        CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
    901986     END SELECT
    902      out(iv) = v
    903   END DO
    904 END FUNCTION horzcat_i00
    905 !==============================================================================================================================
    906 FUNCTION 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
    910   INTEGER, ALLOCATABLE :: out(:), tmp(:)
    911   INTEGER :: nc
    912   nc = SIZE(v0)
    913   tmp = horzcat_i00(v0(nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    914   IF(nc == 1) out = tmp
    915   IF(nc /= 1) out = [v0(1:nc-1), tmp]
    916 END FUNCTION horzcat_i10
    917 !==============================================================================================================================
    918 FUNCTION 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(:)
    922   INTEGER, ALLOCATABLE :: out(:,:)
    923   INTEGER, POINTER     :: v(:)
    924   INTEGER              :: nrow, ncol, iv, n
    925   LOGICAL              :: pre(9)
     987     i = i+1
     988  END DO
     989END FUNCTION horzcat_r00
     990!==============================================================================================================================
     991FUNCTION horzcat_r10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     992  IMPLICIT NONE
     993  REAL(KIND=REAL32),           INTENT(IN) :: v0(:), v1
     994  REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
     995  REAL(KIND=REAL32), ALLOCATABLE :: out(:), tmp(:)
     996  tmp = horzcat_r00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
     997  out = [v0 , tmp]
     998END FUNCTION horzcat_r10
     999!==============================================================================================================================
     1000FUNCTION horzcat_r11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1001  IMPLICIT NONE
     1002  REAL(KIND=REAL32),           INTENT(IN) :: v0(:)
     1003  REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
     1004  REAL(KIND=REAL32), ALLOCATABLE :: out(:,:)
     1005  INTEGER :: siz(9), nrow, ncol, iv, i, n
     1006  LOGICAL :: pre(9)
    9261007!------------------------------------------------------------------------------------------------------------------------------
    9271008  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
    … …  
    9301011  ALLOCATE(out(nrow, ncol))
    9311012  out(:,1) = v0
    932   DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     1013  i = 2
     1014  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
    9331015     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
     1016        CASE(1); n = SIZE(v1); CASE(2); n = SIZE(v2); CASE(3); n = SIZE(v3); CASE(4); n = SIZE(v4); CASE(5); n = SIZE(v5)
     1017        CASE(6); n = SIZE(v6); CASE(7); n = SIZE(v7); CASE(8); n = SIZE(v8); CASE(9); n = SIZE(v9)
    9361018     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(:)
    940   END DO
    941 END FUNCTION horzcat_i11
    942 !==============================================================================================================================
    943 FUNCTION 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(:)
    947   INTEGER, ALLOCATABLE :: out(:,:), tmp(:,:)
    948   INTEGER :: nc
    949   nc  = SIZE(v0, 2)
    950   tmp = horzcat_i11(v0(:,nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    951   IF(nc == 1) out = tmp
    952   IF(nc /= 1) out = RESHAPE([PACK(v0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(v0, 1), nc + SIZE(tmp, 2)-1])
    953 END FUNCTION horzcat_i21
    954 !==============================================================================================================================
    955 FUNCTION 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
    959   REAL(KIND=REAL32), ALLOCATABLE :: out(:)
    960   REAL(KIND=REAL32), POINTER :: v
    961   INTEGER           :: ncol, iv
    962   LOGICAL           :: pre(9)
     1019     IF(n /= nrow) THEN; CALL msg("Can't concatenate real vectors of differing lengths"); STOP; END IF
     1020     SELECT CASE(iv-1)
     1021        CASE(1); out(:,i) = v1; CASE(2); out(:,i) = v2; CASE(3); out(:,i) = v3; CASE(4); out(:,i) = v4; CASE(5); out(:,i) = v5
     1022        CASE(6); out(:,i) = v6; CASE(7); out(:,i) = v7; CASE(8); out(:,i) = v8; CASE(9); out(:,i) = v9
     1023     END SELECT
     1024     i = i+1
     1025  END DO
     1026END FUNCTION horzcat_r11
     1027!==============================================================================================================================
     1028FUNCTION horzcat_r21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1029  IMPLICIT NONE
     1030  REAL(KIND=REAL32),           INTENT(IN) :: v0(:,:), v1(:)
     1031  REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
     1032  REAL(KIND=REAL32), ALLOCATABLE :: out(:,:), tmp(:,:)
     1033  tmp = horzcat_r11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
     1034  out = horzcat_r22(v0, tmp)
     1035END FUNCTION horzcat_r21
     1036!==============================================================================================================================
     1037FUNCTION horzcat_r22(v0, v1) RESULT(out)
     1038  IMPLICIT NONE
     1039  REAL(KIND=REAL32), INTENT(IN) :: v0(:,:), v1(:,:)
     1040  REAL(KIND=REAL32), ALLOCATABLE :: out(:,:), pk(:)
     1041  INTEGER :: nrow, ncol
     1042  nrow = SIZE(v0,1)
     1043  ncol = SIZE(v0,2)+SIZE(v1,2)
     1044  IF(nrow /= SIZE(v1,1)) THEN; CALL msg("Can't concatenate real arrays of differing rows numbers"); STOP; END IF
     1045  ALLOCATE(out(nrow, ncol))
     1046  pk =      PACK(v0, .TRUE.)
     1047  pk = [pk, PACK(v1, .TRUE.)]
     1048  out = RESHAPE(pk, SHAPE=[nrow, ncol])
     1049END FUNCTION horzcat_r22
     1050!==============================================================================================================================
     1051FUNCTION horzcat_d00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1052  IMPLICIT NONE
     1053  REAL(KIND=REAL64),           INTENT(IN) :: v0
     1054  REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
     1055  REAL(KIND=REAL64), ALLOCATABLE :: out(:)
     1056  INTEGER                       :: ncol, iv, i
     1057  LOGICAL                       :: pre(9)
    9631058!------------------------------------------------------------------------------------------------------------------------------
    9641059  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
    … …  
    9661061  ALLOCATE(out(ncol))
    9671062  out(1) = v0
    968   DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     1063  i = 2
     1064  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
    9691065     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
     1066        CASE(1); out(i) = v1; CASE(2); out(i) = v2; CASE(3); out(i) = v3; CASE(4); out(i) = v4; CASE(5); out(i) = v5
     1067        CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
    9721068     END SELECT
    973      out(iv) = v
    974   END DO
    975 END FUNCTION horzcat_r00
    976 !==============================================================================================================================
    977 FUNCTION 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
    981   REAL(KIND=REAL32), ALLOCATABLE :: out(:), tmp(:)
    982   INTEGER :: nc
    983   nc  = SIZE(v0)
    984   tmp = horzcat_r00(v0(nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    985   IF(nc == 1) out = tmp
    986   IF(nc /= 1) out = [v0(1:nc-1), tmp]
    987 END FUNCTION horzcat_r10
    988 !==============================================================================================================================
    989 FUNCTION 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(:)
    993   REAL(KIND=REAL32), ALLOCATABLE :: out(:,:)
    994   REAL(KIND=REAL32), POINTER     :: v(:)
    995   INTEGER :: nrow, ncol, iv, n
     1069     i = i+1
     1070  END DO
     1071END FUNCTION horzcat_d00
     1072!==============================================================================================================================
     1073FUNCTION horzcat_d10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1074  IMPLICIT NONE
     1075  REAL(KIND=REAL64),           INTENT(IN) :: v0(:), v1
     1076  REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
     1077  REAL(KIND=REAL64), ALLOCATABLE :: out(:), tmp(:)
     1078  tmp = horzcat_d00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
     1079  out = [v0 , tmp]
     1080END FUNCTION horzcat_d10
     1081!==============================================================================================================================
     1082FUNCTION horzcat_d11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1083  IMPLICIT NONE
     1084  REAL(KIND=REAL64),           INTENT(IN) :: v0(:)
     1085  REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
     1086  REAL(KIND=REAL64), ALLOCATABLE :: out(:,:)
     1087  INTEGER :: siz(9), nrow, ncol, iv, i, n
    9961088  LOGICAL :: pre(9)
    9971089!------------------------------------------------------------------------------------------------------------------------------
    … …  
    10011093  ALLOCATE(out(nrow, ncol))
    10021094  out(:,1) = v0
    1003   DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     1095  i = 2
     1096  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
    10041097     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
     1098        CASE(1); n = SIZE(v1); CASE(2); n = SIZE(v2); CASE(3); n = SIZE(v3); CASE(4); n = SIZE(v4); CASE(5); n = SIZE(v5)
     1099        CASE(6); n = SIZE(v6); CASE(7); n = SIZE(v7); CASE(8); n = SIZE(v8); CASE(9); n = SIZE(v9)
    10071100     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(:)
    1011   END DO
    1012 END FUNCTION horzcat_r11
    1013 !==============================================================================================================================
    1014 FUNCTION 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(:)
    1018   REAL(KIND=REAL32), ALLOCATABLE :: out(:,:), tmp(:,:)
    1019   INTEGER :: nc
    1020   nc  = SIZE(v0, 2)
    1021   tmp = horzcat_r11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
    1022   IF(nc == 1) out = tmp
    1023   IF(nc /= 1) out = RESHAPE([PACK(v0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(v0, 1), nc + SIZE(tmp, 2)-1])
    1024 END FUNCTION horzcat_r21
    1025 !==============================================================================================================================
    1026 FUNCTION 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
    1030   REAL(KIND=REAL64), ALLOCATABLE :: out(:)
    1031   REAL(KIND=REAL64), POINTER     :: v
    1032   INTEGER                        :: ncol, iv
    1033   LOGICAL                        :: pre(9)
     1101     IF(n /= nrow) THEN; CALL msg("Can't concatenate double vectors of differing lengths"); STOP; END IF
     1102     SELECT CASE(iv-1)
     1103        CASE(1); out(:,i) = v1; CASE(2); out(:,i) = v2; CASE(3); out(:,i) = v3; CASE(4); out(:,i) = v4; CASE(5); out(:,i) = v5
     1104        CASE(6); out(:,i) = v6; CASE(7); out(:,i) = v7; CASE(8); out(:,i) = v8; CASE(9); out(:,i) = v9
     1105     END SELECT
     1106     i = i+1
     1107  END DO
     1108END FUNCTION horzcat_d11
     1109!==============================================================================================================================
     1110FUNCTION horzcat_d21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1111  IMPLICIT NONE
     1112  REAL(KIND=REAL64),           INTENT(IN) :: v0(:,:), v1(:)
     1113  REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
     1114  REAL(KIND=REAL64), ALLOCATABLE :: out(:,:), tmp(:,:)
     1115  tmp = horzcat_d11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
     1116  out = horzcat_d22(v0, tmp)
     1117END FUNCTION horzcat_d21
     1118!==============================================================================================================================
     1119FUNCTION horzcat_d22(v0, v1) RESULT(out)
     1120  IMPLICIT NONE
     1121  REAL(KIND=REAL64), INTENT(IN) :: v0(:,:), v1(:,:)
     1122  REAL(KIND=REAL64), ALLOCATABLE :: out(:,:), pk(:)
     1123  INTEGER :: nrow, ncol
     1124  nrow = SIZE(v0,1)
     1125  ncol = SIZE(v0,2)+SIZE(v1,2)
     1126  IF(nrow /= SIZE(v1,1)) THEN; CALL msg("Can't concatenate double arrays of differing rows numbers"); STOP; END IF
     1127  ALLOCATE(out(nrow, ncol))
     1128  pk =      PACK(v0, .TRUE.)
     1129  pk = [pk, PACK(v1, .TRUE.)]
     1130  out = RESHAPE(pk, SHAPE=[nrow, ncol])
     1131END FUNCTION horzcat_d22
     1132!==============================================================================================================================
     1133FUNCTION horzcat_l00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1134  IMPLICIT NONE
     1135  LOGICAL,           INTENT(IN) :: v0
     1136  LOGICAL, OPTIONAL, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9
     1137  LOGICAL, ALLOCATABLE :: out(:)
     1138  INTEGER              :: ncol, iv, i
     1139  LOGICAL              :: pre(9)
    10341140!------------------------------------------------------------------------------------------------------------------------------
    10351141  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
    … …  
    10371143  ALLOCATE(out(ncol))
    10381144  out(1) = v0
    1039   DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     1145  i = 2
     1146  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
    10401147     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
     1148        CASE(1); out(i) = v1; CASE(2); out(i) = v2; CASE(3); out(i) = v3; CASE(4); out(i) = v4; CASE(5); out(i) = v5
     1149        CASE(6); out(i) = v6; CASE(7); out(i) = v7; CASE(8); out(i) = v8; CASE(9); out(i) = v9
    10431150     END SELECT
    1044      out(iv) = v
    1045   END DO
    1046 END FUNCTION horzcat_d00
    1047 !==============================================================================================================================
    1048 FUNCTION 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
    1052   REAL(KIND=REAL64), ALLOCATABLE :: out(:), tmp(:)
    1053   INTEGER :: nc
    1054   nc = SIZE(v0)
    1055   tmp = horzcat_d00(v0(nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    1056   IF(nc == 1) out = tmp
    1057   IF(nc /= 1) out = [v0(1:nc-1), tmp]
    1058 END FUNCTION horzcat_d10
    1059 !==============================================================================================================================
    1060 FUNCTION 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(:)
    1064   REAL(KIND=REAL64), ALLOCATABLE :: out(:,:)
    1065   REAL(KIND=REAL64), POINTER     :: v(:)
    1066   INTEGER :: nrow, ncol, iv, n
     1151  i = i+1
     1152  END DO
     1153END FUNCTION horzcat_l00
     1154!==============================================================================================================================
     1155FUNCTION horzcat_l10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1156  IMPLICIT NONE
     1157  LOGICAL,           INTENT(IN) :: v0(:), v1
     1158  LOGICAL, OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9
     1159  LOGICAL, ALLOCATABLE :: out(:), tmp(:)
     1160  tmp = horzcat_l00(v1, v2, v3, v4, v5, v6, v7, v8, v9)
     1161  out = [v0, tmp]
     1162END FUNCTION horzcat_l10
     1163!==============================================================================================================================
     1164FUNCTION horzcat_l11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1165  IMPLICIT NONE
     1166  LOGICAL,           INTENT(IN) :: v0(:)
     1167  LOGICAL, OPTIONAL, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
     1168  LOGICAL, ALLOCATABLE :: out(:,:)
     1169  INTEGER :: siz(9), nrow, ncol, iv, i, n
    10671170  LOGICAL :: pre(9)
    10681171!------------------------------------------------------------------------------------------------------------------------------
    10691172  pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)]
     1173  ncol = 1+COUNT(pre)
    10701174  nrow = SIZE(v0)
    1071   ncol = 1+COUNT(pre)
    10721175  ALLOCATE(out(nrow, ncol))
    1073   DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE
     1176  out(:,1) = v0
     1177  i = 2
     1178  DO iv = i, ncol; IF(.NOT.pre(iv-1)) CYCLE
    10741179     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
     1180        CASE(1); n = SIZE(v1); CASE(2); n = SIZE(v2); CASE(3); n = SIZE(v3); CASE(4); n = SIZE(v4); CASE(5); n = SIZE(v5)
     1181        CASE(6); n = SIZE(v6); CASE(7); n = SIZE(v7); CASE(8); n = SIZE(v8); CASE(9); n = SIZE(v9)
    10771182     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(:)
    1081   END DO
    1082 END FUNCTION horzcat_d11
    1083 !==============================================================================================================================
    1084 FUNCTION 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(:)
    1088   REAL(KIND=REAL64), ALLOCATABLE :: out(:,:), tmp(:,:)
    1089   INTEGER :: nc
    1090   nc  = SIZE(v0, 2)
    1091   tmp = horzcat_d11(v0(:,nc), v1, v2, v3, v4, v5, v6, v7, v8, v9)
    1092   IF(nc == 1) out = tmp
    1093   IF(nc /= 1) out = RESHAPE([PACK(v0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(v0, 1), nc + SIZE(tmp, 2)-1])
    1094 END FUNCTION horzcat_d21
     1183     IF(n /= nrow) THEN; CALL msg("Can't concatenate logical vectors of differing lengths"); STOP; END IF
     1184     SELECT CASE(iv-1)
     1185        CASE(1); out(:,i) = v1; CASE(2); out(:,i) = v2; CASE(3); out(:,i) = v3; CASE(4); out(:,i) = v4; CASE(5); out(:,i) = v5
     1186        CASE(6); out(:,i) = v6; CASE(7); out(:,i) = v7; CASE(8); out(:,i) = v8; CASE(9); out(:,i) = v9
     1187     END SELECT
     1188     i = i+1
     1189  END DO
     1190END FUNCTION horzcat_l11
     1191!==============================================================================================================================
     1192FUNCTION horzcat_l21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out)
     1193  IMPLICIT NONE
     1194  LOGICAL,           INTENT(IN) :: v0(:,:), v1(:)
     1195  LOGICAL, OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:)
     1196  LOGICAL, ALLOCATABLE :: out(:,:), tmp(:,:)
     1197  tmp = horzcat_l11(v1, v2, v3, v4, v5, v6, v7, v8, v9)
     1198  out = horzcat_l22(v0, tmp)
     1199END FUNCTION horzcat_l21
     1200!==============================================================================================================================
     1201FUNCTION horzcat_l22(v0, v1) RESULT(out)
     1202  IMPLICIT NONE
     1203  LOGICAL, INTENT(IN) :: v0(:,:), v1(:,:)
     1204  LOGICAL, ALLOCATABLE :: out(:,:), pk(:)
     1205  INTEGER :: nrow, ncol
     1206  nrow = SIZE(v0,1)
     1207  ncol = SIZE(v0,2)+SIZE(v1,2)
     1208  IF(nrow /= SIZE(v1,1)) THEN; CALL msg("Can't concatenate logical arrays of differing rows numbers"); STOP; END IF
     1209  ALLOCATE(out(nrow, ncol))
     1210  pk =      PACK(v0, .TRUE.)
     1211  pk = [pk, PACK(v1, .TRUE.)]
     1212  out = RESHAPE(pk, SHAPE=[nrow, ncol])
     1213END FUNCTION horzcat_l22
    10951214!==============================================================================================================================
    10961215
Note: See TracChangeset for help on using the changeset viewer.