1! { dg-do run } 2! { dg-options "-std=legacy" } 3! { dg-require-effective-target tls_runtime } 4use omp_lib 5 common /tlsblock/ x, y 6 integer :: x, y, z 7 save z 8!$omp threadprivate (/tlsblock/, z) 9 10 call test_flush 11 call test_ordered 12 call test_threadprivate 13 14contains 15 subroutine test_flush 16 integer :: i, j 17 i = 0 18 j = 0 19!$omp parallel num_threads (4) 20 if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads () 21 if (omp_get_thread_num () .eq. 0) j = j + 1 22!$omp flush (i, j) 23!$omp barrier 24 if (omp_get_thread_num () .eq. 1) j = j + 2 25!$omp flush 26!$omp barrier 27 if (omp_get_thread_num () .eq. 2) j = j + 3 28!$omp flush (i) 29!$omp flush (j) 30!$omp barrier 31 if (omp_get_thread_num () .eq. 3) j = j + 4 32!$omp end parallel 33 end subroutine test_flush 34 35 subroutine test_ordered 36 integer :: i, j 37 integer, dimension (100) :: d 38 d(:) = -1 39!$omp parallel do ordered schedule (dynamic) num_threads (4) 40 do i = 1, 100, 5 41!$omp ordered 42 d(i) = i 43!$omp end ordered 44 end do 45 j = 1 46 do 100 i = 1, 100 47 if (i .eq. j) then 48 if (d(i) .ne. i) STOP 1 49 j = i + 5 50 else 51 if (d(i) .ne. -1) STOP 2 52 end if 53100 d(i) = -1 54 end subroutine test_ordered 55 56 subroutine test_threadprivate 57 common /tlsblock/ x, y 58!$omp threadprivate (/tlsblock/) 59 integer :: i, j, x, y 60 logical :: m, n 61 call omp_set_num_threads (4) 62 call omp_set_dynamic (.false.) 63 i = -1 64 x = 6 65 y = 7 66 z = 8 67 n = .false. 68 m = .false. 69!$omp parallel copyin (/tlsblock/, z) reduction (.or.:m) & 70!$omp& num_threads (4) 71 if (omp_get_thread_num () .eq. 0) i = omp_get_num_threads () 72 if (x .ne. 6 .or. y .ne. 7 .or. z .ne. 8) STOP 3 73 x = omp_get_thread_num () 74 y = omp_get_thread_num () + 1024 75 z = omp_get_thread_num () + 4096 76!$omp end parallel 77 if (x .ne. 0 .or. y .ne. 1024 .or. z .ne. 4096) STOP 4 78!$omp parallel num_threads (4), private (j) reduction (.or.:n) 79 if (omp_get_num_threads () .eq. i) then 80 j = omp_get_thread_num () 81 if (x .ne. j .or. y .ne. j + 1024 .or. z .ne. j + 4096) & 82& STOP 5 83 end if 84!$omp end parallel 85 m = m .or. n 86 n = .false. 87!$omp parallel num_threads (4), copyin (z) reduction (.or. : n) & 88!$omp&private (j) 89 if (z .ne. 4096) n = .true. 90 if (omp_get_num_threads () .eq. i) then 91 j = omp_get_thread_num () 92 if (x .ne. j .or. y .ne. j + 1024) STOP 6 93 end if 94!$omp end parallel 95 if (m .or. n) STOP 7 96 end subroutine test_threadprivate 97end 98