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