1! Exercise nested function decomposition, gcc/tree-nested.c.
2
3! { dg-do run }
4! { dg-options "-std=legacy" }
5
6program collapse2
7  call test1
8  call test2
9contains
10  subroutine test1
11    integer :: i, j, k, a(1:3, 4:6, 5:7)
12    logical :: l
13    l = .false.
14    a(:, :, :) = 0
15    !$acc parallel reduction (.or.:l)
16    !$acc loop worker vector collapse(4 - 1)
17      do 164 i = 1, 3
18        do 164 j = 4, 6
19          do 164 k = 5, 7
20            a(i, j, k) = i + j + k
21164      end do
22    !$acc loop worker vector reduction(.or.:l) collapse(2)
23firstdo: do i = 1, 3
24        do j = 4, 6
25          do k = 5, 7
26            if (a(i, j, k) .ne. (i + j + k)) l = .true.
27          end do
28        end do
29      end do firstdo
30    !$acc end parallel
31    if (l) STOP 1
32  end subroutine test1
33
34  subroutine test2
35    integer :: a(3,3,3), k, kk, kkk, l, ll, lll
36    a = 0
37    !$acc parallel num_workers(8)
38    ! Use "gang(static:1)" here and below to effectively turn gang-redundant
39    ! execution mode into something like gang-single.
40    !$acc loop gang(static:1) collapse(1)
41      do 115 k=1,3
42         !$acc loop collapse(2)
43  dokk: do kk=1,3
44          do kkk=1,3
45            a(k,kk,kkk) = 1
46          enddo
47        enddo dokk
48115   continue
49    !$acc loop gang(static:1) collapse(1)
50      do k=1,3
51         if (any(a(k,1:3,1:3).ne.1)) STOP 2
52      enddo
53    ! Use "gang(static:1)" here and below to effectively turn gang-redundant
54    ! execution mode into something like gang-single.
55    !$acc loop gang(static:1) collapse(1)
56 dol: do 120 l=1,3
57    !$acc loop collapse(2)
58  doll: do ll=1,3
59          do lll=1,3
60            a(l,ll,lll) = 2
61          enddo
62        enddo doll
63120   end do dol
64    !$acc loop gang(static:1) collapse(1)
65     do l=1,3
66        if (any(a(l,1:3,1:3).ne.2)) STOP 3
67     enddo
68    !$acc end parallel
69  end subroutine test2
70
71end program collapse2
72