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