rhomt.f90 1.71 KB
Newer Older
 Markus Betzinger committed Apr 26, 2016 1 2 ``````MODULE m_rhomt CONTAINS `````` Gregor Michalicek committed Apr 11, 2018 3 `````` SUBROUTINE rhomt(atoms,we,ne,eigVecCoeffs,denCoeffs,ispin) `````` Markus Betzinger committed Apr 26, 2016 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 `````` Gregor Michalicek committed Apr 11, 2018 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 `````` Gregor Michalicek committed Apr 10, 2018 18 `````` `````` Markus Betzinger committed Apr 26, 2016 19 `````` INTEGER i,l,lm ,n,na,natom,m `````` Gregor Michalicek committed Apr 10, 2018 20 `````` `````` Markus Betzinger committed Apr 26, 2016 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 `````` Gregor Michalicek committed Apr 11, 2018 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))) `````` Markus Betzinger committed Apr 26, 2016 37 38 39 40 41 42 43 `````` ENDDO ENDDO ENDDO ENDDO ENDDO END SUBROUTINE rhomt END MODULE m_rhomt``````