Skip to content

Commit

Permalink
Added intermediate eigenvalue/singular value outputs for eigs, eigh, …
Browse files Browse the repository at this point in the history 
…svds.
  • Loading branch information
@Simkern
Simkern committed Feb 4, 2025
1 parent a83b74e commit 70977cb
Show file tree
Hide file tree
Showing 6 changed files with 250 additions and 40 deletions.
29 changes: 21 additions & 8 deletions src/IterativeSolvers/EIGHS/eighs.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
use stdlib_strings, only: padr
use stdlib_linalg, only: eigh
implicit none
character(len=*), parameter :: eighs_output = 'eighs_output.txt'
contains

!----- Utility functions -----
Expand Down Expand Up @@ -73,13 +74,15 @@ end function eigenvalue_residual_cdp
integer :: i, j, k, nev, conv
real(sp) :: tol
real(sp) :: beta
logical :: outpost
character(len=256) :: msg

if (time_lightkrylov()) call timer%start('eighs_rsp')
! Deaks with the optional args.
nev = size(X)
kdim_ = optval(kdim, 4*nev)
tol = optval(tolerance, rtol_sp)
kdim_ = optval(kdim, 4*nev)
tol = optval(tolerance, rtol_sp)
outpost = optval(write_intermediate, .false.)

! Allocate working variables.
allocate(Xwrk(kdim_+1), mold=X(1)) ; call zero_basis(Xwrk)
Expand Down Expand Up @@ -113,6 +116,7 @@ end function eigenvalue_residual_cdp
write(msg,'(I0,A,I0,A,I0,A)') conv, '/', nev, ' eigenvalues converged after ', k, &
& ' iterations of the Lanczos process.'
call log_information(msg, module=this_module, procedure='eighs_rsp')
if (outpost) call write_results_rsp(eighs_output, eigvals_wrk(:k), residuals_wrk(:k), tol)
if (conv >= nev) exit lanczos_iter
enddo lanczos_iter

Expand Down Expand Up @@ -163,13 +167,15 @@ end function eigenvalue_residual_cdp
integer :: i, j, k, nev, conv
real(dp) :: tol
real(dp) :: beta
logical :: outpost
character(len=256) :: msg

if (time_lightkrylov()) call timer%start('eighs_rdp')
! Deaks with the optional args.
nev = size(X)
kdim_ = optval(kdim, 4*nev)
tol = optval(tolerance, rtol_dp)
kdim_ = optval(kdim, 4*nev)
tol = optval(tolerance, rtol_dp)
outpost = optval(write_intermediate, .false.)

! Allocate working variables.
allocate(Xwrk(kdim_+1), mold=X(1)) ; call zero_basis(Xwrk)
Expand Down Expand Up @@ -203,6 +209,7 @@ end function eigenvalue_residual_cdp
write(msg,'(I0,A,I0,A,I0,A)') conv, '/', nev, ' eigenvalues converged after ', k, &
& ' iterations of the Lanczos process.'
call log_information(msg, module=this_module, procedure='eighs_rdp')
if (outpost) call write_results_rdp(eighs_output, eigvals_wrk(:k), residuals_wrk(:k), tol)
if (conv >= nev) exit lanczos_iter
enddo lanczos_iter

Expand Down Expand Up @@ -253,13 +260,15 @@ end function eigenvalue_residual_cdp
integer :: i, j, k, nev, conv
real(sp) :: tol
complex(sp) :: beta
logical :: outpost
character(len=256) :: msg

if (time_lightkrylov()) call timer%start('eighs_csp')
! Deaks with the optional args.
nev = size(X)
kdim_ = optval(kdim, 4*nev)
tol = optval(tolerance, rtol_sp)
kdim_ = optval(kdim, 4*nev)
tol = optval(tolerance, rtol_sp)
outpost = optval(write_intermediate, .false.)

! Allocate working variables.
allocate(Xwrk(kdim_+1), mold=X(1)) ; call zero_basis(Xwrk)
Expand Down Expand Up @@ -293,6 +302,7 @@ end function eigenvalue_residual_cdp
write(msg,'(I0,A,I0,A,I0,A)') conv, '/', nev, ' eigenvalues converged after ', k, &
& ' iterations of the Lanczos process.'
call log_information(msg, module=this_module, procedure='eighs_csp')
if (outpost) call write_results_rsp(eighs_output, eigvals_wrk(:k), residuals_wrk(:k), tol)
if (conv >= nev) exit lanczos_iter
enddo lanczos_iter

Expand Down Expand Up @@ -343,13 +353,15 @@ end function eigenvalue_residual_cdp
integer :: i, j, k, nev, conv
real(dp) :: tol
complex(dp) :: beta
logical :: outpost
character(len=256) :: msg

if (time_lightkrylov()) call timer%start('eighs_cdp')
! Deaks with the optional args.
nev = size(X)
kdim_ = optval(kdim, 4*nev)
tol = optval(tolerance, rtol_dp)
kdim_ = optval(kdim, 4*nev)
tol = optval(tolerance, rtol_dp)
outpost = optval(write_intermediate, .false.)

! Allocate working variables.
allocate(Xwrk(kdim_+1), mold=X(1)) ; call zero_basis(Xwrk)
Expand Down Expand Up @@ -383,6 +395,7 @@ end function eigenvalue_residual_cdp
write(msg,'(I0,A,I0,A,I0,A)') conv, '/', nev, ' eigenvalues converged after ', k, &
& ' iterations of the Lanczos process.'
call log_information(msg, module=this_module, procedure='eighs_cdp')
if (outpost) call write_results_rdp(eighs_output, eigvals_wrk(:k), residuals_wrk(:k), tol)
if (conv >= nev) exit lanczos_iter
enddo lanczos_iter

Expand Down
8 changes: 6 additions & 2 deletions src/IterativeSolvers/EIGHS/eighs.fypp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@ submodule (lightkrylov_iterativesolvers) hermitian_eigensolvers
use stdlib_strings, only: padr
use stdlib_linalg, only: eigh
implicit none
character(len=*), parameter :: eighs_output = 'eighs_output.txt'
contains

!----- Utility functions -----
Expand Down Expand Up @@ -45,13 +46,15 @@ contains
integer :: i, j, k, nev, conv
real(${kind}$) :: tol
${type}$ :: beta
logical :: outpost
character(len=256) :: msg

if (time_lightkrylov()) call timer%start('eighs_${type[0]}$${kind}$')
! Deaks with the optional args.
nev = size(X)
kdim_ = optval(kdim, 4*nev)
tol = optval(tolerance, rtol_${kind}$)
kdim_ = optval(kdim, 4*nev)
tol = optval(tolerance, rtol_${kind}$)
outpost = optval(write_intermediate, .false.)

! Allocate working variables.
allocate(Xwrk(kdim_+1), mold=X(1)) ; call zero_basis(Xwrk)
Expand Down Expand Up @@ -85,6 +88,7 @@ contains
write(msg,'(I0,A,I0,A,I0,A)') conv, '/', nev, ' eigenvalues converged after ', k, &
& ' iterations of the Lanczos process.'
call log_information(msg, module=this_module, procedure='eighs_${type[0]}$${kind}$')
if (outpost) call write_results_r${kind}$(eighs_output, eigvals_wrk(:k), residuals_wrk(:k), tol)
if (conv >= nev) exit lanczos_iter
enddo lanczos_iter

Expand Down
Loading

0 comments on commit 70977cb

Please sign in to comment.