62 lines · plain
1! Offloading test which aims to test that an allocatable/descriptor type map2! will allow the appropriate slicing behaviour.3! REQUIRES: flang, amdgpu4 5subroutine slice_writer(n, a, b, c)6 implicit none7 integer, intent(in) :: n8 real(8), intent(in) :: a(n)9 real(8), intent(in) :: b(n)10 real(8), intent(out) :: c(n)11 integer :: i12 13 !$omp target teams distribute parallel do14 do i=1,n15 c(i) = b(i) + a(i)16 end do17end subroutine slice_writer18 19! RUN: %libomptarget-compile-fortran-run-and-check-generic20program main21 implicit none22 real(kind=8), allocatable :: a(:,:,:)23 integer :: i, j, k, idx, idx1, idx2, idx324 25 i=5026 j=10027 k=228 29 allocate(a(1:i,1:j,1:k))30 31 do idx1=1, i32 do idx2=1, j33 do idx3=1, k34 a(idx1,idx2,idx3) = idx235 end do36 end do37 end do38 39 do idx=1,k40 !$omp target enter data map(alloc: a(1:i,:, idx))41 42 !$omp target update to(a(1:i, 1:30, idx), &43 !$omp& a(1:i, 61:100, idx))44 45 call slice_writer(i, a(:, 1, idx), a(:, 61, idx), a(:, 31, idx))46 call slice_writer(i, a(:, 30, idx), a(:, 100, idx), a(:, 60, idx))47 48 !$omp target update from(a(1:i, 31:60, idx))49 !$omp target exit data map(delete: a(1:i, :, idx))50 51 print *, a(1, 31, idx), a(2, 31, idx), a(i, 31, idx)52 print *, a(1, 60, idx), a(2, 60, idx), a(i, 60, idx)53 enddo54 55 deallocate(a)56end program57 58! CHECK: 62. 62. 62.59! CHECK: 130. 130. 130.60! CHECK: 62. 62. 62.61! CHECK: 130. 130. 130.62