Skip to content

332 ensure portability of openmp target backend across nividia and amd gpus #335

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
pbartholomew08 wants to merge 3 commits into
base: main
Choose a base branch
from
Open

332 ensure portability of openmp target backend across nividia and amd gpus #335

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
2fde75b
WIP -- moving from has_device_addr -> is_device_ptr
pbartholomew08 Jul 31, 2026
2631e7c
WIP: continuing move to is_device_ptr
pbartholomew08 Aug 3, 2026
7840bc9
NVHPC compiles OMP target offload
pbartholomew08 Aug 3, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
21 changes: 12 additions & 9 deletions src/CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -82,15 +82,15 @@ endif()

list(APPEND SRC ${IOSRC})

if(${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI" OR
${CMAKE_Fortran_COMPILER_ID} STREQUAL "NVHPC")
list(APPEND SRC ${CUDASRC})
list(APPEND BACKENDSRC backend/cuda/backend.f90)
endif()

if(OMP_TGT)
list(APPEND SRC ${OMPTGTSRC})
list(APPEND BACKENDSRC backend/omp/target/backend.f90)
else()
if(${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI" OR
${CMAKE_Fortran_COMPILER_ID} STREQUAL "NVHPC")
list(APPEND SRC ${CUDASRC})
list(APPEND BACKENDSRC backend/cuda/backend.f90)
endif()
endif()

if(WITH_2DECOMPFFT)
Expand Down Expand Up @@ -121,7 +121,12 @@ target_link_libraries(xcompact PRIVATE x3d2)
# if CUDA compiler
if(${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI" OR
${CMAKE_Fortran_COMPILER_ID} STREQUAL "NVHPC")
set(CMAKE_Fortran_FLAGS "-cpp -cuda")
if (NOT OMP_TGT)
set(CMAKE_Fortran_FLAGS "-cpp -cuda")
target_compile_options(xcompact PRIVATE "-DCUDA")
else()
set(CMAKE_Fortran_FLAGS "-cpp")
endif()
set(CMAKE_Fortran_FLAGS_DEBUG "-g -O0 -traceback -Mbounds -Mchkptr -Ktrap=fp")
# Note: -Ktrap=fp traps FP exceptions process-wide. On some NVIDIA GPUs (for example RTX A4000)
# it was giving a divide-by-zero inside cuFFTMp's PTX-JIT compiler during Poisson FFT plan creation
Expand All @@ -130,8 +135,6 @@ if(${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI" OR
target_link_options(x3d2 INTERFACE "-cuda")
target_link_options(x3d2 INTERFACE "-cudalib=cufftmp")

target_compile_options(xcompact PRIVATE "-DCUDA")

elseif(${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU" OR
${CMAKE_Fortran_COMPILER_ID} STREQUAL "LLVMFlang" OR
${CMAKE_Fortran_COMPILER_ID} STREQUAL "Flang")
Expand Down
78 changes: 47 additions & 31 deletions src/backend/omp/target/allocator.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -33,14 +33,15 @@ module m_omptgt_allocator

type, extends(field_t) :: omptgt_field_t
! A device-resident field
integer, private :: n
integer, dimension(3), private :: dims
integer, private :: dev_id
type(c_ptr), private :: dev_ptr = c_null_ptr
real(dp), pointer, private :: p_data_tgt(:) => null()
real(dp), pointer, contiguous :: data_tgt(:, :, :) => null()
contains
procedure :: fill => fill_omptgt
procedure :: get_shape => get_shape_omptgt
procedure :: set_shape => set_shape_omptgt
procedure :: get_dev_ptr
final :: omptgt_field_destroy
end type omptgt_field_t

Expand Down Expand Up @@ -87,17 +88,15 @@ subroutine omptgt_field_init(ngrid, next, id, f)
error stop "Device ID is HOST"
end if

f%dev_ptr = omp_target_alloc(ngrid*c_sizeof(0.0_dp), f%dev_id)
call c_f_pointer(f%dev_ptr, f%p_data_tgt, shape=[ngrid])
f%n = ngrid
f%dims = -1
f%dev_ptr = omp_target_alloc(f%n*c_sizeof(0.0_dp), f%dev_id)

end subroutine omptgt_field_init

subroutine omptgt_field_destroy(self)
type(omptgt_field_t) :: self

nullify (self%data_tgt)
nullify (self%p_data_tgt)

if (c_associated(self%dev_ptr)) then
call omp_target_free(self%dev_ptr, self%dev_id)
end if
Expand All @@ -107,60 +106,77 @@ subroutine fill_omptgt(self, c)
class(omptgt_field_t) :: self
real(dp), intent(in) :: c

!call fill_omptgt_(self%p_data_tgt, c, size(self%p_data_tgt))
call fill_omptgt_3d_(self%data_tgt, c)
call fill_omptgt_(self%dev_ptr, c, self%n)
!call fill_omptgt_3d_(self%dev_ptr, c)

end subroutine fill_omptgt

subroutine fill_omptgt_(p_data_tgt, c, n)
real(dp), dimension(:), intent(inout) :: p_data_tgt
subroutine fill_omptgt_(dev_ptr, c, n)
type(c_ptr), intent(inout) :: dev_ptr
real(dp), intent(in) :: c
integer, intent(in) :: n

real(dp), dimension(:), pointer :: p_data_tgt
integer :: i

!$omp target teams loop has_device_addr(p_data_tgt)
!$omp target teams is_device_ptr(dev_ptr)
call c_f_pointer(dev_ptr, p_data_tgt, shape=[n])
!$omp loop
do i = 1, n
p_data_tgt(i) = c
end do
!$omp end target teams loop
!$omp end loop
!$omp end target teams

end subroutine

subroutine fill_omptgt_3d_(data_tgt, c)
real(dp), dimension(:, :, :), intent(inout) :: data_tgt
real(dp), intent(in) :: c
!!subroutine fill_omptgt_3d_(dev_ptr, c)
!! type(c_ptr), intent(inout) :: dev_ptr
!! real(dp), intent(in) :: c

integer, dimension(3) :: n
integer :: i, j, k
!! real(dp), dimension(:,:,:), pointer :: p_data_tgt
!! integer, dimension(3) :: n
!! integer :: i, j, k

n = shape(data_tgt)
!! n = shape(data_tgt)

!$omp target teams loop collapse(3) has_device_addr(data_tgt)
do k = 1, n(3)
do j = 1, n(2)
do i = 1, n(1)
data_tgt(i, j, k) = c
end do
end do
end do
!$omp end target teams loop
end subroutine
!! !$omp target teams loop collapse(3) is_device_ptr(dev_ptr)
!! call c_f_pointer(dev_ptr, p_data_tgt, shape=n)
!! do k = 1, n(3)
!! do j = 1, n(2)
!! do i = 1, n(1)
!! p_data_tgt(i, j, k) = c
!! end do
!! end do
!! end do
!! !$omp end target teams loop
!!end subroutine

function get_shape_omptgt(self) result(dims)
class(omptgt_field_t) :: self
integer :: dims(3)
!$omp declare target

dims = shape(self%data_tgt)
dims = self%dims
end function

subroutine set_shape_omptgt(self, dims)
class(omptgt_field_t) :: self
integer, intent(in) :: dims(3)

call c_f_pointer(self%dev_ptr, self%data_tgt, shape=dims)
if (product(dims) < self%n) then

@CFD-Xing CFD-Xing Aug 7, 2026

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This should be if (product(dims) <= self%n) then

self%dims = dims
else
error stop "Trying to set shape of field greater than capacity"
end if

end subroutine

type(c_ptr) function get_dev_ptr(self) result(ptr)
class(omptgt_field_t) :: self

ptr = self%dev_ptr
end function

end module m_omptgt_allocator

Loading
Loading