brintos

brintos / llvm-project-archived public Read only

0
0
Text · 1.4 KiB · 0c896e6 Raw
66 lines · plain
1! REQUIRES: flang, amdgpu2 3! RUN: %libomptarget-compile-fortran-generic4! RUN: %libomptarget-run-generic 2>&1 | %fcheck-generic5 6module enter_exit_mapper_mod7  implicit none8 9  type :: field_type10    real, allocatable :: values(:)11  end type field_type12 13  type :: tile_type14    type(field_type) :: field15    integer, allocatable :: neighbors(:)16  end type tile_type17 18contains19  subroutine init_tile(tile)20    type(tile_type), intent(inout) :: tile21    integer :: j22 23    allocate(tile%field%values(4))24    allocate(tile%neighbors(4))25    do j = 1, 426      tile%field%values(j) = 10.0 * j27      tile%neighbors(j) = j28    end do29  end subroutine init_tile30 31end module enter_exit_mapper_mod32 33program implicit_enter_exit34  use enter_exit_mapper_mod35  implicit none36  integer :: j37  type(tile_type) :: tile38 39  call init_tile(tile)40 41  !$omp target enter data map(alloc: tile%field%values)42 43  !$omp target44  do j = 1, size(tile%field%values)45    tile%field%values(j) = 5.0 * j46  end do47  !$omp end target48 49  !$omp target exit data map(from: tile%field%values)50 51  do j = 1, size(tile%field%values)52    if (tile%field%values(j) /= 5.0 * j) then53      print *, "======= Test Failed! ======="54      stop 155    end if56    if (tile%neighbors(j) /= j) then57      print *, "======= Test Failed! ======="58      stop 159    end if60  end do61 62  print *, "======= Test Passed! ======="63end program implicit_enter_exit64 65! CHECK: ======= Test Passed! =======66