Skip to content

Fix array_strides with nvhpc; Note: not working on Linux_aarch64 #74

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

Draft
wdeconinck wants to merge 3 commits into
base: develop
Choose a base branch
from
Draft

Fix array_strides with nvhpc; Note: not working on Linux_aarch64 #74

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
da34485
[fctest] Fix wrong inline initialisation
wdeconinck Nov 7, 2025
58e60d5
[fctest] Add capability to inspect and ignore last check
wdeconinck Nov 13, 2025
55d0afc
Fix array_strides with nvhpc; Note: not working on Linux_aarch64
wdeconinck Nov 6, 2025
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
10 changes: 10 additions & 0 deletions CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,7 @@ ecbuild_check_fortran( FEATURES finalization )

set( FEATURE_FINAL_DEFAULT ON )
set( PGIBUG_ATLAS_197 0 )
set( HAVE_NOREPACK 1 )
if( CMAKE_Fortran_COMPILER_ID MATCHES "PGI|NVHPC" )
if( ${CMAKE_Fortran_COMPILER_VERSION} VERSION_LESS 19.4 )
set( PGIBUG_ATLAS_197 1 )
Expand All @@ -40,6 +41,15 @@ if( CMAKE_Fortran_COMPILER_ID MATCHES "PGI|NVHPC" )
list( APPEND FCKIT_QUARANTAINED_TESTS fckit_test_shared_ptr )
# deallocation of list of shared_ptr only seems to deallocate first entry
endif()
check_fortran_compiler_flag(-Mnotarget_temps SUPPORTED_FLAG_NOTARGET_TEMPS)
if(NOT SUPPORTED_FLAG_NOTARGET_TEMPS)
set( HAVE_NOREPACK 0 )
ecbuild_warn("The NVHPC Fortran flag -Mnotarget_temps is not supported. "
"In practice this means that a Fortran array sliced on first (leftmost) dimension (so discontiguous) "
"will be repacked as a temporary contiguous array when passed as argument and copied in/out. "
"Other types of slices are not repacked regardless. "
"See https://github.com/ecmwf/fckit/issues/73")
endif()
endif()
if( CMAKE_Fortran_COMPILER_ID STREQUAL "Intel" )
# known to work: 2021.4.0.20210910 from intel/2021.4
Expand Down
3 changes: 3 additions & 0 deletions src/fckit/CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -66,6 +66,9 @@ if( CMAKE_Fortran_COMPILER_ID MATCHES "PGI|NVHPC" )
# PGF90-W-0435-Array declared with zero size
# (/tmp/nawd/atlas-bundle/source/fckit/src/fckit/module/fckit_array.F90: 25)
set_source_files_properties( module/fckit_array.F90 PROPERTIES COMPILE_FLAGS "-w" )

ecbuild_add_fortran_flags("-Mnotarget_temps" NAME fckit_fortran_norepack NO_FAIL) # otherwise wrong strides computation of arrays passed as arguments
# Not all NVHPC installations support this. See https://github.com/ecmwf/fckit/issues/73
endif()


Expand Down
67 changes: 65 additions & 2 deletions src/fckit/fctest.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,8 @@ module fctest
public
character(len=1024) :: source_file
integer(c_int32_t) :: exit_status
integer(c_int32_t) :: exit_status_before_check
integer(c_int32_t) :: check_status
interface FCE
module procedure fctest_check_equal_int32
module procedure fctest_check_equal_int64_int32
Expand Down Expand Up @@ -61,25 +63,42 @@ end function sweep_leading_blanks
subroutine fctest_error(line)
integer(c_int32_t), intent(in) :: line
write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line)))
exit_status_before_check=exit_status
check_status=1
exit_status=1
end subroutine

function fctest_last_check_failed()
logical :: fctest_last_check_failed
fctest_last_check_failed = (check_status /= 0)
end function

subroutine fctest_ignore_last_check()
exit_status=exit_status_before_check
end subroutine

subroutine fctest_check_equal_int32(V1,V2,line)
integer(c_int32_t), intent(in) :: V1, V2
integer(c_int32_t), intent(in) :: line
exit_status_before_check=exit_status
check_status=0
if(V1/=V2) then
write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line)))
write(0,*) "--> [",V1,"!=",V2,"]"
check_status=1
exit_status=1
endif
end subroutine

