Line data Source code
1 : MODULE m_wann_mmk0_updown_sph_at
2 : use m_juDFT
3 : CONTAINS
4 0 : SUBROUTINE wann_mmk0_updown_sph_at(
5 0 : > l_noco,alph,beta,
6 0 : > llod,noccbd,nlod,natd,ntypd,lmaxd,lmax,lmd,
7 0 : > ntype,neq,nlo,llo,
8 0 : > radial1_ff,radial1_gg,
9 0 : > radial1_fg,radial1_gf,
10 0 : > acof,bcof,ccof,
11 0 : > ddn,uulon,dulon,uloulopn,
12 0 : > atomlist_num,atomlist,
13 0 : = mmn)
14 : c**************************************************************
15 : c Overlaps of the spin-down parts of the Bloch functions
16 : c with the spin-up parts in the MT-spheres. Atom-resolved.
17 : c Frank Freimuth
18 : c**************************************************************
19 : implicit none
20 : logical, intent (in) :: l_noco
21 : integer, intent (in) :: llod,nlod,natd,ntypd,lmaxd,lmd
22 : integer, intent (in) :: lmax(:) !(ntypd)
23 : integer, intent (in) :: ntype,noccbd
24 : REAL, INTENT (IN) :: alph(ntypd),beta(ntypd)
25 : integer, intent (in) :: neq(ntypd)
26 : integer, intent (in) :: nlo(ntypd),llo(nlod,ntypd)
27 : real, intent (in) :: radial1_ff(:,:,0:,0:,:)
28 : real, intent (in) :: radial1_gg(:,:,0:,0:,:)
29 : real, intent (in) :: radial1_fg(:,:,0:,0:,:)
30 : real, intent (in) :: radial1_gf(:,:,0:,0:,:)
31 : real, intent (in) :: ddn(0:lmaxd,ntypd,2)
32 : real, intent (in) :: uloulopn(nlod,nlod,ntypd,2)
33 : real, intent (in) :: uulon(nlod,ntypd,2),dulon(nlod,ntypd,2)
34 : complex, intent (in) :: ccof(-llod:llod,noccbd,nlod,natd,2)
35 : complex, intent (in) :: acof(noccbd,0:lmd,natd,2)
36 : complex, intent (in) :: bcof(noccbd,0:lmd,natd,2)
37 : integer, intent(in) :: atomlist_num
38 : integer, intent(in) :: atomlist(:)
39 :
40 : complex, intent (inout) :: mmn(:,:,:) !mmn(noccbd,noccbd,natd)
41 :
42 : integer :: i,j,l,lo,lop,m,natom,nn,ntyp
43 : integer :: nt1,nt2,lm,n,ll1,i1spin,i2spin
44 0 : complex :: suma(natd),sumb(natd)
45 0 : complex :: sumc(natd),sumd(natd)
46 : complex :: suma12(2,2),sumb12(2,2)
47 : complex :: sumc12(2,2),sumd12(2,2)
48 0 : real, allocatable :: qlo(:,:,:,:,:)
49 0 : real, allocatable :: qaclo(:,:,:,:),qbclo(:,:,:,:)
50 : COMPLEX :: ccchi(2,2),ci
51 : integer :: nat2
52 : logical :: l_inthelist
53 :
54 0 : call timestart("wann_mmk0_updown_sph_at")
55 0 : ci = cmplx(0.0,1.0)
56 : allocate (qlo(noccbd,noccbd,nlod,nlod,natd),
57 : + qaclo(noccbd,noccbd,nlod,natd),
58 0 : + qbclo(noccbd,noccbd,nlod,natd) )
59 : c---> performs summations of the overlaps of the wavefunctions
60 0 : do i = 1,noccbd
61 0 : do j = 1,noccbd
62 0 : nt1 = 1
63 0 : do n = 1,ntype
64 0 : if(l_noco)then
65 : ccchi(1,1) = conjg( exp( ci*alph(n)/2)*cos(beta(n)/2))
66 : ccchi(1,2) = conjg(-exp( ci*alph(n)/2)*sin(beta(n)/2))
67 : ccchi(2,1) = conjg( exp(-ci*alph(n)/2)*sin(beta(n)/2))
68 : ccchi(2,2) = conjg( exp(-ci*alph(n)/2)*cos(beta(n)/2))
69 : endif
70 0 : nt2 = nt1 + neq(n) - 1
71 0 : do l = 0,lmax(n)
72 0 : if(.not.l_noco)then
73 0 : suma = cmplx(0.,0.)
74 0 : sumb = cmplx(0.,0.)
75 0 : sumc = cmplx(0.,0.)
76 0 : sumd = cmplx(0.,0.)
77 0 : ll1 = l* (l+1)
78 0 : do m = -l,l
79 0 : lm = ll1 + m
80 0 : do natom = nt1,nt2
81 : suma(natom) = suma(natom) + acof(i,lm,natom,1)*
82 0 : + conjg(acof(j,lm,natom,2))
83 : sumb(natom) = sumb(natom) + bcof(i,lm,natom,1)*
84 0 : + conjg(bcof(j,lm,natom,2))
85 : sumc(natom) = sumc(natom) + acof(i,lm,natom,1)*
86 0 : + conjg(bcof(j,lm,natom,2))
87 : sumd(natom) = sumd(natom) + bcof(i,lm,natom,1)*
88 0 : + conjg(acof(j,lm,natom,2))
89 : enddo !natom
90 : enddo !m
91 0 : do natom=nt1,nt2
92 0 : l_inthelist=.false.
93 0 : do nat2=1,atomlist_num
94 0 : if(atomlist(nat2).eq.natom)then
95 : l_inthelist=.true.
96 : exit
97 : endif
98 : enddo !nat2
99 0 : if(l_inthelist)then
100 : mmn(j,i,nat2) = mmn(j,i,nat2) +
101 : + ( suma(natom)*radial1_ff(1,2,l,l,n)+
102 : + sumb(natom)*radial1_gg(1,2,l,l,n)+
103 : + sumc(natom)*radial1_fg(1,2,l,l,n)+
104 0 : + sumd(natom)*radial1_gf(1,2,l,l,n) )
105 : endif
106 : enddo !natom
107 : else
108 0 : stop 'not yet finished'
109 : suma12 = cmplx(0.,0.)
110 : sumb12 = cmplx(0.,0.)
111 : sumc12 = cmplx(0.,0.)
112 : sumd12 = cmplx(0.,0.)
113 : ll1 = l* (l+1)
114 : do i1spin=1,2
115 : do i2spin=1,2
116 : do m = -l,l
117 : lm = ll1 + m
118 : do natom = nt1,nt2
119 : suma12(i1spin,i2spin) = suma12(i1spin,i2spin)
120 : + + acof(i,lm,natom,i1spin)*
121 : + conjg(acof(j,lm,natom,i2spin))
122 : sumb12(i1spin,i2spin) = sumb12(i1spin,i2spin)
123 : + + bcof(i,lm,natom,i1spin)*
124 : + conjg(bcof(j,lm,natom,i2spin))
125 : sumc12(i1spin,i2spin) = sumc12(i1spin,i2spin)
126 : + + acof(i,lm,natom,i1spin)*
127 : + conjg(bcof(j,lm,natom,i2spin))
128 : sumd12(i1spin,i2spin) = sumd12(i1spin,i2spin)
129 : + + bcof(i,lm,natom,i1spin)*
130 : + conjg(acof(j,lm,natom,i2spin))
131 : enddo !natom
132 : enddo !m
133 : do natom=nt1,nt2
134 : mmn(i,j,natom) = mmn(i,j,natom)
135 : & +
136 : & suma12(i1spin,i2spin)*radial1_ff(i1spin,i2spin,l,l,n)
137 : & *ccchi(1,i2spin)*conjg(ccchi(2,i1spin))
138 :
139 : & +
140 : & sumb12(i1spin,i2spin)*radial1_gg(i1spin,i2spin,l,l,n)
141 : & *ccchi(1,i2spin)*conjg(ccchi(2,i1spin))
142 :
143 : & +
144 : & sumc12(i1spin,i2spin)*radial1_fg(i1spin,i2spin,l,l,n)
145 : & *ccchi(1,i2spin)*conjg(ccchi(2,i1spin))
146 :
147 : & +
148 : & sumd12(i1spin,i2spin)*radial1_gf(i1spin,i2spin,l,l,n)
149 : & *ccchi(1,i2spin)*conjg(ccchi(2,i1spin))
150 : enddo !natom
151 : enddo !i2spin
152 : enddo !i1spin
153 : endif
154 :
155 : enddo !l
156 0 : nt1 = nt1 + neq(n)
157 : enddo !n
158 : enddo ! cycle by j-band
159 : enddo ! cycle by i-band
160 :
161 : c---> initialize qlo arrays
162 0 : qlo(:,:,:,:,:) = 0.0
163 0 : qaclo(:,:,:,:) = 0.0
164 0 : qbclo(:,:,:,:) = 0.0
165 : c---> prepare the coefficients
166 0 : natom = 0
167 0 : do ntyp = 1,ntype
168 0 : do nn = 1,neq(ntyp)
169 0 : natom = natom + 1
170 0 : do lo = 1,nlo(ntyp)
171 0 : if(l_noco)then
172 0 : stop 'not yet finished'
173 : else
174 0 : l = llo(lo,ntyp)
175 0 : ll1 = l* (l+1)
176 0 : do m = -l,l
177 0 : lm = ll1 + m
178 0 : do i = 1,noccbd
179 0 : do j = 1,noccbd
180 : qbclo(j,i,lo,natom) = qbclo(j,i,lo,natom) + real(
181 : + bcof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) +
182 0 : + ccof(m,i,lo,natom,1)*conjg(bcof(j,lm,natom,2)) )
183 : qaclo(j,i,lo,natom) = qaclo(j,i,lo,natom) + real(
184 : + acof(i,lm,natom,1)*conjg(ccof(m,j,lo,natom,2)) +
185 0 : + ccof(m,i,lo,natom,1)*conjg(acof(j,lm,natom,2)) )
186 : enddo
187 : enddo
188 : enddo
189 0 : do lop = 1,nlo(ntyp)
190 0 : if (llo(lop,ntyp).eq.l) then
191 0 : do m = -l,l
192 0 : do i = 1,noccbd
193 0 : do j = 1,noccbd
194 : qlo(j,i,lop,lo,natom) = qlo(j,i,lop,lo,natom)+
195 : + real(conjg(ccof(m,j,lop,natom,2))
196 0 : * *ccof(m,i,lo,natom,1))
197 : enddo
198 : enddo
199 : enddo
200 : endif
201 : enddo !lop
202 : endif !l_noco
203 : enddo !lo
204 : enddo !nn
205 : enddo !ntyp
206 : c---> perform summation of the coefficients with the integrals
207 : c---> of the radial basis functions
208 : natom=0
209 0 : do ntyp = 1,ntype
210 0 : do nn=1,neq(ntyp)
211 0 : natom=natom+1
212 :
213 0 : l_inthelist=.false.
214 0 : do nat2=1,atomlist_num
215 0 : if(atomlist(nat2).eq.natom)then
216 : l_inthelist=.true.
217 : exit
218 : endif
219 : enddo !nat2
220 0 : if(.not.l_inthelist) cycle
221 :
222 0 : do lo = 1,nlo(ntyp)
223 0 : l = llo(lo,ntyp)
224 0 : do i = 1,noccbd
225 0 : do j = 1,noccbd
226 : mmn(j,i,nat2)= mmn(j,i,nat2) +
227 : + ( qaclo(j,i,lo,natom)*uulon(lo,ntyp,2) +
228 0 : + qbclo(j,i,lo,natom)*dulon(lo,ntyp,2) )
229 : enddo
230 : enddo
231 0 : do lop = 1,nlo(ntyp)
232 0 : if (llo(lop,ntyp).eq.l) then
233 0 : do i = 1,noccbd
234 0 : do j = 1,noccbd
235 : mmn(j,i,nat2) = mmn(j,i,nat2) +
236 0 : + qlo(j,i,lop,lo,natom)*uloulopn(lop,lo,ntyp,2)
237 : enddo
238 : enddo
239 : endif
240 : enddo
241 : enddo !lo
242 : enddo !nn
243 : enddo !ntyp
244 0 : deallocate ( qlo,qaclo,qbclo )
245 :
246 0 : call timestop("wann_mmk0_updown_sph_at")
247 0 : END SUBROUTINE wann_mmk0_updown_sph_at
248 : END MODULE m_wann_mmk0_updown_sph_at
|
