blob: 3dd1f90f04c733233bcddeb8c35f70d32a7aefe9 [file] [log] [blame]
! { dg-do run }
! Comprehensive run-time test for use_device_addr
!
! Differs from use_device_addr-1.f90 by using a 4-byte variable (c_float)
!
! This test case assumes that a 'var' appearing in 'use_device_addr' is
! only used as 'c_loc(var)' - such that only the actual data is used/usable
! on the device - and not meta data ((dynamic) type information, 'present()'
! status, array shape).
!
! Untested in this test case are:
! - arrays with array descriptor
! - polymorphic variables
! - absent optional arguments
!
module target_procs
use iso_c_binding
implicit none (type, external)
private
public :: copy3_array, copy3_scalar
contains
subroutine copy3_array_int(from_ptr, to_ptr, N)
!$omp declare target
real(c_float) :: from_ptr(:)
real(c_float) :: to_ptr(:)
integer, value :: N
integer :: i
!$omp parallel do
do i = 1, N
to_ptr(i) = 3 * from_ptr(i)
end do
!$omp end parallel do
end subroutine copy3_array_int
subroutine copy3_scalar_int(from, to)
!$omp declare target
real(c_float) :: from, to
to = 3 * from
end subroutine copy3_scalar_int
subroutine copy3_array(from, to, N)
type(c_ptr), value :: from, to
integer, value :: N
real(c_float), pointer :: from_ptr(:), to_ptr(:)
call c_f_pointer(from, from_ptr, shape=[N])
call c_f_pointer(to, to_ptr, shape=[N])
call do_offload_scalar(from_ptr,to_ptr)
contains
subroutine do_offload_scalar(from_r, to_r)
real(c_float), target :: from_r(:), to_r(:)
! The extra function is needed as is_device_ptr
! requires non-value, non-pointer dummy arguments
!$omp target is_device_ptr(from_r, to_r)
call copy3_array_int(from_r, to_r, N)
!$omp end target
end subroutine do_offload_scalar
end subroutine copy3_array
subroutine copy3_scalar(from, to)
type(c_ptr), value, target :: from, to
real(c_float), pointer :: from_ptr(:), to_ptr(:)
! Standard-conform detour of using an array as at time of writing
! is_device_ptr below does not handle scalars
call c_f_pointer(from, from_ptr, shape=[1])
call c_f_pointer(to, to_ptr, shape=[1])
call do_offload_scalar(from_ptr,to_ptr)
contains
subroutine do_offload_scalar(from_r, to_r)
real(c_float), target :: from_r(:), to_r(:)
! The extra function is needed as is_device_ptr
! requires non-value, non-pointer dummy arguments
!$omp target is_device_ptr(from_r, to_r)
call copy3_scalar_int(from_r(1), to_r(1))
!$omp end target
end subroutine do_offload_scalar
end subroutine copy3_scalar
end module target_procs
! Test local dummy arguments (w/o optional)
module test_dummies
use iso_c_binding
use target_procs
implicit none (type, external)
private
public :: test_dummy_call_1, test_dummy_call_2
contains
subroutine test_dummy_call_1()
integer, parameter :: N = 1000
! scalars
real(c_float), target :: aa, bb
real(c_float), target, allocatable :: cc, dd
real(c_float), pointer :: ee, ff
! non-descriptor arrays
real(c_float), target :: gg(N), hh(N)
allocate(cc, dd, ee, ff)
aa = 11.0_c_float
bb = 22.0_c_float
cc = 33.0_c_float
dd = 44.0_c_float
ee = 55.0_c_float
ff = 66.0_c_float
gg = 77.0_c_float
hh = 88.0_c_float
call test_dummy_callee_1(aa, bb, cc, dd, ee, ff, gg, hh, N)
deallocate(ee, ff) ! pointers, only
end subroutine test_dummy_call_1
subroutine test_dummy_callee_1(aa, bb, cc, dd, ee, ff, gg, hh, N)
! scalars
real(c_float), target :: aa, bb
real(c_float), target, allocatable :: cc, dd
real(c_float), pointer :: ee, ff
! non-descriptor arrays
real(c_float), target :: gg(N), hh(N)
integer, value :: N
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
call copy3_scalar(c_loc(aa), c_loc(bb))
!$omp end target data
if (abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa)) stop 1
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 2
!$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
call copy3_scalar(c_loc(cc), c_loc(dd))
!$omp end target data
if (abs(cc - 33.0_c_float) > 10.0_c_float * epsilon(cc)) stop 3
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) stop 4
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
call copy3_scalar(c_loc(ee), c_loc(ff))
!$omp end target data
if (abs(ee - 55.0_c_float) > 10.0_c_float * epsilon(ee)) stop 5
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) stop 6
!$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh)
call copy3_array(c_loc(gg), c_loc(hh), N)
!$omp end target data
if (any(abs(gg - 77.0_c_float) > 10.0_c_float * epsilon(gg))) stop 7
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) stop 8
end subroutine test_dummy_callee_1
! Save device ptr - and recall pointer
subroutine test_dummy_call_2()
integer, parameter :: N = 1000
! scalars
real(c_float), target :: aa, bb
real(c_float), target, allocatable :: cc, dd
real(c_float), pointer :: ee, ff
! non-descriptor arrays
real(c_float), target :: gg(N), hh(N)
type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr
real(c_float), pointer :: aptr, bptr, cptr, dptr, eptr, fptr
real(c_float), pointer :: gptr(:), hptr(:)
allocate(cc, dd, ee, ff)
call test_dummy_callee_2(aa, bb, cc, dd, ee, ff, gg, hh, &
c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr, &
aptr, bptr, cptr, dptr, eptr, fptr, gptr, hptr, &
N)
deallocate(ee, ff)
end subroutine test_dummy_call_2
subroutine test_dummy_callee_2(aa, bb, cc, dd, ee, ff, gg, hh, &
c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr, &
aptr, bptr, cptr, dptr, eptr, fptr, gptr, hptr, &
N)
! scalars
real(c_float), target :: aa, bb
real(c_float), target, allocatable :: cc, dd
real(c_float), pointer :: ee, ff
! non-descriptor arrays
real(c_float), target :: gg(N), hh(N)
type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr
real(c_float), pointer :: aptr, bptr, cptr, dptr, eptr, fptr
real(c_float), pointer :: gptr(:), hptr(:)
integer, value :: N
real(c_float) :: dummy
aa = 111.0_c_float
bb = 222.0_c_float
cc = 333.0_c_float
dd = 444.0_c_float
ee = 555.0_c_float
ff = 666.0_c_float
gg = 777.0_c_float
hh = 888.0_c_float
!$omp target data map(to:aa) map(from:bb)
!$omp target data map(alloc:dummy) use_device_addr(aa,bb)
c_aptr = c_loc(aa)
c_bptr = c_loc(bb)
aptr => aa
bptr => bb
!$omp end target data
! check c_loc ptr once
call copy3_scalar(c_aptr, c_bptr)
!$omp target update from(bb)
if (abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 9
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 10
! check c_loc ptr again after target-value modification
aa = 1111.0_c_float
!$omp target update to(aa)
call copy3_scalar(c_aptr, c_bptr)
!$omp target update from(bb)
if (abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 11
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 12
! check Fortran pointer after target-value modification
aa = 11111.0_c_float
!$omp target update to(aa)
call copy3_scalar(c_loc(aptr), c_loc(bptr))
!$omp target update from(bb)
if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 13
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 14
!$omp end target data
if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 15
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 16
!$omp target data map(to:cc) map(from:dd)
!$omp target data map(alloc:dummy) use_device_addr(cc,dd)
c_cptr = c_loc(cc)
c_dptr = c_loc(dd)
cptr => cc
dptr => dd
!$omp end target data
! check c_loc ptr once
call copy3_scalar(c_cptr, c_dptr)
!$omp target update from(dd)
if (abs(cc - 333.0_c_float) > 10.0_c_float * epsilon(cc)) stop 17
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) stop 18
! check c_loc ptr again after target-value modification
cc = 3333.0_c_float
!$omp target update to(cc)
call copy3_scalar(c_cptr, c_dptr)
!$omp target update from(dd)
if (abs(cc - 3333.0_c_float) > 10.0_c_float * epsilon(cc)) stop 19
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) stop 20
! check Fortran pointer after target-value modification
cc = 33333.0_c_float
!$omp target update to(cc)
call copy3_scalar(c_loc(cptr), c_loc(dptr))
!$omp target update from(dd)
if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(cc)) stop 21
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) stop 22
!$omp end target data
if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd)) stop 23
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd)) stop 24
!$omp target data map(to:ee) map(from:ff)
!$omp target data map(alloc:dummy) use_device_addr(ee,ff)
c_eptr = c_loc(ee)
c_fptr = c_loc(ff)
eptr => ee
fptr => ff
!$omp end target data
! check c_loc ptr once
call copy3_scalar(c_eptr, c_fptr)
!$omp target update from(ff)
if (abs(ee - 555.0_c_float) > 10.0_c_float * epsilon(ee)) stop 25
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) stop 26
! check c_loc ptr again after target-value modification
ee = 5555.0_c_float
!$omp target update to(ee)
call copy3_scalar(c_eptr, c_fptr)
!$omp target update from(ff)
if (abs(ee - 5555.0_c_float) > 10.0_c_float * epsilon(ee)) stop 27
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) stop 28
! check Fortran pointer after target-value modification
ee = 55555.0_c_float
!$omp target update to(ee)
call copy3_scalar(c_loc(eptr), c_loc(fptr))
!$omp target update from(ff)
if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) stop 29
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff)) stop 30
!$omp end target data
if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) stop 31
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) stop 32
!$omp target data map(to:gg) map(from:hh)
!$omp target data map(alloc:dummy) use_device_addr(gg,hh)
c_gptr = c_loc(gg)
c_hptr = c_loc(hh)
gptr => gg
hptr => hh
!$omp end target data
! check c_loc ptr once
call copy3_array(c_gptr, c_hptr, N)
!$omp target update from(hh)
if (any(abs(gg - 777.0_c_float) > 10.0_c_float * epsilon(gg))) stop 33
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(hh))) stop 34
! check c_loc ptr again after target-value modification
gg = 7777.0_c_float
!$omp target update to(gg)
call copy3_array(c_gptr, c_hptr, N)
!$omp target update from(hh)
if (any(abs(gg - 7777.0_c_float) > 10.0_c_float * epsilon(gg))) stop 35
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) stop 36
! check Fortran pointer after target-value modification
gg = 77777.0_c_float
!$omp target update to(gg)
call copy3_array(c_loc(gptr), c_loc(hptr), N)
!$omp target update from(hh)
if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) stop 37
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) stop 38
!$omp end target data
if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) stop 39
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) stop 40
end subroutine test_dummy_callee_2
end module test_dummies
! Test local dummy arguments + VALUE (w/o optional)
module test_dummies_value
use iso_c_binding
use target_procs
implicit none (type, external)
private
public :: test_dummy_val_call_1, test_dummy_val_call_2
contains
subroutine test_dummy_val_call_1()
! scalars - with value, neither allocatable nor pointer no dimension permitted
real(c_float), target :: aa, bb
aa = 11.0_c_float
bb = 22.0_c_float
call test_dummy_val_callee_1(aa, bb)
end subroutine test_dummy_val_call_1
subroutine test_dummy_val_callee_1(aa, bb)
! scalars
real(c_float), value, target :: aa, bb
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
call copy3_scalar(c_loc(aa), c_loc(bb))
!$omp end target data
if (abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa)) stop 41
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 42
end subroutine test_dummy_val_callee_1
! Save device ptr - and recall pointer
subroutine test_dummy_val_call_2()
! scalars - with value, neither allocatable nor pointer no dimension permitted
real(c_float), target :: aa, bb
type(c_ptr) :: c_aptr, c_bptr
real(c_float), pointer :: aptr, bptr
call test_dummy_val_callee_2(aa, bb, c_aptr, c_bptr, aptr, bptr)
end subroutine test_dummy_val_call_2
subroutine test_dummy_val_callee_2(aa, bb, c_aptr, c_bptr, aptr, bptr)
real(c_float), value, target :: aa, bb
type(c_ptr), value :: c_aptr, c_bptr
real(c_float), pointer :: aptr, bptr
real(c_float) :: dummy
aa = 111.0_c_float
bb = 222.0_c_float
!$omp target data map(to:aa) map(from:bb)
!$omp target data map(alloc:dummy) use_device_addr(aa,bb)
c_aptr = c_loc(aa)
c_bptr = c_loc(bb)
aptr => aa
bptr => bb
!$omp end target data
! check c_loc ptr once
call copy3_scalar(c_aptr, c_bptr)
!$omp target update from(bb)
if (abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 43
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 44
! check c_loc ptr again after target-value modification
aa = 1111.0_c_float
!$omp target update to(aa)
call copy3_scalar(c_aptr, c_bptr)
!$omp target update from(bb)
if (abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 45
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 46
! check Fortran pointer after target-value modification
aa = 11111.0_c_float
!$omp target update to(aa)
call copy3_scalar(c_loc(aptr), c_loc(bptr))
!$omp target update from(bb)
if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 47
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 48
!$omp end target data
if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 49
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 50
end subroutine test_dummy_val_callee_2
end module test_dummies_value
! Test local dummy arguments + OPTIONAL
! Values present and ptr associated to nonzero
module test_dummies_opt
use iso_c_binding
use target_procs
implicit none (type, external)
private
public :: test_dummy_opt_call_1, test_dummy_opt_call_2
contains
subroutine test_dummy_opt_call_1()
integer, parameter :: N = 1000
! scalars
real(c_float), target :: aa, bb
real(c_float), target, allocatable :: cc, dd
real(c_float), pointer :: ee, ff
! non-descriptor arrays
real(c_float), target :: gg(N), hh(N)
allocate(cc, dd, ee, ff)
aa = 11.0_c_float
bb = 22.0_c_float
cc = 33.0_c_float
dd = 44.0_c_float
ee = 55.0_c_float
ff = 66.0_c_float
gg = 77.0_c_float
hh = 88.0_c_float
call test_dummy_opt_callee_1(aa, bb, cc, dd, ee, ff, gg, hh, N)
call test_dummy_opt_callee_1_absent(N=N)
deallocate(ee, ff) ! pointers, only
end subroutine test_dummy_opt_call_1
subroutine test_dummy_opt_callee_1(aa, bb, cc, dd, ee, ff, gg, hh, N)
! scalars
real(c_float), optional, target :: aa, bb
real(c_float), optional, target, allocatable :: cc, dd
real(c_float), optional, pointer :: ee, ff
! non-descriptor arrays
real(c_float), optional, target :: gg(N), hh(N)
integer, value :: N
! All shall be present - and pointing to non-NULL
if (.not.present(aa) .or. .not.present(bb)) stop 51
if (.not.present(cc) .or. .not.present(dd)) stop 52
if (.not.present(ee) .or. .not.present(ff)) stop 53
if (.not.present(gg) .or. .not.present(hh)) stop 54
if (.not.associated(ee) .or. .not.associated(ff)) stop 55
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
if (.not.present(aa) .or. .not.present(bb)) stop 56
if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) stop 57
call copy3_scalar(c_loc(aa), c_loc(bb))
!$omp end target data
if (abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa)) stop 58
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 59
!$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
if (.not.present(cc) .or. .not.present(dd)) stop 60
if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) stop 61
call copy3_scalar(c_loc(cc), c_loc(dd))
!$omp end target data
if (abs(cc - 33.0_c_float) > 10.0_c_float * epsilon(cc)) stop 62
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) stop 63
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
if (.not.present(ee) .or. .not.present(ff)) stop 64
if (.not.associated(ee) .or. .not.associated(ff)) stop 65
if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) stop 66
call copy3_scalar(c_loc(ee), c_loc(ff))
!$omp end target data
if (abs(ee - 55.0_c_float) > 10.0_c_float * epsilon(ee)) stop 67
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) stop 68
!$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh)
if (.not.present(gg) .or. .not.present(hh)) stop 69
if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) stop 70
call copy3_array(c_loc(gg), c_loc(hh), N)
!$omp end target data
if (any(abs(gg - 77.0_c_float) > 10.0_c_float * epsilon(gg))) stop 71
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) stop 72
end subroutine test_dummy_opt_callee_1
subroutine test_dummy_opt_callee_1_absent(aa, bb, cc, dd, ee, ff, gg, hh, N)
! scalars
real(c_float), optional, target :: aa, bb
real(c_float), optional, target, allocatable :: cc, dd
real(c_float), optional, pointer :: ee, ff
! non-descriptor arrays
real(c_float), optional, target :: gg(N), hh(N)
integer, value :: N
integer :: err
! All shall be absent
if (present(aa) .or. present(bb)) stop 243
if (present(cc) .or. present(dd)) stop 244
if (present(ee) .or. present(ff)) stop 245
if (present(gg) .or. present(hh)) stop 246
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
if (present(aa) .or. present(bb)) stop 247
!$omp end target data
!$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
if (present(cc) .or. present(dd)) stop 248
!$omp end target data
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
if (present(ee) .or. present(ff)) stop 249
!$omp end target data
!$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh)
if (present(gg) .or. present(hh)) stop 250
!$omp end target data
end subroutine test_dummy_opt_callee_1_absent
! Save device ptr - and recall pointer
subroutine test_dummy_opt_call_2()
integer, parameter :: N = 1000
! scalars
real(c_float), target :: aa, bb
real(c_float), target, allocatable :: cc, dd
real(c_float), pointer :: ee, ff
! non-descriptor arrays
real(c_float), target :: gg(N), hh(N)
type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr
real(c_float), pointer :: aptr, bptr, cptr, dptr, eptr, fptr
real(c_float), pointer :: gptr(:), hptr(:)
allocate(cc, dd, ee, ff)
call test_dummy_opt_callee_2(aa, bb, cc, dd, ee, ff, gg, hh, &
c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr, &
aptr, bptr, cptr, dptr, eptr, fptr, gptr, hptr, &
N)
deallocate(ee, ff)
end subroutine test_dummy_opt_call_2
subroutine test_dummy_opt_callee_2(aa, bb, cc, dd, ee, ff, gg, hh, &
c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr, &
aptr, bptr, cptr, dptr, eptr, fptr, gptr, hptr, &
N)
! scalars
real(c_float), optional, target :: aa, bb
real(c_float), optional, target, allocatable :: cc, dd
real(c_float), optional, pointer :: ee, ff
! non-descriptor arrays
real(c_float), optional, target :: gg(N), hh(N)
type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr
real(c_float), optional, pointer :: aptr, bptr, cptr, dptr, eptr, fptr
real(c_float), optional, pointer :: gptr(:), hptr(:)
integer, value :: N
real(c_float) :: dummy
! All shall be present - and pointing to non-NULL
if (.not.present(aa) .or. .not.present(bb)) stop 73
if (.not.present(cc) .or. .not.present(dd)) stop 74
if (.not.present(ee) .or. .not.present(ff)) stop 75
if (.not.present(gg) .or. .not.present(hh)) stop 76
if (.not.associated(ee) .or. .not.associated(ff)) stop 77
aa = 111.0_c_float
bb = 222.0_c_float
cc = 333.0_c_float
dd = 444.0_c_float
ee = 555.0_c_float
ff = 666.0_c_float
gg = 777.0_c_float
hh = 888.0_c_float
!$omp target data map(to:aa) map(from:bb)
!$omp target data map(alloc:dummy) use_device_addr(aa,bb)
if (.not.present(aa) .or. .not.present(bb)) stop 78
if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) stop 79
c_aptr = c_loc(aa)
c_bptr = c_loc(bb)
aptr => aa
bptr => bb
if (.not.c_associated(c_aptr) .or. .not.c_associated(c_bptr)) stop 80
if (.not.associated(aptr) .or. .not.associated(bptr)) stop 81
!$omp end target data
if (.not.present(aa) .or. .not.present(bb)) stop 82
if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) stop 83
if (.not.c_associated(c_aptr) .or. .not.c_associated(c_bptr)) stop 84
if (.not.associated(aptr) .or. .not.associated(bptr)) stop 85
! check c_loc ptr once
call copy3_scalar(c_aptr, c_bptr)
!$omp target update from(bb)
if (abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 86
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 87
! check c_loc ptr again after target-value modification
aa = 1111.0_c_float
!$omp target update to(aa)
call copy3_scalar(c_aptr, c_bptr)
!$omp target update from(bb)
if (abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 88
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 89
! check Fortran pointer after target-value modification
aa = 11111.0_c_float
!$omp target update to(aa)
call copy3_scalar(c_loc(aptr), c_loc(bptr))
!$omp target update from(bb)
if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 90
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 91
!$omp end target data
if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 92
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 93
!$omp target data map(to:cc) map(from:dd)
!$omp target data map(alloc:dummy) use_device_addr(cc,dd)
if (.not.present(cc) .or. .not.present(dd)) stop 94
if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) stop 95
c_cptr = c_loc(cc)
c_dptr = c_loc(dd)
cptr => cc
dptr => dd
if (.not.c_associated(c_cptr) .or. .not.c_associated(c_dptr)) stop 96
if (.not.associated(cptr) .or. .not.associated(dptr)) stop 97
!$omp end target data
if (.not.present(cc) .or. .not.present(dd)) stop 98
if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) stop 99
if (.not.c_associated(c_cptr) .or. .not.c_associated(c_dptr)) stop 100
if (.not.associated(cptr) .or. .not.associated(dptr)) stop 101
! check c_loc ptr once
call copy3_scalar(c_cptr, c_dptr)
!$omp target update from(dd)
if (abs(cc - 333.0_c_float) > 10.0_c_float * epsilon(cc)) stop 102
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) stop 103
! check c_loc ptr again after target-value modification
cc = 3333.0_c_float
!$omp target update to(cc)
call copy3_scalar(c_cptr, c_dptr)
!$omp target update from(dd)
if (abs(cc - 3333.0_c_float) > 10.0_c_float * epsilon(cc)) stop 104
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) stop 105
! check Fortran pointer after target-value modification
cc = 33333.0_c_float
!$omp target update to(cc)
call copy3_scalar(c_loc(cptr), c_loc(dptr))
!$omp target update from(dd)
if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(cc)) stop 106
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) stop 107
!$omp end target data
if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd)) stop 108
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd)) stop 109
!$omp target data map(to:ee) map(from:ff)
!$omp target data map(alloc:dummy) use_device_addr(ee,ff)
if (.not.present(ee) .or. .not.present(ff)) stop 110
if (.not.associated(ee) .or. .not.associated(ff)) stop 111
if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) stop 112
c_eptr = c_loc(ee)
c_fptr = c_loc(ff)
eptr => ee
fptr => ff
if (.not.c_associated(c_eptr) .or. .not.c_associated(c_fptr)) stop 113
if (.not.associated(eptr) .or. .not.associated(fptr)) stop 114
!$omp end target data
if (.not.present(ee) .or. .not.present(ff)) stop 115
if (.not.associated(ee) .or. .not.associated(ff)) stop 116
if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) stop 117
if (.not.c_associated(c_eptr) .or. .not.c_associated(c_fptr)) stop 118
if (.not.associated(eptr) .or. .not.associated(fptr)) stop 119
! check c_loc ptr once
call copy3_scalar(c_eptr, c_fptr)
!$omp target update from(ff)
if (abs(ee - 555.0_c_float) > 10.0_c_float * epsilon(ee)) stop 120
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) stop 121
! check c_loc ptr again after target-value modification
ee = 5555.0_c_float
!$omp target update to(ee)
call copy3_scalar(c_eptr, c_fptr)
!$omp target update from(ff)
if (abs(ee - 5555.0_c_float) > 10.0_c_float * epsilon(ee)) stop 122
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) stop 123
! check Fortran pointer after target-value modification
ee = 55555.0_c_float
!$omp target update to(ee)
call copy3_scalar(c_loc(eptr), c_loc(fptr))
!$omp target update from(ff)
if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) stop 124
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff)) stop 125
!$omp end target data
if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) stop 126
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) stop 127
!$omp target data map(to:gg) map(from:hh)
!$omp target data map(alloc:dummy) use_device_addr(gg,hh)
if (.not.present(gg) .or. .not.present(hh)) stop 128
if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) stop 129
c_gptr = c_loc(gg)
c_hptr = c_loc(hh)
gptr => gg
hptr => hh
if (.not.c_associated(c_gptr) .or. .not.c_associated(c_hptr)) stop 130
if (.not.associated(gptr) .or. .not.associated(hptr)) stop 131
!$omp end target data
if (.not.present(gg) .or. .not.present(hh)) stop 132
if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) stop 133
if (.not.c_associated(c_gptr) .or. .not.c_associated(c_hptr)) stop 134
if (.not.associated(gptr) .or. .not.associated(hptr)) stop 135
! check c_loc ptr once
call copy3_array(c_gptr, c_hptr, N)
!$omp target update from(hh)
if (any(abs(gg - 777.0_c_float) > 10.0_c_float * epsilon(gg))) stop 136
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(hh))) stop 137
! check c_loc ptr again after target-value modification
gg = 7777.0_c_float
!$omp target update to(gg)
call copy3_array(c_gptr, c_hptr, N)
!$omp target update from(hh)
if (any(abs(gg - 7777.0_c_float) > 10.0_c_float * epsilon(gg))) stop 138
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) stop 139
! check Fortran pointer after target-value modification
gg = 77777.0_c_float
!$omp target update to(gg)
call copy3_array(c_loc(gptr), c_loc(hptr), N)
!$omp target update from(hh)
if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) stop 140
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) stop 141
!$omp end target data
if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) stop 142
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) stop 143
end subroutine test_dummy_opt_callee_2
end module test_dummies_opt
! Test local dummy arguments + OPTIONAL + VALUE
! Values present
module test_dummies_opt_value
use iso_c_binding
use target_procs
implicit none (type, external)
private
public :: test_dummy_opt_val_call_1, test_dummy_opt_val_call_2
contains
subroutine test_dummy_opt_val_call_1()
! scalars - with value, neither allocatable nor pointer no dimension permitted
real(c_float), target :: aa, bb
aa = 11.0_c_float
bb = 22.0_c_float
call test_dummy_opt_val_callee_1(aa, bb)
end subroutine test_dummy_opt_val_call_1
subroutine test_dummy_opt_val_callee_1(aa, bb)
! scalars
real(c_float), optional, value, target :: aa, bb
if (.not.present(aa) .or. .not.present(bb)) stop 144
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
if (.not.present(aa) .or. .not.present(bb)) stop 145
if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) stop 146
call copy3_scalar(c_loc(aa), c_loc(bb))
!$omp end target data
if (abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa)) stop 147
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 148
end subroutine test_dummy_opt_val_callee_1
! Save device ptr - and recall pointer
subroutine test_dummy_opt_val_call_2()
! scalars - with value, neither allocatable nor pointer no dimension permitted
real(c_float), target :: aa, bb
type(c_ptr) :: c_aptr, c_bptr
real(c_float), pointer :: aptr, bptr
call test_dummy_opt_val_callee_2(aa, bb, c_aptr, c_bptr, aptr, bptr)
end subroutine test_dummy_opt_val_call_2
subroutine test_dummy_opt_val_callee_2(aa, bb, c_aptr, c_bptr, aptr, bptr)
real(c_float), optional, value, target :: aa, bb
type(c_ptr), optional, value :: c_aptr, c_bptr
real(c_float), optional, pointer :: aptr, bptr
real(c_float) :: dummy
if (.not.present(aa) .or. .not.present(bb)) stop 149
if (.not.present(c_aptr) .or. .not.present(c_bptr)) stop 150
if (.not.present(aptr) .or. .not.present(bptr)) stop 151
aa = 111.0_c_float
bb = 222.0_c_float
!$omp target data map(to:aa) map(from:bb)
if (.not.present(aa) .or. .not.present(bb)) stop 152
if (.not.present(c_aptr) .or. .not.present(c_bptr)) stop 153
if (.not.present(aptr) .or. .not.present(bptr)) stop 154
!$omp target data map(alloc:dummy) use_device_addr(aa,bb)
if (.not.present(aa) .or. .not.present(bb)) stop 155
if (.not.present(c_aptr) .or. .not.present(c_bptr)) stop 156
if (.not.present(aptr) .or. .not.present(bptr)) stop 157
c_aptr = c_loc(aa)
c_bptr = c_loc(bb)
aptr => aa
bptr => bb
if (.not.c_associated(c_aptr) .or. .not.c_associated(c_bptr)) stop 158
if (.not.associated(aptr) .or. .not.associated(bptr)) stop 159
!$omp end target data
! check c_loc ptr once
call copy3_scalar(c_aptr, c_bptr)
!$omp target update from(bb)
if (abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 160
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 161
! check c_loc ptr again after target-value modification
aa = 1111.0_c_float
!$omp target update to(aa)
call copy3_scalar(c_aptr, c_bptr)
!$omp target update from(bb)
if (abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 162
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 163
! check Fortran pointer after target-value modification
aa = 11111.0_c_float
!$omp target update to(aa)
call copy3_scalar(c_loc(aptr), c_loc(bptr))
!$omp target update from(bb)
if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 164
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 165
!$omp end target data
if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 166
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 167
end subroutine test_dummy_opt_val_callee_2
end module test_dummies_opt_value
! Test nullptr
module test_nullptr
use iso_c_binding
implicit none (type, external)
private
public :: test_nullptr_1
contains
subroutine test_nullptr_1()
! scalars
real(c_float), pointer :: aa, bb
real(c_float), pointer :: ee, ff
real(c_float), allocatable, target :: gg, hh
type(c_ptr) :: c_aptr, c_bptr, c_eptr, c_fptr, c_gptr, c_hptr
real(c_float), pointer :: aptr, bptr, eptr, fptr, gptr, hptr
aa => null()
bb => null()
ee => null()
ff => null()
if (associated(aa) .or. associated(bb)) stop 168
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
if (c_associated(c_loc(aa)) .or. c_associated(c_loc(bb))) stop 169
c_aptr = c_loc(aa)
c_bptr = c_loc(bb)
aptr => aa
bptr => bb
if (c_associated(c_aptr) .or. c_associated(c_bptr)) stop 170
if (associated(aptr) .or. associated(bptr, bb)) stop 171
!$omp end target data
if (c_associated(c_aptr) .or. c_associated(c_bptr)) stop 172
if (associated(aptr) .or. associated(bptr, bb)) stop 173
if (allocated(gg)) stop 174
!$omp target data map(tofrom:gg) use_device_addr(gg)
if (c_associated(c_loc(gg))) stop 175
c_gptr = c_loc(gg)
gptr => gg
if (c_associated(c_gptr)) stop 176
if (associated(gptr)) stop 177
if (allocated(gg)) stop 178
!$omp end target data
if (c_associated(c_gptr)) stop 179
if (associated(gptr)) stop 180
if (allocated(gg)) stop 181
call test_dummy_opt_nullptr_callee_1(ee, ff, hh, c_eptr, c_fptr, c_hptr, eptr, fptr, hptr)
end subroutine test_nullptr_1
subroutine test_dummy_opt_nullptr_callee_1(ee, ff, hh, c_eptr, c_fptr, c_hptr, eptr, fptr, hptr)
! scalars
real(c_float), optional, pointer :: ee, ff
real(c_float), optional, allocatable, target :: hh
type(c_ptr), optional :: c_eptr, c_fptr, c_hptr
real(c_float), optional, pointer :: eptr, fptr, hptr
if (.not.present(ee) .or. .not.present(ff)) stop 182
if (associated(ee) .or. associated(ff)) stop 183
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
if (.not.present(ee) .or. .not.present(ff)) stop 184
if (associated(ee) .or. associated(ff)) stop 185
if (c_associated(c_loc(ee)) .or. c_associated(c_loc(ff))) stop 186
c_eptr = c_loc(ee)
c_fptr = c_loc(ff)
eptr => ee
fptr => ff
if (c_associated(c_eptr) .or. c_associated(c_fptr)) stop 187
if (associated(eptr) .or. associated(fptr)) stop 188
!$omp end target data
if (c_associated(c_eptr) .or. c_associated(c_fptr)) stop 189
if (associated(eptr) .or. associated(fptr)) stop 190
if (associated(ee) .or. associated(ff)) stop 191
if (.not.present(hh)) stop 192
if (allocated(hh)) stop 193
!$omp target data map(tofrom:hh) use_device_addr(hh)
if (.not.present(hh)) stop 194
if (allocated(hh)) stop 195
if (c_associated(c_loc(hh))) stop 196
c_hptr = c_loc(hh)
hptr => hh
if (c_associated(c_hptr)) stop 197
if (associated(hptr)) stop 198
if (allocated(hh)) stop 199
!$omp end target data
if (c_associated(c_hptr)) stop 200
if (associated(hptr)) stop 201
if (allocated(hh)) stop 202
end subroutine test_dummy_opt_nullptr_callee_1
end module test_nullptr
! Test local variables
module tests
use iso_c_binding
use target_procs
implicit none (type, external)
private
public :: test_main_1, test_main_2
contains
! map + use_device_addr + c_loc
subroutine test_main_1()
integer, parameter :: N = 1000
! scalars
real(c_float), target :: aa, bb
real(c_float), target, allocatable :: cc, dd
real(c_float), pointer :: ee, ff
! non-descriptor arrays
real(c_float), target :: gg(N), hh(N)
allocate(cc, dd, ee, ff)
aa = 11.0_c_float
bb = 22.0_c_float
cc = 33.0_c_float
dd = 44.0_c_float
ee = 55.0_c_float
ff = 66.0_c_float
gg = 77.0_c_float
hh = 88.0_c_float
!$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
call copy3_scalar(c_loc(aa), c_loc(bb))
!$omp end target data
if (abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa)) stop 203
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 204
!$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
call copy3_scalar(c_loc(cc), c_loc(dd))
!$omp end target data
if (abs(cc - 33.0_c_float) > 10.0_c_float * epsilon(cc)) stop 205
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) stop 206
!$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
call copy3_scalar(c_loc(ee), c_loc(ff))
!$omp end target data
if (abs(ee - 55.0_c_float) > 10.0_c_float * epsilon(ee)) stop 207
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) stop 208
!$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh)
call copy3_array(c_loc(gg), c_loc(hh), N)
!$omp end target data
if (any(abs(gg - 77.0_c_float) > 10.0_c_float * epsilon(gg))) stop 209
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) stop 210
deallocate(ee, ff) ! pointers, only
end subroutine test_main_1
! Save device ptr - and recall pointer
subroutine test_main_2
integer, parameter :: N = 1000
! scalars
real(c_float), target :: aa, bb
real(c_float), target, allocatable :: cc, dd
real(c_float), pointer :: ee, ff
! non-descriptor arrays
real(c_float), target :: gg(N), hh(N)
real(c_float) :: dummy
type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr
real(c_float), pointer :: aptr, bptr, cptr, dptr, eptr, fptr
real(c_float), pointer :: gptr(:), hptr(:)
allocate(cc, dd, ee, ff)
aa = 111.0_c_float
bb = 222.0_c_float
cc = 333.0_c_float
dd = 444.0_c_float
ee = 555.0_c_float
ff = 666.0_c_float
gg = 777.0_c_float
hh = 888.0_c_float
!$omp target data map(to:aa) map(from:bb)
!$omp target data map(alloc:dummy) use_device_addr(aa,bb)
c_aptr = c_loc(aa)
c_bptr = c_loc(bb)
aptr => aa
bptr => bb
!$omp end target data
! check c_loc ptr once
call copy3_scalar(c_aptr, c_bptr)
!$omp target update from(bb)
if (abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 211
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 212
! check c_loc ptr again after target-value modification
aa = 1111.0_c_float
!$omp target update to(aa)
call copy3_scalar(c_aptr, c_bptr)
!$omp target update from(bb)
if (abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 213
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 214
! check Fortran pointer after target-value modification
aa = 11111.0_c_float
!$omp target update to(aa)
call copy3_scalar(c_loc(aptr), c_loc(bptr))
!$omp target update from(bb)
if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 215
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 216
!$omp end target data
if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) stop 217
if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) stop 218
!$omp target data map(to:cc) map(from:dd)
!$omp target data map(alloc:dummy) use_device_addr(cc,dd)
c_cptr = c_loc(cc)
c_dptr = c_loc(dd)
cptr => cc
dptr => dd
!$omp end target data
! check c_loc ptr once
call copy3_scalar(c_cptr, c_dptr)
!$omp target update from(dd)
if (abs(cc - 333.0_c_float) > 10.0_c_float * epsilon(cc)) stop 219
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) stop 220
! check c_loc ptr again after target-value modification
cc = 3333.0_c_float
!$omp target update to(cc)
call copy3_scalar(c_cptr, c_dptr)
!$omp target update from(dd)
if (abs(cc - 3333.0_c_float) > 10.0_c_float * epsilon(cc)) stop 221
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) stop 222
! check Fortran pointer after target-value modification
cc = 33333.0_c_float
!$omp target update to(cc)
call copy3_scalar(c_loc(cptr), c_loc(dptr))
!$omp target update from(dd)
if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(cc)) stop 223
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) stop 224
!$omp end target data
if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd)) stop 225
if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd)) stop 226
!$omp target data map(to:ee) map(from:ff)
!$omp target data map(alloc:dummy) use_device_addr(ee,ff)
c_eptr = c_loc(ee)
c_fptr = c_loc(ff)
eptr => ee
fptr => ff
!$omp end target data
! check c_loc ptr once
call copy3_scalar(c_eptr, c_fptr)
!$omp target update from(ff)
if (abs(ee - 555.0_c_float) > 10.0_c_float * epsilon(ee)) stop 227
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) stop 228
! check c_loc ptr again after target-value modification
ee = 5555.0_c_float
!$omp target update to(ee)
call copy3_scalar(c_eptr, c_fptr)
!$omp target update from(ff)
if (abs(ee - 5555.0_c_float) > 10.0_c_float * epsilon(ee)) stop 229
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) stop 230
! check Fortran pointer after target-value modification
ee = 55555.0_c_float
!$omp target update to(ee)
call copy3_scalar(c_loc(eptr), c_loc(fptr))
!$omp target update from(ff)
if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) stop 231
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff)) stop 232
!$omp end target data
if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) stop 233
if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) stop 234
!$omp target data map(to:gg) map(from:hh)
!$omp target data map(alloc:dummy) use_device_addr(gg,hh)
c_gptr = c_loc(gg)
c_hptr = c_loc(hh)
gptr => gg
hptr => hh
!$omp end target data
! check c_loc ptr once
call copy3_array(c_gptr, c_hptr, N)
!$omp target update from(hh)
if (any(abs(gg - 777.0_c_float) > 10.0_c_float * epsilon(gg))) stop 235
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(hh))) stop 236
! check c_loc ptr again after target-value modification
gg = 7777.0_c_float
!$omp target update to(gg)
call copy3_array(c_gptr, c_hptr, N)
!$omp target update from(hh)
if (any(abs(gg - 7777.0_c_float) > 10.0_c_float * epsilon(gg))) stop 237
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) stop 238
! check Fortran pointer after target-value modification
gg = 77777.0_c_float
!$omp target update to(gg)
call copy3_array(c_loc(gptr), c_loc(hptr), N)
!$omp target update from(hh)
if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) stop 239
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) stop 240
!$omp end target data
if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) stop 241
if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) stop 242
deallocate(ee, ff)
end subroutine test_main_2
end module tests
program omp_device_addr
use tests
use test_dummies
use test_dummies_value
use test_dummies_opt
use test_dummies_opt_value
use test_nullptr
implicit none (type, external)
call test_main_1()
call test_main_2()
call test_dummy_call_1()
call test_dummy_call_2()
call test_dummy_val_call_1()
call test_dummy_val_call_2()
call test_dummy_opt_call_1()
call test_dummy_opt_call_2()
call test_dummy_opt_val_call_1()
call test_dummy_opt_val_call_2()
call test_nullptr_1()
end program omp_device_addr