libgomp/testsuite/libgomp.fortran/teams2.f90

   1 program teams2
   2   use omp_lib
   3   integer :: i, j, err
   4   err = 0
   5 !$omp teams reduction(+:err)
   6   err = err + bar (0, 0, 0)
   7 !$omp end teams
   8   if (err .ne. 0) stop 1
   9 !$omp teams reduction(+:err)
  10   err = err + bar (1, 0, 0)
  11 !$omp end teams
  12   if (err .ne. 0) stop 2
  13 !$omp teams reduction(+:err)
  14 !$omp distribute
  15   do i = 0, 63
  16     err = err + bar (2, i, 0)
  17   end do
  18 !$omp end teams
  19   if (err .ne. 0) stop 3
  20 !$omp teams reduction(+:err)
  21 !$omp distribute
  22   do i = 0, 63
  23 !$omp parallel do reduction(+:err)
  24     do j = 0, 31
  25       err = err + bar (3, i, j)
  26     end do
  27   end do
  28 !$omp end teams
  29   if (err .ne. 0) stop 4
  30 contains
  31   subroutine foo (x, y, z, a, b)
  32     integer :: x, y, z, a, b(64), i, j
  33     if (x .eq. 0) then
  34       do i = 0, 63
  35 !$omp parallel do shared (a, b)
  36         do j = 0, 31
  37           call foo (3, i, j, a, b)
  38         end do
  39       end do
  40     else if (x .eq. 1) then
  41 !$omp distribute dist_schedule (static, 1)
  42       do i = 0, 63
  43 !$omp parallel do shared (a, b)
  44         do j = 0, 31
  45           call foo (3, i, j, a, b)
  46         end do
  47       end do
  48     else if (x .eq. 2) then
  49 !$omp parallel do shared (a, b)
  50       do j = 0, 31
  51         call foo (3, y, j, a, b)
  52       end do
  53     else
  54 !$omp atomic
  55       b(y + 1) = b(y + 1) + z
  56 !$omp end atomic
  57 !$omp atomic
  58       a = a + 1
  59 !$omp end atomic
  60     end if
  61   end subroutine
  62
  63   integer function bar (x, y, z)
  64     use omp_lib
  65     integer :: x, y, z, a, b(64), i, c, d, e, f
  66     a = 8
  67     do i = 0, 63
  68       b(i + 1) = i
  69     end do
  70     call foo (x, y, z, a, b)
  71     if (x .eq. 0) then
  72       if (a .ne. 8 + 64 * 32) then
  73         bar = 1
  74         return
  75       end if
  76       do i = 0, 63
  77         if (b(i + 1) .ne. i + 31 * 32 / 2) then
  78           bar = 1
  79           return
  80         end if
  81       end do
  82     else if (x .eq. 1) then
  83       c = omp_get_num_teams ()
  84       d = omp_get_team_num ()
  85       e = d
  86       f = 0
  87       do i = 0, 63
  88         if (i .eq. e) then
  89           if (b(i + 1) .ne. i + 31 * 32 / 2) then
  90             bar = 1
  91             return
  92           end if
  93           f = f + 1
  94           e = e + c
  95         else if (b(i + 1) .ne. i) then
  96           bar = 1
  97           return
  98         end if
  99       end do
 100       if (a .lt. 8 .or. a > 8 + f * 32) then
 101         bar = 1
 102         return
 103       end if
 104     else if (x .eq. 2) then
 105       if (a .ne. 8 + 32) then
 106         bar = 1
 107         return
 108       end if
 109       do i = 0, 63
 110         if (i .eq. y) then
 111           c = 31 * 32 / 2
 112         else
 113           c = 0
 114         end if
 115         if (b(i + 1) .ne. i + c) then
 116           bar = 1
 117           return
 118         end if
 119       end do
 120     else if (x .eq. 3) then
 121       if (a .ne. 8 + 1) then
 122         bar = 1
 123         return
 124       end if
 125       do i = 0, 63
 126         if (i .eq. y) then
 127           c = z
 128         else
 129           c = 0
 130         end if
 131         if (b (i + 1) .ne. i + c) then
 132           bar = 1
 133           return
 134         end if
 135       end do
 136     end if
 137     bar = 0
 138     return
 139   end function
 140 end program