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_tlmw
8 : use m_juDFT
9 : contains
10 8 : subroutine wann_tlmw(
11 8 : > nwfs,lwf,mrwf,
12 8 : > l_nocosoc,spi,jspin,
13 8 : < tlmwf)
14 : c*********************************************************************
15 : c Express the angular part of the trial orbital
16 : c in terms of spherical harmonics.
17 : c Y. Mokrousov
18 : c*********************************************************************
19 : c Modifications for soc and noco.
20 : c Tidied-up version.
21 : c Frank Freimuth
22 : c*********************************************************************
23 :
24 : implicit none
25 :
26 : integer, intent (in) :: nwfs
27 : integer, intent (in) :: lwf(nwfs),mrwf(nwfs)
28 : logical, intent (in) :: l_nocosoc
29 : integer, intent (in) :: spi(nwfs),jspin
30 : complex, intent (out) :: tlmwf(0:3,-3:3,nwfs)
31 :
32 : integer :: nwf,l,lr,mr,m,i,ii,j,jj
33 : complex :: tlm(0:3,-3:3,1:7)
34 : complex :: ic
35 : intrinsic :: cmplx,sqrt,cos,sin
36 :
37 8 : call timestart("wann_tlmw")
38 8 : ic = cmplx(0.,1.)
39 :
40 : c..in this part the 'primary' matrices for the basic non-hybridized
41 : c..states are constructed, the coefficients are written to the tlm
42 : c..these coefficients arise due to the fact that the tws comprise the
43 : c..real harmonics, while the wave functions operate in terms of normal
44 : c..ones
45 :
46 8 : tlm(:,:,:) = cmplx(0.,0.)
47 :
48 40 : do l = 0,3
49 :
50 40 : if (l.eq.0) then
51 : c..s-state
52 8 : tlm(0,0,1) = cmplx(1.,0.)
53 :
54 24 : elseif (l.eq.1) then
55 : c..pz-state
56 8 : tlm(1,0,1) = cmplx(1.,0.)
57 : c..px-state
58 8 : tlm(1,-1,2) = cmplx(1.,0.)/(sqrt(2.))
59 8 : tlm(1,1,2) = -cmplx(1.,0.)/(sqrt(2.))
60 : c..py-state
61 8 : tlm(1,-1,3) = ic/(sqrt(2.))
62 8 : tlm(1,1,3) = ic/(sqrt(2.))
63 :
64 16 : elseif (l.eq.2) then
65 : c..dz2-state
66 8 : tlm(2,0,1) = cmplx(1.,0.)
67 : c..dxz-state
68 8 : tlm(2,1,2) = -cmplx(1.,0.)/(sqrt(2.))
69 8 : tlm(2,-1,2) = cmplx(1.,0.)/(sqrt(2.))
70 : c..dyz-state
71 8 : tlm(2,1,3) = ic/(sqrt(2.))
72 8 : tlm(2,-1,3) = ic/(sqrt(2.))
73 : c..dx2-y2-state
74 8 : tlm(2,2,4) = cmplx(1.,0.)/(sqrt(2.))
75 8 : tlm(2,-2,4) = cmplx(1.,0.)/(sqrt(2.))
76 : c..dxy-state
77 8 : tlm(2,2,5) = -ic/(sqrt(2.))
78 8 : tlm(2,-2,5) = ic/(sqrt(2.))
79 :
80 : elseif (l.eq.3)then
81 : c..
82 8 : tlm(3,0,1) = cmplx(1.,0.)
83 : c..
84 8 : tlm(3,1,2) = -cmplx(1.,0.)/(sqrt(2.))
85 8 : tlm(3,-1,2) = cmplx(1.,0.)/(sqrt(2.))
86 : c..
87 8 : tlm(3,1,3) = ic/(sqrt(2.))
88 8 : tlm(3,-1,3) = ic/(sqrt(2.))
89 : c..
90 8 : tlm(3,2,4) = cmplx(1.,0.)/(sqrt(2.))
91 8 : tlm(3,-2,4) = cmplx(1.,0.)/(sqrt(2.))
92 : c..
93 8 : tlm(3,2,5) = -ic/(sqrt(2.))
94 8 : tlm(3,-2,5) = ic/(sqrt(2.))
95 : c..
96 8 : tlm(3,3,6) = -cmplx(1.,0.)/(sqrt(2.))
97 8 : tlm(3,-3,6) = cmplx(1.,0.)/(sqrt(2.))
98 : c..
99 8 : tlm(3,3,7) = ic/(sqrt(2.))
100 8 : tlm(3,-3,7) = ic/(sqrt(2.))
101 : else
102 : CALL juDFT_error("no tlm for this l",calledby ="wann_tlmw")
103 : endif
104 :
105 : enddo
106 :
107 : c..now we are ready for more complex hybridized states, which
108 : c..correspond to the negative values of lwf
109 :
110 2312 : tlmwf(:,:,:) = cmplx(0.,0.)
111 :
112 72 : do nwf = 1,nwfs
113 :
114 64 : if( ((3-2*jspin).ne.spi(nwf)).and.l_nocosoc ) cycle
115 :
116 64 : lr = lwf(nwf)
117 64 : mr = mrwf(nwf)
118 :
119 72 : if (lr.ge.0) then
120 0 : tlmwf(lr,:,nwf) = tlm(lr,:,mr)
121 : elseif (lr.eq.-1) then
122 :
123 0 : if (mr.eq.1) then
124 : c..sp-1
125 0 : tlmwf(0,:,nwf) = (1./(sqrt(2.)))*tlm(0,:,1)
126 0 : tlmwf(1,:,nwf) = (1./(sqrt(2.)))*tlm(1,:,2)
127 0 : elseif (mr.eq.2) then
128 : c..sp-2
129 0 : tlmwf(0,:,nwf) = (1./(sqrt(2.)))*tlm(0,:,1)
130 0 : tlmwf(1,:,nwf) = -(1./(sqrt(2.)))*tlm(1,:,2)
131 : endif
132 :
133 : elseif (lr.eq.-2) then
134 :
135 0 : if (mr.eq.1) then
136 : c..sp2-1
137 0 : tlmwf(0,:,nwf) = (1./(sqrt(3.)))*tlm(0,:,1)
138 : tlmwf(1,:,nwf) = -(1./(sqrt(6.)))*tlm(1,:,2) +
139 0 : + (1./(sqrt(2.)))*tlm(1,:,3)
140 0 : elseif (mr.eq.2) then
141 : c..sp2-2
142 0 : tlmwf(0,:,nwf) = (1./(sqrt(3.)))*tlm(0,:,1)
143 : tlmwf(1,:,nwf) = -(1./(sqrt(6.)))*tlm(1,:,2)
144 0 : + -(1./(sqrt(2.)))*tlm(1,:,3)
145 0 : elseif (mr.eq.3) then
146 : c..sp2-3
147 0 : tlmwf(0,:,nwf) = (1./(sqrt(3.)))*tlm(0,:,1)
148 0 : tlmwf(1,:,nwf) = (2./(sqrt(6.)))*tlm(1,:,2)
149 : endif
150 :
151 : elseif (lr.eq.-3) then
152 :
153 64 : if (mr.eq.1) then
154 : c..sp3-1
155 128 : tlmwf(0,:,nwf) = 0.5*tlm(0,:,1)
156 128 : tlmwf(1,:,nwf) = 0.5*( tlm(1,:,2)+tlm(1,:,3)+tlm(1,:,1) )
157 48 : elseif (mr.eq.2) then
158 : c..sp3-2
159 128 : tlmwf(0,:,nwf) = 0.5*tlm(0,:,1)
160 128 : tlmwf(1,:,nwf) = 0.5*( tlm(1,:,2)-tlm(1,:,3)-tlm(1,:,1) )
161 32 : elseif (mr.eq.3) then
162 : c..sp3-4
163 128 : tlmwf(0,:,nwf) = 0.5*tlm(0,:,1)
164 128 : tlmwf(1,:,nwf) = 0.5*(-tlm(1,:,2)+tlm(1,:,3)-tlm(1,:,1) )
165 16 : elseif (mr.eq.4) then
166 : c..sp3-4
167 128 : tlmwf(0,:,nwf) = 0.5*tlm(0,:,1)
168 128 : tlmwf(1,:,nwf) = 0.5*(-tlm(1,:,2)-tlm(1,:,3)+tlm(1,:,1) )
169 : endif
170 :
171 : elseif (lr.eq.-4) then
172 :
173 : if (mr.eq.1) then
174 : c..sp3d-1
175 0 : tlmwf(0,:,nwf) = (1./(sqrt(3.)))*tlm(0,:,1)
176 : tlmwf(1,:,nwf) = -(1./(sqrt(6.)))*tlm(1,:,2)
177 0 : & +(1./(sqrt(2.)))*tlm(1,:,3)
178 : elseif (mr.eq.2) then
179 : c..sp3d-2
180 0 : tlmwf(0,:,nwf) = (1./(sqrt(3.)))*tlm(0,:,1)
181 : tlmwf(1,:,nwf) = -(1./(sqrt(6.)))*tlm(1,:,2)
182 0 : & -(1./(sqrt(2.)))*tlm(1,:,3)
183 : elseif (mr.eq.3) then
184 : c..sp3d-3
185 0 : tlmwf(0,:,nwf) = (1./(sqrt(3.)))*tlm(0,:,1)
186 0 : tlmwf(1,:,nwf) = (2./(sqrt(6.)))*tlm(1,:,2)
187 : elseif (mr.eq.4) then
188 : c..sp3d-4
189 0 : tlmwf(1,:,nwf) = (1./(sqrt(2.)))*tlm(1,:,1)
190 0 : tlmwf(2,:,nwf) = (1./(sqrt(2.)))*tlm(2,:,1)
191 : elseif (mr.eq.5) then
192 : c..sp3d-5
193 0 : tlmwf(1,:,nwf) = -(1./(sqrt(2.)))*tlm(1,:,1)
194 0 : tlmwf(2,:,nwf) = (1./(sqrt(2.)))*tlm(2,:,1)
195 : endif
196 :
197 : elseif (lr.eq.-5) then
198 :
199 : if (mr.eq.1) then
200 : c..sp3d2-1
201 0 : tlmwf(0,:,nwf) = (1./(sqrt(6.)))*tlm(0,:,1)
202 0 : tlmwf(1,:,nwf) = -(1./(sqrt(2.)))*tlm(1,:,2)
203 : tlmwf(2,:,nwf) = -(1./(sqrt(12.)))*tlm(2,:,1)
204 0 : & +0.5*tlm(2,:,4)
205 : elseif (mr.eq.2) then
206 : c..sp3d2-2
207 0 : tlmwf(0,:,nwf) = (1./(sqrt(6.)))*tlm(0,:,1)
208 0 : tlmwf(1,:,nwf) = (1./(sqrt(2.)))*tlm(1,:,2)
209 : tlmwf(2,:,nwf) = -(1./(sqrt(12.)))*tlm(2,:,1)
210 0 : & +0.5*tlm(2,:,4)
211 : elseif (mr.eq.3) then
212 : c..sp3d2-3
213 0 : tlmwf(0,:,nwf) = (1./(sqrt(6.)))*tlm(0,:,1)
214 0 : tlmwf(1,:,nwf) = -(1./(sqrt(2.)))*tlm(1,:,3)
215 : tlmwf(2,:,nwf) = -(1./(sqrt(12.)))*tlm(2,:,1)
216 0 : & -0.5*tlm(2,:,4)
217 : elseif (mr.eq.4) then
218 : c..sp3d2-4
219 0 : tlmwf(0,:,nwf) = (1./(sqrt(6.)))*tlm(0,:,1)
220 0 : tlmwf(1,:,nwf) = (1./(sqrt(2.)))*tlm(1,:,3)
221 : tlmwf(2,:,nwf) = -(1./(sqrt(12.)))*tlm(2,:,1)
222 0 : & -0.5*tlm(2,:,4)
223 : elseif (mr.eq.5) then
224 : c..sp3d2-5
225 0 : tlmwf(0,:,nwf) = (1./(sqrt(6.)))*tlm(0,:,1)
226 0 : tlmwf(1,:,nwf) = -(1./(sqrt(2.)))*tlm(1,:,1)
227 0 : tlmwf(2,:,nwf) = (1./(sqrt(3.)))*tlm(2,:,1)
228 : elseif (mr.eq.6) then
229 : c..sp3d2-5
230 0 : tlmwf(0,:,nwf) = (1./(sqrt(6.)))*tlm(0,:,1)
231 0 : tlmwf(1,:,nwf) = (1./(sqrt(2.)))*tlm(1,:,1)
232 0 : tlmwf(2,:,nwf) = (1./(sqrt(3.)))*tlm(2,:,1)
233 : endif
234 :
235 : else
236 0 : CALL juDFT_error("no tlmw for this lr",calledby="wann_tlmw")
237 : endif
238 :
239 : enddo
240 :
241 8 : call timestop("wann_tlmw")
242 8 : end subroutine wann_tlmw
243 : end module m_wann_tlmw
|