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)) call abort 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) call abort 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) call abort 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) call abort 93 if (a .ne. 6 * g .or. b .ne. 3 ** g) call abort 94 if (iand (g, 1) .eq. 1) then 95 if (c .ne. 8) call abort 96 else if (c .ne. 0) then 97 call abort 98 end if 99 if (d .ne. 1024 / (2 ** g)) call abort 100 if (e .ne. 0 .or. f .ne. g - 1) call abort 101 end subroutine test_atomic 102end 103