1! { dg-do run } 2! { dg-options "-std=legacy" } 3 4use omp_lib 5 call test_parallel 6 call test_do 7 call test_sections 8 call test_single 9 10contains 11 subroutine test_parallel 12 integer :: a, b, c, e, f, g, i, j 13 integer, dimension (20) :: d 14 logical :: h 15 a = 6 16 b = 8 17 c = 11 18 d(:) = -1 19 e = 13 20 f = 24 21 g = 27 22 h = .false. 23 i = 1 24 j = 16 25!$omp para& 26!$omp&llel & 27!$omp if (a .eq. 6) private (b, c) shared (d) private (e) & 28 !$omp firstprivate(f) num_threads (a - 1) first& 29!$ompprivate(g)default (shared) reduction (.or. : h) & 30!$omp reduction(*:i) 31 if (i .ne. 1) h = .true. 32 i = 2 33 if (f .ne. 24) h = .true. 34 if (g .ne. 27) h = .true. 35 e = 7 36 b = omp_get_thread_num () 37 if (b .eq. 0) j = 24 38 f = b 39 g = f 40 c = omp_get_num_threads () 41 if (c .gt. a - 1 .or. c .le. 0) h = .true. 42 if (b .ge. c) h = .true. 43 d(b + 1) = c 44 if (f .ne. g .or. f .ne. b) h = .true. 45!$omp endparallel 46 if (h) STOP 1 47 if (a .ne. 6) STOP 2 48 if (j .ne. 24) STOP 3 49 if (d(1) .eq. -1) STOP 4 50 e = 1 51 do g = 1, d(1) 52 if (d(g) .ne. d(1)) STOP 5 53 e = e * 2 54 end do 55 if (e .ne. i) STOP 6 56 end subroutine test_parallel 57 58 subroutine test_do_orphan 59 integer :: k, l 60!$omp parallel do private (l) 61 do 600 k = 1, 16, 2 62600 l = k 63 end subroutine test_do_orphan 64 65 subroutine test_do 66 integer :: i, j, k, l, n 67 integer, dimension (64) :: d 68 logical :: m 69 70 j = 16 71 d(:) = -1 72 m = .true. 73 n = 24 74!$omp parallel num_threads (4) shared (i, k, d) private (l) & 75!$omp&reduction (.and. : m) 76 if (omp_get_thread_num () .eq. 0) then 77 k = omp_get_num_threads () 78 end if 79 call test_do_orphan 80!$omp do schedule (static) firstprivate (n) 81 do 200 i = 1, j 82 if (i .eq. 1 .and. n .ne. 24) STOP 7 83 n = i 84200 d(n) = omp_get_thread_num () 85!$omp enddo nowait 86 87!$omp do lastprivate (i) schedule (static, 5) 88 do 201 i = j + 1, 2 * j 89201 d(i) = omp_get_thread_num () + 1024 90 ! Implied omp end do here 91 92 if (i .ne. 33) m = .false. 93 94!$omp do private (j) schedule (dynamic) 95 do i = 33, 48 96 d(i) = omp_get_thread_num () + 2048 97 end do 98!$omp end do nowait 99 100!$omp do schedule (runtime) 101 do i = 49, 4 * j 102 d(i) = omp_get_thread_num () + 4096 103 end do 104 ! Implied omp end do here 105!$omp end parallel 106 if (.not. m) STOP 8 107 108 j = 0 109 do i = 1, 64 110 if (d(i) .lt. j .or. d(i) .ge. j + k) STOP 9 111 if (i .eq. 16) j = 1024 112 if (i .eq. 32) j = 2048 113 if (i .eq. 48) j = 4096 114 end do 115 end subroutine test_do 116 117 subroutine test_sections 118 integer :: i, j, k, l, m, n 119 i = 9 120 j = 10 121 k = 11 122 l = 0 123 m = 0 124 n = 30 125 call omp_set_dynamic (.false.) 126 call omp_set_num_threads (4) 127!$omp parallel num_threads (4) 128!$omp sections private (i) firstprivate (j, k) lastprivate (j) & 129!$omp& reduction (+ : l, m) 130!$omp section 131 i = 24 132 if (j .ne. 10 .or. k .ne. 11 .or. m .ne. 0) l = 1 133 m = m + 4 134!$omp section 135 i = 25 136 if (j .ne. 10 .or. k .ne. 11) l = 1 137 m = m + 6 138!$omp section 139 i = 26 140 if (j .ne. 10 .or. k .ne. 11) l = 1 141 m = m + 8 142!$omp section 143 i = 27 144 if (j .ne. 10 .or. k .ne. 11) l = 1 145 m = m + 10 146 j = 271 147!$omp end sections nowait 148!$omp sections lastprivate (n) 149!$omp section 150 n = 6 151!$omp section 152 n = 7 153!$omp endsections 154!$omp end parallel 155 if (j .ne. 271 .or. l .ne. 0) STOP 10 156 if (m .ne. 4 + 6 + 8 + 10) STOP 11 157 if (n .ne. 7) STOP 12 158 end subroutine test_sections 159 160 subroutine test_single 161 integer :: i, j, k, l 162 logical :: m 163 i = 200 164 j = 300 165 k = 400 166 l = 500 167 m = .false. 168!$omp parallel num_threads (4), private (i, j), reduction (.or. : m) 169 i = omp_get_thread_num () 170 j = omp_get_thread_num () 171!$omp single private (k) 172 k = 64 173!$omp end single nowait 174!$omp single private (k) firstprivate (l) 175 if (i .ne. omp_get_thread_num () .or. i .ne. j) then 176 j = -1 177 else 178 j = -2 179 end if 180 if (l .ne. 500) j = -1 181 l = 265 182!$omp end single copyprivate (j) 183 if (i .ne. omp_get_thread_num () .or. j .ne. -2) m = .true. 184!$omp endparallel 185 if (m) STOP 13 186 end subroutine test_single 187end 188