1 ! Test eoshift3 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), dimension (n1, n3) :: shift1
9 integer (kind = 2), dimension (n1, n3) :: shift2
10 integer (kind = 4), dimension (n1, n3) :: shift3
11 integer (kind = 8), dimension (n1, n3) :: shift4
14 filler (1, :) = (/ 'tic', 'tac', 'toe', 'tip' /)
15 filler (2, :) = (/ 'zzz', 'yyy', 'xxx', 'www' /)
17 shift1 (1, :) = (/ 1, 3, 2, 2 /)
18 shift1 (2, :) = (/ 2, 1, 1, 3 /)
26 a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3)
31 call test (eoshift (a, shift1, filler, 2), .true.)
32 call test (eoshift (a, shift2, filler, 2), .true.)
33 call test (eoshift (a, shift3, filler, 2), .true.)
34 call test (eoshift (a, shift4, filler, 2), .true.)
36 call test (eoshift (a, shift1, dim = 2), .false.)
37 call test (eoshift (a, shift2, dim = 2), .false.)
38 call test (eoshift (a, shift3, dim = 2), .false.)
39 call test (eoshift (a, shift4, dim = 2), .false.)
41 subroutine test (b, has_filler)
42 character (len = slen), dimension (n1, n2, n3) :: b
49 i2p = i2 + shift1 (i1, i3)
51 if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort
52 else if (has_filler) then
53 if (b (i1, i2, i3) .ne. filler (i1, i3)) call abort
55 if (b (i1, i2, i3) .ne. '') call abort