| ! { 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 |
