libgomp/testsuite/libgomp.fortran/task-reduction-16.f90

   1 module m
   2   implicit none (external, type)
   3   integer :: a, b(0:2) = [1, 1, 1]
   4   integer(8) :: c(0:1) = [not(0_8), not(0_8)]
   5 contains
   6   subroutine bar (i)
   7     integer :: i
   8     !$omp task in_reduction (*: b) in_reduction (iand: c) &
   9     !$omp&     in_reduction (+: a)
  10       a = a + 4
  11       b(1) = b(1) * 4
  12       c(1) = iand (c(1), not(ishft(1_8, i + 16)))
  13     !$omp end task
  14   end subroutine bar
  15
  16   subroutine foo (x)
  17     integer :: x
  18     !$omp scope reduction (task, +: a)
  19       !$omp scope reduction (task, *: b)
  20         !$omp scope reduction (task, iand: c)
  21           !$omp barrier
  22           !$omp sections
  23             !$omp section
  24             block
  25               a = a + 1; b(0) = b(0) * 2; call bar (2); b(2) = b(2) * 3
  26               c(1) = iand(c(1), not(ishft(1_8, 2)))
  27             end block
  28             !$omp section
  29             block
  30               b(0) = b(0) * 2; call bar (4); b(2) = b(2) * 3
  31               c(1) = iand(c(1), not(ishft(1_8, 4))); a = a + 1
  32             end block
  33             !$omp section
  34             block
  35               call bar (6); b(2) = b(2) * 3; c(1) = iand(c(1), not(ishft(1_8, 6)))
  36               a = a + 1; b(0) = b(0) * 2
  37             end block
  38             !$omp section
  39             block
  40               b(2) = b(2) * 3; c(1) = iand(c(1), not(ishft(1_8, 8)))
  41               a = a + 1; b(0) = b(0) * 2; call bar (8)
  42             end block
  43             !$omp section
  44             block
  45               c(1) = iand(c(1), not(ishft(1_8, 10))); a = a + 1
  46               b(0) = b(0) * 2; call bar (10); b(2) = b(2) * 3
  47             end block
  48             !$omp section
  49             block
  50               a = a + 1; b(0) = b(0) * 2; b(2) = b(2) * 3
  51               c(1) = iand(c(1), not(ishft(1_8, 12))); call bar (12)
  52             end block
  53             !$omp section
  54               if (x /= 0) then
  55                 a = a + 1; b(0) = b(0) * 2; b(2) = b(2) * 3
  56                 call bar (14); c(1) = iand (c(1), not(ishft(1_8, 14)))
  57               end if
  58           !$omp end sections
  59         !$omp end scope
  60       !$omp end scope
  61     !$omp end scope
  62   end subroutine foo
  63 end module m
  64
  65 program main
  66   use m
  67   implicit none (type, external)
  68   integer, volatile :: one
  69   one = 1
  70   call foo (0)
  71   if (a /= 30 .or. b(0) /= 64 .or. b(1) /= ishft (1, 12) .or. b(2) /= 3 * 3 * 3 * 3 * 3 * 3 &
  72       .or. c(0) /= not(0_8) .or. c(1) /= not(int(z'15541554', kind=8))) &
  73     stop 1
  74   a = 0
  75   b(:) = [1, 1, 1]
  76   c(1) = not(0_8)
  77   !$omp parallel
  78     call foo (one)
  79   !$omp end parallel
  80   if (a /= 35 .or. b(0) /= 128 .or. b(1) /= ishft(1, 14) .or. b(2) /= 3 * 3 * 3 * 3 * 3 * 3 * 3 &
  81       .or. c(0) /= not(0_8) .or. c(1) /= not(int(z'55545554', kind=8))) &
  82     stop 2
  83 end program main