matrix_invsqrt Subroutine

public subroutine matrix_invsqrt(s, q, nbf, qrnk, tol)

Uses

  • proc~~matrix_invsqrt~~UsesGraph proc~matrix_invsqrt matrix_invsqrt module~eigen eigen proc~matrix_invsqrt->module~eigen module~messages messages proc~matrix_invsqrt->module~messages module~eigen->module~messages module~mathlib_types mathlib_types module~eigen->module~mathlib_types module~oqp_linalg oqp_linalg module~eigen->module~oqp_linalg module~precision precision module~eigen->module~precision comm_IOFILE comm_IOFILE module~messages->comm_IOFILE comm_PAR comm_PAR module~messages->comm_PAR module~io_constants io_constants module~messages->module~io_constants module~messages->module~precision module~blas_wrap blas_wrap module~oqp_linalg->module~blas_wrap module~lapack_wrap lapack_wrap module~oqp_linalg->module~lapack_wrap iso_fortran_env iso_fortran_env module~precision->iso_fortran_env module~blas_wrap->module~messages module~blas_wrap->module~mathlib_types module~blas_wrap->module~precision module~lapack_wrap->module~messages module~lapack_wrap->module~mathlib_types module~lapack_wrap->module~precision

@brief Compute matrix inverse square root using SVD and removing linear dependency @detail This subroutine is used to obtain set of canonical orbitals by diagonalization of the basis set overlap matrix Q = S^{-1/2}, Q^T * S * Q = I @param[in] s Overlap matrix, symmetric packed format @param[out] q Matrix inverse square root, square matrix @param[in] nbf Dimeension of matrices S and Q, basis set size @param[out] qrnk Rank of matrix Q @param[in] tol optional, tolerance to remove linear dependency, default = 1.0e-8

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(in) :: s(*)
real(kind=dp), intent(out) :: q(nbf,*)
integer, intent(in) :: nbf
integer, intent(out), optional :: qrnk
real(kind=dp), intent(in), optional :: tol

Calls

proc~~matrix_invsqrt~~CallsGraph proc~matrix_invsqrt matrix_invsqrt interface~show_message show_message proc~matrix_invsqrt->interface~show_message proc~diag_symm_packed diag_symm_packed proc~matrix_invsqrt->proc~diag_symm_packed proc~diag_symm_packed->interface~show_message dspev dspev proc~diag_symm_packed->dspev dspevx dspevx proc~diag_symm_packed->dspevx

Called by

proc~~matrix_invsqrt~~CalledByGraph proc~matrix_invsqrt matrix_invsqrt proc~guess_hcore guess_hcore proc~guess_hcore->proc~matrix_invsqrt proc~huckel_guess huckel_guess proc~huckel_guess->proc~matrix_invsqrt proc~scf_driver scf_driver proc~scf_driver->proc~matrix_invsqrt proc~guess_hcore_c guess_hcore_C proc~guess_hcore_c->proc~guess_hcore proc~guess_huckel guess_huckel proc~guess_huckel->proc~huckel_guess proc~hf_energy hf_energy proc~hf_energy->proc~scf_driver proc~guess_huckel_c guess_huckel_C proc~guess_huckel_c->proc~guess_huckel

Source Code

  subroutine matrix_invsqrt(s, q, nbf, qrnk, tol)
    use messages,  only: show_message, with_abort
    use eigen,     only: diag_symm_packed
    implicit none

    real(kind=dp), intent(in) :: s(*)
    real(kind=dp), intent(out) :: q(nbf,*)
    integer, intent(in) :: nbf
    real(kind=dp), optional, intent(in) :: tol
    integer, optional, intent(out) :: qrnk

    real(kind=dp), parameter :: deftol = 1.0d-08

    real(kind=dp), allocatable :: tmp(:), eig(:)
    real(kind=dp) :: rtol
    integer :: nbf2, ok, i, j

    rtol = deftol
    if (present(tol)) rtol = tol

    nbf2 = nbf*(nbf+1)/2

    allocate(tmp(nbf2), &
             eig(nbf), &
             stat=ok)
    if (ok/=0) call show_message('Cannot allocate memory', WITH_ABORT)

    tmp(:) = s(1:nbf2)

!   Compute SVD
    call diag_symm_packed(1, nbf, nbf, nbf, tmp, eig, q, ok)

!   Compute Q = S^{-1/2}, eliminating eigenvectors corresponding
!   to small eigenvalues
    j  = 0
    do i = 1, nbf
      if (eig(i) >= rtol) then
        j = j+1
        q(:,j) = q(:,i) / sqrt(eig(i))
      end if
    end do

    q(:,j+1:nbf) = 0

    if (present(qrnk)) qrnk = j

  end subroutine matrix_invsqrt