determ_projection_kp_hamil Subroutine

public subroutine determ_projection_kp_hamil(partial_vecs, full_vecs, rep)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(inout), allocatable :: partial_vecs(:,:)
real(kind=dp), intent(inout), allocatable :: full_vecs(:,:)
type(core_space_t), intent(inout) :: rep

Contents


Source Code

    subroutine determ_projection_kp_hamil(partial_vecs, full_vecs, rep)

        use FciMCData, only: SemiStoch_Comms_Time, SemiStoch_Multiply_Time
        use Parallel_neci, only: MPIBarrier, MPIAllGatherV

        real(dp), allocatable, intent(inout) :: partial_vecs(:, :)
        real(dp), allocatable, intent(inout) :: full_vecs(:, :)
        type(core_space_t), intent(inout) :: rep

        integer :: i, j, ierr, run

        call MPIBarrier(ierr)

        call set_timer(SemiStoch_Comms_Time)

        call MPIAllGatherV(partial_vecs, full_vecs, rep%determ_sizes, rep%determ_displs)

        call halt_timer(SemiStoch_Comms_Time)

        call MPIBarrier(ierr)

        call set_timer(SemiStoch_Multiply_Time)

        if (rep%determ_sizes(iProcIndex) >= 1) then
            ! Start with this because sparse_core_hamil has Hii taken off, but actually we
            ! don't want the projected Hamiltonian to be relative to the HF determinant.
            partial_vecs = Hii * full_vecs(:, rep%determ_displs(iProcIndex) + 1: &
                                           rep%determ_displs(iProcIndex) + rep%determ_sizes(iProcIndex))

            do i = 1, rep%determ_sizes(iProcIndex)
                do j = 1, rep%sparse_core_ham(i)%num_elements
                    partial_vecs(:, i) = partial_vecs(:, i) &
                        + rep%sparse_core_ham(i)%elements(j) &
                         * full_vecs(:, rep%sparse_core_ham(i)%positions(j))
                end do
            end do
        end if

        call halt_timer(SemiStoch_Multiply_Time)

    end subroutine determ_projection_kp_hamil