add a LAPACK w/o pivoting example for DGTSV

NCAR · Oct 20, 2023 · 7dba4b5 · 7dba4b5
1 parent df689b4
commit 7dba4b5
Show file tree

Hide file tree

Showing 5 changed files with 398 additions and 3 deletions.
diff --git a/src/linear_algebras/CMakeLists.txt b/src/linear_algebras/CMakeLists.txt
@@ -7,4 +7,5 @@ target_sources(tuvx_object
     linpack.F90
 )
 
+add_subdirectory(lapack_nopivot)
 ################################################################################
diff --git a/src/linear_algebras/lapack.F90 b/src/linear_algebras/lapack.F90
@@ -211,7 +211,14 @@ function tridiag( this, a, b, c, r ) result( u )
     !
 
     use musica_assert,                 only : assert_msg
+    !!!!!!!!!!!!!!!!!!!!!!!!
+    ! LAPACK with pivoting !
+    !!!!!!!!!!!!!!!!!!!!!!!!
     external :: dgtsv
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! LAPACK without pivoting !
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!
+!    external :: dgtsv_nopivot
 
     class(linear_algebra_lapack_t), intent(in) :: this
     real(dk),            intent(in) :: a(:) ! lower diagonal
@@ -223,12 +230,21 @@ function tridiag( this, a, b, c, r ) result( u )
     integer :: info
 
     u(:) = r(:)
+    !!!!!!!!!!!!!!!!!!!!!!!!
+    ! LAPACK with pivoting !
+    !!!!!!!!!!!!!!!!!!!!!!!!
     call dgtsv( size( b ), 1, a( 2 : size( a ) ), b, c( 1 : size( c ) - 1 ),  &
                 u, size( b ), info )
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!
+    ! LAPACK without pivoting !
+    !!!!!!!!!!!!!!!!!!!!!!!!!!!
+!    call dgtsv_nopivot( size( b ), 1, a( 2 : size( a ) ), b, c( 1 : size( c ) - 1 ),  &
+!                u, size( b ), info )
+
     call assert_msg(236877362, info == 0, "Tridiagonal solver failure")
 
   end function tridiag
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-end module tuvx_linear_algebra_lapack    
+end module tuvx_linear_algebra_lapack    
diff --git a/src/linear_algebras/lapack_nopivot/CMakeLists.txt b/src/linear_algebras/lapack_nopivot/CMakeLists.txt
@@ -0,0 +1,8 @@
+################################################################################
+# Linear algebra source
+
+target_sources(tuvx_object
+  PRIVATE
+    dgtsv.f
+)
+################################################################################