libgomp/testsuite/libgomp.fortran/omp_atomic2.f90

   1 ! { dg-do run }
   2   real, dimension (20) :: r
   3   integer, dimension (20) :: d
   4   integer :: i, j, k, n
   5   integer (kind = 2) :: a, b, c
   6
   7   do 10 i = 1, 20
   8     r(i) = i
   9 10  d(i) = 21 - i
  10
  11   n = 20
  12   call foo (r, d, n)
  13
  14   if (n .ne. 22) call abort
  15   if (any (r .ne. 33)) call abort
  16
  17   i = 1
  18   j = 18
  19   k = 23
  20 !$omp atomic
  21   i = min (i, j, k, n)
  22   if (i .ne. 1) call abort
  23 !$omp atomic
  24   i = max (j, n, k, i)
  25   if (i .ne. 23) call abort
  26
  27   a = 1
  28   b = 18
  29   c = 23
  30 !$omp atomic
  31   a = min (a, b, c)
  32   if (a .ne. 1) call abort
  33 !$omp atomic
  34   a = max (a, b, c)
  35   if (a .ne. 23) call abort
  36
  37 contains
  38   function bar (i)
  39     real bar
  40     integer i
  41     bar = 12.0 + i
  42   end function bar
  43
  44   subroutine foo (x, y, n)
  45     integer i, y (*), n
  46     real x (*)
  47     do i = 1, n
  48 !$omp atomic
  49       x(y(i)) = x(y(i)) + bar (i)
  50     end do
  51 !$omp atomic
  52     n = n + 2
  53   end subroutine foo
  54 end