Hi Jakub,

On 10/10/19 1:55 PM, Jakub Jelinek wrote:
What worries me about the test is that the officially only portable way
to use it in a target region is is_device_ptr.

How about the attached test cases? The only difference is in "module target_procs".

OK now?


Still, I hope the next round of the OpenMP spec permits additionally "type(c_ptr)" – locally defined or as dummy argument with value attribute.

Tobias

PS: is_device_ptr(scalar_real_dummy) crashes as one does a dereference too much. I make a detour by creating a 1-element array out the c-pointer. That's not nice but I believe it is standard conform. In any case, I would prefer to defer modifying the code for is_device_ptr and/or use_device_ptr to another round. (And I need also to get a better understanding what is_device_ptr should actually accept as argument and do with it. It is as unclear to me as use_device_ptr.)

! Comprehensive run-time test for use_device_addr
!
! Differs from use_device_addr-2.f90 by using a 8-byte variable (c_double)
!
! 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
  private
  public :: copy3_array, copy3_scalar
contains
  subroutine copy3_array_int(from_ptr, to_ptr, N)
    !$omp declare target
    real(c_double) :: from_ptr(:)
    real(c_double) :: 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_double) :: 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_double), 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_double), 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_double), 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_double), 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
  private
  public :: test_dummy_call_1, test_dummy_call_2
