1 ! Test eoshift2 for character arrays.
5 integer, parameter :: n1
= 2, n2
= 5, n3
= 4, slen
= 3
6 character (len
= slen
), dimension (n1
, n2
, n3
) :: a
7 character (len
= slen
), dimension (n1
, n3
) :: filler
8 integer (kind
= 1) :: shift1
= 4
9 integer (kind
= 2) :: shift2
= 2
10 integer (kind
= 4) :: shift3
= 3
11 integer (kind
= 8) :: shift4
= 1
14 filler (1, :) = (/ 'tic', 'tac', 'toe', 'tip' /)
15 filler (2, :) = (/ 'zzz', 'yyy', 'xxx', 'www' /)
20 a (i1
, i2
, i3
) = 'ab'(i1
:i1
) // 'cdefg'(i2
:i2
) // 'hijk'(i3
:i3
)
25 call test (eoshift (a
, shift1
, filler
, 2), int (shift1
), .true
.)
26 call test (eoshift (a
, shift2
, filler
, 2), int (shift2
), .true
.)
27 call test (eoshift (a
, shift3
, filler
, 2), int (shift3
), .true
.)
28 call test (eoshift (a
, shift4
, filler
, 2), int (shift4
), .true
.)
30 call test (eoshift (a
, shift1
, dim
= 2), int (shift1
), .false
.)
31 call test (eoshift (a
, shift2
, dim
= 2), int (shift2
), .false
.)
32 call test (eoshift (a
, shift3
, dim
= 2), int (shift3
), .false
.)
33 call test (eoshift (a
, shift4
, dim
= 2), int (shift4
), .false
.)
35 subroutine test (b
, d2
, has_filler
)
36 character (len
= slen
), dimension (n1
, n2
, n3
) :: b
43 if (i2
+ d2
.le
. n2
) then
44 if (b (i1
, i2
, i3
) .ne
. a (i1
, i2
+ d2
, i3
)) call abort
45 else if (has_filler
) then
46 if (b (i1
, i2
, i3
) .ne
. filler (i1
, i3
)) call abort
48 if (b (i1
, i2
, i3
) .ne
. '') call abort