Second fill SymLabelCounts2_rot. - the first 8 places of SymLabelCounts2_rot(1,:) and SymLabelCounts2_rot(2,:) refer to the occupied orbitals - and the second 8 to the virtuals.
subroutine InitOrbitalSeparation()
! This subroutine is called if the SEPARATEOCCVIRT keyword is present in the input, it sets up SymLabelList2_rot so that the first
! NoOcc orbitals are the HF occupied, and the rest the virtual. Within this separation, orbitals are ordered in symmetry
! groups.
! This means that two iterations of the rotate orbs routine will be performed, the first treats the occupied orbitals and the second
! the virtual.
integer :: i, j, ierr, SymCurr, Symi
integer(TagIntType) :: SymVirtOrbsTag, SymOccOrbsTag
integer :: lo, hi
integer, allocatable :: SymVirtOrbs(:), SymOccOrbs(:)
character(len=*), parameter :: this_routine = 'InitOrbitalSeparation'
allocate(SymLabelCounts2_rot(2, 16), stat=ierr)
call LogMemAlloc('SymLabelCounts2_rot', 2 * 16, 4, this_routine, SymLabelCounts2_rotTag, ierr)
SymLabelCounts2_rot(:, :) = 0
! first 8 refer to the occupied, and the second to the virtual.
allocate(LabVirtOrbs(NoOrbs - NoOcc), stat=ierr)
call LogMemAlloc('LabVirtOrbs', (NoOrbs - NoOcc), 4, this_routine, LabVirtOrbsTag, ierr)
LabVirtOrbs(:) = 0
allocate(LabOccOrbs(NoOcc), stat=ierr)
call LogMemAlloc('LabOccOrbs', (NoOcc), 4, this_routine, LabOccOrbsTag, ierr)
LabOccOrbs(:) = 0
allocate(SymVirtOrbs(NoOrbs - NoOcc), stat=ierr)
call LogMemAlloc('SymVirtOrbs', (NoOrbs - NoOcc), 4, this_routine, SymVirtOrbsTag, ierr)
SymVirtOrbs(:) = 0
allocate(SymOccOrbs(NoOcc), stat=ierr)
call LogMemAlloc('SymOccOrbs', (NoOcc), 4, this_routine, SymOccOrbsTag, ierr)
SymOccOrbs(:) = 0
! First fill SymLabelList2_rot.
! This picks out the NoOcc lowest energy orbitals from BRR as these will be the occupied.
! these are then ordered according to symmetry, and the same done to the virtual.
do i = 1, NoOcc
if (tStoreSpinOrbs) then
LabOccOrbs(i) = BRR(i)
SymOccOrbs(i) = int(G1(LabOccOrbs(i))%sym%S)
else
LabOccOrbs(i) = (BRR(2 * i)) / 2
SymOccOrbs(i) = int(G1(LabOccOrbs(i) * 2)%sym%S)
end if
end do
call sort(SymOccOrbs, LabOccOrbs)
! Sorts LabOrbs according to the order of SymOccOrbs (i.e. in terms of symmetry).
do i = 1, NoOrbs - NoOcc
if (tStoreSpinOrbs) then
LabVirtOrbs(i) = BRR(i + NEl)
SymVirtOrbs(i) = int(G1(LabVirtOrbs(i))%sym%S)
else
LabVirtOrbs(i) = (BRR((2 * i) + NEl)) / 2
SymVirtOrbs(i) = int(G1(LabVirtOrbs(i) * 2)%sym%S)
end if
end do
call sort(SymVirtOrbs, LabVirtOrbs)
! SymLabelList2_rot is then filled with the symmetry ordered occupied then virtual arrays.
do i = 1, NoOcc
SymLabelList2_rot(i) = LabOccOrbs(i)
end do
j = 0
do i = NoOcc + 1, NoOrbs
j = j + 1
SymLabelList2_rot(i) = LabVirtOrbs(j)
end do
!************
! Second fill SymLabelCounts2_rot.
! - the first 8 places of SymLabelCounts2_rot(1,:) and SymLabelCounts2_rot(2,:) refer to the occupied orbitals
! - and the second 8 to the virtuals.
if (lNoSymmetry) then
! if we are ignoring symmetry, all orbitals essentially have symmetry 0.
SymLabelCounts2_rot(1, 1) = 1
SymLabelCounts2_rot(1, 9) = NoOcc + 1
SymLabelCounts2_rot(2, 1) = NoOcc
SymLabelCounts2_rot(2, 9) = NoOrbs - NoOcc
else
! otherwise we run through the occupied orbitals, counting the number with each symmetry
! and noting where in SymLabelList2_rot each symmetry block starts.
SymCurr = 0
SymLabelCounts2_rot(1, 1) = 1
do i = 1, NoOcc
if (tStoreSpinOrbs) then
Symi = int(G1(SymLabelList2_rot(i))%sym%S)
else
Symi = int(G1(SymLabelList2_rot(i) * 2)%sym%S)
end if
SymLabelCounts2_rot(2, (Symi + 1)) = SymLabelCounts2_rot(2, (Symi + 1)) + 1
if (Symi > SymCurr) then
SymLabelCounts2_rot(1, (Symi + 1)) = i
SymCurr = Symi
end if
end do
! the same is then done for the virtuals.
SymCurr = 0
SymLabelCounts2_rot(1, 9) = NoOcc + 1
do i = NoOcc + 1, NoOrbs
if (tStoreSpinOrbs) then
Symi = int(G1(SymLabelList2_rot(i))%sym%S)
else
Symi = int(G1(SymLabelList2_rot(i) * 2)%sym%S)
end if
SymLabelCounts2_rot(2, (Symi + 9)) = SymLabelCounts2_rot(2, (Symi + 9)) + 1
if (Symi > SymCurr) then
SymLabelCounts2_rot(1, (Symi + 9)) = i
SymCurr = Symi
end if
end do
end if
! Go through each symmetry group, making sure the orbital pairs are ordered lowest to highest.
do i = 1, 16
if (SymLabelCounts2_rot(2, i) /= 0) then
lo = SymLabelCounts2_rot(1, i)
hi = lo + SymLabelCounts2_rot(2, i) - 1
call sort(SymLabelList2_rot(lo:hi))
end if
end do
! Deallocate the arrays just used in this routine.
deallocate(LabOccOrbs)
call LogMemDealloc(this_routine, LabOccOrbsTag)
deallocate(LabVirtOrbs)
call LogMemDealloc(this_routine, LabVirtOrbsTag)
deallocate(SymOccOrbs)
call LogMemDealloc(this_routine, SymOccOrbsTag)
deallocate(SymVirtOrbs)
call LogMemDealloc(this_routine, SymVirtOrbsTag)
end subroutine InitOrbitalSeparation