doubles_search_guga Subroutine

private subroutine doubles_search_guga(recvcounts, recvdisps)

Arguments

Type IntentOptional Attributes Name
integer(kind=MPIArg), intent(in) :: recvcounts(nProcessors)
integer(kind=MPIArg), intent(in) :: recvdisps(nProcessors)

Contents

Source Code


Source Code

    subroutine doubles_search_guga(recvcounts, recvdisps)
        ! this is the adapted explicit doubles search for the
        ! GUGA-RDMs.
        integer(MPIArg), intent(in) :: recvcounts(nProcessors), recvdisps(nProcessors)

        integer :: i, NoDets, StartDets, nJ(nel), PartInd, FlagsDj
        integer :: j, a, b, c, d
        integer(int_rdm) :: rdm_ind
        integer(n_int) :: ilutJ(0:GugaBits%len_tot), ilutI(0:GugaBits%len_tot)
        real(dp) :: mat_ele, sign_i(lenof_sign), sign_j(lenof_sign)
        logical :: tDetFound

        do i = 1, nProcessors

            NoDets = recvcounts(i) / (GugaBits%len_tot + 1)
            StartDets = (recvdisps(i) / (GugaBits%len_tot + 1)) + 1

            if (NoDets > 1) then

                ilutI = Doub_ExcDjs2(:, StartDets)

                sign_i = extract_matrix_element(ilutI, 2)

                do j = StartDets + 1, (NoDets + StartDets - 1)

                    ilutJ = Doub_ExcDjs2(:, j)

                    call BinSearchParts_rdm(ilutJ, 1, int(TotWalkers), &
                                            PartInd, tDetFound)

                    if (tDetFound) then

                        call extract_bit_rep(CurrentDets(:, PartInd), nJ, sign_j, FlagsDj)

                        mat_ele = extract_matrix_element(ilutJ, 1)
                        rdm_ind = extract_rdm_ind(ilutJ)

                        call extract_2_rdm_ind(rdm_ind, a, b, c, d)

                        call add_to_rdm_spawn_t(two_rdm_spawn, a, b, c, d, &
                                                sign_i * sign_j * mat_ele, .true.)
                    end if
                end do
            end if
        end do

    end subroutine doubles_search_guga