Index: LMDZ6/trunk/libf/misc/strings_mod.f90 =================================================================== --- LMDZ6/trunk/libf/misc/strings_mod.f90 (revision 5748) +++ LMDZ6/trunk/libf/misc/strings_mod.f90 (revision 5749) @@ -800,296 +800,296 @@ !=== Contatenate horizontally scalars/vectors of strings/integers/reals into a vector/array =================================== !============================================================================================================================== -FUNCTION horzcat_s00(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out) - IMPLICIT NONE - CHARACTER(LEN=*), INTENT(IN) :: s0 - CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1, s2, s3, s4, s5, s6, s7, s8, s9 +FUNCTION horzcat_s00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: v0 + CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9 CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:) - CHARACTER(LEN=maxlen), POINTER :: s - INTEGER :: nrow, iv + CHARACTER(LEN=maxlen), POINTER :: v + INTEGER :: ncol, iv LOGICAL :: pre(9) !------------------------------------------------------------------------------------------------------------------------------ - pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)] - nrow = 1+COUNT(pre) - ALLOCATE(out(nrow)) - out(1) = s0 - DO iv = 2, nrow; IF(.NOT.pre(iv-1)) CYCLE - SELECT CASE(iv-1) - CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5 - CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9 - END SELECT - out(iv) = s + pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)] + ncol = 1+COUNT(pre) + ALLOCATE(out(ncol)) + out(1) = v0 + DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE + SELECT CASE(iv-1) + CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5 + CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9 + END SELECT + out(iv) = v END DO END FUNCTION horzcat_s00 !============================================================================================================================== -FUNCTION horzcat_s10(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out) - IMPLICIT NONE - CHARACTER(LEN=*), INTENT(IN) :: s0(:), s1 - CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2, s3, s4, s5, s6, s7, s8, s9 +FUNCTION horzcat_s10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: v0(:), v1 + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9 CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:), tmp(:) INTEGER :: nc - nc = SIZE(s0) - tmp = horzcat_s00(s0(nc), s1, s2, s3, s4, s5, s6, s7, s8, s9) + nc = SIZE(v0) + tmp = horzcat_s00(v0(nc), v1, v2, v3, v4, v5, v6, v7, v8, v9) IF(nc == 1) out = tmp IF(nc /= 1) THEN !ym fix for nvidia compiler -!ym out = [s0(1:nc-1), tmp] - out = s0(1:nc-1) - out = [out , tmp] +!ym out = [v0(1:nc-1), tmp] + out = v0(1:nc-1) + out = [out , tmp] ENDIF END FUNCTION horzcat_s10 !============================================================================================================================== -FUNCTION horzcat_s11(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out) - IMPLICIT NONE - CHARACTER(LEN=*), INTENT(IN) :: s0(:) - CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: s1(:), s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:) +FUNCTION horzcat_s11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: v0(:) + CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:) CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:) - CHARACTER(LEN=maxlen), POINTER :: s(:) - INTEGER :: nrow, ncol, iv, n - LOGICAL :: pre(9) -!------------------------------------------------------------------------------------------------------------------------------ - pre(:) = [PRESENT(s1),PRESENT(s2),PRESENT(s3),PRESENT(s4),PRESENT(s5),PRESENT(s6),PRESENT(s7),PRESENT(s8),PRESENT(s9)] - nrow = SIZE(s0) + CHARACTER(LEN=maxlen), POINTER :: v(:) + INTEGER :: nrow, ncol, iv, n + LOGICAL :: pre(9) +!------------------------------------------------------------------------------------------------------------------------------ + pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)] + nrow = SIZE(v0) ncol = 1+COUNT(pre) ALLOCATE(out(nrow, ncol)) - out(:,1) = s0 + out(:,1) = v0 DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE - SELECT CASE(iv-1) - CASE(1); s=> s1; CASE(2); s=> s2; CASE(3); s=> s3; CASE(4); s=> s4; CASE(5); s=> s5 - CASE(6); s=> s6; CASE(7); s=> s7; CASE(8); s=> s8; CASE(9); s=> s9 - END SELECT - n = SIZE(s, DIM=1) - IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF - out(:,iv) = s(:) + SELECT CASE(iv-1) + CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5 + CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9 + END SELECT + n = SIZE(v, DIM=1) + IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF + out(:,iv) = v(:) END DO END FUNCTION horzcat_s11 !============================================================================================================================== -FUNCTION horzcat_s21(s0, s1, s2, s3, s4, s5, s6, s7, s8, s9) RESULT(out) - IMPLICIT NONE - CHARACTER(LEN=*), INTENT(IN) :: s0(:,:), s1(:) - CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: s2(:), s3(:), s4(:), s5(:), s6(:), s7(:), s8(:), s9(:) +FUNCTION horzcat_s21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + CHARACTER(LEN=*), INTENT(IN) :: v0(:,:), v1(:) + CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:) CHARACTER(LEN=maxlen), ALLOCATABLE :: out(:,:), tmp(:,:), pk(:) INTEGER :: nc - nc = SIZE(s0, 2) - tmp = horzcat_s11(s0(:,nc), s1, s2, s3, s4, s5, s6, s7, s8, s9) + nc = SIZE(v0, 2) + tmp = horzcat_s11(v0(:,nc), v1, v2, v3, v4, v5, v6, v7, v8, v9) IF(nc == 1) out = tmp !ym fix for nvidia compiler -!ym IF(nc /= 1) out = RESHAPE([PACK(s0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(s0, 1), nc + SIZE(tmp, 2)-1]) +!ym IF(nc /= 1) out = RESHAPE([PACK(v0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(s0, 1), nc + SIZE(tmp, 2)-1]) IF(nc /= 1) THEN - pk = PACK(s0(:,1:nc-1), .TRUE.) - pk = [ pk, PACK(tmp, .TRUE.)] - out = RESHAPE(pk, SHAPE=[SIZE(s0, 1), nc + SIZE(tmp, 2)-1]) + pk = PACK(v0(:,1:nc-1), .TRUE.) + pk = [ pk, PACK(tmp, .TRUE.)] + out = RESHAPE(pk, SHAPE=[SIZE(v0, 1), nc + SIZE(tmp, 2)-1]) ENDIF END FUNCTION horzcat_s21 !============================================================================================================================== -FUNCTION horzcat_i00(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out) - IMPLICIT NONE - INTEGER, INTENT(IN) :: i0 - INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1, i2, i3, i4, i5, i6, i7, i8, i9 +FUNCTION horzcat_i00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + INTEGER, INTENT(IN) :: v0 + INTEGER, OPTIONAL, TARGET, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9 INTEGER, ALLOCATABLE :: out(:) - INTEGER, POINTER :: i + INTEGER, POINTER :: v INTEGER :: ncol, iv LOGICAL :: pre(9) !------------------------------------------------------------------------------------------------------------------------------ - pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)] + pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)] ncol = SIZE(pre) ALLOCATE(out(ncol)) - out(1) = i0 + out(1) = v0 DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE - SELECT CASE(iv-1) - CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5 - CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9 - END SELECT - out(iv) = i + SELECT CASE(iv-1) + CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5 + CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9 + END SELECT + out(iv) = v END DO END FUNCTION horzcat_i00 !============================================================================================================================== -FUNCTION horzcat_i10(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out) - IMPLICIT NONE - INTEGER, INTENT(IN) :: i0(:), i1 - INTEGER, OPTIONAL, INTENT(IN) :: i2, i3, i4, i5, i6, i7, i8, i9 +FUNCTION horzcat_i10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + INTEGER, INTENT(IN) :: v0(:), v1 + INTEGER, OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9 INTEGER, ALLOCATABLE :: out(:), tmp(:) INTEGER :: nc - nc = SIZE(i0) - tmp = horzcat_i00(i0(nc), i1, i2, i3, i4, i5, i6, i7, i8, i9) + nc = SIZE(v0) + tmp = horzcat_i00(v0(nc), v1, v2, v3, v4, v5, v6, v7, v8, v9) IF(nc == 1) out = tmp - IF(nc /= 1) out = [i0(1:nc-1), tmp] + IF(nc /= 1) out = [v0(1:nc-1), tmp] END FUNCTION horzcat_i10 !============================================================================================================================== -FUNCTION horzcat_i11(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out) - IMPLICIT NONE - INTEGER, INTENT(IN) :: i0(:) - INTEGER, OPTIONAL, TARGET, INTENT(IN) :: i1(:), i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:) +FUNCTION horzcat_i11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + INTEGER, INTENT(IN) :: v0(:) + INTEGER, OPTIONAL, TARGET, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:) INTEGER, ALLOCATABLE :: out(:,:) - INTEGER, POINTER :: i(:) + INTEGER, POINTER :: v(:) INTEGER :: nrow, ncol, iv, n LOGICAL :: pre(9) !------------------------------------------------------------------------------------------------------------------------------ - pre(:) = [PRESENT(i1),PRESENT(i2),PRESENT(i3),PRESENT(i4),PRESENT(i5),PRESENT(i6),PRESENT(i7),PRESENT(i8),PRESENT(i9)] - nrow = SIZE(i0) + pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)] + nrow = SIZE(v0) ncol = 1+COUNT(pre) ALLOCATE(out(nrow, ncol)) - out(:,1) = i0 + out(:,1) = v0 DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE - SELECT CASE(iv-1) - CASE(1); i=> i1; CASE(2); i=> i2; CASE(3); i=> i3; CASE(4); i=> i4; CASE(5); i=> i5 - CASE(6); i=> i6; CASE(7); i=> i7; CASE(8); i=> i8; CASE(9); i=> i9 - END SELECT - n = SIZE(i, DIM=1) - IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF - out(:,iv) = i(:) + SELECT CASE(iv-1) + CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5 + CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9 + END SELECT + n = SIZE(v, DIM=1) + IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF + out(:,iv) = v(:) END DO END FUNCTION horzcat_i11 !============================================================================================================================== -FUNCTION horzcat_i21(i0, i1, i2, i3, i4, i5, i6, i7, i8, i9) RESULT(out) - IMPLICIT NONE - INTEGER, INTENT(IN) :: i0(:,:), i1(:) - INTEGER, OPTIONAL, INTENT(IN) :: i2(:), i3(:), i4(:), i5(:), i6(:), i7(:), i8(:), i9(:) +FUNCTION horzcat_i21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + INTEGER, INTENT(IN) :: v0(:,:), v1(:) + INTEGER, OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:) INTEGER, ALLOCATABLE :: out(:,:), tmp(:,:) INTEGER :: nc - nc = SIZE(i0, 2) - tmp = horzcat_i11(i0(:,nc), i1, i2, i3, i4, i5, i6, i7, i8, i9) + nc = SIZE(v0, 2) + tmp = horzcat_i11(v0(:,nc), v1, v2, v3, v4, v5, v6, v7, v8, v9) IF(nc == 1) out = tmp - IF(nc /= 1) out = RESHAPE([PACK(i0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(i0, 1), nc + SIZE(tmp, 2)-1]) + IF(nc /= 1) out = RESHAPE([PACK(v0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(v0, 1), nc + SIZE(tmp, 2)-1]) END FUNCTION horzcat_i21 !============================================================================================================================== -FUNCTION horzcat_r00(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out) - IMPLICIT NONE - REAL(KIND=REAL32), INTENT(IN) :: r0 - REAL(KIND=REAL32), OPTIONAL, TARGET, INTENT(IN) :: r1, r2, r3, r4, r5, r6, r7, r8, r9 +FUNCTION horzcat_r00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + REAL(KIND=REAL32), INTENT(IN) :: v0 + REAL(KIND=REAL32), OPTIONAL, TARGET, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9 REAL(KIND=REAL32), ALLOCATABLE :: out(:) - REAL(KIND=REAL32), POINTER :: r + REAL(KIND=REAL32), POINTER :: v INTEGER :: ncol, iv LOGICAL :: pre(9) !------------------------------------------------------------------------------------------------------------------------------ - pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)] + pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)] ncol = 1+COUNT(pre) ALLOCATE(out(ncol)) - out(1) = r0 + out(1) = v0 DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE - SELECT CASE(iv-1) - CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5 - CASE(6); r=> r6; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9 - END SELECT - out(iv) = r + SELECT CASE(iv-1) + CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5 + CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9 + END SELECT + out(iv) = v END DO END FUNCTION horzcat_r00 !============================================================================================================================== -FUNCTION horzcat_r10(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out) - IMPLICIT NONE - REAL(KIND=REAL32), INTENT(IN) :: r0(:), r1 - REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: r2, r3, r4, r5, r6, r7, r8, r9 +FUNCTION horzcat_r10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + REAL(KIND=REAL32), INTENT(IN) :: v0(:), v1 + REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9 REAL(KIND=REAL32), ALLOCATABLE :: out(:), tmp(:) INTEGER :: nc - nc = SIZE(r0) - tmp = horzcat_r00(r0(nc), r1, r2, r3, r4, r5, r6, r7, r8, r9) + nc = SIZE(v0) + tmp = horzcat_r00(v0(nc), v1, v2, v3, v4, v5, v6, v7, v8, v9) IF(nc == 1) out = tmp - IF(nc /= 1) out = [r0(1:nc-1), tmp] + IF(nc /= 1) out = [v0(1:nc-1), tmp] END FUNCTION horzcat_r10 !============================================================================================================================== -FUNCTION horzcat_r11(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out) - IMPLICIT NONE - REAL(KIND=REAL32), INTENT(IN) :: r0(:) - REAL(KIND=REAL32), OPTIONAL, TARGET, INTENT(IN) :: r1(:), r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:) +FUNCTION horzcat_r11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + REAL(KIND=REAL32), INTENT(IN) :: v0(:) + REAL(KIND=REAL32), OPTIONAL, TARGET, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:) REAL(KIND=REAL32), ALLOCATABLE :: out(:,:) - REAL(KIND=REAL32), POINTER :: r(:) + REAL(KIND=REAL32), POINTER :: v(:) INTEGER :: nrow, ncol, iv, n LOGICAL :: pre(9) !------------------------------------------------------------------------------------------------------------------------------ - pre(:) = [PRESENT(r1),PRESENT(r2),PRESENT(r3),PRESENT(r4),PRESENT(r5),PRESENT(r6),PRESENT(r7),PRESENT(r8),PRESENT(r9)] - nrow = SIZE(r0) + pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)] + nrow = SIZE(v0) ncol = 1+COUNT(pre) ALLOCATE(out(nrow, ncol)) - out(:,1) = r0 + out(:,1) = v0 DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE - SELECT CASE(iv-1) - CASE(1); r=> r1; CASE(2); r=> r2; CASE(3); r=> r3; CASE(4); r=> r4; CASE(5); r=> r5 - CASE(6); r=> r5; CASE(7); r=> r7; CASE(8); r=> r8; CASE(9); r=> r9 - END SELECT - n = SIZE(r, DIM=1) - IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF - out(:,iv) = r(:) + SELECT CASE(iv-1) + CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5 + CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9 + END SELECT + n = SIZE(v, DIM=1) + IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF + out(:,iv) = v(:) END DO END FUNCTION horzcat_r11 !============================================================================================================================== -FUNCTION horzcat_r21(r0, r1, r2, r3, r4, r5, r6, r7, r8, r9) RESULT(out) - IMPLICIT NONE - REAL(KIND=REAL32), INTENT(IN) :: r0(:,:), r1(:) - REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: r2(:), r3(:), r4(:), r5(:), r6(:), r7(:), r8(:), r9(:) +FUNCTION horzcat_r21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + REAL(KIND=REAL32), INTENT(IN) :: v0(:,:), v1(:) + REAL(KIND=REAL32), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:) REAL(KIND=REAL32), ALLOCATABLE :: out(:,:), tmp(:,:) INTEGER :: nc - nc = SIZE(r0, 2) - tmp = horzcat_r11(r0(:,nc), r1, r2, r3, r4, r5, r6, r7, r8, r9) + nc = SIZE(v0, 2) + tmp = horzcat_r11(v1, v2, v3, v4, v5, v6, v7, v8, v9) IF(nc == 1) out = tmp - IF(nc /= 1) out = RESHAPE([PACK(r0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(r0, 1), nc + SIZE(tmp, 2)-1]) + IF(nc /= 1) out = RESHAPE([PACK(v0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(v0, 1), nc + SIZE(tmp, 2)-1]) END FUNCTION horzcat_r21 !============================================================================================================================== -FUNCTION horzcat_d00(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out) - IMPLICIT NONE - REAL(KIND=REAL64), INTENT(IN) :: d0 - REAL(KIND=REAL64), OPTIONAL, TARGET, INTENT(IN) :: d1, d2, d3, d4, d5, d6, d7, d8, d9 +FUNCTION horzcat_d00(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + REAL(KIND=REAL64), INTENT(IN) :: v0 + REAL(KIND=REAL64), OPTIONAL, TARGET, INTENT(IN) :: v1, v2, v3, v4, v5, v6, v7, v8, v9 REAL(KIND=REAL64), ALLOCATABLE :: out(:) - REAL(KIND=REAL64), POINTER :: d - INTEGER :: ncol, iv - LOGICAL :: pre(9) -!------------------------------------------------------------------------------------------------------------------------------ - pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)] + REAL(KIND=REAL64), POINTER :: v + INTEGER :: ncol, iv + LOGICAL :: pre(9) +!------------------------------------------------------------------------------------------------------------------------------ + pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)] ncol = 1+COUNT(pre) ALLOCATE(out(ncol)) - out(1) = d0 + out(1) = v0 DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE - SELECT CASE(iv-1) - CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5 - CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9 - END SELECT - out(iv) = d + SELECT CASE(iv-1) + CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5 + CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9 + END SELECT + out(iv) = v END DO END FUNCTION horzcat_d00 !============================================================================================================================== -FUNCTION horzcat_d10(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out) - IMPLICIT NONE - REAL(KIND=REAL64), INTENT(IN) :: d0(:), d1 - REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: d2, d3, d4, d5, d6, d7, d8, d9 +FUNCTION horzcat_d10(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + REAL(KIND=REAL64), INTENT(IN) :: v0(:), v1 + REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v2, v3, v4, v5, v6, v7, v8, v9 REAL(KIND=REAL64), ALLOCATABLE :: out(:), tmp(:) INTEGER :: nc - nc = SIZE(d0) - tmp = horzcat_d00(d0(nc), d1, d2, d3, d4, d5, d6, d7, d8, d9) + nc = SIZE(v0) + tmp = horzcat_d00(v0(nc), v1, v2, v3, v4, v5, v6, v7, v8, v9) IF(nc == 1) out = tmp - IF(nc /= 1) out = [d0(1:nc-1), tmp] + IF(nc /= 1) out = [v0(1:nc-1), tmp] END FUNCTION horzcat_d10 !============================================================================================================================== -FUNCTION horzcat_d11(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out) - IMPLICIT NONE - REAL(KIND=REAL64), INTENT(IN) :: d0(:) - REAL(KIND=REAL64), OPTIONAL, TARGET, INTENT(IN) :: d1(:), d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:) +FUNCTION horzcat_d11(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + REAL(KIND=REAL64), INTENT(IN) :: v0(:) + REAL(KIND=REAL64), OPTIONAL, TARGET, INTENT(IN) :: v1(:), v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:) REAL(KIND=REAL64), ALLOCATABLE :: out(:,:) - REAL(KIND=REAL64), POINTER :: d(:) - INTEGER :: nrow, ncol, iv, n - LOGICAL :: pre(9) -!------------------------------------------------------------------------------------------------------------------------------ - nrow = SIZE(d0) - pre(:) = [PRESENT(d1),PRESENT(d2),PRESENT(d3),PRESENT(d4),PRESENT(d5),PRESENT(d6),PRESENT(d7),PRESENT(d8),PRESENT(d9)] + REAL(KIND=REAL64), POINTER :: v(:) + INTEGER :: nrow, ncol, iv, n + LOGICAL :: pre(9) +!------------------------------------------------------------------------------------------------------------------------------ + pre(:) = [PRESENT(v1),PRESENT(v2),PRESENT(v3),PRESENT(v4),PRESENT(v5),PRESENT(v6),PRESENT(v7),PRESENT(v8),PRESENT(v9)] + nrow = SIZE(v0) ncol = 1+COUNT(pre) ALLOCATE(out(nrow, ncol)) DO iv = 2, ncol; IF(.NOT.pre(iv-1)) CYCLE - SELECT CASE(iv-1) - CASE(1); d=> d1; CASE(2); d=> d2; CASE(3); d=> d3; CASE(4); d=> d4; CASE(5); d=> d5 - CASE(6); d=> d6; CASE(7); d=> d7; CASE(8); d=> d8; CASE(9); d=> d9 - END SELECT - n = SIZE(d, DIM=1) - IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF - out(:,iv) = d(:) + SELECT CASE(iv-1) + CASE(1); v=> v1; CASE(2); v=> v2; CASE(3); v=> v3; CASE(4); v=> v4; CASE(5); v=> v5 + CASE(6); v=> v6; CASE(7); v=> v7; CASE(8); v=> v8; CASE(9); v=> v9 + END SELECT + n = SIZE(v, DIM=1) + IF(n /= nrow) THEN; CALL msg("Can't concatenate vectors of differing lengths"); STOP; END IF + out(:,iv) = v(:) END DO END FUNCTION horzcat_d11 !============================================================================================================================== -FUNCTION horzcat_d21(d0, d1, d2, d3, d4, d5, d6, d7, d8, d9) RESULT(out) - IMPLICIT NONE - REAL(KIND=REAL64), INTENT(IN) :: d0(:,:), d1(:) - REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: d2(:), d3(:), d4(:), d5(:), d6(:), d7(:), d8(:), d9(:) +FUNCTION horzcat_d21(v0, v1, v2, v3, v4, v5, v6, v7, v8, v9) RESULT(out) + IMPLICIT NONE + REAL(KIND=REAL64), INTENT(IN) :: v0(:,:), v1(:) + REAL(KIND=REAL64), OPTIONAL, INTENT(IN) :: v2(:), v3(:), v4(:), v5(:), v6(:), v7(:), v8(:), v9(:) REAL(KIND=REAL64), ALLOCATABLE :: out(:,:), tmp(:,:) INTEGER :: nc - nc = SIZE(d0, 2) - tmp = horzcat_d11(d0(:,nc), d1, d2, d3, d4, d5, d6, d7, d8, d9) + nc = SIZE(v0, 2) + tmp = horzcat_d11(v0(:,nc), v1, v2, v3, v4, v5, v6, v7, v8, v9) IF(nc == 1) out = tmp - IF(nc /= 1) out = RESHAPE([PACK(d0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(d0, 1), nc + SIZE(tmp, 2)-1]) + IF(nc /= 1) out = RESHAPE([PACK(v0(:,1:nc-1), .TRUE.), PACK(tmp, .TRUE.)], SHAPE=[SIZE(v0, 1), nc + SIZE(tmp, 2)-1]) END FUNCTION horzcat_d21 !==============================================================================================================================