subroutine determ_projection_no_death() ! 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 DetBitOps, only: DetBitEQ use FciMCData, only: SemiStoch_Comms_Time use FciMCData, only: SemiStoch_Multiply_Time use Parallel_neci, only: MPIBarrier, MPIAllGatherV integer :: i, j, ierr, run, part_type do run = 1, size(cs_replicas) associate(rep => cs_replicas(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 ! Perform the multiplication. rep%partial_determ_vecs = 0.0_dp #ifdef CMPLX_ block integer :: r_pt, i_pt do i = 1, rep%determ_sizes(iProcIndex) do j = 1, rep%sparse_core_ham(i)%num_elements do r_pt = rep%min_part(), rep%max_part(), 2 i_pt = r_pt + 1 rep%partial_determ_vecs(r_pt, i) = rep%partial_determ_vecs(r_pt, i) & - Real(rep%sparse_core_ham(i)%elements(j)) & * rep%full_determ_vecs(r_pt, rep%sparse_core_ham(i)%positions(j)) & + Aimag(rep%sparse_core_ham(i)%elements(j)) & * rep%full_determ_vecs(i_pt, rep%sparse_core_ham(i)%positions(j)) rep%partial_determ_vecs(i_pt, i) = rep%partial_determ_vecs(i_pt, i) & - Aimag(rep%sparse_core_ham(i)%elements(j)) & * rep%full_determ_vecs(r_pt, rep%sparse_core_ham(i)%positions(j)) & - Real(rep%sparse_core_ham(i)%elements(j)) & * rep%full_determ_vecs(i_pt, rep%sparse_core_ham(i)%positions(j)) end do end do end do end block #else do i = 1, rep%determ_sizes(iProcIndex) do j = 1, rep%sparse_core_ham(i)%num_elements rep%partial_determ_vecs(:, i) = rep%partial_determ_vecs(:, i) & - rep%sparse_core_ham(i)%elements(j) & * rep%full_determ_vecs(:, rep%sparse_core_ham(i)%positions(j)) end do end do #endif ! Remove contribution from the diagonal elements, since the ! propagator has no diagonal. do i = 1, rep%determ_sizes(iProcIndex) rep%partial_determ_vecs(:, i) = rep%partial_determ_vecs(:, i) & + rep%core_ham_diag(i) & * rep%full_determ_vecs(:, i + rep%determ_displs(iProcIndex)) end do ! 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) if (tSkipRef(run) .and. DetBitEQ(CurrentDets(:, rep%indices_of_determ_states(i)), & iLutRef(:, run), nIfD)) then rep%partial_determ_vecs(:, i) = 0.0_dp end if end do end if call halt_timer(SemiStoch_Multiply_Time) end associate end do end subroutine determ_projection_no_death