contains
  subroutine test_dummy_call_1()
     integer, parameter :: N = 1000

     ! scalars
     real(c_double), target :: aa, bb
     real(c_double), target, allocatable :: cc, dd
     real(c_double), pointer :: ee, ff

     ! non-descriptor arrays
     real(c_double), target :: gg(N), hh(N)

     allocate(cc, dd, ee, ff)

     aa = 11.0_c_double
     bb = 22.0_c_double
     cc = 33.0_c_double
     dd = 44.0_c_double
     ee = 55.0_c_double
     ff = 66.0_c_double
     gg = 77.0_c_double
     hh = 88.0_c_double

     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_double), target :: aa, bb
     real(c_double), target, allocatable :: cc, dd
     real(c_double), pointer :: ee, ff

     ! non-descriptor arrays
     real(c_double), 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_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()

     !$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_double) > 10.0_c_double * epsilon(cc)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort()

     !$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_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort()


     !$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_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort()
  end subroutine test_dummy_callee_1

  ! Save device ptr - and recall pointer
  subroutine test_dummy_call_2()
     integer, parameter :: N = 1000

     ! scalars
     real(c_double), target :: aa, bb
     real(c_double), target, allocatable :: cc, dd
     real(c_double), pointer :: ee, ff

     ! non-descriptor arrays
     real(c_double), 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_double), pointer :: aptr, bptr, cptr, dptr, eptr, fptr
     real(c_double), 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_double), target :: aa, bb
     real(c_double), target, allocatable :: cc, dd
     real(c_double), pointer :: ee, ff

     ! non-descriptor arrays
     real(c_double), 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_double), pointer :: aptr, bptr, cptr, dptr, eptr, fptr
     real(c_double), pointer :: gptr(:), hptr(:)

     integer, value :: N

     real(c_double) :: dummy

     aa = 111.0_c_double
     bb = 222.0_c_double
     cc = 333.0_c_double
     dd = 444.0_c_double
     ee = 555.0_c_double
     ff = 666.0_c_double
     gg = 777.0_c_double
     hh = 888.0_c_double

     !$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_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()

     ! check c_loc ptr again after target-value modification
     aa = 1111.0_c_double
     !$omp target update to(aa)
     call copy3_scalar(c_aptr, c_bptr)
     !$omp target update from(bb)
     if (abs(aa - 1111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()

     ! check Fortran pointer after target-value modification
     aa = 11111.0_c_double
     !$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_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()
     !$omp end target data

     if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()


     !$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_double) > 10.0_c_double * epsilon(cc)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort()

     ! check c_loc ptr again after target-value modification
     cc = 3333.0_c_double
     !$omp target update to(cc)
     call copy3_scalar(c_cptr, c_dptr)
     !$omp target update from(dd)
     if (abs(cc - 3333.0_c_double) > 10.0_c_double * epsilon(cc)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort()

     ! check Fortran pointer after target-value modification
     cc = 33333.0_c_double
     !$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_double) > 10.0_c_double * epsilon(cc)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort()
     !$omp end target data

     if (abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(dd)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(dd)) call abort()


     !$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_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort()

     ! check c_loc ptr again after target-value modification
     ee = 5555.0_c_double
     !$omp target update to(ee)
     call copy3_scalar(c_eptr, c_fptr)
     !$omp target update from(ff)
     if (abs(ee - 5555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort()

     ! check Fortran pointer after target-value modification
     ee = 55555.0_c_double
     !$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_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ff)) call abort()
     !$omp end target data

     if (abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort()


     !$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_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(hh))) call abort()

     ! check c_loc ptr again after target-value modification
     gg = 7777.0_c_double
     !$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_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort()

     ! check Fortran pointer after target-value modification
     gg = 77777.0_c_double
     !$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_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort()
     !$omp end target data

     if (any(abs(gg - 77777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort()
  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
  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_double), target :: aa, bb

     aa = 11.0_c_double
     bb = 22.0_c_double

     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_double), 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_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()
  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_double), target :: aa, bb
     type(c_ptr) :: c_aptr, c_bptr
     real(c_double), 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_double), value, target :: aa, bb
     type(c_ptr), value :: c_aptr, c_bptr
     real(c_double), pointer :: aptr, bptr

     real(c_double) :: dummy

     aa = 111.0_c_double
     bb = 222.0_c_double

     !$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_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()

     ! check c_loc ptr again after target-value modification
     aa = 1111.0_c_double
     !$omp target update to(aa)
     call copy3_scalar(c_aptr, c_bptr)
     !$omp target update from(bb)
     if (abs(aa - 1111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()

     ! check Fortran pointer after target-value modification
     aa = 11111.0_c_double
     !$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_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()
     !$omp end target data

     if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()
  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
  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_double), target :: aa, bb
     real(c_double), target, allocatable :: cc, dd
     real(c_double), pointer :: ee, ff

     ! non-descriptor arrays
     real(c_double), target :: gg(N), hh(N)

     allocate(cc, dd, ee, ff)

     aa = 11.0_c_double
     bb = 22.0_c_double
     cc = 33.0_c_double
     dd = 44.0_c_double
     ee = 55.0_c_double
     ff = 66.0_c_double
     gg = 77.0_c_double
     hh = 88.0_c_double

     call test_dummy_opt_callee_1(aa, bb, cc, dd, ee, ff, gg, hh, 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_double), optional, target :: aa, bb
     real(c_double), optional, target, allocatable :: cc, dd
     real(c_double), optional, pointer :: ee, ff

     ! non-descriptor arrays
     real(c_double), 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)) call abort()
     if (.not.present(cc) .or. .not.present(dd)) call abort()
     if (.not.present(ee) .or. .not.present(ff)) call abort()
     if (.not.present(gg) .or. .not.present(hh)) call abort()

     if (.not.associated(ee) .or. .not.associated(ff)) call abort()

     !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
     if (.not.present(aa) .or. .not.present(bb)) call abort()
     if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort()
     call copy3_scalar(c_loc(aa), c_loc(bb))
     !$omp end target data
     if (abs(aa - 11.0_c_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()

     !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
     if (.not.present(cc) .or. .not.present(dd)) call abort()
     if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) call abort()
     call copy3_scalar(c_loc(cc), c_loc(dd))
     !$omp end target data
     if (abs(cc - 33.0_c_double) > 10.0_c_double * epsilon(cc)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort()

     !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
     if (.not.present(ee) .or. .not.present(ff)) call abort()
     if (.not.associated(ee) .or. .not.associated(ff)) call abort()
     if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) call abort()
     call copy3_scalar(c_loc(ee), c_loc(ff))
     !$omp end target data
     if (abs(ee - 55.0_c_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort()

     !$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh)
     if (.not.present(gg) .or. .not.present(hh)) call abort()
     if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) call abort()
     call copy3_array(c_loc(gg), c_loc(hh), N)
     !$omp end target data
     if (any(abs(gg - 77.0_c_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort()
  end subroutine test_dummy_opt_callee_1

  ! Save device ptr - and recall pointer
  subroutine test_dummy_opt_call_2()
     integer, parameter :: N = 1000

     ! scalars
     real(c_double), target :: aa, bb
     real(c_double), target, allocatable :: cc, dd
     real(c_double), pointer :: ee, ff

     ! non-descriptor arrays
     real(c_double), 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_double), pointer :: aptr, bptr, cptr, dptr, eptr, fptr
     real(c_double), 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_double), optional, target :: aa, bb
     real(c_double), optional, target, allocatable :: cc, dd
     real(c_double), optional, pointer :: ee, ff

     ! non-descriptor arrays
     real(c_double), 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_double), optional, pointer :: aptr, bptr, cptr, dptr, eptr, fptr
     real(c_double), optional, pointer :: gptr(:), hptr(:)

     integer, value :: N

     real(c_double) :: dummy

     ! All shall be present - and pointing to non-NULL
     if (.not.present(aa) .or. .not.present(bb)) call abort()
     if (.not.present(cc) .or. .not.present(dd)) call abort()
     if (.not.present(ee) .or. .not.present(ff)) call abort()
     if (.not.present(gg) .or. .not.present(hh)) call abort()

     if (.not.associated(ee) .or. .not.associated(ff)) call abort()

     aa = 111.0_c_double
     bb = 222.0_c_double
     cc = 333.0_c_double
     dd = 444.0_c_double
     ee = 555.0_c_double
     ff = 666.0_c_double
     gg = 777.0_c_double
     hh = 888.0_c_double

     !$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)) call abort()
     if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort()
     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)) call abort()
     if (.not.associated(aptr) .or. .not.associated(bptr)) call abort()
     !$omp end target data

     if (.not.present(aa) .or. .not.present(bb)) call abort()
     if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort()
     if (.not.c_associated(c_aptr) .or. .not.c_associated(c_bptr)) call abort()
     if (.not.associated(aptr) .or. .not.associated(bptr)) call abort()

     ! check c_loc ptr once
     call copy3_scalar(c_aptr, c_bptr)
     !$omp target update from(bb)
     if (abs(aa - 111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()

     ! check c_loc ptr again after target-value modification
     aa = 1111.0_c_double
     !$omp target update to(aa)
     call copy3_scalar(c_aptr, c_bptr)
     !$omp target update from(bb)
     if (abs(aa - 1111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()

     ! check Fortran pointer after target-value modification
     aa = 11111.0_c_double
     !$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_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()
     !$omp end target data

     if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()


     !$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)) call abort()
     if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) call abort()
     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)) call abort()
     if (.not.associated(cptr) .or. .not.associated(dptr)) call abort()
     !$omp end target data
     if (.not.present(cc) .or. .not.present(dd)) call abort()
     if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) call abort()
     if (.not.c_associated(c_cptr) .or. .not.c_associated(c_dptr)) call abort()
     if (.not.associated(cptr) .or. .not.associated(dptr)) call abort()

     ! check c_loc ptr once
     call copy3_scalar(c_cptr, c_dptr)
     !$omp target update from(dd)
     if (abs(cc - 333.0_c_double) > 10.0_c_double * epsilon(cc)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort()

     ! check c_loc ptr again after target-value modification
     cc = 3333.0_c_double
     !$omp target update to(cc)
     call copy3_scalar(c_cptr, c_dptr)
     !$omp target update from(dd)
     if (abs(cc - 3333.0_c_double) > 10.0_c_double * epsilon(cc)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort()

     ! check Fortran pointer after target-value modification
     cc = 33333.0_c_double
     !$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_double) > 10.0_c_double * epsilon(cc)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort()
     !$omp end target data

     if (abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(dd)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(dd)) call abort()


     !$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)) call abort()
     if (.not.associated(ee) .or. .not.associated(ff)) call abort()
     if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) call abort()
     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)) call abort()
     if (.not.associated(eptr) .or. .not.associated(fptr)) call abort()
     !$omp end target data
     if (.not.present(ee) .or. .not.present(ff)) call abort()
     if (.not.associated(ee) .or. .not.associated(ff)) call abort()
     if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) call abort()
     if (.not.c_associated(c_eptr) .or. .not.c_associated(c_fptr)) call abort()
     if (.not.associated(eptr) .or. .not.associated(fptr)) call abort()

     ! check c_loc ptr once
     call copy3_scalar(c_eptr, c_fptr)
     !$omp target update from(ff)
     if (abs(ee - 555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort()

     ! check c_loc ptr again after target-value modification
     ee = 5555.0_c_double
     !$omp target update to(ee)
     call copy3_scalar(c_eptr, c_fptr)
     !$omp target update from(ff)
     if (abs(ee - 5555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort()

     ! check Fortran pointer after target-value modification
     ee = 55555.0_c_double
     !$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_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ff)) call abort()
     !$omp end target data

     if (abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort()


     !$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)) call abort()
     if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) call abort()
     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)) call abort()
     if (.not.associated(gptr) .or. .not.associated(hptr)) call abort()
     !$omp end target data
     if (.not.present(gg) .or. .not.present(hh)) call abort()
     if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) call abort()
     if (.not.c_associated(c_gptr) .or. .not.c_associated(c_hptr)) call abort()
     if (.not.associated(gptr) .or. .not.associated(hptr)) call abort()

     ! 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_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(hh))) call abort()

     ! check c_loc ptr again after target-value modification
     gg = 7777.0_c_double
     !$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_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort()

     ! check Fortran pointer after target-value modification
     gg = 77777.0_c_double
     !$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_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort()
     !$omp end target data

     if (any(abs(gg - 77777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort()
  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
  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_double), target :: aa, bb

     aa = 11.0_c_double
     bb = 22.0_c_double

     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_double), optional, value, target :: aa, bb

     if (.not.present(aa) .or. .not.present(bb)) call abort()

     !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
     if (.not.present(aa) .or. .not.present(bb)) call abort()
     if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort()
     call copy3_scalar(c_loc(aa), c_loc(bb))
     !$omp end target data
     if (abs(aa - 11.0_c_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()
  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_double), target :: aa, bb
     type(c_ptr) :: c_aptr, c_bptr
     real(c_double), 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_double), optional, value, target :: aa, bb
     type(c_ptr), optional, value :: c_aptr, c_bptr
     real(c_double), optional, pointer :: aptr, bptr

     real(c_double) :: dummy

     if (.not.present(aa) .or. .not.present(bb)) call abort()
     if (.not.present(c_aptr) .or. .not.present(c_bptr)) call abort()
     if (.not.present(aptr) .or. .not.present(bptr)) call abort()

     aa = 111.0_c_double
     bb = 222.0_c_double

     !$omp target data map(to:aa) map(from:bb)
     if (.not.present(aa) .or. .not.present(bb)) call abort()
     if (.not.present(c_aptr) .or. .not.present(c_bptr)) call abort()
     if (.not.present(aptr) .or. .not.present(bptr)) call abort()

     !$omp target data map(alloc:dummy) use_device_addr(aa,bb)
     if (.not.present(aa) .or. .not.present(bb)) call abort()
     if (.not.present(c_aptr) .or. .not.present(c_bptr)) call abort()
     if (.not.present(aptr) .or. .not.present(bptr)) call abort()

     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)) call abort()
     if (.not.associated(aptr) .or. .not.associated(bptr)) call abort()
     !$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_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()

     ! check c_loc ptr again after target-value modification
     aa = 1111.0_c_double
     !$omp target update to(aa)
     call copy3_scalar(c_aptr, c_bptr)
     !$omp target update from(bb)
     if (abs(aa - 1111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()

     ! check Fortran pointer after target-value modification
     aa = 11111.0_c_double
     !$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_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()
     !$omp end target data

     if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()
  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
  private
  public :: test_nullptr_1
contains
  subroutine test_nullptr_1()
     ! scalars
     real(c_double), pointer :: aa, bb
     real(c_double), pointer :: ee, ff

     type(c_ptr) :: c_aptr, c_bptr, c_eptr, c_fptr
     real(c_double), pointer :: aptr, bptr, eptr, fptr

     aa => null()
     bb => null()
     ee => null()
     ff => null()

     if (associated(aa) .or. associated(bb)) call abort()
     !$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))) call abort()
     c_aptr = c_loc(aa)
     c_bptr = c_loc(bb)
     aptr => aa
     bptr => bb
     if (c_associated(c_aptr) .or. c_associated(c_bptr)) call abort()
     if (associated(aptr) .or. associated(bptr, bb)) call abort()
     !$omp end target data
     if (c_associated(c_aptr) .or. c_associated(c_bptr)) call abort()
     if (associated(aptr) .or. associated(bptr, bb)) call abort()

     call test_dummy_opt_nullptr_callee_1(ee, ff, c_eptr, c_fptr, eptr, fptr)
  end subroutine test_nullptr_1

  subroutine test_dummy_opt_nullptr_callee_1(ee, ff, c_eptr, c_fptr, eptr, fptr)
     ! scalars
     real(c_double), optional, pointer :: ee, ff

     type(c_ptr), optional :: c_eptr, c_fptr
     real(c_double), optional, pointer :: eptr, fptr

     if (.not.present(ee) .or. .not.present(ff)) call abort()
     if (associated(ee) .or. associated(ff)) call abort()

     !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
     if (.not.present(ee) .or. .not.present(ff)) call abort()
     if (associated(ee) .or. associated(ff)) call abort()
     if (c_associated(c_loc(ee)) .or. c_associated(c_loc(ff))) call abort()
     c_eptr = c_loc(ee)
     c_fptr = c_loc(ff)
     eptr => ee
     fptr => ff
     if (c_associated(c_eptr) .or. c_associated(c_fptr)) call abort()
     if (associated(eptr) .or. associated(fptr)) call abort()
     !$omp end target data

     if (c_associated(c_eptr) .or. c_associated(c_fptr)) call abort()
     if (associated(eptr) .or. associated(fptr)) call abort()
  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
  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_double), target :: aa, bb
     real(c_double), target, allocatable :: cc, dd
     real(c_double), pointer :: ee, ff

     ! non-descriptor arrays
     real(c_double), target :: gg(N), hh(N)

     allocate(cc, dd, ee, ff)


     aa = 11.0_c_double
     bb = 22.0_c_double
     cc = 33.0_c_double
     dd = 44.0_c_double
     ee = 55.0_c_double
     ff = 66.0_c_double
     gg = 77.0_c_double
     hh = 88.0_c_double

     !$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_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()

     !$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_double) > 10.0_c_double * epsilon(cc)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort()

     !$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_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort()


     !$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_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort()

     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_double), target :: aa, bb
     real(c_double), target, allocatable :: cc, dd
     real(c_double), pointer :: ee, ff

     ! non-descriptor arrays
     real(c_double), target :: gg(N), hh(N)

     real(c_double) :: dummy
     type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, c_gptr, c_hptr
     real(c_double), pointer :: aptr, bptr, cptr, dptr, eptr, fptr
     real(c_double), pointer :: gptr(:), hptr(:)

     allocate(cc, dd, ee, ff)

     aa = 111.0_c_double
     bb = 222.0_c_double
     cc = 333.0_c_double
     dd = 444.0_c_double
     ee = 555.0_c_double
     ff = 666.0_c_double
     gg = 777.0_c_double
     hh = 888.0_c_double

     !$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_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()

     ! check c_loc ptr again after target-value modification
     aa = 1111.0_c_double
     !$omp target update to(aa)
     call copy3_scalar(c_aptr, c_bptr)
     !$omp target update from(bb)
     if (abs(aa - 1111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()

     ! check Fortran pointer after target-value modification
     aa = 11111.0_c_double
     !$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_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()
     !$omp end target data

     if (abs(aa - 11111.0_c_double) > 10.0_c_double * epsilon(aa)) call abort()
     if (abs(3.0_c_double * aa - bb) > 10.0_c_double * epsilon(aa)) call abort()


     !$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_double) > 10.0_c_double * epsilon(cc)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort()

     ! check c_loc ptr again after target-value modification
     cc = 3333.0_c_double
     !$omp target update to(cc)
     call copy3_scalar(c_cptr, c_dptr)
     !$omp target update from(dd)
     if (abs(cc - 3333.0_c_double) > 10.0_c_double * epsilon(cc)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort()

     ! check Fortran pointer after target-value modification
     cc = 33333.0_c_double
     !$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_double) > 10.0_c_double * epsilon(cc)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(cc)) call abort()
     !$omp end target data

     if (abs(cc - 33333.0_c_double) > 10.0_c_double * epsilon(dd)) call abort()
     if (abs(3.0_c_double * cc - dd) > 10.0_c_double * epsilon(dd)) call abort()


     !$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_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort()

     ! check c_loc ptr again after target-value modification
     ee = 5555.0_c_double
     !$omp target update to(ee)
     call copy3_scalar(c_eptr, c_fptr)
     !$omp target update from(ff)
     if (abs(ee - 5555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort()

     ! check Fortran pointer after target-value modification
     ee = 55555.0_c_double
     !$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_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ff)) call abort()
     !$omp end target data

     if (abs(ee - 55555.0_c_double) > 10.0_c_double * epsilon(ee)) call abort()
     if (abs(3.0_c_double * ee - ff) > 10.0_c_double * epsilon(ee)) call abort()


     !$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_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(hh))) call abort()

     ! check c_loc ptr again after target-value modification
     gg = 7777.0_c_double
     !$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_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort()

     ! check Fortran pointer after target-value modification
     gg = 77777.0_c_double
     !$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_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort()
     !$omp end target data

     if (any(abs(gg - 77777.0_c_double) > 10.0_c_double * epsilon(gg))) call abort()
     if (any(abs(3.0_c_double * gg - hh) > 10.0_c_double * epsilon(gg))) call abort()

     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

  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
