PrintOrbOccs Subroutine

public subroutine PrintOrbOccs(OrbOccs)


Type IntentOptional Attributes Name
real(kind=dp) :: OrbOccs(nBasis)


Source Code

Source Code

    subroutine PrintOrbOccs(OrbOccs)

        ! This routine takes whatever orbital basis we're using and is called
        ! at the end of a spawn to find the contribution of each orbital to the
        ! final wavefunction. This is done by histogramming the determinant
        ! populations, and then running over these adding the  coefficients of
        ! each determinant to the orbitals occupied. This is essentially
        ! < Psi | a_p+ a_p | Psi > - the diagonal terms of the one electron
        ! reduced density matrix.

        real(dp) :: Norm, OrbOccs(nBasis), AllOrbOccs(nBasis)
        integer :: i, iunit
        logical :: tWarning

        AllOrbOccs = 0.0_dp

        call MPIReduce(OrbOccs, MPI_SUM, AllOrbOccs)

        ! Want to normalise the orbital contributions for convenience.
        tWarning = .false.
        if (iProcIndex == 0) then
            Norm = 0.0_dp
            do i = 1, nBasis
                Norm = Norm + AllOrbOccs(i)
                if ((AllOrbOccs(i) < 0) .or. (Norm < 0)) then
                    write(stdout, *) 'WARNING: Integer overflow when calculating the orbital occupations.'
                    tWarning = .true.
                end if
            end do
            if (Norm > 1.0e-8_dp) then
                do i = 1, nBasis
                    AllOrbOccs(i) = AllOrbOccs(i) / Norm
                end do
            end if

            iunit = get_free_unit()
            open(iunit, file='ORBOCCUPATIONS', status='UNKNOWN')
            write(iunit, '(A15,A30)') '# Orbital no.', 'Normalised occupation'
            if (tWarning) write(iunit, *) 'WARNING: integer OVERFLOW OCCURRED WHEN CALCULATING THESE OCCUPATIONS'
            do i = 1, nBasis
                write(iunit, '(I15,F30.10)') i, AllOrbOccs(i)
            end do
        end if

    end subroutine PrintOrbOccs