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