libgomp/testsuite/libgomp.fortran/omp_parse4.f90

   1 ! { dg-do run }
   2 !$ use omp_lib
   3   call test_workshare
   4
   5 contains
   6   subroutine test_workshare
   7     integer :: i, j, k, l, m
   8     double precision, dimension (64) :: d, e
   9     integer, dimension (10) :: f, g
  10     integer, dimension (16, 16) :: a, b, c
  11     integer, dimension (16) :: n
  12     d(:) = 1
  13     e = 7
  14     f = 10
  15     l = 256
  16     m = 512
  17     g(1:3) = -1
  18     g(4:6) = 0
  19     g(7:8) = 5
  20     g(9:10) = 10
  21     forall (i = 1:16, j = 1:16) a (i, j) = i * 16 + j
  22     forall (j = 1:16) n (j) = j
  23 !$omp parallel num_threads (4) private (j, k)
  24 !$omp barrier
  25 !$omp workshare
  26     i = 6
  27     e(:) = d(:)
  28     where (g .lt. 0)
  29       f = 100
  30     elsewhere (g .eq. 0)
  31       f = 200 + f
  32     elsewhere
  33       where (g .gt. 6) f = f + sum (g)
  34       f = 300 + f
  35     end where
  36     where (f .gt. 210) g = 0
  37 !$omp end workshare nowait
  38 !$omp workshare
  39     forall (j = 1:16, k = 1:16) b (k, j) = a (j, k)
  40     forall (k = 1:16) c (k, 1:16) = a (1:16, k)
  41     forall (j = 2:16, n (17 - j) / 4 * 4 .ne. n (17 - j))
  42       n (j) = n (j - 1) * n (j)
  43     end forall
  44 !$omp endworkshare
  45 !$omp workshare
  46 !$omp atomic
  47     i = i + 8 + 6
  48 !$omp critical
  49 !$omp critical (critical_foox)
  50     l = 128
  51 !$omp end critical (critical_foox)
  52 !$omp endcritical
  53 !$omp parallel num_threads (2)
  54 !$  if (omp_get_thread_num () .eq. 0) m = omp_get_num_threads ()
  55 !$omp atomic
  56     l = 1 + l
  57 !$omp end parallel
  58 !$omp end workshare
  59 !$omp end parallel
  60
  61     if (any (f .ne. (/100, 100, 100, 210, 210, 210, 310, 310, 337, 337/))) &
  62 &     call abort
  63     if (any (g .ne. (/-1, -1, -1, 0, 0, 0, 0, 0, 0, 0/))) call abort
  64     if (i .ne. 20) call abort
  65 !$  if (l .ne. 128 + m) call abort
  66     if (any (d .ne. 1 .or. e .ne. 1)) call abort
  67     if (any (b .ne. transpose (a))) call abort
  68     if (any (c .ne. b)) call abort
  69     if (any (n .ne. (/1, 2, 6, 12, 5, 30, 42, 56, 9, 90, &
  70 &                     110, 132, 13, 182, 210, 240/))) call abort
  71   end subroutine test_workshare
  72 end