! 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
  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
  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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()

     !$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)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort()

     !$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)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort()


     !$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))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort()
  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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()
     !$omp end target data

     if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()


     !$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)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort()
     !$omp end target data

     if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd)) call abort()


     !$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)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff)) call abort()
     !$omp end target data

     if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort()


     !$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))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(hh))) call abort()

     ! 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))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort()

     ! 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))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort()
     !$omp end target data

     if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort()
  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
  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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()
  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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()
     !$omp end target data

     if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()
  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
  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)
     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)) call abort()
     if (.not.present(cc) .or. .not.present(dd)) call abort()
     if (.not.present(ee) .or. .not.present(ff)) call abort()
     if (.not.present(gg) .or. .not.present(hh)) call abort()

     if (.not.associated(ee) .or. .not.associated(ff)) call abort()

     !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
     if (.not.present(aa) .or. .not.present(bb)) call abort()
     if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort()
     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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()

     !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd)
     if (.not.present(cc) .or. .not.present(dd)) call abort()
     if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) call abort()
     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)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort()

     !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
     if (.not.present(ee) .or. .not.present(ff)) call abort()
     if (.not.associated(ee) .or. .not.associated(ff)) call abort()
     if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) call abort()
     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)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort()

     !$omp target data map(to:gg) map(from:hh) use_device_addr(gg,hh)
     if (.not.present(gg) .or. .not.present(hh)) call abort()
     if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) call abort()
     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))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort()
  end subroutine test_dummy_opt_callee_1

  ! 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)) call abort()
     if (.not.present(cc) .or. .not.present(dd)) call abort()
     if (.not.present(ee) .or. .not.present(ff)) call abort()
     if (.not.present(gg) .or. .not.present(hh)) call abort()

     if (.not.associated(ee) .or. .not.associated(ff)) call abort()

     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)) call abort()
     if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort()
     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)) call abort()
     if (.not.associated(aptr) .or. .not.associated(bptr)) call abort()
     !$omp end target data

     if (.not.present(aa) .or. .not.present(bb)) call abort()
     if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort()
     if (.not.c_associated(c_aptr) .or. .not.c_associated(c_bptr)) call abort()
     if (.not.associated(aptr) .or. .not.associated(bptr)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()
     !$omp end target data

     if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()


     !$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)) call abort()
     if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) call abort()
     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)) call abort()
     if (.not.associated(cptr) .or. .not.associated(dptr)) call abort()
     !$omp end target data
     if (.not.present(cc) .or. .not.present(dd)) call abort()
     if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) call abort()
     if (.not.c_associated(c_cptr) .or. .not.c_associated(c_dptr)) call abort()
     if (.not.associated(cptr) .or. .not.associated(dptr)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort()
     !$omp end target data

     if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd)) call abort()


     !$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)) call abort()
     if (.not.associated(ee) .or. .not.associated(ff)) call abort()
     if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) call abort()
     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)) call abort()
     if (.not.associated(eptr) .or. .not.associated(fptr)) call abort()
     !$omp end target data
     if (.not.present(ee) .or. .not.present(ff)) call abort()
     if (.not.associated(ee) .or. .not.associated(ff)) call abort()
     if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) call abort()
     if (.not.c_associated(c_eptr) .or. .not.c_associated(c_fptr)) call abort()
     if (.not.associated(eptr) .or. .not.associated(fptr)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff)) call abort()
     !$omp end target data

     if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort()


     !$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)) call abort()
     if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) call abort()
     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)) call abort()
     if (.not.associated(gptr) .or. .not.associated(hptr)) call abort()
     !$omp end target data
     if (.not.present(gg) .or. .not.present(hh)) call abort()
     if (.not.c_associated(c_loc(gg)) .or. .not.c_associated(c_loc(hh))) call abort()
     if (.not.c_associated(c_gptr) .or. .not.c_associated(c_hptr)) call abort()
     if (.not.associated(gptr) .or. .not.associated(hptr)) call abort()

     ! 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))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(hh))) call abort()

     ! 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))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort()

     ! 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))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort()
     !$omp end target data

     if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort()
  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
  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)) call abort()

     !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb)
     if (.not.present(aa) .or. .not.present(bb)) call abort()
     if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) call abort()
     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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()
  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)) call abort()
     if (.not.present(c_aptr) .or. .not.present(c_bptr)) call abort()
     if (.not.present(aptr) .or. .not.present(bptr)) call abort()

     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)) call abort()
     if (.not.present(c_aptr) .or. .not.present(c_bptr)) call abort()
     if (.not.present(aptr) .or. .not.present(bptr)) call abort()

     !$omp target data map(alloc:dummy) use_device_addr(aa,bb)
     if (.not.present(aa) .or. .not.present(bb)) call abort()
     if (.not.present(c_aptr) .or. .not.present(c_bptr)) call abort()
     if (.not.present(aptr) .or. .not.present(bptr)) call abort()

     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)) call abort()
     if (.not.associated(aptr) .or. .not.associated(bptr)) call abort()
     !$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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()
     !$omp end target data

     if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()
  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
  private
  public :: test_nullptr_1
