subroutine HistNatOrbEvalues()
use LoggingData, only: tTruncRODump
use RotateOrbsData, only: CoeffT1, EvaluesTrunc
integer :: i, k, a, b, NoOcc, io1, io2
real(dp) :: EvalueEnergies(1:NoOrbs), OrbEnergies(1:NoOrbs)
real(dp) :: SumEvalues
io1 = get_free_unit()
NoOcc = NEl / 2 ! Is this correct in all cases?!
open(io1, file='EVALUES-PLOTRAT', status='unknown')
if (tStoreSpinOrbs) then
k = 0
do i = 1, SpatOrbs
k = k + 2
write(io1, '(F20.10,ES20.10)') real(k - 1, dp) / real(NoOrbs, dp), Evalues(i)
write(io1, '(F20.10,ES20.10)') real(k, dp) / real(NoOrbs, dp), Evalues(SpatOrbs + i)
end do
else if (tRotateOccOnly) then
k = 0
do i = 1, NoOcc
k = k + 1
write(io1, '(F20.10,ES20.10)') real(k, dp) / real(NoOcc, dp), Evalues(i)
end do
else if (tRotateVirtOnly) then
k = NoOcc
do i = NoOcc + 1, NoOrbs
k = k + 1
write(io1, '(F20.10,ES20.10)') real(k - NoOcc, dp) / real(NoOrbs - NoOcc, dp), Evalues(i)
end do
else
k = 0
do i = 1, SpatOrbs
k = k + 1
write(io1, '(F20.10,ES20.10)') real(k, dp) / real(NoOrbs, dp), Evalues(i)
end do
end if
close(io1)
! Want to write out the eigenvectors in order of the energy of the new
! orbitals - so that we can see the occupations of the type of orbital.
! For now, keep this separate to the transformation of ARR - even
! though it is equivalent.
OrbEnergies(:) = 0.0_dp
EvalueEnergies(:) = 0.0_dp
SumEvalues = 0.0_dp
do i = 1, NoOrbs
if (tStoreSpinOrbs) then
SumEvalues = SumEvalues + Evalues(i)
else
SumEvalues = SumEvalues + (2 * Evalues(i))
end if
if (tTruncRODump) then
EvalueEnergies(i) = EvaluesTrunc(i)
else
EvalueEnergies(i) = Evalues(i)
end if
! We are only interested in the diagonal elements.
do a = 1, NoOrbs
b = SymLabelList2_rot(a)
if (tStoreSpinOrbs) then
OrbEnergies(i) = OrbEnergies(i) + (CoeffT1(a, i) * ARR(b, 2) * CoeffT1(a, i))
else
OrbEnergies(i) = OrbEnergies(i) + (CoeffT1(a, i) * ARR(2 * b, 2) * CoeffT1(a, i))
end if
end do
end do
! ARR(:,1) - ordered by energy, ARR(:,2) - ordered by spin-orbital
! index.
call sort(orbEnergies(1:noOrbs), EvalueEnergies(1:noOrbs))
io2 = get_free_unit()
open(io2, file='EVALUES-ENERGY', status='unknown')
do i = 1, NoOrbs
write(io2, *) OrbEnergies(NoOrbs - i + 1), EvalueEnergies(NoOrbs - i + 1)
end do
write(io2, *) 'The sum of the occupation numbers (eigenvalues) = ', SumEvalues
write(io2, *) 'The number of electrons = ', NEl
call neci_flush(io2)
close(io2)
call neci_flush(stdout)
call PrintOccTable()
end subroutine HistNatOrbEvalues