1! Test cshift1 for character arrays. 2! { dg-do run } 3program main 4 implicit none 5 integer, parameter :: n1 = 2, n2 = 3, n3 = 4, slen = 3 6 character (len = slen), dimension (n1, n2, n3) :: a 7 integer (kind = 1), dimension (2, 4) :: shift1 8 integer (kind = 2), dimension (2, 4) :: shift2 9 integer (kind = 4), dimension (2, 4) :: shift3 10 integer (kind = 8), dimension (2, 4) :: shift4 11 integer :: i1, i2, i3 12 13 do i3 = 1, n3 14 do i2 = 1, n2 15 do i1 = 1, n1 16 a (i1, i2, i3) = 'ab'(i1:i1) // 'cde'(i2:i2) // 'fghi'(i3:i3) 17 end do 18 end do 19 end do 20 21 shift1 (1, :) = (/ 4, 11, 19, 20 /) 22 shift1 (2, :) = (/ 55, 5, 1, 2 /) 23 shift2 = shift1 24 shift3 = shift1 25 shift4 = shift1 26 27 call test (cshift (a, shift1, 2)) 28 call test (cshift (a, shift2, 2)) 29 call test (cshift (a, shift3, 2)) 30 call test (cshift (a, shift4, 2)) 31contains 32 subroutine test (b) 33 character (len = slen), dimension (n1, n2, n3) :: b 34 integer :: i2p 35 36 do i3 = 1, n3 37 do i2 = 1, n2 38 do i1 = 1, n1 39 i2p = mod (shift1 (i1, i3) + i2 - 1, n2) + 1 40 if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) STOP 1 41 end do 42 end do 43 end do 44 end subroutine test 45end program main 46