Absorb entries with repeated frozen orbitals into the corresponding lower-order terms.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=dp), | intent(inout) | :: | matel | |||
| integer(kind=int64), | intent(in) | :: | indices(num_inds) |
subroutine add_core_en(matel, indices) HElement_t(dp), intent(inout) :: matel integer(int64), intent(in) :: indices(num_inds) integer :: counts integer(int64) :: idx(num_ex), ct real(dp) :: prefactor, delta integer(MPIArg) :: ierr if(t_freeze(indices)) then ! Count the number of different indices appearing counts = count_frozen_inds(indices) ! How many pairs of frozen orbitals do we have select case(counts) ! 1 => double excitation case(1) idx = frozen_double_entry(indices, prefactor) ! There are up to eight potential double excitations with four given indices ! to which the LMat entry contributes - this is because LMat is hermitian ! but UMat is not do ct = 1, num_ex ! If the index is assigned, there is a duplicate frozen orb if(idx(ct) > 0) then ! Absorb the matrix element into UMat (with the corresponding prefactor ! according to permutation and number of possible spin terms ! UMat(idx(ct)) = UMat(idx(ct)) + prefactor*matel delta = prefactor * matel ! Use a remote update of UMat call MPI_Accumulate(delta, 1, MPI_DOUBLE_PRECISION, 0, & idx(ct) - 1, 1, MPI_DOUBLE_PRECISION, MPI_SUM, umat_win, ierr) ! Flush the RMA operation: ! This calls synchronize RMA operations (MPI_Get, MPI_Put or MPI_Accumulate) call MPI_Win_flush(0, umat_win) endif end do ! 2 => single excitation case(2) idx(1:2) = frozen_single_entry(indices, prefactor) if(idx(1) > 0) then ! Absorb the matrix element into TMat ! TMat2D is indexed with spin orbs call add_to_tmat(spatToSpinAlpha(idx(1)), spatToSpinAlpha(idx(2))) call add_to_tmat(spatToSpinBeta(idx(1)), spatToSpinBeta(idx(2))) endif ! 3 => diagonal element case(3) call frozen_diagonal_entry(indices, prefactor) ECore_local = ECore_local + prefactor * matel end select ! Zero the matrix element for further usage (i.e. will not turn up anymore) matel = 0.0_dp endif contains subroutine add_to_tmat(ind1, ind2) integer(int64), intent(in) :: ind1, ind2 TMat_local(ind1, ind2) = TMat_local(ind1, ind2) + prefactor * matel ! TMat is hermitian, as is the 3-body term if(ind1 /= ind2) & TMat_local(ind2, ind1) = TMat_local(ind2, ind1) + prefactor * matel end subroutine add_to_tmat end subroutine add_core_en