subroutine fctest_check_equal_int64(V1,V2,line)
integer(c_int64_t), intent(in) :: V1, V2
integer(c_int32_t), intent(in) :: line
exit_status_before_check=exit_status
check_status=0
if(V1/=V2) then
write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line)))
write(0,*) "--> [",V1,"!=",V2,"]"
check_status=1
exit_status=1
endif
end subroutine
Expand All @@ -88,9 +107,12 @@ subroutine fctest_check_equal_int64_int32(V1,V2,line)
integer(c_int64_t), intent(in) :: V1
integer(c_int32_t), intent(in) :: V2
integer(c_int32_t), intent(in) :: line
exit_status_before_check=exit_status
check_status=0
if(V1/=V2) then
write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line)))
write(0,*) "--> [",V1,"!=",V2,"]"
check_status=1
exit_status=1
endif
end subroutine
Expand All @@ -99,58 +121,76 @@ subroutine fctest_check_equal_int32_int64(V1,V2,line)
integer(c_int32_t), intent(in) :: V1
integer(c_int64_t), intent(in) :: V2
integer(c_int32_t), intent(in) :: line
exit_status_before_check=exit_status
check_status=0
if(V1/=V2) then
write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line)))
write(0,*) "--> [",V1,"!=",V2,"]"
check_status=1
exit_status=1
endif
end subroutine

subroutine fctest_check_equal_real32(V1,V2,line)
real(kind=c_float), intent(in) :: V1, V2
integer(c_int32_t), intent(in) :: line
exit_status_before_check=exit_status
check_status=0
if(V1/=V2) then
write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line)))
write(0,*) "--> [",V1,"!=",V2,"]"
check_status=1
exit_status=1
endif
end subroutine

subroutine fctest_check_equal_real64(V1,V2,line)
real(kind=c_double), intent(in) :: V1, V2
integer(c_int32_t), intent(in) :: line
exit_status_before_check=exit_status
check_status=0
if(V1/=V2) then
write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line)))
write(0,*) "--> [",V1,"!=",V2,"]"
check_status=1
exit_status=1
endif
end subroutine

subroutine fctest_check_equal_logical(V1,V2,line)
logical, intent(in) :: V1, V2
integer(c_int32_t), intent(in) :: line
exit_status_before_check=exit_status
check_status=0
if(V1.neqv.V2) then
write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line)))
write(0,*) "--> [",V1,"!=",V2,"]"
check_status=1
exit_status=1
endif
end subroutine

subroutine fctest_check_equal_string(V1,V2,line)
character(kind=c_char,len=*), intent(in) :: V1, V2
integer(c_int32_t), intent(in) :: line
exit_status_before_check=exit_status
check_status=0
if(V1/=V2) then
write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line)))
write(0,*) "--> [",V1,"!=",V2,"]"
check_status=1
exit_status=1
endif
end subroutine

subroutine fctest_check_equal_int32_r1(V1,V2,line)
integer(c_int32_t), intent(in) :: V1(:), V2(:)
integer(c_int32_t), intent(in) :: line
logical :: compare = .True.
logical :: compare
integer(c_int32_t) :: j
exit_status_before_check=exit_status
check_status=0
compare = .True.
if( size(V1) /= size(V2) ) compare = .False.
if( compare .eqv. .True. ) then
do j=1,size(V1)
Expand All @@ -162,15 +202,19 @@ subroutine fctest_check_equal_int32_r1(V1,V2,line)
if( size(V1) <= 30 ) then
write(0,*) "--> [ ",V1," ] != [ ",V2," ] "
endif
check_status=1
exit_status=1
endif
end subroutine

