1! PR fortran/98858 2! 3! Assumed-size array with use_device_ptr() 4! 5program test_use_device_ptr 6 use iso_c_binding, only: c_ptr, c_loc, c_f_pointer 7 implicit none 8 double precision :: alpha 9 integer, parameter :: lda = 10 10 integer, allocatable :: mat(:, :) 11 integer :: i, j 12 13 allocate(mat(lda, lda)) 14 do i = 1, lda 15 do j = 1, lda 16 mat(j,i) = i*100 + j 17 end do 18 end do 19 20 !$omp target enter data map(to:mat) 21 call dgemm(lda, mat) 22 !$omp target exit data map(from:mat) 23 24 do i = 1, lda 25 do j = 1, lda 26 if (mat(j,i) /= -(i*100 + j)) stop 1 27 end do 28 end do 29 30 !$omp target enter data map(to:mat) 31 call dgemm2(lda, mat) 32 !$omp target exit data map(from:mat) 33 34 do i = 1, lda 35 do j = 1, lda 36 if (mat(j,i) /= (i*100 + j)) stop 1 37 end do 38 end do 39 40 contains 41 42 subroutine dgemm(lda, a) 43 implicit none 44 integer :: lda 45 integer, target:: a(lda,*) ! need target attribute to use c_loc 46 !$omp target data use_device_ptr(a) 47 call negate_it(c_loc(a), lda) 48 !$omp end target data 49 end subroutine 50 51 subroutine dgemm2(lda, a) 52 implicit none 53 integer :: lda 54 integer, target:: a(lda,*) ! need target attribute to use c_loc 55 !$omp target data use_device_addr(a) 56 call negate_it(c_loc(a), lda) 57 !$omp end target data 58 end subroutine 59 60 subroutine negate_it(a, n) 61 type(c_ptr), value :: a 62 integer, value :: n 63 integer, pointer :: array(:,:) 64 65 ! detour due to OpenMP 5.0 oddness 66 call c_f_pointer(a, array, [n,n]) 67 call do_offload(array, n) 68 end 69 70 subroutine do_offload(aptr, n) 71 integer, target :: aptr(:,:) 72 integer, value :: n 73 !$omp target is_device_ptr(aptr) 74 call negate_it_tgt(aptr, n) 75 !$omp end target 76 end subroutine do_offload 77 78 subroutine negate_it_tgt(array, n) 79 !$omp declare target 80 integer, value :: n 81 integer :: array(n,n) 82 integer :: i, j 83 !$omp parallel do collapse(2) 84 do i = 1, n 85 do j = 1, n 86 array(j,i) = - array(j,i) 87 end do 88 end do 89 !$omp end parallel do 90 end subroutine 91end program 92