calc_overlap_matrix Subroutine

public subroutine calc_overlap_matrix(nvecs, krylov_array, array_len, s_matrix)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nvecs
integer(kind=n_int), intent(in) :: krylov_array(0:,:)
integer, intent(in) :: array_len
real(kind=dp), intent(out) :: s_matrix(:,:)

Contents

Source Code


Source Code

    subroutine calc_overlap_matrix(nvecs, krylov_array, array_len, s_matrix)

        integer, intent(in) :: nvecs
        integer(n_int), intent(in) :: krylov_array(0:, :)
        integer, intent(in) :: array_len
        real(dp), intent(out) :: s_matrix(:, :)

        integer :: idet, ivec, jvec, ind(nvecs)
        integer(n_int) :: int_sign(lenof_sign_kp)
        real(dp) :: real_sign_1(lenof_sign_kp), real_sign_2(lenof_sign_kp)

        ! Just in case!
        s_matrix(:, :) = 0.0_dp

        do jvec = 1, nvecs
            ! The first index of the sign in krylov_array, for each vector.
            ind(jvec) = nifd + lenof_sign_kp * (jvec - 1) + 1
        end do

        ! Loop over all determinants in the Krylov array.
        do idet = 1, array_len
            ! Loop over all Krylov vectors.
            do ivec = 1, nvecs
                int_sign = krylov_array(ind(ivec):ind(ivec) + lenof_sign_kp - 1, idet)
                real_sign_1 = transfer(int_sign, real_sign_1)
                if (IsUnoccDet(real_sign_1)) cycle

                do jvec = 1, ivec
                    int_sign = krylov_array(ind(jvec):ind(jvec) + lenof_sign_kp - 1, idet)
                    real_sign_2 = transfer(int_sign, real_sign_1)
                    if (IsUnoccDet(real_sign_2)) cycle

                    s_matrix(jvec, ivec) = s_matrix(jvec, ivec) + &
                                           (real_sign_1(kp_ind_1(1)) * real_sign_2(kp_ind_2(1)) + &
                                            real_sign_1(kp_ind_2(1)) * real_sign_2(kp_ind_1(1))) / 2.0_dp

                    ! Fill in the lower-half of the overlap matrix.
                    s_matrix(ivec, jvec) = s_matrix(jvec, ivec)
                end do
            end do
        end do

    end subroutine calc_overlap_matrix