brintos

brintos / llvm-project-archived public Read only

0
0
Text · 1.8 KiB · 5410a06 Raw
77 lines · plain
1! Offloading test with a target region mapping a declare target Fortran array2! writing some values to it and checking the host correctly receives the3! updates made on the device.4! REQUIRES: flang, amdgpu5 6! RUN: %libomptarget-compile-fortran-run-and-check-generic7module test_08  implicit none9  INTEGER :: arr1(10) = (/0,0,0,0,0,0,0,0,0,0/)10  INTEGER :: arr2(10) = (/0,0,0,0,0,0,0,0,0,0/)11  !$omp declare target link(arr1) enter(arr2)12  INTEGER :: scalar = 113  !$omp declare target link(scalar)14end module test_015 16subroutine test_with_array_link_and_tofrom()17  use test_018  integer :: i = 119  integer :: j = 1120  !$omp target map(tofrom:arr1, i, j)21  do while (i <= j)22      arr1(i) = i;23      i = i + 124  end do25  !$omp end target26 27  ! CHECK: 1 2 3 4 5 6 7 8 9 1028  PRINT *, arr1(:)29end subroutine test_with_array_link_and_tofrom30 31subroutine test_with_array_link_only()32  use test_033  integer :: i = 134  integer :: j = 1135  !$omp target map(i, j)36      do while (i <= j)37          arr1(i) = i + 1;38          i = i + 139      end do40  !$omp end target41 42  ! CHECK: 2 3 4 5 6 7 8 9 10 1143  PRINT *, arr1(:)44end subroutine test_with_array_link_only45 46subroutine test_with_array_enter_only()47  use test_048  integer :: i = 149  integer :: j = 1150  !$omp target map(i, j)51      do while (i <= j)52          arr2(i) = i + 1;53          i = i + 154      end do55  !$omp end target56 57  ! CHECK: 0 0 0 0 0 0 0 0 0 058  PRINT *, arr2(:)59end subroutine test_with_array_enter_only60 61subroutine test_with_scalar_link_only()62  use test_063  !$omp target64      scalar = 1065  !$omp end target66 67  ! CHECK: 1068  PRINT *, scalar69end subroutine test_with_scalar_link_only70 71program main72  call test_with_array_link_and_tofrom()73  call test_with_array_link_only()74  call test_with_array_enter_only()75  call test_with_scalar_link_only()76end program77