diff options
Diffstat (limited to 'libgomp/testsuite/libgomp.fortran')
31 files changed, 1571 insertions, 0 deletions
diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.50.1.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.50.1.f90 new file mode 100644 index 00000000000..76e9068e30f --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.50.1.f90 @@ -0,0 +1,44 @@ +! { dg-do run } + +module e_50_1_mod +contains + subroutine init (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine vec_mult (N) + integer :: i, N + real :: p(N), v1(N), v2(N) + call init (v1, v2, N) + !$omp target + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + call check (p, N) + end subroutine + +end module + +program e_50_1 + use e_50_1_mod, only : vec_mult + integer :: n + n = 1000 + call vec_mult (n) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.50.2.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.50.2.f90 new file mode 100644 index 00000000000..af469f4d687 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.50.2.f90 @@ -0,0 +1,43 @@ +! { dg-do run } + +module e_50_2_mod +contains + subroutine init (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine vec_mult (N) + integer :: i, N + real :: p(N), v1(N), v2(N) + call init (v1, v2, N) + !$omp target map(v1,v2,p) + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + call check (p, N) + end subroutine +end module + +program e_50_2 + use e_50_2_mod, only : vec_mult + integer :: n + n = 1000 + call vec_mult (n) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.50.3.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.50.3.f90 new file mode 100644 index 00000000000..975470411cb --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.50.3.f90 @@ -0,0 +1,43 @@ +! { dg-do run } + +module e_50_3_mod +contains + subroutine init (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine vec_mult (N) + integer :: i, N + real :: p(N), v1(N), v2(N) + call init (v1, v2, N) + !$omp target map(to: v1,v2) map(from: p) + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + call check (p, N) + end subroutine +end module + +program e_50_3 + use e_50_3_mod, only : vec_mult + integer :: n + n = 1000 + call vec_mult (n) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.50.4.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.50.4.f90 new file mode 100644 index 00000000000..f94794e16aa --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.50.4.f90 @@ -0,0 +1,59 @@ +! { dg-do run } + +module e_50_4_mod +contains + subroutine init (v1, v2, N) + integer :: i, N + real, pointer, dimension(:) :: v1, v2 + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real, pointer, dimension(:) :: p + do i = 1, N + diff = p(i) - (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine vec_mult_1 (p, v1, v2, N) + integer :: i, N + real, pointer, dimension(:) :: p, v1, v2 + !$omp target map(to: v1(1:N), v2(:N)) map(from: p(1:N)) + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + end subroutine + + subroutine vec_mult_2 (p, v1, v2, N) + real, dimension(*) :: p, v1, v2 + integer :: i, N + !$omp target map(to: v1(1:N), v2(:N)) map(from: p(1:N)) + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + end subroutine +end module + +program e_50_4 + use e_50_4_mod, only : init, check, vec_mult_1, vec_mult_2 + real, pointer, dimension(:) :: p1, p2, v1, v2 + integer :: n + n = 1000 + allocate (p1(n), p2(n), v1(n), v2(n)) + call init (v1, v2, n) + call vec_mult_1 (p1, v1, v2, n) + call vec_mult_2 (p2, v1, v2, n) + call check (p1, N) + call check (p2, N) + deallocate (p1, p2, v1, v2) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.50.5.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.50.5.f90 new file mode 100644 index 00000000000..3f454d7d55e --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.50.5.f90 @@ -0,0 +1,47 @@ +! { dg-do run } +! { dg-require-effective-target offload_device } + +module e_50_5_mod +integer, parameter :: THRESHOLD1 = 500, THRESHOLD2 = 100 +contains + subroutine init (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine vec_mult (N) + use omp_lib, only: omp_is_initial_device + integer :: i, N + real :: p(N), v1(N), v2(N) + call init (v1, v2, N) + !$omp target if(N > THRESHOLD1) map(to: v1,v2) map(from: p) + if (omp_is_initial_device ()) call abort + !$omp parallel do if(N > THRESHOLD2) + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + call check (p, N) + end subroutine +end module + +program e_50_5 + use e_50_5_mod, only : vec_mult + integer :: n + n = 1000 + call vec_mult (n) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.51.1.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.1.f90 new file mode 100644 index 00000000000..98e5c0b8f77 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.1.f90 @@ -0,0 +1,45 @@ +! { dg-do run } + +module e_51_1_mod +contains + subroutine init (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine vec_mult (N) + real :: p(N), v1(N), v2(N) + integer :: i, N + call init (v1, v2, N) + !$omp target data map(to: v1, v2) map(from: p) + !$omp target + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + !$omp end target data + call check (p, N) + end subroutine +end module + +program e_51_1 + use e_51_1_mod, only : vec_mult + integer :: n + n = 1000 + call vec_mult (n) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.51.2.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.2.f90 new file mode 100644 index 00000000000..360cdeda7e1 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.2.f90 @@ -0,0 +1,61 @@ +! { dg-do run } + +module e_51_2_mod +contains + subroutine init (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine init_again (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i - 3.0 + v2(i) = i + 2.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - 2 * (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine vec_mult (N) + real :: p(N), v1(N), v2(N) + integer :: i, N + call init (v1, v2, N) + !$omp target data map(from: p) + !$omp target map(to: v1, v2 ) + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + call init_again (v1, v2, N) + !$omp target map(to: v1, v2 ) + !$omp parallel do + do i = 1, N + p(i) = p(i) + v1(i) * v2(i) + end do + !$omp end target + !$omp end target data + call check (p, N) + end subroutine +end module + +program e_51_2 + use e_51_2_mod, only : vec_mult + integer :: n + n = 1000 + call vec_mult (n) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.51.3.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.3.f90 new file mode 100644 index 00000000000..a3d9c188f93 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.3.f90 @@ -0,0 +1,79 @@ +! { dg-do run } + +module e_51_3_mod +contains + subroutine init (Q, rows, cols) + integer :: i, k, rows, cols + double precision :: Q(rows,cols) + do k = 1, cols + do i = 1, rows + Q(i,k) = 10 * i + k + end do + end do + end subroutine + + subroutine check (P, Q, rows, cols) + integer :: i, k, rows, cols + double precision, parameter :: EPS = 0.00001 + double precision :: P(rows,cols), Q(rows,cols), diff + do k = 1, cols + do i = 1, rows + diff = P(i,k) - Q(i,k) + if (diff > EPS .or. -diff > EPS) call abort + end do + end do + end subroutine + + subroutine gramSchmidt_ref (Q, rows, cols) + integer :: i, k, rows, cols + double precision :: Q(rows,cols), tmp + do k = 1, cols + tmp = 0.0d0 + do i = 1, rows + tmp = tmp + (Q(i,k) * Q(i,k)) + end do + tmp = 1.0d0 / sqrt (tmp) + do i = 1, rows + Q(i,k) = Q(i,k) * tmp + end do + end do + end subroutine + + subroutine gramSchmidt (Q, rows, cols) + integer :: i, k, rows, cols + double precision :: Q(rows,cols), tmp + !$omp target data map(Q) + do k = 1, cols + tmp = 0.0d0 + !$omp target + !$omp parallel do reduction(+:tmp) + do i = 1, rows + tmp = tmp + (Q(i,k) * Q(i,k)) + end do + !$omp end target + tmp = 1.0d0 / sqrt (tmp) + !$omp target + !$omp parallel do + do i = 1, rows + Q(i,k) = Q(i,k) * tmp + end do + !$omp end target + end do + !$omp end target data + end subroutine +end module + +program e_51_3 + use e_51_3_mod, only : init, check, gramSchmidt, gramSchmidt_ref + integer :: cols, rows + double precision, pointer :: P(:,:), Q(:,:) + cols = 5 + rows = 5 + allocate (P(rows,cols), Q(rows,cols)) + call init (P, rows, cols) + call init (Q, rows, cols) + call gramSchmidt_ref (P, rows, cols) + call gramSchmidt (Q, rows, cols) + call check (P, Q, rows, cols) + deallocate (P, Q) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.51.4.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.4.f90 new file mode 100644 index 00000000000..e9de6ae0015 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.4.f90 @@ -0,0 +1,54 @@ +! { dg-do run } + +module e_51_4_mod +contains + subroutine init (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine foo (p, v1, v2, N) + real, pointer, dimension(:) :: p, v1, v2 + integer :: N + call init (v1, v2, N) + !$omp target data map(to: v1, v2) map(from: p) + call vec_mult (p, v1, v2, N) + !$omp end target data + call check (p, N) + end subroutine + + subroutine vec_mult (p, v1, v2, N) + real, pointer, dimension(:) :: p, v1, v2 + integer :: i, N + !$omp target map(to: v1, v2) map(from: p) + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + end subroutine +end module + +program e_51_4 + use e_51_4_mod, only : foo + integer :: n + real, pointer, dimension(:) :: p, v1, v2 + n = 1000 + allocate (p(n), v1(n), v2(n)) + call foo (p, v1, v2, n) + deallocate (p, v1, v2) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.51.5.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.5.f90 new file mode 100644 index 00000000000..01a41adb0f4 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.5.f90 @@ -0,0 +1,53 @@ +! { dg-do run } + +module e_51_5_mod +contains + subroutine init (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine foo (p, v1, v2, N) + real, dimension(:) :: p, v1, v2 + integer :: N + call init (v1, v2, N) + !$omp target data map(to: v1, v2, N) map(from: p) + call vec_mult (p, v1, v2, N) + !$omp end target data + call check (p, N) + end subroutine + + subroutine vec_mult (p, v1, v2, N) + real, dimension(:) :: p, v1, v2 + integer :: i, N + !$omp target map(to: v1, v2, N) map(from: p) + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + end subroutine +end module + +program e_51_5 + use e_51_5_mod, only : foo + integer, parameter :: N = 1024 + real, allocatable, dimension(:) :: p, v1, v2 + allocate(p(N), v1(N), v2(N)) + call foo (p, v1, v2, N) + deallocate (p, v1, v2) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.51.6.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.6.f90 new file mode 100644 index 00000000000..258da21e8f4 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.6.f90 @@ -0,0 +1,66 @@ +! { dg-do run } +! { dg-require-effective-target offload_device } + +module e_51_6_mod +integer, parameter :: THRESHOLD = 500 +contains + subroutine init (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine init_again (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i - 3.0 + v2(i) = i + 2.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - 2 * (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine vec_mult (N) + use omp_lib, only: omp_is_initial_device + real :: p(N), v1(N), v2(N) + integer :: i, N + call init (v1, v2, N) + !$omp target data if(N > THRESHOLD) map(from: p) + !$omp target if(N > THRESHOLD) map(to: v1, v2) + if (omp_is_initial_device ()) call abort + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + call init_again (v1, v2, N) + !$omp target if(N > THRESHOLD) map(to: v1, v2) + if (omp_is_initial_device ()) call abort + !$omp parallel do + do i = 1, N + p(i) = p(i) + v1(i) * v2(i) + end do + !$omp end target + !$omp end target data + call check (p, N) + end subroutine +end module + +program e_51_6 + use e_51_6_mod, only : vec_mult + integer :: n + n = 1000 + call vec_mult (n) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.51.7.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.7.f90 new file mode 100644 index 00000000000..2ddac9e4665 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.51.7.f90 @@ -0,0 +1,49 @@ +! { dg-do run } +! { dg-require-effective-target offload_device } + +module e_51_7_mod +integer, parameter :: THRESHOLD = 500 +contains + subroutine init (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine vec_mult (N) + use omp_lib, only: omp_is_initial_device + real :: p(N), v1(N), v2(N) + integer :: i, N + call init (v1, v2, N) + !$omp target data if(N > THRESHOLD) map(to: v1, v2) map(from: p) + !$omp target + if (omp_is_initial_device ()) call abort + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + !$omp end target data + call check (p, N) + end subroutine +end module + +program e_51_7 + use e_51_7_mod, only : vec_mult + integer :: n + n = 1000 + call vec_mult (n) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.52.1.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.52.1.f90 new file mode 100644 index 00000000000..e23c0bb7bca --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.52.1.f90 @@ -0,0 +1,65 @@ +! { dg-do run } + +module e_52_1_mod +contains + subroutine init (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine init_again (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i - 3.0 + v2(i) = i + 2.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - 2 * (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine vec_mult (p, v1, v2, N) + real :: p(N), v1(N), v2(N) + integer :: i, N + call init (v1, v2, N) + !$omp target data map(to: v1, v2) map(from: p) + !$omp target + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + call init_again (v1, v2, N) + !$omp target update to(v1, v2) + !$omp target + !$omp parallel do + do i = 1, N + p(i) = p(i) + v1(i) * v2(i) + end do + !$omp end target + !$omp end target data + call check (p, N) + end subroutine +end module + +program e_52_1 + use e_52_1_mod, only : vec_mult + integer :: n + real, pointer :: p(:), v1(:), v2(:) + n = 1000 + allocate (p(n), v1(n), v2(n)) + call vec_mult (p, v1, v2, n) + deallocate (p, v1, v2) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.52.2.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.52.2.f90 new file mode 100644 index 00000000000..3735e5342e4 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.52.2.f90 @@ -0,0 +1,77 @@ +! { dg-do run } + +module e_52_2_mod +contains + subroutine init (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine init_again (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i - 3.0 + v2(i) = i + 2.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - (i * i + (i + 2.0) * (i - 3.0)) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + logical function maybe_init_again (v, N) + real :: v(N) + integer :: i, N + do i = 1, N + v(i) = i + end do + maybe_init_again = .true. + end function + + subroutine vec_mult (p, v1, v2, N) + real :: p(N), v1(N), v2(N) + integer :: i, N + logical :: changed + call init (v1, v2, N) + !$omp target data map(to: v1, v2) map(from: p) + !$omp target + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target + changed = maybe_init_again (v1, N) + !$omp target update if(changed) to(v1(:N)) + changed = maybe_init_again (v2, N) + !$omp target update if(changed) to(v2(:N)) + !$omp target + !$omp parallel do + do i = 1, N + p(i) = p(i) + v1(i) * v2(i) + end do + !$omp end target + !$omp end target data + call check (p, N) + end subroutine +end module + +program e_52_2 + use e_52_2_mod, only : vec_mult + integer :: n + real, pointer :: p(:), v1(:), v2(:) + n = 1000 + allocate (p(n), v1(n), v2(n)) + call vec_mult (p, v1, v2, n) + deallocate (p, v1, v2) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.53.1.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.53.1.f90 new file mode 100644 index 00000000000..a1885afa1b5 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.53.1.f90 @@ -0,0 +1,31 @@ +! { dg-do run } + +module e_53_1_mod + integer :: THRESHOLD = 20 +contains + integer recursive function fib (n) result (f) + !$omp declare target + integer :: n + if (n <= 0) then + f = 0 + else if (n == 1) then + f = 1 + else + f = fib (n - 1) + fib (n - 2) + end if + end function + + integer function fib_wrapper (n) + integer :: x + !$omp target map(to: n) if(n > THRESHOLD) + x = fib (n) + !$omp end target + fib_wrapper = x + end function +end module + +program e_53_1 + use e_53_1_mod, only : fib, fib_wrapper + if (fib (15) /= fib_wrapper (15)) call abort + if (fib (25) /= fib_wrapper (25)) call abort +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.53.2.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.53.2.f90 new file mode 100644 index 00000000000..5bc900cac80 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.53.2.f90 @@ -0,0 +1,22 @@ +! { dg-do run } + +program e_53_2 + !$omp declare target (fib) + integer :: x, fib + !$omp target + x = fib (25) + !$omp end target + if (x /= fib (25)) call abort +end program + +integer recursive function fib (n) result (f) + !$omp declare target + integer :: n + if (n <= 0) then + f = 0 + else if (n == 1) then + f = 1 + else + f = fib (n - 1) + fib (n - 2) + end if +end function diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.53.3.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.53.3.f90 new file mode 100644 index 00000000000..fffbb7ff17b --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.53.3.f90 @@ -0,0 +1,45 @@ +! { dg-do run } + +module e_53_3_mod + !$omp declare target (N, p, v1, v2) + integer, parameter :: N = 1000 + real :: p(N), v1(N), v2(N) +end module + +subroutine init (v1, v2, N) + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do +end subroutine + +subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do +end subroutine + +subroutine vec_mult () + use e_53_3_mod + integer :: i + call init (v1, v2, N); + !$omp target update to(v1, v2) + !$omp target + !$omp parallel do + do i = 1,N + p(i) = v1(i) * v2(i) + end do + !$omp end target + !$omp target update from (p) + call check (p, N) +end subroutine + +program e_53_3 + call vec_mult () +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.53.4.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.53.4.f90 new file mode 100644 index 00000000000..41d251aae37 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.53.4.f90 @@ -0,0 +1,68 @@ +! { dg-do run } + +module e_53_4_mod + !$omp declare target (N, Q) + integer, parameter :: N = 10 + real :: Q(N,N) +contains + real function Pfun (i, k) + !$omp declare target + integer, intent(in) :: i, k + Pfun = (Q(i,k) * Q(k,i)) + end function +end module + +real function accum (k) result (tmp) + use e_53_4_mod + integer :: i, k + tmp = 0.0e0 + !$omp target + !$omp parallel do reduction(+:tmp) + do i = 1, N + tmp = tmp + Pfun (k, i) + end do + !$omp end target +end function + +real function accum_ref (k) result (tmp) + use e_53_4_mod + integer :: i, k + tmp = 0.0e0 + do i = 1, N + tmp = tmp + Pfun (k, i) + end do +end function + +subroutine init () + use e_53_4_mod + integer :: i, j + do i = 1, N + do j = 1, N + Q(i,j) = 0.001 * i * j + end do + end do +end subroutine + +subroutine check (a, b) + real :: a, b, err + real, parameter :: EPS = 0.00001 + if (b == 0.0) then + err = a + else if (a == 0.0) then + err = b + else + err = (a - b) / b + end if + if (err > EPS .or. err < -EPS) call abort +end subroutine + +program e_53_4 + use e_53_4_mod + integer :: i + real :: accum, accum_ref + call init () + !$omp target update to(Q) + do i = 1, N + call check (accum (i), accum_ref (i)) + end do +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.53.5.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.53.5.f90 new file mode 100644 index 00000000000..304c9fb2ada --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.53.5.f90 @@ -0,0 +1,80 @@ +! { dg-do run } +! { dg-options "-O2" } +! { dg-additional-options "-msse2" { target sse2_runtime } } +! { dg-additional-options "-mavx" { target avx_runtime } } + +module e_53_5_mod + !$omp declare target (N, Q) + integer, parameter :: N = 10000, M = 1024 + real :: Q(N,N) +contains + real function Pfun (k, i) + !$omp declare simd(Pfun) uniform(i) linear(k) notinbranch + !$omp declare target + integer, value, intent(in) :: i, k + Pfun = (Q(k,i) * Q(i,k)) + end function +end module + +real function accum () result (tmp) + use e_53_5_mod + real :: tmp1 + integer :: i + tmp = 0.0e0 + !$omp target + !$omp parallel do private(tmp1) reduction(+:tmp) + do i = 1, N + tmp1 = 0.0e0 + !$omp simd reduction(+:tmp1) + do k = 1, M + tmp1 = tmp1 + Pfun (k, i) + end do + tmp = tmp + tmp1 + end do + !$omp end target +end function + +real function accum_ref () result (tmp) + use e_53_5_mod + real :: tmp1 + integer :: i + tmp = 0.0e0 + do i = 1, N + tmp1 = 0.0e0 + do k = 1, M + tmp1 = tmp1 + Pfun (k, i) + end do + tmp = tmp + tmp1 + end do +end function + +subroutine init () + use e_53_5_mod + integer :: i, j + do i = 1, N + do j = 1, N + Q(i,j) = 0.001 * i * j + end do + end do +end subroutine + +subroutine check (a, b) + real :: a, b, err + real, parameter :: EPS = 0.00001 + if (b == 0.0) then + err = a + else if (a == 0.0) then + err = b + else + err = (a - b) / b + end if + if (err > EPS .or. err < -EPS) call abort +end subroutine + +program e_53_5 + use e_53_5_mod + real :: accum, accum_ref, d + call init () + !$omp target update to(Q) + call check (accum (), accum_ref ()) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.54.2.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.54.2.f90 new file mode 100644 index 00000000000..7daed69481e --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.54.2.f90 @@ -0,0 +1,65 @@ +! { dg-do run } + +function dotprod_ref (B, C, N) result (sum) + implicit none + real :: B(N), C(N), sum + integer :: N, i + sum = 0.0e0 + do i = 1, N + sum = sum + B(i) * C(i) + end do +end function + +function dotprod (B, C, N, block_size, num_teams, block_threads) result (sum) + implicit none + real :: B(N), C(N), sum + integer :: N, block_size, num_teams, block_threads, i, i0 + sum = 0.0e0 + !$omp target map(to: B, C, block_size, num_teams, block_threads) + !$omp teams num_teams(num_teams) thread_limit(block_threads) & + !$omp& reduction(+:sum) + !$omp distribute + do i0 = 1, N, block_size + !$omp parallel do reduction(+:sum) + do i = i0, min (i0 + block_size - 1, N) + sum = sum + B(i) * C(i) + end do + end do + !$omp end teams + !$omp end target +end function + +subroutine init (B, C, N) + real :: B(N), C(N) + integer :: N, i + do i = 1, N + B(i) = 0.0001 * i + C(i) = 0.000001 * i * i + end do +end subroutine + +subroutine check (a, b) + real :: a, b, err + real, parameter :: EPS = 0.0001 + if (b == 0.0) then + err = a + else if (a == 0.0) then + err = b + else + err = (a - b) / b + end if + if (err > EPS .or. err < -EPS) call abort +end subroutine + +program e_54_1 + integer :: n + real :: ref, d + real, pointer, dimension(:) :: B, C + n = 1024 * 1024 + allocate (B(n), C(n)) + call init (B, C, n) + ref = dotprod_ref (B, C, n) + d = dotprod (B, C, n, 32, 2, 8) + call check (ref, d) + deallocate (B, C) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.54.3.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.54.3.f90 new file mode 100644 index 00000000000..2588d8bb684 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.54.3.f90 @@ -0,0 +1,58 @@ +! { dg-do run } + +function dotprod_ref (B, C, N) result (sum) + implicit none + real :: B(N), C(N), sum + integer :: N, i + sum = 0.0e0 + do i = 1, N + sum = sum + B(i) * C(i) + end do +end function + +function dotprod (B, C, N) result(sum) + real :: B(N), C(N), sum + integer :: N, i + sum = 0.0e0 + !$omp target teams map(to: B, C) + !$omp distribute parallel do reduction(+:sum) + do i = 1, N + sum = sum + B(i) * C(i) + end do + !$omp end target teams +end function + +subroutine init (B, C, N) + real :: B(N), C(N) + integer :: N, i + do i = 1, N + B(i) = 0.0001 * i + C(i) = 0.000001 * i * i + end do +end subroutine + +subroutine check (a, b) + real :: a, b, err + real, parameter :: EPS = 0.0001 + if (b == 0.0) then + err = a + else if (a == 0.0) then + err = b + else + err = (a - b) / b + end if + if (err > EPS .or. err < -EPS) call abort +end subroutine + +program e_54_3 + integer :: n + real :: ref, d + real, pointer, dimension(:) :: B, C + n = 1024 * 1024 + allocate (B(n), C(n)) + call init (B, C, n) + ref = dotprod_ref (B, C, n) + d = dotprod (B, C, n) + call check (ref, d) + deallocate (B, C) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.54.4.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.54.4.f90 new file mode 100644 index 00000000000..efae3c3cc20 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.54.4.f90 @@ -0,0 +1,61 @@ +! { dg-do run } + +function dotprod_ref (B, C, N) result (sum) + implicit none + real :: B(N), C(N), sum + integer :: N, i + sum = 0.0e0 + do i = 1, N + sum = sum + B(i) * C(i) + end do +end function + +function dotprod (B, C, n) result(sum) + real :: B(N), C(N), sum + integer :: N, i + sum = 0.0e0 + !$omp target map(to: B, C) + !$omp teams num_teams(8) thread_limit(16) + !$omp distribute parallel do reduction(+:sum) & + !$omp& dist_schedule(static, 1024) schedule(static, 64) + do i = 1, N + sum = sum + B(i) * C(i) + end do + !$omp end teams + !$omp end target +end function + +subroutine init (B, C, N) + real :: B(N), C(N) + integer :: N, i + do i = 1, N + B(i) = 0.0001 * i + C(i) = 0.000001 * i * i + end do +end subroutine + +subroutine check (a, b) + real :: a, b, err + real, parameter :: EPS = 0.0001 + if (b == 0.0) then + err = a + else if (a == 0.0) then + err = b + else + err = (a - b) / b + end if + if (err > EPS .or. err < -EPS) call abort +end subroutine + +program e_54_4 + integer :: n + real :: ref, d + real, pointer, dimension(:) :: B, C + n = 1024 * 1024 + allocate (B(n), C(n)) + call init (B, C, n) + ref = dotprod_ref (B, C, n) + d = dotprod (B, C, n) + call check (ref, d) + deallocate (B, C) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.54.5.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.54.5.f90 new file mode 100644 index 00000000000..9608d9a2c4e --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.54.5.f90 @@ -0,0 +1,47 @@ +! { dg-do run } + +module e_54_5_mod +contains + subroutine init (v1, v2, N) + integer :: i, N + real, pointer, dimension(:) :: v1, v2 + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real, pointer, dimension(:) :: p + real :: diff + do i = 1, N + diff = p(i) - (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine vec_mult (p, v1, v2, N) + real :: p(N), v1(N), v2(N) + integer :: i, N + !$omp target teams map(to: v1, v2) map(from: p) + !$omp distribute simd + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target teams + end subroutine +end module + +program e_54_5 + use e_54_5_mod, only : init, check, vec_mult + real, pointer, dimension(:) :: p, v1, v2 + integer :: n + n = 1000 + allocate (p(n), v1(n), v2(n)) + call init (v1, v2, n) + call vec_mult (p, v1, v2, n) + call check (p, N) + deallocate (p, v1, v2) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.54.6.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.54.6.f90 new file mode 100644 index 00000000000..f79118816f2 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.54.6.f90 @@ -0,0 +1,47 @@ +! { dg-do run } + +module e_54_6_mod +contains + subroutine init (v1, v2, N) + integer :: i, N + real, pointer, dimension(:) :: v1, v2 + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do + end subroutine + + subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real, pointer, dimension(:) :: p + real :: diff + do i = 1, N + diff = p(i) - (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do + end subroutine + + subroutine vec_mult (p, v1, v2, N) + real :: p(N), v1(N), v2(N) + integer :: i, N + !$omp target teams map(to: v1, v2) map(from: p) + !$omp distribute parallel do simd + do i = 1, N + p(i) = v1(i) * v2(i) + end do + !$omp end target teams + end subroutine +end module + +program e_54_6 + use e_54_6_mod, only : init, check, vec_mult + real, pointer, dimension(:) :: p, v1, v2 + integer :: n + n = 1000 + allocate (p(n), v1(n), v2(n)) + call init (v1, v2, n) + call vec_mult (p, v1, v2, n) + call check (p, N) + deallocate (p, v1, v2) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.55.1.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.55.1.f90 new file mode 100644 index 00000000000..0dd00b4ba8c --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.55.1.f90 @@ -0,0 +1,70 @@ +! { dg-do run } + +module e_55_1_mod + integer, parameter :: N = 10000000, CHUNKSZ = 100000 + real :: Y(N), Z(N) +end module + +subroutine init () + use e_55_1_mod, only : Y, Z, N + integer :: i + do i = 1, N + Y(i) = 0.1 * i + Z(i) = Y(i) + end do +end subroutine + +subroutine check () + use e_55_1_mod, only : Y, Z, N + real :: err + real, parameter :: EPS = 0.00001 + integer :: i + do i = 1, N + if (Y(i) == 0.0) then + err = Z(i) + else if (Z(i) == 0.0) then + err = Y(i) + else + err = (Y(i) - Z(i)) / Z(i) + end if + if (err > EPS .or. err < -EPS) call abort + end do +end subroutine + +real function F (z) + !$omp declare target + real, intent(in) :: z + F = -z +end function + +subroutine pipedF () + use e_55_1_mod, only: Z, N, CHUNKSZ + integer :: C, i + real :: F + do C = 1, N, CHUNKSZ + !$omp task + !$omp target map(Z(C:C+CHUNKSZ-1)) + !$omp parallel do + do i = C, C+CHUNKSZ-1 + Z(i) = F (Z(i)) + end do + !$omp end target + !$omp end task + end do +end subroutine + +subroutine pipedF_ref () + use e_55_1_mod, only: Y, N + integer :: i + real :: F + do i = 1, N + Y(i) = F (Y(i)) + end do +end subroutine + +program e_55_1 + call init () + call pipedF () + call pipedF_ref () + call check () +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.55.2.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.55.2.f90 new file mode 100644 index 00000000000..dfcb5f40ca9 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.55.2.f90 @@ -0,0 +1,56 @@ +! { dg-do run } +! { dg-require-effective-target offload_device } + +subroutine init (v1, v2, N) + !$omp declare target + integer :: i, N + real :: v1(N), v2(N) + do i = 1, N + v1(i) = i + 2.0 + v2(i) = i - 3.0 + end do +end subroutine + +subroutine check (p, N) + integer :: i, N + real, parameter :: EPS = 0.00001 + real :: diff, p(N) + do i = 1, N + diff = p(i) - (i + 2.0) * (i - 3.0) + if (diff > EPS .or. -diff > EPS) call abort + end do +end subroutine + +subroutine vec_mult (p, N) + use omp_lib, only: omp_is_initial_device + real :: p(N) + real, allocatable :: v1(:), v2(:) + integer :: i + !$omp declare target (init) + !$omp target data map(to: v1, v2, N) map(from: p) + !$omp task shared(v1, v2, p) depend(out: v1, v2) + !$omp target map(to: v1, v2, N) + if (omp_is_initial_device ()) call abort + allocate (v1(N), v2(N)) + call init (v1, v2, N) + !$omp end target + !$omp end task + !$omp task shared(v1, v2, p) depend(in: v1, v2) + !$omp target map(to: v1, v2, N) map(from: p) + if (omp_is_initial_device ()) call abort + !$omp parallel do + do i = 1, N + p(i) = v1(i) * v2(i) + end do + deallocate (v1, v2) + !$omp end target + !$omp end task + !$omp end target data + call check (p, N) +end subroutine + +program e_55_2 + integer, parameter :: N = 1000 + real :: p(N) + call vec_mult (p, N) +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.56.3.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.56.3.f90 new file mode 100644 index 00000000000..94da51e4fc3 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.56.3.f90 @@ -0,0 +1,17 @@ +! { dg-do run } + + call foo () +contains + subroutine foo () + integer, target :: A(30) + integer, pointer :: p(:) + !$omp target data map(A(1:4)) + p => A + !$omp target map(p(8:27)) map(A(1:4)) + A(3) = 777 + p(9) = 777 + !$omp end target + !$omp end target data + if (A(3) /= 777 .or. A(9) /= 777) call abort + end subroutine +end diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.56.4.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.56.4.f90 new file mode 100644 index 00000000000..6eb9bc1e5c3 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.56.4.f90 @@ -0,0 +1,18 @@ +! { dg-do run } + + call foo () +contains + subroutine foo () + integer, target :: A(30) + integer, pointer :: p(:) + !$omp target data map(A(1:10)) + p => A + !$omp target map(p(4:10)) map(A(1:10)) + A(3) = 777 + p(9) = 777 + A(9) = 999 + !$omp end target + !$omp end target data + if (A(3) /= 777 .or. A(9) /= 999) call abort + end subroutine +end diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.57.1.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.57.1.f90 new file mode 100644 index 00000000000..291604bee7a --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.57.1.f90 @@ -0,0 +1,56 @@ +! { dg-do run } +! { dg-require-effective-target offload_device } + +program e_57_1 + use omp_lib, only: omp_is_initial_device + integer :: a, b + logical :: c, d + + a = 100 + b = 0 + + !$omp target if(a > 200 .and. a < 400) + c = omp_is_initial_device () + !$omp end target + + !$omp target data map(to: b) if(a > 200 .and. a < 400) + !$omp target + b = 100 + d = omp_is_initial_device () + !$omp end target + !$omp end target data + + if (b /= 100 .or. .not. c .or. d) call abort + + a = a + 200 + b = 0 + + !$omp target if(a > 200 .and. a < 400) + c = omp_is_initial_device () + !$omp end target + + !$omp target data map(to: b) if(a > 200 .and. a < 400) + !$omp target + b = 100 + d = omp_is_initial_device () + !$omp end target + !$omp end target data + + if (b /= 0 .or. c .or. d) call abort + + a = a + 200 + b = 0 + + !$omp target if(a > 200 .and. a < 400) + c = omp_is_initial_device () + !$omp end target + + !$omp target data map(to: b) if(a > 200 .and. a < 400) + !$omp target + b = 100 + d = omp_is_initial_device () + !$omp end target + !$omp end target data + + if (b /= 100 .or. .not. c .or. d) call abort +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.57.2.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.57.2.f90 new file mode 100644 index 00000000000..4a304b5c799 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.57.2.f90 @@ -0,0 +1,24 @@ +! { dg-do run } +! { dg-require-effective-target offload_device } + +program e_57_2 + use omp_lib, only: omp_is_initial_device, omp_get_num_devices + integer, parameter :: N = 10 + integer :: i, num + logical :: offload(N) + num = omp_get_num_devices () + !$omp parallel do + do i = 1, N + !$omp target device(i-1) map(from: offload(i:i)) + offload(i) = omp_is_initial_device () + !$omp end target + end do + + do i = 1, num + if (offload(i)) call abort + end do + + do i = num+1, N + if (.not. offload(i)) call abort + end do +end program diff --git a/libgomp/testsuite/libgomp.fortran/examples-4/e.57.3.f90 b/libgomp/testsuite/libgomp.fortran/examples-4/e.57.3.f90 new file mode 100644 index 00000000000..a29f1b59a26 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/examples-4/e.57.3.f90 @@ -0,0 +1,21 @@ +! { dg-do run } +! { dg-require-effective-target offload_device } + +program e_57_3 + use omp_lib, only: omp_is_initial_device, omp_get_num_devices,& + omp_get_default_device, omp_set_default_device + logical :: res + integer :: default_device + + default_device = omp_get_default_device () + !$omp target + res = omp_is_initial_device () + !$omp end target + if (res) call abort + + call omp_set_default_device (omp_get_num_devices ()) + !$omp target + res = omp_is_initial_device () + !$omp end target + if (.not. res) call abort +end program |