|
111
|
1 ! Test eoshift1 for character arrays.
|
|
|
2 ! { dg-do run }
|
|
|
3 program main
|
|
|
4 implicit none
|
|
|
5 integer, parameter :: n1 = 2, n2 = 5, n3 = 4, slen = 3
|
|
|
6 character (len = slen), dimension (n1, n2, n3) :: a
|
|
|
7 character (len = slen) :: 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
|
|
|
12 integer :: i1, i2, i3
|
|
|
13
|
|
|
14 shift1 (1, :) = (/ 1, 3, 2, 2 /)
|
|
|
15 shift1 (2, :) = (/ 2, 1, 1, 3 /)
|
|
|
16 shift2 = shift1
|
|
|
17 shift3 = shift1
|
|
|
18 shift4 = shift1
|
|
|
19
|
|
|
20 do i3 = 1, n3
|
|
|
21 do i2 = 1, n2
|
|
|
22 do i1 = 1, n1
|
|
|
23 a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3)
|
|
|
24 end do
|
|
|
25 end do
|
|
|
26 end do
|
|
|
27
|
|
|
28 call test (eoshift (a, shift1, 'foo', 2), 'foo')
|
|
|
29 call test (eoshift (a, shift2, 'foo', 2), 'foo')
|
|
|
30 call test (eoshift (a, shift3, 'foo', 2), 'foo')
|
|
|
31 call test (eoshift (a, shift4, 'foo', 2), 'foo')
|
|
|
32
|
|
|
33 filler = ''
|
|
|
34 call test (eoshift (a, shift1, dim = 2), filler)
|
|
|
35 call test (eoshift (a, shift2, dim = 2), filler)
|
|
|
36 call test (eoshift (a, shift3, dim = 2), filler)
|
|
|
37 call test (eoshift (a, shift4, dim = 2), filler)
|
|
|
38 contains
|
|
|
39 subroutine test (b, filler)
|
|
|
40 character (len = slen), dimension (n1, n2, n3) :: b
|
|
|
41 character (len = slen) :: filler
|
|
|
42 integer :: i2p
|
|
|
43
|
|
|
44 do i3 = 1, n3
|
|
|
45 do i2 = 1, n2
|
|
|
46 do i1 = 1, n1
|
|
|
47 i2p = i2 + shift1 (i1, i3)
|
|
|
48 if (i2p .gt. n2) then
|
|
131
|
49 if (b (i1, i2, i3) .ne. filler) STOP 1
|
|
111
|
50 else
|
|
131
|
51 if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) STOP 2
|
|
111
|
52 end if
|
|
|
53 end do
|
|
|
54 end do
|
|
|
55 end do
|
|
|
56 end subroutine test
|
|
|
57 end program main
|
