1 ! Test eoshift0 for character arrays.
5 integer, parameter :: n1 = 6, n2 = 5, n3 = 4, slen = 3
6 character (len = slen), dimension (n1, n2, n3) :: a
7 character (len = slen) :: 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
17 a (i1, i2, i3) = 'abcdef'(i1:i1) // 'ghijk'(i2:i2) // 'lmno'(i3:i3)
22 call test (eoshift (a, shift1, 'foo', 1), int (shift1), 0, 0, 'foo')
23 call test (eoshift (a, shift2, 'foo', 2), 0, int (shift2), 0, 'foo')
24 call test (eoshift (a, shift3, 'foo', 2), 0, int (shift3), 0, 'foo')
25 call test (eoshift (a, shift4, 'foo', 3), 0, 0, int (shift4), 'foo')
28 call test (eoshift (a, shift1, dim = 1), int (shift1), 0, 0, filler)
29 call test (eoshift (a, shift2, dim = 2), 0, int (shift2), 0, filler)
30 call test (eoshift (a, shift3, dim = 2), 0, int (shift3), 0, filler)
31 call test (eoshift (a, shift4, dim = 3), 0, 0, int (shift4), filler)
33 subroutine test (b, d1, d2, d3, filler)
34 character (len = slen), dimension (n1, n2, n3) :: b
35 character (len = slen) :: filler
41 if (i1 + d1 .gt. n1 .or. i2 + d2 .gt. n2 .or. i3 + d3 .gt. n3) then
42 if (b (i1, i2, i3) .ne. filler) call abort
44 if (b (i1, i2, i3) .ne. a (i1 + d1, i2 + d2, i3 + d3)) call abort