rhomt.f90 1.71 KB
Newer Older
1 2
MODULE m_rhomt
CONTAINS
3
  SUBROUTINE rhomt(atoms,we,ne,eigVecCoeffs,denCoeffs,ispin)
4 5 6 7 8 9 10 11 12
    !     ***************************************************************
    !     perform the sum over m (for each l) and bands to set up the
    !     coefficient of spherical charge densities in subroutine
    !     cdnval                                   c.l.fu
    !     ***************************************************************

    USE m_types
    IMPLICIT NONE

13 14 15 16 17
    INTEGER,              INTENT(IN)    :: ne, ispin
    TYPE(t_eigVecCoeffs), INTENT(IN)    :: eigVecCoeffs
    REAL,                 INTENT(IN)    :: we(:)!(nobd)
    TYPE(t_atoms),        INTENT(IN)    :: atoms
    TYPE(t_denCoeffs),    INTENT(INOUT) :: denCoeffs
18

19
    INTEGER i,l,lm ,n,na,natom,m
20

21 22 23 24 25 26 27 28 29 30
    natom = 0
    DO n = 1,atoms%ntype
       DO na = 1,atoms%neq(n)
          natom = natom + 1
          DO l = 0,atoms%lmax(n)
             !     -----> sum over m
             DO m = -l,l
                lm = l* (l+1) + m
                !     -----> sum over occupied bands
                DO i = 1,ne
31 32 33 34 35 36
                   denCoeffs%uu(l,n,ispin) = denCoeffs%uu(l,n,ispin) +&
                      we(i) * REAL(eigVecCoeffs%acof(i,lm,natom,ispin)*CONJG(eigVecCoeffs%acof(i,lm,natom,ispin)))
                   denCoeffs%dd(l,n,ispin) = denCoeffs%dd(l,n,ispin) +&
                      we(i) * REAL(eigVecCoeffs%bcof(i,lm,natom,ispin)*CONJG(eigVecCoeffs%bcof(i,lm,natom,ispin)))
                   denCoeffs%du(l,n,ispin) = denCoeffs%du(l,n,ispin) +&
                      we(i) * REAL(eigVecCoeffs%acof(i,lm,natom,ispin)*CONJG(eigVecCoeffs%bcof(i,lm,natom,ispin)))
37 38 39 40 41 42 43
                ENDDO
             ENDDO
          ENDDO
       ENDDO
    ENDDO
  END SUBROUTINE rhomt
END MODULE m_rhomt