q_mt_sl.f90 5.08 KB
Newer Older
1 2 3 4 5 6 7 8 9 10
MODULE m_qmtsl
CONTAINS
  !***********************************************************************
  ! Calculates the mt-spheres contribution to the layer charge for states 
  !  {En} at the current k-point. 
  !                                      Yury Koroteev 2003
  !                     from eparas.F  by  Philipp Kurz 99/04
  !
  !***********************************************************************
  !
11
  SUBROUTINE q_mt_sl(jsp,atoms,nobd,ikpt,ne,skip_t,noccbd,eigVecCoeffs,usdus,slab)
12 13
    USE m_types
    IMPLICIT NONE
14 15 16 17
    TYPE(t_usdus),INTENT(IN)        :: usdus
    TYPE(t_atoms),INTENT(IN)        :: atoms
    TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
    TYPE(t_slab), INTENT(INOUT)     :: slab
18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
    !     ..
    !     .. Scalar Arguments ..
    INTEGER, INTENT (IN) :: nobd,jsp      
    INTEGER, INTENT (IN) :: ne,ikpt ,skip_t,noccbd
    !     ..
    !     .. Local Scalars ..
    INTEGER i,l,lo ,natom,nn,ntyp,nt1,nt2,m
    INTEGER lm,n,ll1,ipol,icore,index,nl
    REAL fac,sabd,ss,qq
    COMPLEX suma,sumb,sumab,sumba
    !     ..
    !     .. Local Arrays ..
    REAL, ALLOCATABLE :: qlo(:,:,:),qmt(:,:),qmtlo(:,:)
    REAL, ALLOCATABLE :: qaclo(:,:,:),qbclo(:,:,:),qmttot(:,:)
    !     ..
    !     .. Intrinsic Functions ..
    INTRINSIC conjg,cmplx


37
    ALLOCATE ( qlo(nobd,atoms%nlod,atoms%ntype),qmt(atoms%ntype,SIZE(slab%qmtsl,2)) )
Daniel Wortmann's avatar
Daniel Wortmann committed
38
    ALLOCATE ( qaclo(nobd,atoms%nlod,atoms%ntype),qbclo(nobd,atoms%nlod,atoms%ntype) )
39
    ALLOCATE ( qmttot(atoms%ntype,SIZE(slab%qmtsl,2)),qmtlo(atoms%ntype,SIZE(slab%qmtsl,2)) )
40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
    !
    !--->    l-decomposed density for each valence state
    !
    !         DO 140 i = (skip_t+1),ne    ! this I need for all states
    DO i = 1,ne              ! skip in next loop
       nt1 = 1
       DO n = 1,atoms%ntype
          fac = 1./atoms%neq(n)
          nt2 = nt1 + atoms%neq(n) - 1
          sabd = 0.0
          DO l = 0,atoms%lmax(n)
             suma = CMPLX(0.,0.)
             sumb = CMPLX(0.,0.)
             ll1 = l* (l+1)
             DO m = -l,l
                lm = ll1 + m
                DO natom = nt1,nt2
57 58
                   suma = suma + eigVecCoeffs%acof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%acof(i,lm,natom,jsp))
                   sumb = sumb + eigVecCoeffs%bcof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp))
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
                ENDDO
             enddo
             ss = suma + sumb*usdus%ddn(l,n,jsp)
             sabd = sabd + ss
          enddo
          qmt(n,i) = sabd*fac
          nt1 = nt1 + atoms%neq(n)
       enddo
    enddo
    !                  
    !---> initialize qlo
    !
    qlo=0.0
    qaclo=0.0
    qbclo=0.0
    !
    !---> density for each local orbital and valence state
    !
    natom = 0
    DO ntyp = 1,atoms%ntype
       DO nn = 1,atoms%neq(ntyp)
          natom = natom + 1
          DO lo = 1,atoms%nlo(ntyp)
             l = atoms%llo(lo,ntyp)
             ll1 = l* (l+1)
             DO i = 1,ne
                DO m = -l,l
                   lm = ll1 + m
                   qlo(i,lo,ntyp) = qlo(i,lo,ntyp) +&
88
                        eigVecCoeffs%ccof(m,i,lo,natom,jsp)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,jsp))
89
                   qbclo(i,lo,ntyp) = qbclo(i,lo,ntyp) +&
90 91
                        eigVecCoeffs%bcof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,jsp)) +&
                        eigVecCoeffs%ccof(m,i,lo,natom,jsp)*CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp))
92
                   qaclo(i,lo,ntyp) = qaclo(i,lo,ntyp) +&
93 94
                        eigVecCoeffs%acof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,jsp)) +&
                        eigVecCoeffs%ccof(m,i,lo,natom,jsp)*CONJG(eigVecCoeffs%acof(i,lm,natom,jsp))
95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
                ENDDO
             ENDDO
          ENDDO
       ENDDO
    ENDDO
    natom = 1
    DO ntyp = 1,atoms%ntype
       IF (atoms%invsat(natom).EQ.1) THEN
          DO lo = 1,atoms%nlo(ntyp)
             DO i = 1,ne
                qlo(i,lo,ntyp) = 2*qlo(i,lo,ntyp)
             ENDDO
          ENDDO
       ENDIF
       natom = natom + atoms%neq(ntyp)
    ENDDO
    !
    !--->  l-decomposed density for each valence state
    !--->      ( a contribution from local orbitals)
    !--->                       and
    !--->  total  l-decomposed density for each valence state
    !
    DO i = 1,ne
       DO ntyp = 1,atoms%ntype
          fac = 1.0/atoms%neq(ntyp)
          qq = 0.0
          DO lo = 1,atoms%nlo(ntyp)
             qq = qq + qlo(i,lo,ntyp)*usdus%uloulopn(lo,lo,ntyp,jsp) +&
                  qaclo(i,lo,ntyp)*usdus%uulon(lo,ntyp,jsp)     +&
                  qbclo(i,lo,ntyp)*usdus%dulon(lo,ntyp,jsp)    
          ENDDO
          qmtlo(ntyp,i) = qq*fac
          qmttot(ntyp,i) = qmt(ntyp,i) + qmtlo(ntyp,i)
       ENDDO
    ENDDO
    !
    DO i = 1,ne
132
       DO nl = 1,slab%nsl
133 134
          qq = 0.0
          DO ntyp = 1,atoms%ntype
135
             qq = qq + qmttot(ntyp,i)*slab%nmtsl(ntyp,nl)
136
          ENDDO
137
          slab%qmtsl(nl,i,ikpt,jsp) = qq
138 139 140 141 142 143 144 145 146 147 148
       ENDDO
    ENDDO
    !        DO ntyp = 1,ntype
    !        write(*,*) qmttot(ntyp,1)
    !        write(*,*) (nmtsl(ntyp,nl),nl=1,nsl)
    !        ENDDO
    !
    DEALLOCATE ( qlo,qmt,qmtlo,qaclo,qbclo,qmttot )

  END SUBROUTINE q_mt_sl
END MODULE m_qmtsl