Merge pull request #2 from jvdp1/blas_jv

Support of MKL
zoziha · Jul 17, 2024 · 9de0589 · 9de0589
2 parents 3254fd0 + b867c2b
commit 9de0589
Show file tree

Hide file tree

Showing 4 changed files with 26 additions and 16 deletions.
diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml
@@ -138,8 +138,6 @@ jobs:
         -DCMAKE_MAXIMUM_RANK:String=4
         -DCMAKE_INSTALL_PREFIX=$PWD/_dist
         -DFIND_BLAS:STRING=TRUE
-        -DBLAS_LIBRARIES="/opt/intel/oneapi/mkl/latest/lib/intel64/libmkl_rt.so"
-        -DLAPACK_LIBRARIES="/opt/intel/oneapi/mkl/latest/lib/intel64/libmkl_rt.so"
         -S . -B build_mkl
     
     - name: Build and compile with MKL

diff --git a/CMakeLists.txt b/CMakeLists.txt
@@ -46,11 +46,23 @@ option(FIND_BLAS "Find external BLAS and LAPACK" ON)
 
 # --- find BLAS and LAPACK
 if(FIND_BLAS)
-  find_package(BLAS)
+  if(NOT BLAS_FOUND)
+    #Required for MKL
+    if(DEFINED ENV{MKLROOT} OR "${BLA_VENDOR}" MATCHES "^Intel")
+      enable_language("C")
+    endif()
+    find_package("BLAS")
+  endif()
   if(BLAS_FOUND)
     add_compile_definitions(STDLIB_EXTERNAL_BLAS)
   endif()
-  find_package(LAPACK)
+  if(NOT LAPACK_FOUND)
+    #Required for MKL
+    if(DEFINED ENV{MKLROOT} OR "${BLA_VENDOR}" MATCHES "^Intel")
+      enable_language("C")
+    endif()
+    find_package("LAPACK")
+  endif()
   if(LAPACK_FOUND)
     add_compile_definitions(STDLIB_EXTERNAL_LAPACK)
   endif()

diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt
@@ -122,10 +122,10 @@ add_library(${PROJECT_NAME} ${SRC})
 
 # Link to BLAS and LAPACK
 if(BLAS_FOUND)
-  target_link_libraries(${PROJECT_NAME} BLAS::BLAS)
+  target_link_libraries(${PROJECT_NAME} "BLAS::BLAS")
 endif()
 if(LAPACK_FOUND)
-  target_link_libraries(${PROJECT_NAME} LAPACK::LAPACK)
+  target_link_libraries(${PROJECT_NAME} "LAPACK::LAPACK")
 endif()
 
 set_target_properties(

diff --git a/test/linalg/test_linalg_svd.fypp b/test/linalg/test_linalg_svd.fypp
@@ -93,7 +93,7 @@ module test_linalg_svd
         if (allocated(error)) return        
         call check(error, all(abs(s-s_sol)<=tol), test//': S')
         if (allocated(error)) return             
-        call check(error, all(abs(u-u_sol)<=tol) .or. all(abs(u+u_sol)<=tol), test//': U')
+        call check(error, all(abs(abs(u)-abs(u_sol))<=tol), test//': U')
         if (allocated(error)) return             
 
         !> [S, U]. Overwrite A matrix
@@ -104,7 +104,7 @@ module test_linalg_svd
         if (allocated(error)) return        
         call check(error, all(abs(s-s_sol)<=tol), test//': S')
         if (allocated(error)) return             
-        call check(error, all(abs(u-u_sol)<=tol) .or. all(abs(u+u_sol)<=tol), test//': U')
+        call check(error, all(abs(abs(u)-abs(u_sol))<=tol), test//': U')
         if (allocated(error)) return            
 
         !> [S, U, V^T]
@@ -116,9 +116,9 @@ module test_linalg_svd
         if (allocated(error)) return        
         call check(error, all(abs(s-s_sol)<=tol), test//': S')
         if (allocated(error)) return             
-        call check(error, all(abs(u-u_sol)<=tol) .or. all(abs(u+u_sol)<=tol), test//': U')
+        call check(error, all(abs(abs(u)-abs(u_sol))<=tol), test//': U')
         if (allocated(error)) return           
-        call check(error, all(abs(vt-vt_sol)<=tol) .or. all(abs(vt+vt_sol)<=tol), test//': V^T')
+        call check(error, all(abs(abs(vt)-abs(vt_sol))<=tol), test//': V^T')
         if (allocated(error)) return           
 
         !> [S, V^T]. Do not overwrite A matrix
@@ -130,7 +130,7 @@ module test_linalg_svd
         if (allocated(error)) return        
         call check(error, all(abs(s-s_sol)<=tol), test//': S')
         if (allocated(error)) return             
-        call check(error, all(abs(vt-vt_sol)<=tol) .or. all(abs(vt+vt_sol)<=tol), test//': V^T')
+        call check(error, all(abs(abs(vt)-abs(vt_sol))<=tol), test//': V^T')
         if (allocated(error)) return   
 
         !> [S, V^T]. Overwrite A matrix
@@ -141,7 +141,7 @@ module test_linalg_svd
         if (allocated(error)) return        
         call check(error, all(abs(s-s_sol)<=tol), test//': S')
         if (allocated(error)) return             
-        call check(error, all(abs(vt-vt_sol)<=tol) .or. all(abs(vt+vt_sol)<=tol), test//': V^T')
+        call check(error, all(abs(abs(vt)-abs(vt_sol))<=tol), test//': V^T')
         if (allocated(error)) return           
 
         !> [U, S, V^T].
@@ -151,11 +151,11 @@ module test_linalg_svd
         test = '[U, S, V^T]'
         call check(error,state%ok(),test//': '//state%print())
         if (allocated(error)) return        
-        call check(error, all(abs(u-u_sol)<=tol) .or. all(abs(u+u_sol)<=tol), test//': U')
+        call check(error, all(abs(abs(u)-abs(u_sol))<=tol), test//': U')
         if (allocated(error)) return                   
         call check(error, all(abs(s-s_sol)<=tol), test//': S')
         if (allocated(error)) return     
-        call check(error, all(abs(vt-vt_sol)<=tol) .or. all(abs(vt+vt_sol)<=tol), test//': V^T')
+        call check(error, all(abs(abs(vt)-abs(vt_sol))<=tol), test//': V^T')
         if (allocated(error)) return             
 
         !> [U, S, V^T]. Partial storage -> compare until k=2 columns of U rows of V^T
@@ -167,11 +167,11 @@ module test_linalg_svd
         test = '[U, S, V^T], partial storage'
         call check(error,state%ok(),test//': '//state%print())
         if (allocated(error)) return        
-        call check(error, all(abs(u(:,:2)-u_sol(:,:2))<=tol) .or. all(abs(u(:,:2)+u_sol(:,:2))<=tol), test//': U(:,:2)')
+        call check(error, all(abs(abs(u(:,:2))-abs(u_sol(:,:2)))<=tol), test//': U(:,:2)')
         if (allocated(error)) return                   
         call check(error, all(abs(s-s_sol)<=tol), test//': S')
         if (allocated(error)) return     
-        call check(error, all(abs(vt(:2,:)-vt_sol(:2,:))<=tol) .or. all(abs(vt(:2,:)+vt_sol(:2,:))<=tol), test//': V^T(:2,:)')
+        call check(error, all(abs(abs(vt(:2,:))-abs(vt_sol(:2,:)))<=tol), test//': V^T(:2,:)')
         if (allocated(error)) return           
 
     end subroutine test_svd_${ri}$