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