InitOrbitalSeparation Subroutine

public subroutine InitOrbitalSeparation()


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.

Arguments

None

Contents

Source Code


Source Code

    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