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