libgomp/testsuite/libgomp.fortran/imperfect1.f90

   1 ! { dg-do run }
   2
   3 program foo
   4   integer, save :: f1count(3), f2count(3)
   5
   6   f1count(1) = 0
   7   f1count(2) = 0
   8   f1count(3) = 0
   9   f2count(1) = 0
  10   f2count(2) = 0
  11   f2count(3) = 0
  12
  13   call s1 (3, 4, 5)
  14
  15   ! All intervening code at the same depth must be executed the same
  16   ! number of times.
  17   if (f1count(1) /= f2count(1)) error stop 101
  18   if (f1count(2) /= f2count(2)) error stop 102
  19   if (f1count(3) /= f2count(3)) error stop 103
  20
  21   ! Intervening code must be executed at least as many times as the loop
  22   ! that encloses it.
  23   if (f1count(1) < 3) error stop 111
  24   if (f1count(2) < 3 * 4) error stop 112
  25
  26   ! Intervening code must not be executed more times than the number
  27   ! of logical iterations.
  28   if (f1count(1) > 3 * 4 * 5) error stop 121
  29   if (f1count(2) > 3 * 4 * 5) error stop 122
  30
  31   ! Check that the innermost loop body is executed exactly the number
  32   ! of logical iterations expected.
  33   if (f1count(3) /= 3 * 4 * 5) error stop 131
  34
  35 contains
  36
  37 subroutine f1 (depth, iter)
  38   integer :: depth, iter
  39   f1count(depth) = f1count(depth) + 1
  40 end subroutine
  41
  42 subroutine f2 (depth, iter)
  43   integer :: depth, iter
  44   f2count(depth) = f2count(depth) + 1
  45 end subroutine
  46
  47 subroutine s1 (a1, a2, a3)
  48   integer :: a1, a2, a3
  49   integer :: i, j, k
  50
  51   !$omp do collapse(3)
  52   do i = 1, a1
  53     call f1 (1, i)
  54     do j = 1, a2
  55       call f1 (2, j)
  56       do k = 1, a3
  57         call f1 (3, k)
  58         call f2 (3, k)
  59       end do
  60       call f2 (2, j)
  61     end do
  62     call f2 (1, i)
  63   end do
  64
  65 end subroutine
  66
  67 end program