subroutine OrderCoeffT1()
use RotateOrbsData, only: SymLabelList3_rot
use LoggingData, only: tTruncRODump
integer :: x, i, ierr, StartSort, EndSort, NoOcc
character(len=*), parameter :: t_r = 'OrderCoeffT1'
! Here, if symmetry is kept, we are going to have to reorder the
! eigenvectors according to the size of the eigenvalues, while taking
! the orbital labels (and therefore symmetries) with them. This will be
! put back into MP2VDM from MP2VDMTemp.
! Want to reorder the eigenvalues from largest to smallest, taking the
! eigenvectors with them and the symmetry as well. If using spin
! orbitals, do this for the alpha spin and then the beta.
OrderCoeff_Time%timer_name = 'OrderCoeff'
call set_timer(OrderCoeff_Time, 30)
if (tTruncRODump) then
! If we are truncating, the orbitals stay in this order, so we want
! to take their symmetries with them.
allocate(SymOrbs_rotTemp(NoOrbs), stat=ierr)
call LogMemAlloc('SymOrbs_rotTemp', NoOrbs, 4, t_r, SymOrbs_rotTempTag, ierr)
SymOrbs_rotTemp(:) = 0
if (tStoreSpinOrbs) then
do i = 1, NoOrbs
SymOrbs_rotTemp(i) = int(G1(SymLabelList2_rot(i))%sym%S, 4)
end do
else
do i = 1, NoOrbs
SymOrbs_rotTemp(i) = int(G1(SymLabelList2_rot(i) * 2)%sym%S, 4)
end do
end if
do x = 1, NoSpinCyc
if (x == 1) then
if (tSeparateOccVirt) then
if (tStoreSpinOrbs) then
NoOcc = nOccBeta
else
NoOcc = NEl / 2
end if
else
NoOcc = 0
end if
StartSort = 1
EndSort = SpatOrbs
if (tRotateVirtOnly) StartSort = NoOcc + 1
if (tRotateOccOnly) EndSort = NoOcc
else if (x == 2) then
if (tSeparateOccVirt) then
NoOcc = nOccAlpha
else
NoOcc = 0
end if
StartSort = SpatOrbs + 1
EndSort = NoOrbs
if (tRotateVirtOnly) StartSort = SpatOrbs + NoOcc + 1
if (tRotateOccOnly) EndSort = NoOcc + SpatOrbs
end if
call sort(Evalues(startSort:endSort), natOrbMat(startSort:endSort, startSort:endSort), &
SymOrbs_rotTemp(startSort:endSort))
end do
else
! If we are not truncating, the orbitals get put back into their
! original order, so the symmetry information is still correct,
! no need for the SymOrbs_rot array. Instead, just take the labels
! of SymLabelList3_rot with them.
do x = 1, NoSpinCyc
if (x == 1) then
if (tSeparateOccVirt) then
if (tStoreSpinOrbs) then
NoOcc = nOccBeta
else
NoOcc = NEl / 2
end if
else
NoOcc = 0
end if
StartSort = 1
EndSort = SpatOrbs
if (tRotateOccOnly) EndSort = NoOcc
if (tRotateVirtOnly) StartSort = NoOcc + 1
else if (x == 2) then
if (tSeparateOccVirt) then
NoOcc = nOccAlpha
else
NoOcc = 0
end if
StartSort = SpatOrbs + 1
EndSort = NoOrbs
if (tRotateOccOnly) EndSort = SpatOrbs + NoOcc
if (tRotateVirtOnly) StartSort = SpatOrbs + NoOcc + 1
end if
call sort(EValues(startSort:endSort), NatOrbMat(startSort:endSort, startSort:endSort), &
SymLabelList3_rot(startSort:endSort))
end do
end if
call halt_timer(OrderCoeff_Time)
write(stdout, *) 'Eigen-values: '
do i = 1, NoOrbs
write(stdout, *) Evalues(i)
end do
end subroutine OrderCoeffT1