libgomp/testsuite/libgomp.fortran/order-reproducible-1.f90

   1 ! { dg-additional-sources my-usleep.c }
   2 ! { dg-additional-options -Wno-complain-wrong-lang }
   3
   4 program main
   5   implicit none
   6   interface
   7     subroutine usleep(t) bind(C, name="my_usleep")
   8       use iso_c_binding
   9       integer(c_int), value :: t
  10     end subroutine
  11   end interface
  12
  13   integer :: a(128)
  14   integer :: i
  15
  16   !$omp teams num_teams(5)
  17     !$omp loop bind(teams)
  18     do i = 1, 128
  19       a(i) = i
  20       if (i == 1) then
  21         call usleep (20)
  22       else if (i == 17) then
  23         call usleep (40)
  24       end if
  25     end do
  26     !$omp loop bind(teams)
  27     do i = 1, 128
  28       a(i) = a(i) + i
  29     end do
  30   !$omp end teams
  31   do i = 1, 128
  32     if (a(i) /= 2 * i) &
  33       stop 1
  34   end do
  35   !$omp teams num_teams(5)
  36     !$omp loop bind(teams) order(concurrent)
  37     do i = 1, 128
  38       a(i) = a(i) * 2
  39       if (i == 1) then
  40         call usleep (20)
  41       else if (i == 13) then
  42         call usleep (40)
  43       end if
  44     end do
  45     !$omp loop bind(teams) order(concurrent)
  46     do i = 1, 128
  47       a(i) = a(i) + i
  48     end do
  49   !$omp end teams
  50   do i = 1, 128
  51     if (a(i) /= 5 * i) &
  52       stop 2
  53   end do
  54   !$omp teams num_teams(5)
  55     !$omp loop bind(teams) order(reproducible:concurrent)
  56     do i = 1, 128
  57       a(i) = a(i) * 2
  58       if (i == 3) then
  59         call usleep (20)
  60       else if (i == 106) then
  61         call usleep (40)
  62       end if
  63     end do
  64     !$omp loop bind(teams) order(reproducible:concurrent)
  65     do i = 1, 128
  66       a(i) = a(i) + i
  67     end do
  68   !$omp end teams
  69   do i = 1, 128
  70     if (a(i) /= 11 * i) &
  71       stop 3
  72   end do
  73 end program main