subroutine finalise_1e_rdm(rdm_defs, one_rdms, norm_1rdm)
! This routine takes the 1-RDM (matrix), sums it across processors,
! normalises it, makes it hermitian, and prints out the 'popsfile'
! 1-RDM, i.e. the 1-RDM before it is normalised or made Hermitian.
use LoggingData, only: twrite_RDMs_to_read, tForceCauchySchwarz
use LoggingData, only: RDMExcitLevel
use Parallel_neci, only: iProcIndex, MPISumAll
use rdm_data, only: rdm_definitions_t, one_rdm_t
use RotateOrbsData, only: NoOrbs
type(rdm_definitions_t), intent(in) :: rdm_defs
type(one_rdm_t), intent(inout) :: one_rdms(:)
real(dp), intent(out) :: norm_1rdm(size(one_rdms))
integer :: irdm, ierr
real(dp) :: SumN_Rho_ii(size(one_rdms))
real(dp), allocatable :: AllNode_one_rdm(:, :)
if (RDMExcitLevel == 1) then
allocate(AllNode_one_rdm(NoOrbs, NoOrbs), stat=ierr)
do irdm = 1, size(one_rdms)
call MPISumAll(one_rdms(irdm)%matrix, AllNode_one_rdm)
one_rdms(irdm)%matrix = AllNode_one_rdm
end do
deallocate(AllNode_one_rdm)
end if
! Find the normalisation.
call calc_1e_norms(rdm_defs, one_rdms, norm_1rdm)
if (iProcIndex == 0) then
do irdm = 1, size(one_rdms)
! Write out the unnormalised, non-hermitian OneRDM_POPS.
if (twrite_RDMs_to_read) call write_1rdm(rdm_defs, one_rdms(irdm)%matrix, irdm, norm_1rdm(irdm), .false.)
end do
if (RDMExcitLevel == 1) then
! Only non-transition RDMs should be hermitian and obey the
! Cauchy-Schwarz inequality.
do irdm = 1, rdm_defs%nrdms_standard
call make_1e_rdm_hermitian(one_rdms(irdm)%matrix, norm_1rdm(irdm))
if (tForceCauchySchwarz) call Force_Cauchy_Schwarz(one_rdms(irdm)%matrix)
end do
end if
end if
end subroutine finalise_1e_rdm