| ! { dg-do run } |
| |
| ! Comprehensive run-time test for use_device_addr |
| ! |
| ! Tests array with array descriptor |
| ! |
| ! Differs from use_device_addr-3.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: |
| ! - scalars |
| ! - polymorphic variables |
| ! - absent optional arguments |
| ! |
| module target_procs |
| use iso_c_binding |
| implicit none (type, external) |
| private |
| public :: copy3_array |
| 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_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 |
| 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 |
| |
| real(c_float), target :: aa(N), bb(N) |
| real(c_float), target, allocatable :: cc(:), dd(:) |
| real(c_float), pointer :: ee(:), ff(:) |
| |
| allocate(cc(N), dd(N), ee(N), ff(N)) |
| |
| 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 |
| |
| call test_dummy_callee_1(aa, bb, cc, dd, ee, ff, N) |
| deallocate(ee, ff) ! pointers, only |
| end subroutine test_dummy_call_1 |
| |
| subroutine test_dummy_callee_1(aa, bb, cc, dd, ee, ff, N) |
| real(c_float), target :: aa(:), bb(:) |
| real(c_float), target, allocatable :: cc(:), dd(:) |
| real(c_float), pointer :: ee(:), ff(:) |
| |
| integer, value :: N |
| |
| !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb) |
| call copy3_array(c_loc(aa), c_loc(bb), N) |
| !$omp end target data |
| if (any(abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa))) stop 2 |
| if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 3 |
| |
| !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd) |
| call copy3_array(c_loc(cc), c_loc(dd), N) |
| !$omp end target data |
| if (any(abs(cc - 33.0_c_float) > 10.0_c_float * epsilon(cc))) stop 4 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 5 |
| |
| !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff) |
| call copy3_array(c_loc(ee), c_loc(ff), N) |
| !$omp end target data |
| if (any(abs(ee - 55.0_c_float) > 10.0_c_float * epsilon(ee))) stop 6 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 7 |
| end subroutine test_dummy_callee_1 |
| |
| ! Save device ptr - and recall pointer |
| subroutine test_dummy_call_2() |
| integer, parameter :: N = 1000 |
| |
| real(c_float), target :: aa(N), bb(N) |
| real(c_float), target, allocatable :: cc(:), dd(:) |
| real(c_float), pointer :: ee(:), ff(:) |
| |
| type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr |
| real(c_float), pointer :: aptr(:), bptr(:), cptr(:), dptr(:), eptr(:), fptr(:) |
| |
| allocate(cc(N), dd(N), ee(N), ff(N)) |
| |
| call test_dummy_callee_2(aa, bb, cc, dd, ee, ff, & |
| c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, & |
| aptr, bptr, cptr, dptr, eptr, fptr, & |
| N) |
| deallocate(ee, ff) |
| end subroutine test_dummy_call_2 |
| |
| subroutine test_dummy_callee_2(aa, bb, cc, dd, ee, ff, & |
| c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, & |
| aptr, bptr, cptr, dptr, eptr, fptr, & |
| N) |
| real(c_float), target :: aa(:), bb(:) |
| real(c_float), target, allocatable :: cc(:), dd(:) |
| real(c_float), pointer :: ee(:), ff(:) |
| |
| type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr |
| real(c_float), pointer :: aptr(:), bptr(:), cptr(:), dptr(:), eptr(:), fptr(:) |
| |
| 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 |
| |
| !$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_array(c_aptr, c_bptr, N) |
| !$omp target update from(bb) |
| if (any(abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 8 |
| if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 9 |
| |
| ! check c_loc ptr again after target-value modification |
| aa = 1111.0_c_float |
| !$omp target update to(aa) |
| call copy3_array(c_aptr, c_bptr, N) |
| !$omp target update from(bb) |
| if (any(abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 10 |
| if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 11 |
| |
| ! check Fortran pointer after target-value modification |
| aa = 11111.0_c_float |
| !$omp target update to(aa) |
| call copy3_array(c_loc(aptr), c_loc(bptr), N) |
| !$omp target update from(bb) |
| if (any(abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 12 |
| if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 13 |
| !$omp end target data |
| |
| if (any(abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 14 |
| if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 15 |
| |
| |
| !$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_array(c_cptr, c_dptr, N) |
| !$omp target update from(dd) |
| if (any(abs(cc - 333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 16 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 17 |
| |
| ! check c_loc ptr again after target-value modification |
| cc = 3333.0_c_float |
| !$omp target update to(cc) |
| call copy3_array(c_cptr, c_dptr, N) |
| !$omp target update from(dd) |
| if (any(abs(cc - 3333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 18 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 19 |
| |
| ! check Fortran pointer after target-value modification |
| cc = 33333.0_c_float |
| !$omp target update to(cc) |
| call copy3_array(c_loc(cptr), c_loc(dptr), N) |
| !$omp target update from(dd) |
| if (any(abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 20 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 21 |
| !$omp end target data |
| |
| if (any(abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd))) stop 22 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd))) stop 23 |
| |
| |
| !$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_array(c_eptr, c_fptr, N) |
| !$omp target update from(ff) |
| if (any(abs(ee - 555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 24 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 25 |
| |
| ! check c_loc ptr again after target-value modification |
| ee = 5555.0_c_float |
| !$omp target update to(ee) |
| call copy3_array(c_eptr, c_fptr, N) |
| !$omp target update from(ff) |
| if (any(abs(ee - 5555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 26 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 27 |
| |
| ! check Fortran pointer after target-value modification |
| ee = 55555.0_c_float |
| !$omp target update to(ee) |
| call copy3_array(c_loc(eptr), c_loc(fptr), N) |
| !$omp target update from(ff) |
| if (any(abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 28 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff))) stop 29 |
| !$omp end target data |
| |
| if (any(abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 30 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 31 |
| end subroutine test_dummy_callee_2 |
| end module test_dummies |
| |
| |
| |
| ! 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 |
| |
| real(c_float), target :: aa(N), bb(N) |
| real(c_float), target, allocatable :: cc(:), dd(:) |
| real(c_float), pointer :: ee(:), ff(:) |
| |
| allocate(cc(N), dd(N), ee(N), ff(N)) |
| |
| 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 |
| |
| call test_dummy_opt_callee_1(aa, bb, cc, dd, ee, ff, 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, N) |
| ! scalars |
| real(c_float), optional, target :: aa(:), bb(:) |
| real(c_float), optional, target, allocatable :: cc(:), dd(:) |
| real(c_float), optional, pointer :: ee(:), ff(:) |
| |
| integer, value :: N |
| |
| ! All shall be present - and pointing to non-NULL |
| if (.not.present(aa) .or. .not.present(bb)) stop 32 |
| if (.not.present(cc) .or. .not.present(dd)) stop 33 |
| if (.not.present(ee) .or. .not.present(ff)) stop 34 |
| |
| if (.not.allocated(cc) .or. .not.allocated(dd)) stop 35 |
| if (.not.associated(ee) .or. .not.associated(ff)) stop 36 |
| |
| !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb) |
| if (.not.present(aa) .or. .not.present(bb)) stop 37 |
| if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) stop 38 |
| call copy3_array(c_loc(aa), c_loc(bb), N) |
| !$omp end target data |
| if (any(abs(aa - 11.0_c_float) > 10.0_c_float * epsilon(aa))) stop 39 |
| if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 40 |
| |
| !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd) |
| if (.not.present(cc) .or. .not.present(dd)) stop 41 |
| if (.not.allocated(cc) .or. .not.allocated(dd)) stop 42 |
| if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) stop 43 |
| call copy3_array(c_loc(cc), c_loc(dd), N) |
| !$omp end target data |
| if (any(abs(cc - 33.0_c_float) > 10.0_c_float * epsilon(cc))) stop 44 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 45 |
| |
| !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff) |
| if (.not.present(ee) .or. .not.present(ff)) stop 46 |
| if (.not.associated(ee) .or. .not.associated(ff)) stop 47 |
| if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) stop 48 |
| call copy3_array(c_loc(ee), c_loc(ff), N) |
| !$omp end target data |
| if (any(abs(ee - 55.0_c_float) > 10.0_c_float * epsilon(ee))) stop 49 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 50 |
| end subroutine test_dummy_opt_callee_1 |
| |
| subroutine test_dummy_opt_callee_1_absent(aa, bb, cc, dd, ee, ff, N) |
| ! scalars |
| real(c_float), optional, target :: aa(:), bb(:) |
| real(c_float), optional, target, allocatable :: cc(:), dd(:) |
| real(c_float), optional, pointer :: ee(:), ff(:) |
| |
| integer, value :: N |
| |
| ! All shall be absent |
| if (present(aa) .or. present(bb)) stop 51 |
| if (present(cc) .or. present(dd)) stop 52 |
| if (present(ee) .or. present(ff)) stop 53 |
| |
| !$omp target data map(to:aa) map(from:bb) use_device_addr(aa,bb) |
| if (present(aa) .or. present(bb)) stop 54 |
| !$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 55 |
| !$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 56 |
| !$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 |
| |
| real(c_float), target :: aa(N), bb(N) |
| real(c_float), target, allocatable :: cc(:), dd(:) |
| real(c_float), pointer :: ee(:), ff(:) |
| |
| type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr |
| real(c_float), pointer :: aptr(:), bptr(:), cptr(:), dptr(:), eptr(:), fptr(:) |
| |
| allocate(cc(N), dd(N), ee(N), ff(N)) |
| call test_dummy_opt_callee_2(aa, bb, cc, dd, ee, ff, & |
| c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, & |
| aptr, bptr, cptr, dptr, eptr, fptr, & |
| N) |
| deallocate(ee, ff) |
| end subroutine test_dummy_opt_call_2 |
| |
| subroutine test_dummy_opt_callee_2(aa, bb, cc, dd, ee, ff, & |
| c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr, & |
| aptr, bptr, cptr, dptr, eptr, fptr, & |
| N) |
| ! scalars |
| real(c_float), optional, target :: aa(:), bb(:) |
| real(c_float), optional, target, allocatable :: cc(:), dd(:) |
| real(c_float), optional, pointer :: ee(:), ff(:) |
| |
| type(c_ptr) :: c_aptr, c_bptr, c_cptr, c_dptr, c_eptr, c_fptr |
| real(c_float), optional, pointer :: aptr(:), bptr(:), cptr(:), dptr(:), eptr(:), fptr(:) |
| |
| 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 57 |
| if (.not.present(cc) .or. .not.present(dd)) stop 58 |
| if (.not.present(ee) .or. .not.present(ff)) stop 59 |
| |
| if (.not.allocated(cc) .or. .not.allocated(dd)) stop 60 |
| if (.not.associated(ee) .or. .not.associated(ff)) stop 61 |
| |
| 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 |
| |
| !$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 62 |
| if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) stop 63 |
| 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 64 |
| if (.not.associated(aptr) .or. .not.associated(bptr)) stop 65 |
| !$omp end target data |
| |
| if (.not.present(aa) .or. .not.present(bb)) stop 66 |
| if (.not.c_associated(c_loc(aa)) .or. .not.c_associated(c_loc(bb))) stop 67 |
| if (.not.c_associated(c_aptr) .or. .not.c_associated(c_bptr)) stop 68 |
| if (.not.associated(aptr) .or. .not.associated(bptr)) stop 69 |
| |
| ! check c_loc ptr once |
| call copy3_array(c_aptr, c_bptr, N) |
| !$omp target update from(bb) |
| if (any(abs(aa - 111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 70 |
| if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 71 |
| |
| ! check c_loc ptr again after target-value modification |
| aa = 1111.0_c_float |
| !$omp target update to(aa) |
| call copy3_array(c_aptr, c_bptr, N) |
| !$omp target update from(bb) |
| if (any(abs(aa - 1111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 72 |
| if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 73 |
| |
| ! check Fortran pointer after target-value modification |
| aa = 11111.0_c_float |
| !$omp target update to(aa) |
| call copy3_array(c_loc(aptr), c_loc(bptr), N) |
| !$omp target update from(bb) |
| if (any(abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 74 |
| if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 75 |
| !$omp end target data |
| |
| if (any(abs(aa - 11111.0_c_float) > 10.0_c_float * epsilon(aa))) stop 76 |
| if (any(abs(3.0_c_float * aa - bb) > 10.0_c_float * epsilon(aa))) stop 77 |
| |
| !$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 78 |
| if (.not.allocated(cc) .or. .not.allocated(dd)) stop 79 |
| if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) stop 80 |
| 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 81 |
| if (.not.associated(cptr) .or. .not.associated(dptr)) stop 82 |
| !$omp end target data |
| if (.not.present(cc) .or. .not.present(dd)) stop 83 |
| if (.not.c_associated(c_loc(cc)) .or. .not.c_associated(c_loc(dd))) stop 84 |
| if (.not.c_associated(c_cptr) .or. .not.c_associated(c_dptr)) stop 85 |
| if (.not.associated(cptr) .or. .not.associated(dptr)) stop 86 |
| |
| ! check c_loc ptr once |
| call copy3_array(c_cptr, c_dptr, N) |
| !$omp target update from(dd) |
| if (any(abs(cc - 333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 87 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 88 |
| |
| ! check c_loc ptr again after target-value modification |
| cc = 3333.0_c_float |
| !$omp target update to(cc) |
| call copy3_array(c_cptr, c_dptr, N) |
| !$omp target update from(dd) |
| if (any(abs(cc - 3333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 89 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 90 |
| |
| ! check Fortran pointer after target-value modification |
| cc = 33333.0_c_float |
| !$omp target update to(cc) |
| call copy3_array(c_loc(cptr), c_loc(dptr), N) |
| !$omp target update from(dd) |
| if (any(abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 91 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 92 |
| !$omp end target data |
| |
| if (any(abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd))) stop 93 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd))) stop 94 |
| |
| |
| !$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 95 |
| if (.not.associated(ee) .or. .not.associated(ff)) stop 96 |
| if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) stop 97 |
| 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 98 |
| if (.not.associated(eptr) .or. .not.associated(fptr)) stop 99 |
| !$omp end target data |
| if (.not.present(ee) .or. .not.present(ff)) stop 100 |
| if (.not.associated(ee) .or. .not.associated(ff)) stop 101 |
| if (.not.c_associated(c_loc(ee)) .or. .not.c_associated(c_loc(ff))) stop 102 |
| if (.not.c_associated(c_eptr) .or. .not.c_associated(c_fptr)) stop 103 |
| if (.not.associated(eptr) .or. .not.associated(fptr)) stop 104 |
| |
| ! check c_loc ptr once |
| call copy3_array(c_eptr, c_fptr, N) |
| !$omp target update from(ff) |
| if (any(abs(ee - 555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 105 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 106 |
| |
| ! check c_loc ptr again after target-value modification |
| ee = 5555.0_c_float |
| !$omp target update to(ee) |
| call copy3_array(c_eptr, c_fptr, N) |
| !$omp target update from(ff) |
| if (any(abs(ee - 5555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 107 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 108 |
| |
| ! check Fortran pointer after target-value modification |
| ee = 55555.0_c_float |
| !$omp target update to(ee) |
| call copy3_array(c_loc(eptr), c_loc(fptr), N) |
| !$omp target update from(ff) |
| if (any(abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 109 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff))) stop 110 |
| !$omp end target data |
| |
| if (any(abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 111 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 112 |
| end subroutine test_dummy_opt_callee_2 |
| end module test_dummies_opt |
| |
| |
| |
| ! Test nullptr |
| module test_nullptr |
| use iso_c_binding |
| implicit none (type, external) |
| private |
| public :: test_nullptr_1 |
| contains |
| subroutine test_nullptr_1() |
| 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 113 |
| !$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 114 |
| 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 115 |
| if (associated(aptr) .or. associated(bptr, bb)) stop 116 |
| if (associated(aa) .or. associated(bb)) stop 117 |
| !$omp end target data |
| if (c_associated(c_aptr) .or. c_associated(c_bptr)) stop 118 |
| if (associated(aptr) .or. associated(bptr, bb)) stop 119 |
| if (associated(aa) .or. associated(bb)) stop 120 |
| |
| if (allocated(gg)) stop 121 |
| !$omp target data map(tofrom:gg) use_device_addr(gg) |
| if (c_associated(c_loc(gg))) stop 122 |
| c_gptr = c_loc(gg) |
| gptr => gg |
| if (c_associated(c_gptr)) stop 123 |
| if (associated(gptr)) stop 124 |
| if (allocated(gg)) stop 125 |
| !$omp end target data |
| if (c_associated(c_gptr)) stop 126 |
| if (associated(gptr)) stop 127 |
| if (allocated(gg)) stop 128 |
| |
| 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 129 |
| if (associated(ee) .or. associated(ff)) stop 130 |
| |
| !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff) |
| if (.not.present(ee) .or. .not.present(ff)) stop 131 |
| if (associated(ee) .or. associated(ff)) stop 132 |
| if (c_associated(c_loc(ee)) .or. c_associated(c_loc(ff))) stop 133 |
| 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 134 |
| if (associated(eptr) .or. associated(fptr)) stop 135 |
| !$omp end target data |
| |
| if (c_associated(c_eptr) .or. c_associated(c_fptr)) stop 136 |
| if (associated(eptr) .or. associated(fptr)) stop 137 |
| |
| if (allocated(hh)) stop 138 |
| !$omp target data map(tofrom:hh) use_device_addr(hh) |
| if (c_associated(c_loc(hh))) stop 139 |
| c_hptr = c_loc(hh) |
| hptr => hh |
| if (c_associated(c_hptr)) stop 140 |
| if (associated(hptr)) stop 141 |
| if (allocated(hh)) stop 142 |
| !$omp end target data |
| if (c_associated(c_hptr)) stop 143 |
| if (associated(hptr)) stop 144 |
| if (allocated(hh)) stop 145 |
| 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 |
| |
| real(c_float), target, allocatable :: cc(:), dd(:) |
| real(c_float), pointer :: ee(:), ff(:) |
| |
| allocate(cc(N), dd(N), ee(N), ff(N)) |
| |
| cc = 33.0_c_float |
| dd = 44.0_c_float |
| ee = 55.0_c_float |
| ff = 66.0_c_float |
| |
| !$omp target data map(to:cc) map(from:dd) use_device_addr(cc,dd) |
| call copy3_array(c_loc(cc), c_loc(dd), N) |
| !$omp end target data |
| if (any(abs(cc - 33.0_c_float) > 10.0_c_float * epsilon(cc))) stop 146 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 147 |
| |
| !$omp target data map(to:ee) map(from:ff) use_device_addr(ee,ff) |
| call copy3_array(c_loc(ee), c_loc(ff), N) |
| !$omp end target data |
| if (any(abs(ee - 55.0_c_float) > 10.0_c_float * epsilon(ee))) stop 148 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 149 |
| |
| deallocate(ee, ff) ! pointers, only |
| end subroutine test_main_1 |
| |
| ! Save device ptr - and recall pointer |
| subroutine test_main_2 |
| integer, parameter :: N = 1000 |
| |
| real(c_float), target, allocatable :: cc(:), dd(:) |
| real(c_float), pointer :: ee(:), ff(:) |
| |
| real(c_float) :: dummy |
| type(c_ptr) :: c_cptr, c_dptr, c_eptr, c_fptr |
| real(c_float), pointer :: cptr(:), dptr(:), eptr(:), fptr(:) |
| |
| allocate(cc(N), dd(N), ee(N), ff(N)) |
| |
| cc = 333.0_c_float |
| dd = 444.0_c_float |
| ee = 555.0_c_float |
| ff = 666.0_c_float |
| |
| !$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_array(c_cptr, c_dptr, N) |
| !$omp target update from(dd) |
| if (any(abs(cc - 333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 150 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 151 |
| |
| ! check c_loc ptr again after target-value modification |
| cc = 3333.0_c_float |
| !$omp target update to(cc) |
| call copy3_array(c_cptr, c_dptr, N) |
| !$omp target update from(dd) |
| if (any(abs(cc - 3333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 152 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 153 |
| |
| ! check Fortran pointer after target-value modification |
| cc = 33333.0_c_float |
| !$omp target update to(cc) |
| call copy3_array(c_loc(cptr), c_loc(dptr), N) |
| !$omp target update from(dd) |
| if (any(abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(cc))) stop 154 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(cc))) stop 155 |
| !$omp end target data |
| |
| if (any(abs(cc - 33333.0_c_float) > 10.0_c_float * epsilon(dd))) stop 156 |
| if (any(abs(3.0_c_float * cc - dd) > 10.0_c_float * epsilon(dd))) stop 157 |
| |
| |
| !$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_array(c_eptr, c_fptr, N) |
| !$omp target update from(ff) |
| if (any(abs(ee - 555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 158 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 159 |
| |
| ! check c_loc ptr again after target-value modification |
| ee = 5555.0_c_float |
| !$omp target update to(ee) |
| call copy3_array(c_eptr, c_fptr, N) |
| !$omp target update from(ff) |
| if (any(abs(ee - 5555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 160 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 161 |
| |
| ! check Fortran pointer after target-value modification |
| ee = 55555.0_c_float |
| !$omp target update to(ee) |
| call copy3_array(c_loc(eptr), c_loc(fptr), N) |
| !$omp target update from(ff) |
| if (any(abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 162 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ff))) stop 163 |
| !$omp end target data |
| |
| if (any(abs(ee - 55555.0_c_float) > 10.0_c_float * epsilon(ee))) stop 164 |
| if (any(abs(3.0_c_float * ee - ff) > 10.0_c_float * epsilon(ee))) stop 165 |
| |
| deallocate(ee, ff) |
| end subroutine test_main_2 |
| end module tests |
| |
| |
| program omp_device_addr |
| use tests |
| use test_dummies |
| use test_dummies_opt |
| 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_opt_call_1() |
| call test_dummy_opt_call_2() |
| |
| call test_nullptr_1() |
| end program omp_device_addr |
