@@ -3809,6 +3809,10 @@ gfc_split_omp_clauses (gfc_code *code,
| GFC_OMP_MASK_SIMD;
innermost = GFC_OMP_SPLIT_SIMD;
break;
+ case EXEC_OMP_TARGET_SIMD:
+ mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_SIMD;
+ innermost = GFC_OMP_SPLIT_SIMD;
+ break;
case EXEC_OMP_TARGET_TEAMS:
mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS;
innermost = GFC_OMP_SPLIT_TEAMS;
@@ -4431,10 +4435,13 @@ gfc_trans_omp_teams (gfc_code *code, gfc
stmt = gfc_trans_omp_distribute (code, clausesa);
break;
}
- stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt,
- omp_clauses);
- if (combined)
- OMP_TEAMS_COMBINED (stmt) = 1;
+ if (flag_openmp)
+ {
+ stmt = build2_loc (input_location, OMP_TEAMS, void_type_node, stmt,
+ omp_clauses);
+ if (combined)
+ OMP_TEAMS_COMBINED (stmt) = 1;
+ }
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
@@ -4502,8 +4509,12 @@ gfc_trans_omp_target (gfc_code *code)
break;
}
if (flag_openmp)
- stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt,
- omp_clauses);
+ {
+ stmt = build2_loc (input_location, OMP_TARGET, void_type_node, stmt,
+ omp_clauses);
+ if (code->op != EXEC_OMP_TARGET)
+ OMP_TARGET_COMBINED (stmt) = 1;
+ }
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
@@ -1,44 +0,0 @@
- common /blk/ q, e
- integer :: q, r
- logical :: e
-!$omp parallel
-!$omp single
- call foo (2, 7)
- r = bar (12, 18)
-!$omp end single
-!$omp end parallel
- if (q .ne. 6 .or. r .ne. 17 .or. e) call abort
-contains
- subroutine foo (a, b)
- integer, intent (in) :: a, b
- common /blk/ q, e
- integer :: q, r, d
- logical :: e
-!$omp taskloop lastprivate (q) nogroup
- do d = a, b, 2
- q = d
- if (d < 2 .or. d > 6 .or. iand (d, 1) .ne. 0) then
-!$omp atomic write
- e = .true.
- end if
- end do
- end subroutine foo
- function bar (a, b)
- integer, intent (in) :: a, b
- integer :: bar
- common /blk/ q, e
- integer :: q, r, d, s
- logical :: e
- s = 7
-!$omp taskloop lastprivate (s)
- do d = a, b - 1
- if (d < 12 .or. d > 17) then
-!$omp atomic write
- e = .true.
- end if
- s = d
- end do
-!$omp end taskloop
- bar = s
- end function bar
-end
@@ -0,0 +1,44 @@
+ common /blk/ q, e
+ integer :: q, r
+ logical :: e
+!$omp parallel
+!$omp single
+ call foo (2, 7)
+ r = bar (12, 18)
+!$omp end single
+!$omp end parallel
+ if (q .ne. 6 .or. r .ne. 17 .or. e) call abort
+contains
+ subroutine foo (a, b)
+ integer, intent (in) :: a, b
+ common /blk/ q, e
+ integer :: q, r, d
+ logical :: e
+!$omp taskloop lastprivate (q) nogroup
+ do d = a, b, 2
+ q = d
+ if (d < 2 .or. d > 6 .or. iand (d, 1) .ne. 0) then
+!$omp atomic write
+ e = .true.
+ end if
+ end do
+ end subroutine foo
+ function bar (a, b)
+ integer, intent (in) :: a, b
+ integer :: bar
+ common /blk/ q, e
+ integer :: q, r, d, s
+ logical :: e
+ s = 7
+!$omp taskloop lastprivate (s)
+ do d = a, b - 1
+ if (d < 12 .or. d > 17) then
+!$omp atomic write
+ e = .true.
+ end if
+ s = d
+ end do
+!$omp end taskloop
+ bar = s
+ end function bar
+end
@@ -0,0 +1,134 @@
+! { dg-do run }
+! { dg-options "-O2" }
+! { dg-additional-options "-msse2" { target sse2_runtime } }
+! { dg-additional-options "-mavx" { target avx_runtime } }
+
+ integer, save :: u(1024), v(1024), w(1024), m
+ integer :: i
+ v = (/ (i, i = 1, 1024) /)
+ w = (/ (i + 1, i = 1, 1024) /)
+ !$omp parallel
+ !$omp single
+ call f1 (1, 1024)
+ !$omp end single
+ !$omp end parallel
+ do i = 1, 1024
+ if (u(i) .ne. 2 * i + 1) call abort
+ v(i) = 1024 - i
+ w(i) = 512 - i
+ end do
+ !$omp parallel
+ !$omp single
+ call f2 (2, 1022, 17)
+ !$omp end single
+ !$omp end parallel
+ do i = 1, 1024
+ if (i .lt. 2 .or. i .gt. 1022) then
+ if (u(i) .ne. 2 * i + 1) call abort
+ else
+ if (u(i) .ne. 1536 - 2 * i) call abort
+ end if
+ v(i) = i
+ w(i) = i + 1
+ end do
+ if (m .ne. (1023 + 2 * (1021 * 5 + 17) + 9)) call abort
+ !$omp parallel
+ !$omp single
+ call f3 (1, 1024)
+ !$omp end single
+ !$omp end parallel
+ do i = 1, 1024
+ if (u(i) .ne. 2 * i + 1) call abort
+ v(i) = 1024 - i
+ w(i) = 512 - i
+ end do
+ if (m .ne. 1025) call abort
+ !$omp parallel
+ !$omp single
+ call f4 (0, 31, 1, 32)
+ !$omp end single
+ !$omp end parallel
+ do i = 1, 1024
+ if (u(i) .ne. 1536 - 2 * i) call abort
+ v(i) = i
+ w(i) = i + 1
+ end do
+ if (m .ne. 32 + 33 + 1024) call abort
+ !$omp parallel
+ !$omp single
+ call f5 (0, 31, 1, 32)
+ !$omp end single
+ !$omp end parallel
+ do i = 1, 1024
+ if (u(i) .ne. 2 * i + 1) call abort
+ end do
+ if (m .ne. 32 + 33) call abort
+contains
+ subroutine f1 (a, b)
+ integer, intent(in) :: a, b
+ integer :: d
+ !$omp taskloop simd default(none) shared(u, v, w) nogroup
+ do d = a, b
+ u(d) = v(d) + w(d)
+ end do
+ ! d is predetermined linear, so we can't let the tasks continue past
+ ! end of this function.
+ !$omp taskwait
+ end subroutine f1
+ subroutine f2 (a, b, cx)
+ integer, intent(in) :: a, b, cx
+ integer :: c, d, e
+ c = cx
+ !$omp taskloop simd default(none) shared(u, v, w) linear(d:1) linear(c:5) lastprivate(e)
+ do d = a, b
+ u(d) = v(d) + w(d)
+ c = c + 5
+ e = c + 9
+ end do
+ !$omp end taskloop simd
+ m = d + c + e
+ end subroutine f2
+ subroutine f3 (a, b)
+ integer, intent(in) :: a, b
+ integer, target :: d
+ integer, pointer :: p
+ !$omp taskloop simd default(none) shared(u, v, w) private (p)
+ do d = a, b
+ p => d
+ u(d) = v(d) + w(d)
+ p => null()
+ end do
+ m = d
+ end subroutine f3
+ subroutine f4 (a, b, c, d)
+ integer, intent(in) :: a, b, c, d
+ integer, target :: e, f
+ integer, pointer :: p, q
+ integer :: g, r
+ !$omp taskloop simd default(none) shared(u, v, w) lastprivate(g) collapse(2) private (r, p, q)
+ do e = a, b
+ do f = c, d
+ p => e
+ q => f
+ r = 32 * e + f
+ u(r) = v(r) + w(r)
+ g = r
+ p => null()
+ q => null()
+ end do
+ end do
+ m = e + f + g
+ end subroutine f4
+ subroutine f5 (a, b, c, d)
+ integer, intent(in) :: a, b, c, d
+ integer :: e, f, r
+ !$omp taskloop simd default(none) shared(u, v, w) collapse(2) private (r)
+ do e = a, b
+ do f = c, d
+ r = 32 * e + f
+ u(r) = v(r) + w(r)
+ end do
+ end do
+ m = e + f
+ end subroutine f5
+end
@@ -0,0 +1,72 @@
+! { dg-do run }
+! { dg-options "-O2" }
+
+ integer, save :: g
+ integer :: i
+ !$omp parallel
+ !$omp single
+ if (f1 (74) .ne. 63 + 4) call abort
+ g = 77
+ call f2
+ !$omp taskwait
+ if (g .ne. 63 + 9) call abort
+ if (f3 (7_8, 11_8, 2_8) .ne. 11 * 7 + 13) call abort
+ if (f4 (0_8, 31_8, 16_8, 46_8, 1_8, 2_8, 73) .ne. 32 + 5 * 48 &
+& + 11 * 31 + 17 * 46) call abort
+ !$omp end single
+ !$omp end parallel
+contains
+ function f1 (y)
+ integer, intent(in) :: y
+ integer :: i, f1, x
+ x = y
+ !$omp taskloop firstprivate(x)lastprivate(x)
+ do i = 0, 63
+ if (x .ne. 74) call abort
+ if (i .eq. 63) then
+ x = i + 4
+ end if
+ end do
+ f1 = x
+ end function f1
+ subroutine f2 ()
+ integer :: i
+ !$omp taskloop firstprivate(g)lastprivate(g)nogroup
+ do i = 0, 63
+ if (g .ne. 77) call abort
+ if (i .eq. 63) then
+ g = i + 9
+ end if
+ end do
+ end subroutine f2
+ function f3 (a, b, c)
+ integer(kind=8), intent(in) :: a, b, c
+ integer(kind=8) :: i, f3
+ integer :: l
+ !$omp taskloop default(none) lastprivate (i, l)
+ do i = a, b, c
+ l = i
+ end do
+ !$omp end taskloop
+ f3 = l * 7 + i
+ end function f3
+ function f4 (a, b, c, d, e, f, m)
+ integer(kind=8), intent(in) :: a, b, c, d, e, f
+ integer(kind=8) :: i, j, f4
+ integer, intent(in) :: m
+ integer :: l, k
+ k = m
+ !$omp taskloop default (none) collapse (2) firstprivate (k) &
+ !$omp & lastprivate (i, j, k, l)
+ do i = a, b, e
+ do j = c, d, f
+ if (k .ne. 73) call abort
+ if (i .eq. 31 .and. j .eq. 46) then
+ k = i
+ end if
+ l = j
+ end do
+ end do
+ f4 = i + 5 * j + 11 * k + 17 * l
+ end function f4
+end
@@ -0,0 +1,87 @@
+! { dg-do run }
+! { dg-options "-O2" }
+
+ integer, save :: u(64), v
+ integer :: min_iters, max_iters, ntasks, cnt
+ procedure(grainsize), pointer :: fn
+ !$omp parallel
+ !$omp single
+ fn => grainsize
+ ! If grainsize is present, # of task loop iters is
+ ! >= grainsize && < 2 * grainsize,
+ ! unless # of loop iterations is smaller than grainsize.
+ call test (0, 79, 1, 17, fn, ntasks, min_iters, max_iters, cnt)
+ if (cnt .ne. 79) call abort
+ if (min_iters .lt. 17 .or. max_iters .ge. 17 * 2) call abort
+ call test (-49, 2541, 7, 28, fn, ntasks, min_iters, max_iters, cnt)
+ if (cnt .ne. 370) call abort
+ if (min_iters .lt. 28 .or. max_iters .ge. 28 * 2) call abort
+ call test (7, 21, 2, 15, fn, ntasks, min_iters, max_iters, cnt)
+ if (cnt .ne. 7) call abort
+ if (min_iters .ne. 7 .or. max_iters .ne. 7) call abort
+ if (ntasks .ne. 1) call abort
+ fn => num_tasks
+ ! If num_tasks is present, # of task loop iters is
+ ! min (# of loop iters, num_tasks).
+ call test (-51, 2500, 48, 9, fn, ntasks, min_iters, max_iters, cnt)
+ if (cnt .ne. 54 .or. ntasks .ne. 9) call abort
+ call test (0, 25, 2, 17, fn, ntasks, min_iters, max_iters, cnt)
+ if (cnt .ne. 13 .or. ntasks .ne. 13) call abort
+ !$omp end single
+ !$omp end parallel
+contains
+ subroutine grainsize (a, b, c, d)
+ integer, intent (in) :: a, b, c, d
+ integer :: i, j, k
+ j = 0
+ k = 0
+ !$omp taskloop firstprivate (j, k) grainsize (d)
+ do i = a, b - 1, c
+ if (j .eq. 0) then
+ !$omp atomic capture
+ k = v
+ v = v + 1
+ !$omp end atomic
+ if (k .ge. 64) call abort
+ end if
+ j = j + 1
+ u(k + 1) = j
+ end do
+ end subroutine grainsize
+ subroutine num_tasks (a, b, c, d)
+ integer, intent (in) :: a, b, c, d
+ integer :: i, j, k
+ j = 0
+ k = 0
+ !$omp taskloop firstprivate (j, k) num_tasks (d)
+ do i = a, b - 1, c
+ if (j .eq. 0) then
+ !$omp atomic capture
+ k = v
+ v = v + 1
+ !$omp end atomic
+ if (k .ge. 64) call abort
+ end if
+ j = j + 1
+ u(k + 1) = j
+ end do
+ end subroutine num_tasks
+ subroutine test (a, b, c, d, fn, num_tasks, min_iters, max_iters, cnt)
+ integer, intent (in) :: a, b, c, d
+ procedure(grainsize), pointer :: fn
+ integer, intent (out) :: num_tasks, min_iters, max_iters, cnt
+ integer :: i
+ u(:) = 0
+ v = 0
+ cnt = 0
+ call fn (a, b, c, d)
+ min_iters = 0
+ max_iters = 0
+ num_tasks = v
+ if (v .ne. 0) then
+ min_iters = minval (u(1:v))
+ max_iters = maxval (u(1:v))
+ cnt = sum (u(1:v))
+ end if
+ end subroutine test
+end