determ_proj_approx Subroutine

    subroutine determ_proj_approx()

        ! This subroutine gathers together partial_determ_vecs from each processor so
        ! that the full vector for the whole deterministic space is stored on each processor.
        ! It then performs the deterministic multiplication of the projector on this full vector.

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

        integer :: i, j, ierr, run, part_type, c_run
        character(*), parameter :: t_r = "determ_proj_approx"

        if (.not. t_global_core_space) then
            call stop_all(t_r, "Cannot do approximate projection with core-space replicas")
        end if
        associate(rep => cs_replicas(core_run))
            call MPIBarrier(ierr)

            call set_timer(SemiStoch_Comms_Time)

            call MPIAllGatherV(rep%partial_determ_vecs, rep%full_determ_vecs, &
                               rep%determ_sizes, rep%determ_displs)

            call halt_timer(SemiStoch_Comms_Time)

            call set_timer(SemiStoch_Multiply_Time)

            if (rep%determ_sizes(iProcIndex) >= 1) then

                ! For the moment, we're only adding in these contributions when we need the energy
                ! This will need refinement if we want to continue with the option of inst vs true full RDMs
                ! (as in another CMO branch).

                ! Perform the multiplication.

                rep%partial_determ_vecs = 0.0_dp

#ifdef CMPLX_
                do i = 1, rep%determ_sizes(iProcIndex)
                    do j = 1, approx_ham(i)%num_elements
                        rep%partial_determ_vecs(min_pt, i) = rep%partial_determ_vecs(min_pt, i) &
                            - Real(approx_ham(i)%elements(j)) &
                             * rep%full_determ_vecs(min_pt, approx_ham(i)%positions(j)) &
                            + Aimag(approx_ham(i)%elements(j)) &
                             * rep%full_determ_vecs(max_pt, approx_ham(i)%positions(j))

                        rep%partial_determ_vecs(max_pt, i) = rep%partial_determ_vecs(max_pt, i) &
                            - Aimag(approx_ham(i)%elements(j)) &
                             * rep%full_determ_vecs(min_pt, approx_ham(i)%positions(j)) &
                            - Real(approx_ham(i)%elements(j)) &
                            * rep%full_determ_vecs(max_pt, approx_ham(i)%positions(j))
                    end do
                end do
#else
                do i = 1, rep%determ_sizes(iProcIndex)
                    do j = 1, approx_ham(i)%num_elements
                        rep%partial_determ_vecs(:, i) = rep%partial_determ_vecs(:, i) &
                            - approx_ham(i)%elements(j) * rep%full_determ_vecs(:, approx_ham(i)%positions(j))
                    end do
                end do
#endif

                ! Now add shift*full_determ_vecs to account for the shift, not stored in
                ! approx_ham.
#ifdef CMPLX_
                do i = 1, rep%determ_sizes(iProcIndex)
                    do part_type = 1, lenof_sign
                        rep%partial_determ_vecs(part_type, i) = rep%partial_determ_vecs(part_type, i) &
                            + DiagSft(run) * rep%full_determ_vecs(part_type, i + rep%determ_displs(iProcIndex))
                    end do
                end do
#else
                do i = 1, rep%determ_sizes(iProcIndex)
                    rep%partial_determ_vecs(:, i) = rep%partial_determ_vecs(:, i) &
                        + DiagSft * rep%full_determ_vecs(:, i + rep%determ_displs(iProcIndex))
                end do
#endif

                ! Now multiply the vector by tau to get the final projected vector.
                rep%partial_determ_vecs = rep%partial_determ_vecs * tau

                do i = 1, rep%determ_sizes(iProcIndex)
                    do part_type = 1, rep_size
                        if (tSkipRef(run) .and. DetBitEQ(CurrentDets(:, rep%indices_of_determ_states(i)), &
                            iLutRef(:, run), nIfD)) then
                            rep%partial_determ_vecs(part_type, i) = 0.0_dp
                        end if
                    end do
                end do
            end if

            call halt_timer(SemiStoch_Multiply_Time)
        end associate

    end subroutine determ_proj_approx