store_parent_with_spawned Subroutine

public subroutine store_parent_with_spawned(RDMBiasFacCurr, WalkerNumber, iLutI, DetSpawningAttempts, iLutJ, procJ)

Arguments

Type IntentOptional Attributes Name
real(kind=dp), intent(in) :: RDMBiasFacCurr
integer, intent(in) :: WalkerNumber
integer(kind=n_int), intent(in) :: iLutI(0:niftot)
integer, intent(in) :: DetSpawningAttempts
integer(kind=n_int), intent(in) :: iLutJ(0:niftot)
integer, intent(in) :: procJ

Contents


Source Code

    subroutine store_parent_with_spawned(RDMBiasFacCurr, WalkerNumber, iLutI, &
                                         DetSpawningAttempts, iLutJ, procJ)

        ! We are spawning from iLutI to SpawnedParts(:,ValidSpawnedList(proc)).
        ! This routine stores the parent (D_i) with the spawned child (D_j) so
        ! that we can add in Ci.Cj to the RDM later on. The parent is nifd
        ! integers long, and stored in the second part of the SpawnedParts array
        ! from NIfTot+1 -> NIfTot+1 + nifd.

        use DetBitOps, only: DetBitEQ
        use FciMCData, only: SpawnedParts, ValidSpawnedList, TempSpawnedParts, &
                             TempSpawnedPartsInd
        use CalcData, only: tNonInitsForRDMs

        real(dp), intent(in) :: RDMBiasFacCurr
        integer, intent(in) :: WalkerNumber, procJ
        integer, intent(in) :: DetSpawningAttempts
        integer(n_int), intent(in) :: iLutI(0:niftot), iLutJ(0:niftot)
        logical :: tRDMStoreParent
        integer :: j

        if (abs(RDMBiasFacCurr) < 1.0e-12_dp) then
            ! If RDMBiasFacCurr is exactly zero, any contribution from Ci.Cj
            ! will be zero so it is not worth carrying on.
            call zero_parent(SpawnedParts(:, ValidSpawnedList(procJ)))
            ! in the case of non-variational rdms, we also require the parent
            ! to be an initiator -> only take non-initiators when the
            ! init-agnostic rdms are requested (tNonInitsForRDMs)
            return
        end if

        if (tNonInitsForRDMs .or. all_runs_are_initiator(ilutI)) then

            ! First we want to check if this Di.Dj pair has already been accounted for.
            ! This means searching the Dj's that have already been spawned from this Di, to make sure
            ! the new Dj being spawned on here is not the same.
            ! The Dj children spawned by the current Di are being stored in the array TempSpawnedParts,
            ! so that the reaccurance of a Di.Dj pair may be monitored.

            ! Store the Di parent with the spawned child, unless we find this Dj has already been spawned on.
            tRDMStoreParent = .true.

            ! Run through the Dj walkers that have already been spawned from this particular Di.
            ! If this is the first to be spawned from Di, TempSpawnedPartsInd will be zero, so we
            ! just wont run over anything.

            do j = 1, TempSpawnedPartsInd
                if (DetBitEQ(iLutJ(0:nifd), TempSpawnedParts(0:nifd, j), nifd)) then
                    ! If this Dj is found, we do not want to store the parent with this spawned walker.
                    tRDMStoreParent = .false.
                    exit
                end if
            end do

            if (tRDMStoreParent) then
                ! This is a new Dj that has been spawned from this Di.
                ! We want to store it in the temporary list of spawned parts which have come from this Di.
                if (WalkerNumber /= DetSpawningAttempts) then
                    ! Don't bother storing these if we're on the last walker, or if we only have one
                    ! walker on Di.
                    TempSpawnedPartsInd = TempSpawnedPartsInd + 1
                    TempSpawnedParts(0:nifd, TempSpawnedPartsInd) = iLutJ(0:nifd)
                end if

                ! We also want to make sure the parent Di is stored with this Dj.

                ! We need to carry with the child (and the parent), the sign of the parent.
                ! In actual fact this is the sign of the parent divided by the probability of generating
                ! that pair Di and Dj, to account for the
                ! fact that Di and Dj are not always added to the RDM, but only when Di spawns on Dj.
                ! This RDMBiasFacCurr factor is turned into an integer to pass around to the relevant processors.
                call encode_parent(SpawnedParts(:, ValidSpawnedList(procJ)), &
                                   ilutI, RDMBiasFacCurr)

            else
                ! This Di has already spawned on this Dj - don't store the Di parent with this child,
                ! so that the pair is not double counted.
                ! We are using the probability that Di spawns onto Dj *at least once*, so we don't want to
                ! double count this pair.
                call zero_parent(SpawnedParts(:, ValidSpawnedList(procJ)))
            end if
        else
            ! This Di is a non-initiator, and we specified to take only initiators into account
            call zero_parent(SpawnedParts(:, ValidSpawnedList(procJ)))
        end if

    end subroutine store_parent_with_spawned