1! { dg-do run } 2use omp_lib 3 call test_master 4 call test_critical 5 call test_barrier 6 call test_atomic 7 8contains 9 subroutine test_master 10 logical :: i, j 11 i = .false. 12 j = .false. 13!$omp parallel num_threads (4) 14!$omp master 15 i = .true. 16 j = omp_get_thread_num () .eq. 0 17!$omp endmaster 18!$omp end parallel 19 if (.not. (i .or. j)) stop 1 20 end subroutine test_master 21 22 subroutine test_critical_1 (i, j) 23 integer :: i, j 24!$omp critical(critical_foo) 25 i = i + 1 26!$omp end critical (critical_foo) 27!$omp critical 28 j = j + 1 29!$omp end critical 30 end subroutine test_critical_1 31 32 subroutine test_critical 33 integer :: i, j, n 34 n = -1 35 i = 0 36 j = 0 37!$omp parallel num_threads (4) 38 if (omp_get_thread_num () .eq. 0) n = omp_get_num_threads () 39 call test_critical_1 (i, j) 40 call test_critical_1 (i, j) 41!$omp critical 42 j = j + 1 43!$omp end critical 44!$omp critical (critical_foo) 45 i = i + 1 46!$omp endcritical (critical_foo) 47!$omp end parallel 48 if (n .lt. 1 .or. i .ne. n * 3 .or. j .ne. n * 3) stop 2 49 end subroutine test_critical 50 51 subroutine test_barrier 52 integer :: i 53 logical :: j 54 i = 23 55 j = .false. 56!$omp parallel num_threads (4) 57 if (omp_get_thread_num () .eq. 0) i = 5 58!$omp flush (i) 59!$omp barrier 60 if (i .ne. 5) then 61!$omp atomic 62 j = j .or. .true. 63 end if 64!$omp end parallel 65 if (i .ne. 5 .or. j) stop 3 66 end subroutine test_barrier 67 68 subroutine test_atomic 69 integer :: a, b, c, d, e, f, g 70 a = 0 71 b = 1 72 c = 0 73 d = 1024 74 e = 1024 75 f = -1 76 g = -1 77!$omp parallel num_threads (8) 78!$omp atomic 79 a = a + 2 + 4 80!$omp atomic 81 b = 3 * b 82!$omp atomic 83 c = 8 - c 84!$omp atomic 85 d = d / 2 86!$omp atomic 87 e = min (e, omp_get_thread_num ()) 88!$omp atomic 89 f = max (omp_get_thread_num (), f) 90 if (omp_get_thread_num () .eq. 0) g = omp_get_num_threads () 91!$omp end parallel 92 if (g .le. 0 .or. g .gt. 8) stop 4 93 if (a .ne. 6 * g .or. b .ne. 3 ** g) stop 5 94 if (iand (g, 1) .eq. 1) then 95 if (c .ne. 8) stop 6 96 else if (c .ne. 0) then 97 stop 7 98 end if 99 if (d .ne. 1024 / (2 ** g)) stop 8 100 if (e .ne. 0 .or. f .ne. g - 1) stop 9 101 end subroutine test_atomic 102end 103