Rotate2Orbs Subroutine

public subroutine Rotate2Orbs(i, j, trans_2orbs_coeffs, selfintorb1, selfintorb2, localdelocal)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: i
integer, intent(in) :: j
real(kind=dp), intent(inout), allocatable :: trans_2orbs_coeffs(:,:)
real(kind=dp), intent(inout) :: selfintorb1
real(kind=dp), intent(inout) :: selfintorb2
logical, intent(in) :: localdelocal

Contents

Source Code


Source Code

    subroutine Rotate2Orbs(i, j, trans_2orbs_coeffs, selfintorb1, selfintorb2, localdelocal)

        ! This routine takes two orbitals i,j, and rotates them in order to
        ! maximally localise these. It employs an Edminston-Ruedenberg type
        ! localisation which maximises the self-interaction
        ! \sum_{i=1}^{2} \sum_{r,s,u,v} (c_{ir})*(c_{is})*c_{iu}c_{iv} <p_{i}p_{i}|u|p_{i}p_{i}>
        ! where p_{i} are the original NOs.
        ! The coefficients c are given by the following matrix:
        ! c =  cos a  sin a
        !     -sin a  cos a
        ! Then angle a is found by differentiating and setting it equal to 0
        ! which gives the following analytical expression of the form
        ! tan a = -x/y
        ! where x and y are sums of the original NO four index integrals.

        use IntegralsData, only: umat
        use UMatCache, only: UMatInd

        real(dp), allocatable, intent(inout) :: trans_2orbs_coeffs(:, :)
        real(dp), intent(inout) :: selfintorb1, selfintorb2

        real(dp) :: alpha2(17)
        real(dp) :: selfinteractions(17)
        real(dp) :: coeffcos, coeffsin, maxint
        integer :: maxangle(1)
        integer :: indicesij(2)
        integer, intent(in) :: i, j
        integer :: l1, l2, l3, l4, l5
        logical, intent(in) :: localdelocal

        indicesij(1) = i
        indicesij(2) = j
        trans_2orbs_coeffs(:, :) = 0.0_dp

        ! Umat(UMatInd(i,j,k,l)) contains the four-index integrals
        ! <ij|kl> (physical notation) in the NO basis

        coeffcos = Umat(UmatInd(i, i, i, j)) + Umat(UmatInd(i, i, j, i)) + Umat(UmatInd(i, j, i, i)) &
            & - Umat(UmatInd(i, j, j, j)) + Umat(UmatInd(j, i, i, i)) - Umat(UmatInd(j, i, j, j)) &
            & - Umat(UmatInd(j, j, i, j)) - Umat(UmatInd(j, j, j, i))

        coeffsin = -Umat(UmatInd(i, i, i, i)) + Umat(UmatInd(i, i, j, j)) + Umat(UmatInd(i, j, i, j)) &
            & + Umat(UmatInd(i, j, j, i)) + Umat(UmatInd(j, i, i, j)) + Umat(UmatInd(j, i, j, i)) &
            & + Umat(UmatInd(j, j, i, i)) - Umat(UmatInd(j, j, j, j))

        ! atan return a value in [-pi/2,pi/2]
        ! because of the 4*alpha in the equation there are 8 distinct solutions
        ! i.e. in the range 0,2*pi
        ! i.e. possible solutions are separated by (2*pi/8)=pi/4
        ! for safety 16 solutions are evaluated.
        alpha2(9) = atan((-coeffcos / coeffsin))
        alpha2(9) = alpha2(9) / 4.0_dp
        do l1 = 8, 1, -1
            alpha2(l1) = alpha2(l1 + 1) - (pi / 4.0_dp)
        end do
        do l1 = 10, 17
            alpha2(l1) = alpha2(l1 - 1) + (pi / 4.0_dp)
        end do

        ! second derivatives to find maximum (necessary since the minimum, i.e. fully delocalised
        ! orbitals satisfy the same conditions
        !secondderiv(1) = (4.0_dp*coeffsin*cos(4.0_dp*alpha(1))) - (4.0_dp*coeffcos*sin(4.0_dp*alpha(1)))
        !secondderiv(2) = (4.0_dp*coeffsin*cos(4.0_dp*alpha(2))) - (4.0_dp*coeffcos*sin(4.0_dp*alpha(2)))

        ! Compute selfinteractions to check which one is largest.
        ! This is a better measure than the second derivatives.
        selfinteractions(:) = 0.0_dp

        do l1 = 1, 17
            trans_2orbs_coeffs(1, 1) = cos(alpha2(l1))
            trans_2orbs_coeffs(2, 1) = sin(alpha2(l1))
            trans_2orbs_coeffs(1, 2) = -sin(alpha2(l1))
            trans_2orbs_coeffs(2, 2) = cos(alpha2(l1))

            do l2 = 1, 2
                do l3 = 1, 2
                    do l4 = 1, 2
                        do l5 = 1, 2
                            selfinteractions(l1) = selfinteractions(l1) + trans_2orbs_coeffs(l2, 1)&
                                &* trans_2orbs_coeffs(l3, 1) *&
                                &trans_2orbs_coeffs(l4, 1) * trans_2orbs_coeffs(l5, 1) *&
                                &Umat(UmatInd(indicesij(l2), indicesij(l3), indicesij(l4), indicesij(l5)))
                        end do
                    end do
                end do
            end do
            do l2 = 1, 2
                do l3 = 1, 2
                    do l4 = 1, 2
                        do l5 = 1, 2
                            selfinteractions(l1) = selfinteractions(l1) + trans_2orbs_coeffs(l2, 2)&
                                &* trans_2orbs_coeffs(l3, 2) *&
                                &trans_2orbs_coeffs(l4, 2) * trans_2orbs_coeffs(l5, 2) *&
                                &Umat(UmatInd(indicesij(l2), indicesij(l3), indicesij(l4), indicesij(l5)))
                        end do
                    end do
                end do
            end do
        end do

        ! Choose the angle which maximises the self interactions.
        if (.not. localdelocal) then
            ! Maximally delocalised.
            maxangle = minloc(selfinteractions)
            maxint = minval(selfinteractions)
        else if (localdelocal) then
            ! Maximally localised.
            maxangle = maxloc(selfinteractions)
            maxint = maxval(selfinteractions)
        end if

        ! Return transformatin coefficients.
        trans_2orbs_coeffs(1, 1) = cos(alpha2(maxangle(1)))
        trans_2orbs_coeffs(2, 1) = sin(alpha2(maxangle(1)))
        trans_2orbs_coeffs(1, 2) = -sin(alpha2(maxangle(1)))
        trans_2orbs_coeffs(2, 2) = cos(alpha2(maxangle(1)))

        ! New self-interactions for transformed orbitals.
        selfintorb1 = 0.0_dp
        selfintorb2 = 0.0_dp

        do l2 = 1, 2
            do l3 = 1, 2
                do l4 = 1, 2
                    do l5 = 1, 2
                        selfintorb1 = selfintorb1 + trans_2orbs_coeffs(l2, 1)&
                            &* trans_2orbs_coeffs(l3, 1) *&
                            &trans_2orbs_coeffs(l4, 1) * trans_2orbs_coeffs(l5, 1) *&
                            &Umat(UmatInd(indicesij(l2), indicesij(l3), indicesij(l4), indicesij(l5)))

                        selfintorb2 = selfintorb2 + trans_2orbs_coeffs(l2, 2)&
                            &* trans_2orbs_coeffs(l3, 2) *&
                            &trans_2orbs_coeffs(l4, 2) * trans_2orbs_coeffs(l5, 2) *&
                            &Umat(UmatInd(indicesij(l2), indicesij(l3), indicesij(l4), indicesij(l5)))
                    end do
                end do
            end do
        end do

    end subroutine Rotate2Orbs