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