contains
  subroutine test_nullptr_1()
     ! scalars
     real(c_float), pointer :: aa, bb
     real(c_float), pointer :: ee, ff

     type(c_ptr) :: c_aptr, c_bptr, c_eptr, c_fptr
     real(c_float), pointer :: aptr, bptr, eptr, fptr

     aa => null()
     bb => null()
     ee => null()
     ff => null()

     if (associated(aa) .or. associated(bb)) call abort()
     !$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))) call abort()
     c_aptr = c_loc(aa)
     c_bptr = c_loc(bb)
     aptr => aa
     bptr => bb
     if (c_associated(c_aptr) .or. c_associated(c_bptr)) call abort()
     if (associated(aptr) .or. associated(bptr, bb)) call abort()
     !$omp end target data
     if (c_associated(c_aptr) .or. c_associated(c_bptr)) call abort()
     if (associated(aptr) .or. associated(bptr, bb)) call abort()

     call test_dummy_opt_nullptr_callee_1(ee, ff, c_eptr, c_fptr, eptr, fptr)
  end subroutine test_nullptr_1

  subroutine test_dummy_opt_nullptr_callee_1(ee, ff, c_eptr, c_fptr, eptr, fptr)
     ! scalars
     real(c_float), optional, pointer :: ee, ff

     type(c_ptr), optional :: c_eptr, c_fptr
     real(c_float), optional, pointer :: eptr, fptr

     if (.not.present(ee) .or. .not.present(ff)) call abort()
     if (associated(ee) .or. associated(ff)) call abort()

     !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff)
     if (.not.present(ee) .or. .not.present(ff)) call abort()
     if (associated(ee) .or. associated(ff)) call abort()
     if (c_associated(c_loc(ee)) .or. c_associated(c_loc(ff))) call abort()
     c_eptr = c_loc(ee)
     c_fptr = c_loc(ff)
     eptr => ee
     fptr => ff
     if (c_associated(c_eptr) .or. c_associated(c_fptr)) call abort()
     if (associated(eptr) .or. associated(fptr)) call abort()
     !$omp end target data

     if (c_associated(c_eptr) .or. c_associated(c_fptr)) call abort()
     if (associated(eptr) .or. associated(fptr)) call abort()
  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
  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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()

     !$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)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort()

     !$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)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort()


     !$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))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort()

     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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()
     !$omp end target data

     if (abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa)) call abort()
     if (abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa)) call abort()


     !$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)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc)) call abort()
     !$omp end target data

     if (abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd)) call abort()
     if (abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd)) call abort()


     !$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)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort()

     ! 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)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff)) call abort()
     !$omp end target data

     if (abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee)) call abort()
     if (abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee)) call abort()


     !$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))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(hh))) call abort()

     ! 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))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort()

     ! 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))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort()
     !$omp end target data

     if (any(abs(gg - 77777.0_c_float) > 10.0_c_float * epsilon(gg))) call abort()
     if (any(abs(3.0_c_float * gg - hh) > 10.0_c_float * epsilon(gg))) call abort()

     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

  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

Reply via email to