Skip to content
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.

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

Find BLAS LAPACK: add tests #1

Merged
merged 3 commits into from
Jul 3, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
11 changes: 10 additions & 1 deletion test/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,15 @@ macro(ADDTEST name)
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
endmacro(ADDTEST)

macro(ADDTESTPP name)
add_executable(test_${name} test_${name}.F90)
target_link_libraries(test_${name} "${PROJECT_NAME}" "test-drive::test-drive")
add_test(NAME ${name}
COMMAND $<TARGET_FILE:test_${name}> ${CMAKE_CURRENT_BINARY_DIR}
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
endmacro(ADDTESTPP)


add_subdirectory(array)
add_subdirectory(ascii)
add_subdirectory(bitsets)
Expand All @@ -30,4 +39,4 @@ add_subdirectory(system)
add_subdirectory(quadrature)
add_subdirectory(math)
add_subdirectory(stringlist)
add_subdirectory(terminal)
add_subdirectory(terminal)
11 changes: 9 additions & 2 deletions test/linalg/CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -1,15 +1,22 @@
set(
fppFiles
"test_linalg.fypp"
"test_blas_lapack.fypp"
"test_linalg_eigenvalues.fypp"
"test_linalg_solve.fypp"
"test_linalg_lstsq.fypp"
"test_linalg_determinant.fypp"
"test_linalg_svd.fypp"
"test_linalg_matrix_property_checks.fypp"
)

# Preprocessed files to contain preprocessor directives -> .F90
set(
cppFiles
"test_blas_lapack.fypp"
)

fypp_f90("${fyppFlags}" "${fppFiles}" outFiles)
fypp_f90pp("${fyppFlags}" "${cppFiles}" outPreprocFiles)

ADDTEST(linalg)
ADDTEST(linalg_determinant)
Expand All @@ -18,4 +25,4 @@ ADDTEST(linalg_matrix_property_checks)
ADDTEST(linalg_solve)
ADDTEST(linalg_lstsq)
ADDTEST(linalg_svd)
ADDTEST(blas_lapack)
ADDTESTPP(blas_lapack)
73 changes: 72 additions & 1 deletion test/linalg/test_blas_lapack.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,9 @@ contains
new_unittest("test_gemv${t1[0]}$${k1}$", test_gemv${t1[0]}$${k1}$), &
new_unittest("test_getri${t1[0]}$${k1}$", test_getri${t1[0]}$${k1}$), &
#:endfor
new_unittest("test_idamax", test_idamax) &
new_unittest("test_idamax", test_idamax), &
new_unittest("test_external_blas",external_blas_test), &
new_unittest("test_external_lapack",external_lapack_test) &
]

end subroutine collect_blas_lapack
Expand Down Expand Up @@ -117,6 +119,75 @@ contains

end subroutine test_idamax

!> Test availability of the external BLAS interface
subroutine external_blas_test(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error

#ifdef STDLIB_EXTERNAL_BLAS
interface
subroutine saxpy(n,sa,sx,incx,sy,incy)
import sp,ilp
implicit none(type,external)
real(sp), intent(in) :: sa,sx(*)
integer(ilp), intent(in) :: incx,incy,n
real(sp), intent(inout) :: sy(*)
end subroutine saxpy
end interface

integer(ilp), parameter :: n = 5, inc=1
real(sp) :: a,x(n),y(n)

x = 1.0_sp
y = 2.0_sp
a = 3.0_sp

call saxpy(n,a,x,inc,y,inc)
call check(error, all(abs(y-5.0_sp)<sqrt(epsilon(0.0_sp))), "saxpy: check result")
if (allocated(error)) return

#else
call skip_test(error, "Not using an external BLAS")
#endif

end subroutine external_blas_test

!> Test availability of the external BLAS interface
subroutine external_lapack_test(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error

#ifdef STDLIB_EXTERNAL_LAPACK
interface
subroutine dgetrf( m, n, a, lda, ipiv, info )
import dp,ilp
implicit none(type,external)
integer(ilp), intent(out) :: info,ipiv(*)
integer(ilp), intent(in) :: lda,m,n
real(dp), intent(inout) :: a(lda,*)
end subroutine dgetrf
end interface

integer(ilp), parameter :: n = 3
real(dp) :: A(n,n)
integer(ilp) :: ipiv(n),info


A = eye(n)
info = 123

! Factorize matrix
call dgetrf(n,n,A,n,ipiv,info)

call check(error, info==0, "dgetrf: check result")
if (allocated(error)) return

#else
call skip_test(error, "Not using an external LAPACK")
#endif

end subroutine external_lapack_test

end module test_blas_lapack


Expand Down
Loading