CALCTMATUEG Subroutine

subroutine CALCTMATUEG(nbasis, ALAT, G1, CST, TPERIODIC, OMEGA)

Arguments

Type IntentOptional Attributes Name
integer :: nbasis
real(kind=dp) :: ALAT(4)
type(BasisFN) :: G1(nbasis)
real(kind=dp) :: CST
logical :: TPERIODIC
real(kind=dp) :: OMEGA

Contents

Source Code


Source Code

SUBROUTINE CALCTMATUEG(nbasis, ALAT, G1, CST, TPERIODIC, OMEGA)
    use constants, only: dp, stdout
    use SystemData, only: BasisFN, k_offset, iPeriodicDampingType, kvec, k_lattice_constant
    USE OneEInts, only: SetupTMAT, TMAT2D
    use util_mod, only: get_free_unit
    use SystemData, only: tUEG2
    use Parallel_neci, only: iProcIndex, Root

    IMPLICIT NONE
    INTEGER nbasis
    TYPE(BASISFN) G1(nbasis)
    real(dp) ALAT(4), CST, K_REAL(3), temp
    INTEGER I
    INTEGER iSIZE, iunit
    real(dp) OMEGA
    LOGICAL TPERIODIC
    real(dp), PARAMETER :: PI = 3.1415926535897932384626433832795029_dp

!=================================================
    if(tUEG2) then

        IF(TPERIODIC) write(stdout, *) "Periodic UEG"
        iunit = get_free_unit()

        if(iProcIndex == Root) open(iunit, FILE='TMAT', STATUS='UNKNOWN')
        CALL SetupTMAT(nbasis, 2, iSIZE)
        DO I = 1, nbasis
            !K_OFFSET in cartesian coordinates
            K_REAL = real(kvec(I, 1:3) + K_OFFSET, dp)
            temp = K_REAL(1)**2 + K_REAL(2)**2 + K_REAL(3)**2
            ! TMAT is diagonal for the UEG
            TMAT2D(I, 1) = 0.5_dp * temp * k_lattice_constant**2
            if(iProcIndex == Root) write(iunit, *) I, I, TMAT2D(I, 1)
        end do
        if(iProcIndex == Root) close(iunit)

        RETURN
    end if ! tUEG2
!=================================================

    IF(TPERIODIC) write(stdout, *) "Periodic UEG"
    iunit = get_free_unit()
    if(iProcIndex == Root) open(iunit, FILE='TMAT', STATUS='UNKNOWN')
    CALL SetupTMAT(nbasis, 2, iSIZE)

    DO I = 1, nbasis
        K_REAL = G1(I)%K + K_OFFSET
        TMAT2D(I, 1) = ((ALAT(1)**2) * ((K_REAL(1)**2) / (ALAT(1)**2) +        &
    &        (K_REAL(2)**2) / (ALAT(2)**2) + (K_REAL(3)**2) / (ALAT(3)**2)))
        TMAT2D(I, 1) = TMAT2D(I, 1) * (CST)
!..  The G=0 component is explicitly calculated for the cell interactions as 2 PI Rc**2 .
!   we *1/2 as we attribute only half the interaction to this cell.
        IF(TPERIODIC .and. iPeriodicDampingType /= 0) TMAT2D(I, 1) = TMAT2D(I, 1) - (PI * ALAT(4)**2 / OMEGA)
        if(iProcIndex == Root) write(iunit, *) I, I, TMAT2D(I, 1)
    end do
    if(iProcIndex == Root) close(iunit)
    RETURN
END SUBROUTINE CALCTMATUEG