subroutine fctest_check_equal_int64_r1(V1,V2,line)
integer(c_int64_t), intent(in) :: V1(:), V2(:)
integer(c_int32_t), intent(in) :: line
logical :: compare = .True.
logical :: compare
integer(c_int32_t) :: j
exit_status_before_check=exit_status
check_status=0
compare = .True.
if( size(V1) /= size(V2) ) compare = .False.
if( compare .eqv. .True. ) then
do j=1,size(V1)
Expand All @@ -182,6 +226,7 @@ subroutine fctest_check_equal_int64_r1(V1,V2,line)
if( size(V1) <= 30 ) then
write(0,*) "--> [ ",V1," ] != [ ",V2," ]"
endif
check_status=1
exit_status=1
endif
end subroutine
Expand All @@ -191,6 +236,8 @@ subroutine fctest_check_equal_real32_r1(V1,V2,line)
integer(c_int32_t), intent(in) :: line
logical :: compare
integer(c_int32_t) :: j
exit_status_before_check=exit_status
check_status=0
compare = .True.
if( size(V1) /= size(V2) ) compare = .False.
if( compare .eqv. .True. ) then
Expand All @@ -203,6 +250,7 @@ subroutine fctest_check_equal_real32_r1(V1,V2,line)
if( size(V1) <= 30 ) then
write(0,*) "--> [ ",V1," ] != [ ",V2," ]"
endif
check_status=1
exit_status=1
endif
end subroutine
Expand All @@ -212,6 +260,8 @@ subroutine fctest_check_equal_real64_r1(V1,V2,line)
integer(c_int32_t), intent(in) :: line
logical :: compare
integer(c_int32_t) :: j
exit_status_before_check=exit_status
check_status=0
compare = .True.
if( size(V1) /= size(V2) ) compare = .False.
if( compare .eqv. .True. ) then
Expand All @@ -224,26 +274,33 @@ subroutine fctest_check_equal_real64_r1(V1,V2,line)
if( size(V1) <= 30 ) then
write(0,*) "--> [ ",V1," ] != [ ",V2," ]"
endif
check_status=1
exit_status=1
endif
end subroutine

subroutine fctest_check_close_real32(V1,V2,TOL,line)
real(kind=c_float), intent(in) :: V1, V2, TOL
integer(c_int32_t), intent(in) :: line
exit_status_before_check=exit_status
check_status=0
if(.not.(abs(V1-V2)<=TOL)) then;
write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line)))
write(0,*) "--> [",V1,"!=",V2,"]"
check_status=1
exit_status=1
endif
end subroutine

subroutine fctest_check_close_real64(V1,V2,TOL,line)
real(kind=c_double), intent(in) :: V1, V2, TOL
integer(c_int32_t), intent(in) :: line
exit_status_before_check=exit_status
check_status=0
if(.not.(abs(V1-V2)<=TOL)) then;
write(0,'(2A,I0,2A)') trim(source_file),":",line,": warning: ",trim(sweep_leading_blanks(get_source_line(line)))
write(0,*) "--> [",V1,"!=",V2,"]"
check_status=1
exit_status=1
endif
end subroutine
Expand All @@ -254,6 +311,8 @@ subroutine fctest_check_close_real32_r1(V1,V2,TOL,line)
integer(c_int32_t), intent(in) :: line
logical :: compare
integer(c_int32_t) :: j
exit_status_before_check=exit_status
check_status=0
compare = .True.
if( size(V1) /= size(V2) ) compare = .False.
if( compare .eqv. .True. ) then
Expand All @@ -266,6 +325,7 @@ subroutine fctest_check_close_real32_r1(V1,V2,TOL,line)
if( size(V1) <= 30 ) then
write(0,*) "--> [ ",V1," ] != [ ",V2," ]"
endif
check_status=1
exit_status=1
endif
end subroutine
Expand All @@ -276,6 +336,8 @@ subroutine fctest_check_close_real64_r1(V1,V2,TOL,line)
integer(c_int32_t), intent(in) :: line
logical :: compare
integer(c_int32_t) :: j
exit_status_before_check=exit_status
check_status=0
compare = .True.
if( size(V1) /= size(V2) ) compare = .False.
if( compare .eqv. .True. ) then
Expand All @@ -288,6 +350,7 @@ subroutine fctest_check_close_real64_r1(V1,V2,TOL,line)
if( size(V1) <= 30 ) then
write(0,*) "--> [ ",V1," ] != [ ",V2," ]"
endif
check_status=1
exit_status=1
endif
end subroutine
Expand Down
Loading
Loading