Mercurial > hg > CbC > CbC_gcc
comparison libgomp/testsuite/libgomp.fortran/omp_parse3.f90 @ 0:a06113de4d67
first commit
| author | kent <kent@cr.ie.u-ryukyu.ac.jp> |
|---|---|
| date | Fri, 17 Jul 2009 14:47:48 +0900 |
| parents | |
| children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:a06113de4d67 |
|---|---|
| 1 ! { dg-do run } | |
| 2 ! { dg-require-effective-target tls_runtime } | |
| 3 use 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 | |
| 13 contains | |
| 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 | |
| 52 100 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, x, y | |
| 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 !$omp&private (j) | |
| 88 if (z .ne. 4096) n = .true. | |
| 89 if (omp_get_num_threads () .eq. i) then | |
| 90 j = omp_get_thread_num () | |
| 91 if (x .ne. j .or. y .ne. j + 1024) call abort | |
| 92 end if | |
| 93 !$omp end parallel | |
| 94 if (m .or. n) call abort | |
| 95 end subroutine test_threadprivate | |
| 96 end |