LCOV - code coverage report
Current view: top level - cdn - q_mt_sl.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 60 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             : MODULE m_qmtsl
       2             : CONTAINS
       3             :   !***********************************************************************
       4             :   ! Calculates the mt-spheres contribution to the layer charge for states 
       5             :   !  {En} at the current k-point. 
       6             :   !                                      Yury Koroteev 2003
       7             :   !                     from eparas.F  by  Philipp Kurz 99/04
       8             :   !
       9             :   !***********************************************************************
      10             :   !
      11           0 :   SUBROUTINE q_mt_sl(jsp,atoms,nobd,ikpt,ne,skip_t,noccbd,eigVecCoeffs,usdus,slab)
      12             :     USE m_types_setup
      13             :     USE m_types_usdus
      14             :     USE m_types_cdnval, ONLY: t_eigVecCoeffs, t_slab
      15             :     IMPLICIT NONE
      16             :     TYPE(t_usdus),INTENT(IN)        :: usdus
      17             :     TYPE(t_atoms),INTENT(IN)        :: atoms
      18             :     TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
      19             :     TYPE(t_slab), INTENT(INOUT)     :: slab
      20             :     !     ..
      21             :     !     .. Scalar Arguments ..
      22             :     INTEGER, INTENT (IN) :: nobd,jsp      
      23             :     INTEGER, INTENT (IN) :: ne,ikpt ,skip_t,noccbd
      24             :     !     ..
      25             :     !     .. Local Scalars ..
      26             :     INTEGER i,l,lo ,natom,nn,ntyp,nt1,nt2,m
      27             :     INTEGER lm,n,ll1,ipol,icore,index,nl
      28             :     REAL fac,sabd,ss,qq
      29             :     COMPLEX suma,sumb,sumab,sumba
      30             :     !     ..
      31             :     !     .. Local Arrays ..
      32           0 :     REAL, ALLOCATABLE :: qlo(:,:,:),qmt(:,:),qmtlo(:,:)
      33           0 :     REAL, ALLOCATABLE :: qaclo(:,:,:),qbclo(:,:,:),qmttot(:,:)
      34             :     !     ..
      35             :     !     .. Intrinsic Functions ..
      36             :     INTRINSIC conjg,cmplx
      37             : 
      38             : 
      39           0 :     ALLOCATE ( qlo(nobd,atoms%nlod,atoms%ntype),qmt(atoms%ntype,SIZE(slab%qmtsl,2)) )
      40           0 :     ALLOCATE ( qaclo(nobd,atoms%nlod,atoms%ntype),qbclo(nobd,atoms%nlod,atoms%ntype) )
      41           0 :     ALLOCATE ( qmttot(atoms%ntype,SIZE(slab%qmtsl,2)),qmtlo(atoms%ntype,SIZE(slab%qmtsl,2)) )
      42             :     !
      43             :     !--->    l-decomposed density for each valence state
      44             :     !
      45             :     !         DO 140 i = (skip_t+1),ne    ! this I need for all states
      46           0 :     DO i = 1,ne              ! skip in next loop
      47             :        nt1 = 1
      48           0 :        DO n = 1,atoms%ntype
      49           0 :           fac = 1./atoms%neq(n)
      50           0 :           nt2 = nt1 + atoms%neq(n) - 1
      51           0 :           sabd = 0.0
      52           0 :           DO l = 0,atoms%lmax(n)
      53           0 :              suma = CMPLX(0.,0.)
      54           0 :              sumb = CMPLX(0.,0.)
      55           0 :              ll1 = l* (l+1)
      56           0 :              DO m = -l,l
      57           0 :                 lm = ll1 + m
      58           0 :                 DO natom = nt1,nt2
      59           0 :                    suma = suma + eigVecCoeffs%acof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%acof(i,lm,natom,jsp))
      60           0 :                    sumb = sumb + eigVecCoeffs%bcof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp))
      61             :                 ENDDO
      62             :              enddo
      63           0 :              ss = suma + sumb*usdus%ddn(l,n,jsp)
      64           0 :              sabd = sabd + ss
      65             :           enddo
      66           0 :           qmt(n,i) = sabd*fac
      67           0 :           nt1 = nt1 + atoms%neq(n)
      68             :        enddo
      69             :     enddo
      70             :     !                  
      71             :     !---> initialize qlo
      72             :     !
      73           0 :     qlo=0.0
      74           0 :     qaclo=0.0
      75           0 :     qbclo=0.0
      76             :     !
      77             :     !---> density for each local orbital and valence state
      78             :     !
      79             :     natom = 0
      80           0 :     DO ntyp = 1,atoms%ntype
      81           0 :        DO nn = 1,atoms%neq(ntyp)
      82           0 :           natom = natom + 1
      83           0 :           DO lo = 1,atoms%nlo(ntyp)
      84           0 :              l = atoms%llo(lo,ntyp)
      85           0 :              ll1 = l* (l+1)
      86           0 :              DO i = 1,ne
      87           0 :                 DO m = -l,l
      88           0 :                    lm = ll1 + m
      89             :                    qlo(i,lo,ntyp) = qlo(i,lo,ntyp) +&
      90           0 :                         eigVecCoeffs%ccof(m,i,lo,natom,jsp)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,jsp))
      91             :                    qbclo(i,lo,ntyp) = qbclo(i,lo,ntyp) +&
      92             :                         eigVecCoeffs%bcof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,jsp)) +&
      93           0 :                         eigVecCoeffs%ccof(m,i,lo,natom,jsp)*CONJG(eigVecCoeffs%bcof(i,lm,natom,jsp))
      94             :                    qaclo(i,lo,ntyp) = qaclo(i,lo,ntyp) +&
      95             :                         eigVecCoeffs%acof(i,lm,natom,jsp)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,jsp)) +&
      96           0 :                         eigVecCoeffs%ccof(m,i,lo,natom,jsp)*CONJG(eigVecCoeffs%acof(i,lm,natom,jsp))
      97             :                 ENDDO
      98             :              ENDDO
      99             :           ENDDO
     100             :        ENDDO
     101             :     ENDDO
     102             :     natom = 1
     103           0 :     DO ntyp = 1,atoms%ntype
     104           0 :        IF (atoms%invsat(natom).EQ.1) THEN
     105           0 :           DO lo = 1,atoms%nlo(ntyp)
     106           0 :              DO i = 1,ne
     107           0 :                 qlo(i,lo,ntyp) = 2*qlo(i,lo,ntyp)
     108             :              ENDDO
     109             :           ENDDO
     110             :        ENDIF
     111           0 :        natom = natom + atoms%neq(ntyp)
     112             :     ENDDO
     113             :     !
     114             :     !--->  l-decomposed density for each valence state
     115             :     !--->      ( a contribution from local orbitals)
     116             :     !--->                       and
     117             :     !--->  total  l-decomposed density for each valence state
     118             :     !
     119           0 :     DO i = 1,ne
     120           0 :        DO ntyp = 1,atoms%ntype
     121           0 :           fac = 1.0/atoms%neq(ntyp)
     122           0 :           qq = 0.0
     123           0 :           DO lo = 1,atoms%nlo(ntyp)
     124             :              qq = qq + qlo(i,lo,ntyp)*usdus%uloulopn(lo,lo,ntyp,jsp) +&
     125             :                   qaclo(i,lo,ntyp)*usdus%uulon(lo,ntyp,jsp)     +&
     126           0 :                   qbclo(i,lo,ntyp)*usdus%dulon(lo,ntyp,jsp)    
     127             :           ENDDO
     128           0 :           qmtlo(ntyp,i) = qq*fac
     129           0 :           qmttot(ntyp,i) = qmt(ntyp,i) + qmtlo(ntyp,i)
     130             :        ENDDO
     131             :     ENDDO
     132             :     !
     133           0 :     DO i = 1,ne
     134           0 :        DO nl = 1,slab%nsl
     135             :           qq = 0.0
     136           0 :           DO ntyp = 1,atoms%ntype
     137           0 :              qq = qq + qmttot(ntyp,i)*slab%nmtsl(ntyp,nl)
     138             :           ENDDO
     139           0 :           slab%qmtsl(nl,i,ikpt,jsp) = qq
     140             :        ENDDO
     141             :     ENDDO
     142             :     !        DO ntyp = 1,ntype
     143             :     !        write(*,*) qmttot(ntyp,1)
     144             :     !        write(*,*) (nmtsl(ntyp,nl),nl=1,nsl)
     145             :     !        ENDDO
     146             :     !
     147           0 :     DEALLOCATE ( qlo,qmt,qmtlo,qaclo,qbclo,qmttot )
     148             : 
     149           0 :   END SUBROUTINE q_mt_sl
     150             : END MODULE m_qmtsl

Generated by: LCOV version 1.13