Line data Source code
1 : MODULE m_orbcomp
2 : use m_types_orbcomp
3 : CONTAINS
4 20 : SUBROUTINE orb_comp(banddos,jspin,ikpt,nobd,ev_list,atoms,ne,usdus,eigVecCoeffs,orbcomp)
5 : !***********************************************************************
6 : ! Calculates an orbital composition of eigen states
7 : !
8 : ! Yury Koroteev 2003-12-24
9 : !***********************************************************************
10 : ! ABBREVIATIONS
11 : ! dimentions
12 : ! nobd : in, number of considered bands
13 : ! lmd : in, (lmaxd + 1)**2
14 : ! natd : in, number of atoms in a film
15 : ! lmaxd : in, max of l
16 : ! ntypd : in, number of mt-sphere types
17 : ! nlod : in, number of local orbitals in mt-sphere types
18 : ! llod : in, l max for local orbitals in mt-sphere types
19 : ! ----------------------------------------------------------------------
20 : ! neq(ntypd) : in, number of mt-spheres of the same type
21 : ! acof(nobd,0:lmd,natd) : in, a,b coefficients of linearized
22 : ! bcof(nobd,0:lmd,natd) : in, mt-wavefunctions for each band and atom
23 : ! ccof(-llod:llod,nobd, :
24 : ! : nobd,natd) : in, c coefficients for local orbitals
25 : ! ddn(16,ntypd) : in,
26 : ! uulon(16,ntypd) : in,
27 : ! dulon(16,ntypd) : in,
28 : ! uloulopn(16,ntypd) : in,
29 : ! nlo(ntypd) : in,
30 : ! llo(nlod,ntypd) : in,
31 : !-----------------------------------------------------------------------
32 : ! comp(nobd,16,natd) : out, an orbital composition of states
33 : ! qmtp(nobd,natd) : out, the portion of the state in mt-sphere
34 : !-----------------------------------------------------------------------
35 : USE m_types
36 : use m_abcrot2
37 : IMPLICIT NONE
38 : TYPE(t_atoms),INTENT(IN) :: atoms
39 : TYPE(t_banddos),INTENT(IN) :: banddos
40 : TYPE(t_usdus),INTENT(IN) :: usdus
41 : TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
42 : TYPE(t_orbcomp),INTENT(INOUT) :: orbcomp
43 :
44 : ! ..Scalar Argument
45 : INTEGER, INTENT (IN) :: nobd,ne,jspin,ikpt
46 :
47 : INTEGER, INTENT (IN) :: ev_list(nobd)
48 :
49 20 : COMPLEX, ALLOCATABLE :: acof(:,:)
50 : COMPLEX, ALLOCATABLE :: bcof(:,:)
51 : COMPLEX, ALLOCATABLE :: ccof(:,:,:)
52 :
53 : ! ..Local Scalars
54 : INTEGER n,mt,ityp,lm,lo,n_dos
55 : INTEGER l,lme,nate,lmaxe,jspe,nobc,nei
56 : REAL summed,cf
57 : REAL ddn0,ddn1,ddn2,ddn3,ddn12,ddn22,ddn32
58 : COMPLEX ca00,ca01,ca02,ca03,ca04,ca05,ca06,ca07,ca08,ca09
59 : COMPLEX ca10,ca11,ca12,ca13,ca14,ca15,ca16,ca17,ca18,ca19
60 : COMPLEX ca20,ca21,ca22
61 : COMPLEX cb00,cb01,cb02,cb03,cb04,cb05,cb06,cb07,cb08,cb09
62 : COMPLEX cb10,cb11,cb12,cb13,cb14,cb15,cb16,cb17,cb18,cb19
63 : COMPLEX cb20,cb21,cb22
64 : COMPLEX cc00,cc01,cc02,cc03,cc04,cc05,cc06,cc07,cc08,cc09
65 : COMPLEX cc10,cc11,cc12,cc13,cc14,cc15,cc16,cc17,cc18,cc19
66 : COMPLEX cc20,cc21,cc22
67 : COMPLEX ck00,ck01,ck02,ck03,ck04,ck05,ck06,ck07,ck08,ck09
68 : COMPLEX ck10,ck11,ck12,ck13,ck14,ck15,ck16,ck17,ck18,ck19
69 : COMPLEX ck20,ck21,ck22
70 : ! ..
71 : ! ..Local Arrays
72 : REAL comp(23)
73 : ! ..
74 : !
75 : REAL,PARAMETER :: h=0.50, g=0.0625
76 : !****************************************************
77 : !
78 :
79 80 : ALLOCATE(acof(size(eigVecCoeffs%abcof,1),0:size(eigVecCoeffs%abcof,2)-1))
80 60 : ALLOCATE(bcof(size(eigVecCoeffs%abcof,1),0:size(eigVecCoeffs%abcof,2)-1))
81 100 : ALLOCATE(ccof(-atoms%llod:atoms%llod,size(eigVecCoeffs%ccof,2),size(eigVecCoeffs%ccof,3)))
82 :
83 60 : DO ityp = 1,atoms%ntype
84 40 : ddn0 = usdus%ddn(0,ityp,jspin)
85 40 : ddn1 = usdus%ddn(1,ityp,jspin)
86 40 : ddn2 = usdus%ddn(2,ityp,jspin)
87 40 : ddn3 = usdus%ddn(3,ityp,jspin)
88 100 : DO mt=atoms%firstAtom(ityp),atoms%firstAtom(ityp)+atoms%neq(ityp)-1
89 :
90 40 : if (.not.banddos%dos_atom(mt)) cycle
91 : !assign and rotate if requested the abcofs
92 40 : IF (ANY((/banddos%alpha(mt),banddos%beta(mt),banddos%gamma(mt)/).NE.0.0)) THEN
93 0 : CALL abcrot2(ityp,mt,atoms,banddos,eigVecCoeffs,jspin,acof,bcof,ccof) ! rotate ab-coeffs
94 : ELSE
95 128520 : acof=eigVecCoeffs%abcof(:,:,0,mt,jspin)
96 128520 : bcof=eigVecCoeffs%abcof(:,:,1,mt,jspin)
97 80 : ccof=eigVecCoeffs%ccof(:,:,:,mt,jspin)
98 : ENDIF
99 : !find index for dos
100 60 : DO n_dos=1,size(banddos%dos_atomlist)
101 60 : if (banddos%dos_atomlist(n_dos)==mt) exit
102 : ENDDO
103 800 : DO n=1,ne
104 : !
105 : ! acof
106 : ! s-states
107 720 : ca00 = acof(n,0)
108 : ! p-states
109 720 : ca01 = acof(n,1) - acof(n,3)
110 720 : ca02 = acof(n,1) + acof(n,3)
111 720 : ca03 = acof(n,2)
112 : ! d-states
113 720 : ca04 = acof(n,4) - acof(n,8)
114 720 : ca05 = acof(n,5) + acof(n,7)
115 720 : ca06 = acof(n,5) - acof(n,7)
116 720 : ca07 = acof(n,4) + acof(n,8)
117 720 : ca08 = acof(n,6)
118 : !
119 : ! f-states: a cubic set (cub)
120 : !
121 : ca09 = ( acof(n,9) - acof(n,15) )*SQRT(5.0) -&
122 720 : ( acof(n,11) - acof(n,13) )*SQRT(3.0)
123 : ca10 = ( acof(n,9) + acof(n,15) )*SQRT(5.0) +&
124 720 : ( acof(n,11) + acof(n,13) )*SQRT(3.0)
125 720 : ca11 = acof(n,12)
126 : ca12 = ( acof(n,9) + acof(n,15) )*SQRT(3.0) -&
127 720 : ( acof(n,11) + acof(n,13) )*SQRT(5.0)
128 720 : ca13 = acof(n,10) + acof(n,14)
129 : ca14 = ( acof(n,9) - acof(n,15) )*SQRT(3.0) +&
130 720 : ( acof(n,11) - acof(n,13) )*SQRT(5.0)
131 720 : ca15 = acof(n,10) - acof(n,14)
132 : !
133 : ! f-states: a low symmetry set (lss)
134 : !
135 720 : ca16 = acof(n,11) - acof(n,13)
136 720 : ca17 = acof(n,11) + acof(n,13)
137 720 : ca18 = acof(n,12)
138 720 : ca19 = acof(n,10) - acof(n,14)
139 720 : ca20 = acof(n,10) + acof(n,14)
140 720 : ca21 = acof(n,9) - acof(n,15)
141 720 : ca22 = acof(n,9) + acof(n,15)
142 : !
143 : ! bcof
144 : ! s-states
145 720 : cb00 = bcof(n,0)
146 : ! p-states
147 720 : cb01 = bcof(n,1) - bcof(n,3)
148 720 : cb02 = bcof(n,1) + bcof(n,3)
149 720 : cb03 = bcof(n,2)
150 : ! d-states
151 720 : cb04 = bcof(n,4) - bcof(n,8)
152 720 : cb05 = bcof(n,5) + bcof(n,7)
153 720 : cb06 = bcof(n,5) - bcof(n,7)
154 720 : cb07 = bcof(n,4) + bcof(n,8)
155 720 : cb08 = bcof(n,6)
156 : !
157 : ! f-states: a cubic set (cub)
158 : !
159 : cb09 = ( bcof(n,9) - bcof(n,15) )*SQRT(5.0) -&
160 720 : ( bcof(n,11) - bcof(n,13) )*SQRT(3.0)
161 : cb10 = ( bcof(n,9) + bcof(n,15) )*SQRT(5.0) +&
162 720 : ( bcof(n,11) + bcof(n,13) )*SQRT(3.0)
163 720 : cb11 = bcof(n,12)
164 : cb12 = ( bcof(n,9) + bcof(n,15) )*SQRT(3.0) -&
165 720 : ( bcof(n,11) + bcof(n,13) )*SQRT(5.0)
166 720 : cb13 = bcof(n,10) + bcof(n,14)
167 : cb14 = ( bcof(n,9) - bcof(n,15) )*SQRT(3.0) +&
168 720 : ( bcof(n,11) - bcof(n,13) )*SQRT(5.0)
169 720 : cb15 = bcof(n,10) - bcof(n,14)
170 : !
171 : ! f-states: a low symmetry set (lss)
172 : !
173 720 : cb16 = bcof(n,11) - bcof(n,13)
174 720 : cb17 = bcof(n,11) + bcof(n,13)
175 720 : cb18 = bcof(n,12)
176 720 : cb19 = bcof(n,10) - bcof(n,14)
177 720 : cb20 = bcof(n,10) + bcof(n,14)
178 720 : cb21 = bcof(n,9) - bcof(n,15)
179 720 : cb22 = bcof(n,9) + bcof(n,15)
180 : !------------------------------------------------------------------
181 : ! s
182 720 : comp(1) = ca00*CONJG(ca00) + cb00*CONJG(cb00)*ddn0
183 : ! p
184 720 : comp(2) = ( ca01*CONJG(ca01) + cb01*CONJG(cb01)*ddn1 )*h
185 720 : comp(3) = ( ca02*CONJG(ca02) + cb02*CONJG(cb02)*ddn1 )*h
186 720 : comp(4) = ca03*CONJG(ca03) + cb03*CONJG(cb03)*ddn1
187 : ! d
188 720 : comp(5) = ( ca04*CONJG(ca04) + cb04*CONJG(cb04)*ddn2 )*h
189 720 : comp(6) = ( ca05*CONJG(ca05) + cb05*CONJG(cb05)*ddn2 )*h
190 720 : comp(7) = ( ca06*CONJG(ca06) + cb06*CONJG(cb06)*ddn2 )*h
191 720 : comp(8) = ( ca07*CONJG(ca07) + cb07*CONJG(cb07)*ddn2 )*h
192 720 : comp(9) = ca08*CONJG(ca08) + cb08*CONJG(cb08)*ddn2
193 : ! f: a cubic set
194 720 : comp(10) = ( ca09*CONJG(ca09) + cb09*CONJG(cb09)*ddn3 )*g
195 720 : comp(11) = ( ca10*CONJG(ca10) + cb10*CONJG(cb10)*ddn3 )*g
196 720 : comp(12) = ca11*CONJG(ca11) + cb11*CONJG(cb11)*ddn3
197 720 : comp(13) = ( ca12*CONJG(ca12) + cb12*CONJG(cb12)*ddn3 )*g
198 720 : comp(14) = ( ca13*CONJG(ca13) + cb13*CONJG(cb13)*ddn3 )*h
199 720 : comp(15) = ( ca14*CONJG(ca14) + cb14*CONJG(cb14)*ddn3 )*g
200 720 : comp(16) = ( ca15*CONJG(ca15) + cb15*CONJG(cb15)*ddn3 )*h
201 : ! f: a low symmetry set
202 720 : comp(17) = ( ca16*CONJG(ca16) + cb16*CONJG(cb16)*ddn3 )*h
203 720 : comp(18) = ( ca17*CONJG(ca17) + cb17*CONJG(cb17)*ddn3 )*h
204 720 : comp(19) = ca18*CONJG(ca18) + cb18*CONJG(cb18)*ddn3
205 720 : comp(20) = ( ca19*CONJG(ca19) + cb19*CONJG(cb19)*ddn3 )*h
206 720 : comp(21) = ( ca20*CONJG(ca20) + cb20*CONJG(cb20)*ddn3 )*h
207 720 : comp(22) = ( ca21*CONJG(ca21) + cb21*CONJG(cb21)*ddn3 )*h
208 720 : comp(23) = ( ca22*CONJG(ca22) + cb22*CONJG(cb22)*ddn3 )*h
209 : !--------------------------------------------------------------------
210 : ! ccof ( contributions from local orbitals )
211 : !
212 720 : DO lo = 1,atoms%nlo(ityp)
213 0 : l = atoms%llo(lo,ityp)
214 : ! lo-s
215 0 : IF ( l.EQ.0 ) THEN
216 0 : cc00 = ccof(0,n,lo)
217 0 : ck00 = CONJG(cc00)
218 :
219 : comp(1) = comp(1) +&
220 : ( ca00*ck00 + cc00*CONJG(ca00) )*usdus%uulon(lo,ityp,jspin) +&
221 0 : ( cb00*ck00 + cc00*CONJG(cb00) )*usdus%dulon(lo,ityp,jspin) + cc00*ck00*usdus%uloulopn(lo,lo,ityp,jspin)
222 0 : CYCLE
223 : ENDIF
224 : ! lo-p
225 0 : IF ( l.EQ.1 ) THEN
226 0 : cc01 = ccof(-1,n,lo) - ccof(1,n,lo)
227 0 : cc02 = ccof(-1,n,lo) + ccof(1,n,lo)
228 0 : cc03 = ccof( 0,n,lo)
229 :
230 0 : ck01 = CONJG(cc01)
231 0 : ck02 = CONJG(cc02)
232 0 : ck03 = CONJG(cc03)
233 : !
234 : comp(2) = comp(2) + (( ca01*ck01 + cc01*CONJG(ca01) )*usdus%uulon(lo,ityp,jspin) +&
235 0 : ( cb01*ck01 + cc01*CONJG(cb01) )*usdus%dulon(lo,ityp,jspin) + cc01*ck01*usdus%uloulopn(lo,lo,ityp,jspin) )*h
236 : comp(3) = comp(3) + (( ca02*ck02 + cc02*CONJG(ca02) )*usdus%uulon(lo,ityp,jspin) +&
237 0 : ( cb02*ck02 + cc02*CONJG(cb02) )*usdus%dulon(lo,ityp,jspin) + cc02*ck02*usdus%uloulopn(lo,lo,ityp,jspin) )*h
238 : comp(4) = comp(4) + ( ca03*ck03 + cc03*CONJG(ca03) )*usdus%uulon(lo,ityp,jspin) +&
239 0 : ( cb03*ck03 + cc03*CONJG(cb03) )*usdus%dulon(lo,ityp,jspin) + cc03*ck03*usdus%uloulopn(lo,lo,ityp,jspin)
240 0 : CYCLE
241 : ENDIF
242 : ! lo-d
243 0 : IF ( l.EQ.2 ) THEN
244 0 : cc04 = ccof(-2,n,lo) - ccof(2,n,lo)
245 0 : cc05 = ccof(-1,n,lo) + ccof(1,n,lo)
246 0 : cc06 = ccof(-1,n,lo) - ccof(1,n,lo)
247 0 : cc07 = ccof(-2,n,lo) + ccof(2,n,lo)
248 0 : cc08 = ccof( 0,n,lo)
249 :
250 0 : ck04 = CONJG(cc04)
251 0 : ck05 = CONJG(cc05)
252 0 : ck06 = CONJG(cc06)
253 0 : ck07 = CONJG(cc07)
254 0 : ck08 = CONJG(cc08)
255 :
256 : comp(5) = comp(5) + (( ca04*ck04 + cc04*CONJG(ca04) )*usdus%uulon(lo,ityp,jspin) +&
257 0 : ( cb04*ck04 + cc04*CONJG(cb04) )*usdus%dulon(lo,ityp,jspin) + cc04*ck04*usdus%uloulopn(lo,lo,ityp,jspin) )*h
258 : comp(6) = comp(6) + (( ca05*ck05 + cc05*CONJG(ca05) )*usdus%uulon(lo,ityp,jspin) +&
259 0 : ( cb05*ck05 + cc05*CONJG(cb05) )*usdus%dulon(lo,ityp,jspin) + cc05*ck05*usdus%uloulopn(lo,lo,ityp,jspin) )*h
260 : comp(7) = comp(7) + (( ca06*ck06 + cc06*CONJG(ca06) )*usdus%uulon(lo,ityp,jspin) +&
261 0 : ( cb06*ck06 + cc06*CONJG(cb06) )*usdus%dulon(lo,ityp,jspin) + cc06*ck06*usdus%uloulopn(lo,lo,ityp,jspin) )*h
262 : comp(8) = comp(8) + (( ca07*ck07 + cc07*CONJG(ca07) )*usdus%uulon(lo,ityp,jspin) +&
263 0 : ( cb07*ck07 + cc07*CONJG(cb07) )*usdus%dulon(lo,ityp,jspin) + cc07*ck07*usdus%uloulopn(lo,lo,ityp,jspin) )*h
264 : comp(9) = comp(9) + ( ca08*ck08 + cc08*CONJG(ca08) )*usdus%uulon(lo,ityp,jspin) +&
265 0 : ( cb08*ck08 + cc08*CONJG(cb08) )*usdus%dulon(lo,ityp,jspin) + cc08*ck08*usdus%uloulopn(lo,lo,ityp,jspin)
266 0 : CYCLE
267 : ENDIF
268 : ! lo-f
269 720 : IF ( l.EQ.3 ) THEN
270 : !
271 : ! a cubic set (cub)
272 : !
273 : cc09 = ( ccof(-3,n,lo) - ccof(3,n,lo) )*SQRT(5.0) -&
274 0 : ( ccof(-1,n,lo) - ccof(1,n,lo) )*SQRT(3.0)
275 : cc10 = ( ccof(-3,n,lo) + ccof(3,n,lo) )*SQRT(5.0) +&
276 0 : ( ccof(-1,n,lo) + ccof(1,n,lo) )*SQRT(3.0)
277 0 : cc11 = ccof( 0,n,lo)
278 : cc12 = ( ccof(-3,n,lo) + ccof(3,n,lo) )*SQRT(3.0) -&
279 0 : ( ccof(-1,n,lo) + ccof(1,n,lo) )*SQRT(5.0)
280 0 : cc13 = ccof(-2,n,lo) + ccof(2,n,lo)
281 : cc14 = ( ccof(-3,n,lo) - ccof(3,n,lo) )*SQRT(3.0) +&
282 0 : ( ccof(-1,n,lo) - ccof(1,n,lo) )*SQRT(5.0)
283 0 : cc15 = ccof(-2,n,lo) - ccof(2,n,lo)
284 : !
285 0 : ck09 = CONJG(cc09)
286 0 : ck10 = CONJG(cc10)
287 0 : ck11 = CONJG(cc11)
288 0 : ck12 = CONJG(cc12)
289 0 : ck13 = CONJG(cc13)
290 0 : ck14 = CONJG(cc14)
291 0 : ck15 = CONJG(cc15)
292 : !
293 : comp(10) = comp(10) + (( ca09*ck09 + cc09*CONJG(ca09) )*usdus%uulon(lo,ityp,jspin) +&
294 0 : ( cb09*ck09 + cc09*CONJG(cb09) )*usdus%dulon(lo,ityp,jspin) + cc09*ck09*usdus%uloulopn(lo,lo,ityp,jspin) )*g
295 : comp(11) = comp(11) + (( ca10*ck10 + cc10*CONJG(ca10) )*usdus%uulon(lo,ityp,jspin) +&
296 0 : ( cb10*ck10 + cc10*CONJG(cb10) )*usdus%dulon(lo,ityp,jspin) + cc10*ck10*usdus%uloulopn(lo,lo,ityp,jspin) )*g
297 : comp(12) = comp(12) + ( ca11*ck11 + cc11*CONJG(ca11) )*usdus%uulon(lo,ityp,jspin) +&
298 0 : ( cb11*ck11 + cc11*CONJG(cb11) )*usdus%dulon(lo,ityp,jspin) + cc11*ck11*usdus%uloulopn(lo,lo,ityp,jspin)
299 : comp(13) = comp(13) + (( ca12*ck12 + cc12*CONJG(ca12) )*usdus%uulon(lo,ityp,jspin) +&
300 0 : ( cb12*ck12 + cc12*CONJG(cb12) )*usdus%dulon(lo,ityp,jspin) + cc12*ck12*usdus%uloulopn(lo,lo,ityp,jspin) )*g
301 : comp(14) = comp(14) + (( ca13*ck13 + cc13*CONJG(ca13) )*usdus%uulon(lo,ityp,jspin) +&
302 0 : ( cb13*ck13 + cc13*CONJG(cb13) )*usdus%dulon(lo,ityp,jspin) + cc13*ck13*usdus%uloulopn(lo,lo,ityp,jspin) )*h
303 : comp(15) = comp(15) + (( ca14*ck14 + cc14*CONJG(ca14) )*usdus%uulon(lo,ityp,jspin) +&
304 0 : ( cb14*ck14 + cc14*CONJG(cb14) )*usdus%dulon(lo,ityp,jspin) + cc14*ck14*usdus%uloulopn(lo,lo,ityp,jspin) )*g
305 : comp(16) = comp(16) + (( ca15*ck15 + cc15*CONJG(ca15) )*usdus%uulon(lo,ityp,jspin) +&
306 0 : ( cb15*ck15 + cc15*CONJG(cb15) )*usdus%dulon(lo,ityp,jspin) + cc15*ck15*usdus%uloulopn(lo,lo,ityp,jspin) )*h
307 : !
308 : ! a low symmetry set (lss)
309 : !
310 0 : cc16 = ccof(-1,n,lo) - ccof(1,n,lo)
311 0 : cc17 = ccof(-1,n,lo) + ccof(1,n,lo)
312 0 : cc18 = ccof( 0,n,lo)
313 0 : cc19 = ccof(-2,n,lo) - ccof(2,n,lo)
314 0 : cc20 = ccof(-2,n,lo) + ccof(2,n,lo)
315 0 : cc21 = ccof(-3,n,lo) - ccof(3,n,lo)
316 0 : cc22 = ccof(-3,n,lo) + ccof(3,n,lo)
317 : !
318 0 : ck16 = CONJG(cc16)
319 0 : ck17 = CONJG(cc17)
320 0 : ck18 = CONJG(cc18)
321 0 : ck19 = CONJG(cc19)
322 0 : ck20 = CONJG(cc20)
323 0 : ck21 = CONJG(cc21)
324 0 : ck22 = CONJG(cc22)
325 : !
326 : comp(17) = comp(17) + (( ca16*ck16 + cc16*CONJG(ca16) )*usdus%uulon(lo,ityp,jspin) +&
327 0 : ( cb16*ck16 + cc16*CONJG(cb16) )*usdus%dulon(lo,ityp,jspin) + cc16*ck16*usdus%uloulopn(lo,lo,ityp,jspin) )*h
328 : comp(18) = comp(18) + (( ca17*ck17 + cc17*CONJG(ca17) )*usdus%uulon(lo,ityp,jspin) +&
329 0 : ( cb17*ck17 + cc17*CONJG(cb17) )*usdus%dulon(lo,ityp,jspin) + cc17*ck17*usdus%uloulopn(lo,lo,ityp,jspin) )*h
330 : comp(19) = comp(19) + ( ca18*ck18 + cc18*CONJG(ca18) )*usdus%uulon(lo,ityp,jspin) +&
331 0 : ( cb18*ck18 + cc18*CONJG(cb18) )*usdus%dulon(lo,ityp,jspin) + cc18*ck18*usdus%uloulopn(lo,lo,ityp,jspin)
332 : comp(20) = comp(20) + (( ca19*ck19 + cc19*CONJG(ca19) )*usdus%uulon(lo,ityp,jspin) +&
333 0 : ( cb19*ck19 + cc19*CONJG(cb19) )*usdus%dulon(lo,ityp,jspin) + cc19*ck19*usdus%uloulopn(lo,lo,ityp,jspin) )*h
334 : comp(21) = comp(21) + (( ca20*ck20 + cc20*CONJG(ca20) )*usdus%uulon(lo,ityp,jspin) +&
335 0 : ( cb20*ck20 + cc20*CONJG(cb20) )*usdus%dulon(lo,ityp,jspin) + cc20*ck20*usdus%uloulopn(lo,lo,ityp,jspin) )*h
336 : comp(22) = comp(22) + (( ca21*ck21 + cc21*CONJG(ca21) )*usdus%uulon(lo,ityp,jspin) +&
337 0 : ( cb21*ck21 + cc21*CONJG(cb21) )*usdus%dulon(lo,ityp,jspin) + cc21*ck21*usdus%uloulopn(lo,lo,ityp,jspin) )*h
338 : comp(23) = comp(23) + (( ca22*ck22 + cc22*CONJG(ca22) )*usdus%uulon(lo,ityp,jspin) +&
339 0 : ( cb22*ck22 + cc22*CONJG(cb22) )*usdus%dulon(lo,ityp,jspin) + cc22*ck22*usdus%uloulopn(lo,lo,ityp,jspin) )*h
340 : ENDIF
341 : ENDDO
342 : !-------------------------------------------------------------------
343 : ! calculate an orbital cnomposition in percets
344 : !
345 12240 : summed = sum(comp(1:16))
346 720 : cf = 100.0/summed
347 720 : orbcomp%qmtp(ev_list(n),n_dos,ikpt,jspin) = summed*100.0
348 17320 : if (abs(summed)>1E-18) orbcomp%comp(ev_list(n),:,n_dos,ikpt,jspin) = comp(:)*cf
349 : !----------------------------------------------------
350 : ENDDO ! bands (n)
351 : ENDDO ! atoms mt (=atoms%nat)
352 : ENDDO ! types (ityp)
353 : !
354 20 : END SUBROUTINE orb_comp
355 : END MODULE m_orbcomp
|
