libgomp/testsuite/libgomp.fortran/masked-1.f90

   1 module m
   2   use omp_lib
   3   implicit none (type, external)
   4 contains
   5   subroutine foo (x, a)
   6     integer, value :: x
   7     integer, contiguous :: a(0:)
   8     integer :: i
   9
  10     !$omp masked
  11       if (omp_get_thread_num () /= 0) &
  12         stop 1
  13       a(128) = a(128) + 1
  14     !$omp end masked
  15
  16     !$omp masked filter (0)
  17       if (omp_get_thread_num () /= 0) &
  18         stop 2
  19       a(129) = a(129) + 1
  20     !$omp end masked
  21
  22     !$omp masked filter (7)
  23       if (omp_get_thread_num () /= 7) &
  24         stop 3
  25       a(130) = a(130) + 1
  26     !$omp end masked
  27
  28     !$omp masked filter (x)
  29       if (omp_get_thread_num () /= x) &
  30         stop 4
  31       a(131) = a(131) + 1
  32     !$omp end masked
  33
  34     !$omp masked taskloop simd filter (x) shared(a) grainsize (12) simdlen (4)
  35       do i = 0, 127
  36         a(i) = a(i) + i
  37       end do
  38     !$omp end masked taskloop simd
  39   end
  40 end
  41
  42 program main
  43   use m
  44   implicit none (type, external)
  45   integer :: i
  46   integer :: a(0:135)
  47
  48   a = 0
  49
  50   !$omp parallel num_threads (4)
  51     call foo (4, a)
  52   !$omp end parallel
  53   do i = 0, 127
  54     if (a(i) /= 0) &
  55       stop 5
  56   end do
  57   if (a(128) /= 1 .or. a(129) /= 1 .or. a(130) /= 0 .or. a(131) /= 0) &
  58     stop 6
  59
  60   !$omp parallel num_threads (4)
  61     call foo (3, a)
  62   !$omp end parallel
  63   do i = 0, 127
  64     if (a(i) /= i) &
  65       stop 7
  66   end do
  67   if (a(128) /= 2 .or. a(129) /= 2 .or. a(130) /= 0 .or. a(131) /= 1) &
  68     stop 8
  69
  70   !$omp parallel num_threads (8)
  71     call foo (8, a)
  72   !$omp end parallel
  73   do i = 0, 127
  74     if (a(i) /= i) &
  75       stop 9
  76   end do
  77   if (a(128) /= 3 .or. a(129) /= 3 .or. a(130) /= 1 .or. a(131) /= 1) &
  78     stop 10
  79
  80   !$omp parallel num_threads (8)
  81     call foo (6, a)
  82   !$omp end parallel
  83   do i = 0, 127
  84     if (a(i) /= 2 * i) &
  85       stop 11
  86   end do
  87   if (a(128) /= 4 .or. a(129) /= 4 .or. a(130) /= 2 .or. a(131) /= 2) &
  88     stop 12
  89
  90   do i = 0, 7
  91     a(i) = 0
  92   end do
  93   ! The filter expression can evaluate to different values in different threads.
  94   !$omp parallel masked num_threads (8) filter (omp_get_thread_num () + 1)
  95     a(omp_get_thread_num ()) = a(omp_get_thread_num ()) + 1
  96   !$omp end parallel masked
  97   do i = 0, 7
  98     if (a(i) /= 0) &
  99       stop 13
 100   end do
 101
 102   ! And multiple threads can be filtered.
 103   !$omp parallel masked num_threads (8) filter (iand (omp_get_thread_num (), not(1)))
 104     a(omp_get_thread_num ()) = a(omp_get_thread_num ()) + 1
 105   !$omp end parallel masked
 106   do i = 0, 7
 107     block
 108       integer :: j
 109       j = iand (i, 1)
 110       if (j /= 0) then
 111         j = 0
 112       else
 113         j = 1
 114       end if
 115       if (a(i) /= j) &
 116         stop 14
 117     end block
 118   end do
 119 end program main