Skip to content

Commit

Permalink
Merge pull request #98 from nekStab/fixed_sp_tests
Browse files Browse the repository at this point in the history 
Fixed the tests so that single precision no longer fails.
  • Loading branch information
@Simkern
Simkern authored Jun 17, 2024
2 parents 8bf79dc + d36dd4b commit aadd575
Show file tree
Hide file tree
Showing 7 changed files with 244 additions and 237 deletions.
40 changes: 24 additions & 16 deletions src/BaseKrylov.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2548,8 +2548,9 @@ subroutine lanczos_bidiagonalization_rsp(A, U, V, B, info, kstart, kend, verbosi

! Full re-orthogonalization of the right Krylov subspace.
if (k > 1 ) then
call orthogonalize_against_basis(V(k), V(1:k-1), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, &

call double_gram_schmidt_step(V(k), V(:k-1), info, if_chk_orthonormal=.false.)
call check_info(info, 'double_gram_schmidt_step', module=this_module, &
& procedure='lanczos_bidiagonalization_rsp, first pass')
end if

Expand All @@ -2566,7 +2567,7 @@ subroutine lanczos_bidiagonalization_rsp(A, U, V, B, info, kstart, kend, verbosi
call A%matvec(V(k), U(k+1))

! Full re-orthogonalization of the left Krylov subspace.
call orthogonalize_against_basis(U(k+1), U(1:k), info, if_chk_orthonormal=.false.)
call double_gram_schmidt_step(U(k+1), U(:k), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, &
& procedure='lanczos_bidiagonalization_rsp, second pass')

Expand Down Expand Up @@ -2631,8 +2632,9 @@ subroutine lanczos_bidiagonalization_rdp(A, U, V, B, info, kstart, kend, verbosi

! Full re-orthogonalization of the right Krylov subspace.
if (k > 1 ) then
call orthogonalize_against_basis(V(k), V(1:k-1), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, &

call double_gram_schmidt_step(V(k), V(:k-1), info, if_chk_orthonormal=.false.)
call check_info(info, 'double_gram_schmidt_step', module=this_module, &
& procedure='lanczos_bidiagonalization_rdp, first pass')
end if

Expand All @@ -2649,7 +2651,7 @@ subroutine lanczos_bidiagonalization_rdp(A, U, V, B, info, kstart, kend, verbosi
call A%matvec(V(k), U(k+1))

! Full re-orthogonalization of the left Krylov subspace.
call orthogonalize_against_basis(U(k+1), U(1:k), info, if_chk_orthonormal=.false.)
call double_gram_schmidt_step(U(k+1), U(:k), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, &
& procedure='lanczos_bidiagonalization_rdp, second pass')

Expand Down Expand Up @@ -2714,8 +2716,9 @@ subroutine lanczos_bidiagonalization_csp(A, U, V, B, info, kstart, kend, verbosi

! Full re-orthogonalization of the right Krylov subspace.
if (k > 1 ) then
call orthogonalize_against_basis(V(k), V(1:k-1), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, &

call double_gram_schmidt_step(V(k), V(:k-1), info, if_chk_orthonormal=.false.)
call check_info(info, 'double_gram_schmidt_step', module=this_module, &
& procedure='lanczos_bidiagonalization_csp, first pass')
end if

Expand All @@ -2732,7 +2735,7 @@ subroutine lanczos_bidiagonalization_csp(A, U, V, B, info, kstart, kend, verbosi
call A%matvec(V(k), U(k+1))

! Full re-orthogonalization of the left Krylov subspace.
call orthogonalize_against_basis(U(k+1), U(1:k), info, if_chk_orthonormal=.false.)
call double_gram_schmidt_step(U(k+1), U(:k), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, &
& procedure='lanczos_bidiagonalization_csp, second pass')

Expand Down Expand Up @@ -2797,8 +2800,9 @@ subroutine lanczos_bidiagonalization_cdp(A, U, V, B, info, kstart, kend, verbosi

! Full re-orthogonalization of the right Krylov subspace.
if (k > 1 ) then
call orthogonalize_against_basis(V(k), V(1:k-1), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, &

call double_gram_schmidt_step(V(k), V(:k-1), info, if_chk_orthonormal=.false.)
call check_info(info, 'double_gram_schmidt_step', module=this_module, &
& procedure='lanczos_bidiagonalization_cdp, first pass')
end if

Expand All @@ -2815,7 +2819,7 @@ subroutine lanczos_bidiagonalization_cdp(A, U, V, B, info, kstart, kend, verbosi
call A%matvec(V(k), U(k+1))

! Full re-orthogonalization of the left Krylov subspace.
call orthogonalize_against_basis(U(k+1), U(1:k), info, if_chk_orthonormal=.false.)
call double_gram_schmidt_step(U(k+1), U(:k), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, &
& procedure='lanczos_bidiagonalization_cdp, second pass')

Expand Down Expand Up @@ -2862,6 +2866,7 @@ subroutine lanczos_tridiagonalization_rsp(A, X, T, info, kstart, kend, verbosity
k_end = optval(kend, kdim)
verbose = optval(verbosity, .false.)
tolerance = optval(tol, atol_sp)
info = 0

! Lanczos tridiagonalization.
lanczos: do k = k_start, k_end
Expand Down Expand Up @@ -2903,7 +2908,7 @@ subroutine update_tridiag_matrix_rsp(T, X, k)
enddo

! Full re-orthogonalization against existing basis
call orthogonalize_against_basis(X(k+1), X(1:k), info, if_chk_orthonormal=.false.)
call double_gram_schmidt_step(X(k+1), X(:k), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, procedure='update_tridiag_matrix_rsp')

return
Expand Down Expand Up @@ -2932,6 +2937,7 @@ subroutine lanczos_tridiagonalization_rdp(A, X, T, info, kstart, kend, verbosity
k_end = optval(kend, kdim)
verbose = optval(verbosity, .false.)
tolerance = optval(tol, atol_dp)
info = 0

! Lanczos tridiagonalization.
lanczos: do k = k_start, k_end
Expand Down Expand Up @@ -2973,7 +2979,7 @@ subroutine update_tridiag_matrix_rdp(T, X, k)
enddo

! Full re-orthogonalization against existing basis
call orthogonalize_against_basis(X(k+1), X(1:k), info, if_chk_orthonormal=.false.)
call double_gram_schmidt_step(X(k+1), X(:k), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, procedure='update_tridiag_matrix_rdp')

return
Expand Down Expand Up @@ -3002,6 +3008,7 @@ subroutine lanczos_tridiagonalization_csp(A, X, T, info, kstart, kend, verbosity
k_end = optval(kend, kdim)
verbose = optval(verbosity, .false.)
tolerance = optval(tol, atol_sp)
info = 0

! Lanczos tridiagonalization.
lanczos: do k = k_start, k_end
Expand Down Expand Up @@ -3043,7 +3050,7 @@ subroutine update_tridiag_matrix_csp(T, X, k)
enddo

! Full re-orthogonalization against existing basis
call orthogonalize_against_basis(X(k+1), X(1:k), info, if_chk_orthonormal=.false.)
call double_gram_schmidt_step(X(k+1), X(:k), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, procedure='update_tridiag_matrix_csp')

return
Expand Down Expand Up @@ -3072,6 +3079,7 @@ subroutine lanczos_tridiagonalization_cdp(A, X, T, info, kstart, kend, verbosity
k_end = optval(kend, kdim)
verbose = optval(verbosity, .false.)
tolerance = optval(tol, atol_dp)
info = 0

! Lanczos tridiagonalization.
lanczos: do k = k_start, k_end
Expand Down Expand Up @@ -3113,7 +3121,7 @@ subroutine update_tridiag_matrix_cdp(T, X, k)
enddo

! Full re-orthogonalization against existing basis
call orthogonalize_against_basis(X(k+1), X(1:k), info, if_chk_orthonormal=.false.)
call double_gram_schmidt_step(X(k+1), X(:k), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, procedure='update_tridiag_matrix_cdp')

return
Expand Down
10 changes: 6 additions & 4 deletions src/BaseKrylov.fypp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -773,8 +773,9 @@ contains

! Full re-orthogonalization of the right Krylov subspace.
if (k > 1 ) then
call orthogonalize_against_basis(V(k), V(1:k-1), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, &

call double_gram_schmidt_step(V(k), V(:k-1), info, if_chk_orthonormal=.false.)
call check_info(info, 'double_gram_schmidt_step', module=this_module, &
& procedure='lanczos_bidiagonalization_${type[0]}$${kind}$, first pass')
end if

Expand All @@ -791,7 +792,7 @@ contains
call A%matvec(V(k), U(k+1))

! Full re-orthogonalization of the left Krylov subspace.
call orthogonalize_against_basis(U(k+1), U(1:k), info, if_chk_orthonormal=.false.)
call double_gram_schmidt_step(U(k+1), U(:k), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, &
& procedure='lanczos_bidiagonalization_${type[0]}$${kind}$, second pass')

Expand Down Expand Up @@ -844,6 +845,7 @@ contains
k_end = optval(kend, kdim)
verbose = optval(verbosity, .false.)
tolerance = optval(tol, atol_${kind}$)
info = 0

! Lanczos tridiagonalization.
lanczos: do k = k_start, k_end
Expand Down Expand Up @@ -885,7 +887,7 @@ contains
enddo

! Full re-orthogonalization against existing basis
call orthogonalize_against_basis(X(k+1), X(1:k), info, if_chk_orthonormal=.false.)
call double_gram_schmidt_step(X(k+1), X(:k), info, if_chk_orthonormal=.false.)
call check_info(info, 'orthogonalize_against_basis', module=this_module, procedure='update_tridiag_matrix_${type[0]}$${kind}$')

return
Expand Down
Loading

0 comments on commit aadd575

Please sign in to comment.