libgomp/testsuite/libgomp.fortran/reduction6.f90

   1 ! { dg-do run }
   2
   3   integer, dimension (6, 6) :: a
   4   character (36) :: c
   5   integer nthreads
   6   a = 9
   7   nthreads = -1
   8   call foo (a (2:4, 3:5), nthreads)
   9   if (nthreads .eq. 3) then
  10     write (c, '(36i1)') a
  11     if (c .ne. '999999999999966699966699966699999999') call abort
  12   end if
  13 contains
  14   subroutine foo (b, nthreads)
  15     use omp_lib
  16     integer, dimension (3:, 5:) :: b
  17     integer :: err, nthreads
  18     b = 0
  19     err = 0
  20 !$omp parallel num_threads (3) reduction (+:b)
  21     if (any (b .ne. 0)) then
  22 !$omp atomic
  23       err = err + 1
  24     end if
  25 !$omp master
  26     nthreads = omp_get_num_threads ()
  27 !$omp end master
  28     b = 2
  29 !$omp end parallel
  30     if (err .gt. 0) call abort
  31   end subroutine foo
  32 end