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 : MODULE m_jDOS
7 :
8 : !--------------------------------------------------------------------
9 : ! Calculate the decomposition into the total angular momentum states
10 : ! characterized by j= l+-1/2 using the Clebsch Gordan coefficients
11 : !--------------------------------------------------------------------
12 : USE m_types
13 : USE m_clebsch
14 : use m_types_jDOS
15 :
16 : IMPLICIT NONE
17 :
18 : CONTAINS
19 :
20 2 : SUBROUTINE jDOS_comp(ikpt,noccbd,ev_list,we,atoms,banddos,input,usdus,&
21 : denCoeffsOffdiag,eigVecCoeffs,jDOS)
22 :
23 : TYPE(t_atoms), INTENT(IN) :: atoms
24 : TYPE(t_banddos), INTENT(IN) :: banddos
25 : TYPE(t_input), INTENT(IN) :: input
26 : TYPE(t_usdus), INTENT(IN) :: usdus
27 : TYPE(t_denCoeffsOffdiag), INTENT(IN) :: denCoeffsOffdiag
28 : TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
29 : INTEGER, INTENT(IN) :: ikpt
30 : INTEGER, INTENT(IN) :: noccbd
31 : INTEGER, INTENT(IN) :: ev_list(:)
32 : REAL, INTENT(IN) :: we(:)
33 : TYPE(t_jDOS), INTENT(INOUT) :: jDOS
34 :
35 : INTEGER, PARAMETER :: lmax = 3 !Maximum l considered in j decomposition
36 :
37 : INTEGER :: n_dos
38 : INTEGER :: iType,iBand,nn,iAtom,l,jj,j_ind,lmup,lmdown,spin,ilo,ilop
39 : REAL :: j,mj,mup,mdown
40 : REAL :: facup,facdown,summed,cf
41 : COMPLEX :: aup,bup,cup,adown,bdown,cdown,cupp,cdownp
42 : REAL :: c(0:lmax*2)
43 :
44 :
45 4 : DO iAtom = 1, atoms%nat
46 2 : iType = atoms%itype(iAtom)
47 2 : if (.not.banddos%dos_atom(iAtom)) cycle
48 : !find index for dos
49 2 : DO n_dos=1,size(banddos%dos_atomlist)
50 2 : if (banddos%dos_atomlist(n_dos)==iAtom) exit
51 : ENDDO
52 28 : DO iBand = 1, noccbd
53 24 : j_ind = 0
54 24 : c = 0.0
55 120 : DO l = 0, lmax
56 120 : IF(l == 0) THEN
57 : !s-states (are not split up by SOC)
58 72 : DO spin = 1, input%jspins
59 : c(0) = c(0) + eigVecCoeffs%abcof(iBand,0,0,iAtom,spin)*CONJG(eigVecCoeffs%abcof(iBand,0,0,iAtom,spin)) &
60 : + eigVecCoeffs%abcof(iBand,0,1,iAtom,spin)*CONJG(eigVecCoeffs%abcof(iBand,0,1,iAtom,spin)) &
61 48 : *usdus%ddn(0,iType,spin)
62 :
63 120 : DO ilo = 1, atoms%nlo(iType)
64 48 : IF(atoms%llo(ilo,iType) /= 0) CYCLE
65 : c(0) = c(0) + 2*REAL(eigVecCoeffs%abcof(iBand,0,0,iAtom,spin)*eigVecCoeffs%ccof(0,iBand,ilo,iAtom,spin))* usdus%uulon(ilo,iType,spin) &
66 0 : + 2*REAL(eigVecCoeffs%abcof(iBand,0,1,iAtom,spin)*eigVecCoeffs%ccof(0,iBand,ilo,iAtom,spin))* usdus%dulon(ilo,iType,spin)
67 48 : DO ilop = 1, atoms%nlo(iType)
68 0 : IF(atoms%llo(ilo,iType) /= 0) CYCLE
69 48 : c(0) = c(0) + eigVecCoeffs%ccof(0,iBand,ilo,iAtom,spin)*CONJG(eigVecCoeffs%ccof(0,iBand,ilop,iAtom,spin))*usdus%uloulopn(ilo,ilop,iType,spin)
70 : ENDDO
71 : ENDDO
72 : ENDDO
73 : ELSE
74 216 : DO jj = 1, 2
75 144 : j_ind = j_ind+1
76 : ! j = l +- 1/2
77 144 : j = l + (jj-1.5)
78 144 : mj = -j
79 936 : DO WHILE(mj <= j)
80 : !mj = -l-+1/2, .... , l+-1/2
81 :
82 720 : mup = mj - 0.5
83 720 : mdown = mj + 0.5
84 :
85 720 : IF(input%jspins.EQ.1) THEN
86 0 : mdown = mdown * (-1)
87 0 : spin = 1
88 : ELSE
89 : spin = 2
90 : ENDIF
91 :
92 720 : IF(ABS(mup) <= l) THEN
93 648 : lmup = l*(l+1) + INT(mup)
94 648 : facup = clebsch(REAL(l),0.5,mup,0.5,j,mj)
95 648 : aup = facup * eigVecCoeffs%abcof(iBand,lmup,0,iAtom,1)
96 648 : bup = facup * eigVecCoeffs%abcof(iBand,lmup,1,iAtom,1)
97 : ELSE
98 : aup = 0.0
99 : bup = 0.0
100 : ENDIF
101 :
102 720 : IF(ABS(mdown) <= l) THEN
103 648 : lmdown = l*(l+1) + INT(mdown)
104 648 : facdown = clebsch(REAL(l),0.5,mdown,-0.5,j,mj)
105 648 : adown = - facdown * eigVecCoeffs%abcof(iBand,lmdown,0,iAtom,spin)
106 648 : bdown = - facdown * eigVecCoeffs%abcof(iBand,lmdown,1,iAtom,spin)
107 : ELSE
108 : adown = 0.0
109 : bdown = 0.0
110 : ENDIF
111 :
112 : !c := norm of facup |up> + facdown |down>
113 : !We have to write it out explicitely because
114 : !of the offdiagonal scalar products that appear
115 : c(j_ind) = c(j_ind) &
116 : + aup *CONJG(aup) &
117 : + adown*CONJG(adown) &
118 : + bup *CONJG(bup) * usdus%ddn(l,iType,1) &
119 : + bdown*CONJG(bdown) * usdus%ddn(l,iType,spin) &
120 : + 2*REAL(aup *CONJG(adown)) * denCoeffsOffdiag%uu21n(l,iType) &
121 : + 2*REAL(bup *CONJG(bdown)) * denCoeffsOffdiag%dd21n(l,iType) &
122 : + 2*REAL(aup *CONJG(bdown)) * denCoeffsOffdiag%ud21n(l,iType) &
123 720 : + 2*REAL(adown*CONJG(bup)) * denCoeffsOffdiag%du21n(l,iType)
124 :
125 : !Local orbitals
126 1440 : DO ilo = 1, atoms%nlo(iType)
127 720 : IF(atoms%llo(ilo,iType) /= l) CYCLE
128 :
129 144 : IF(ABS(mup) <= l) THEN
130 120 : cup = facup * eigVecCoeffs%ccof(INT(mup),iBand,ilo,iAtom,1)
131 : ELSE
132 : cup = 0.0
133 : ENDIF
134 :
135 144 : IF(ABS(mdown) <= l) THEN
136 120 : cdown = - facdown * eigVecCoeffs%ccof(INT(mdown),iBand,ilo,iAtom,spin)
137 : ELSE
138 : cdown = 0.0
139 : ENDIF
140 :
141 : !Local orbital times ab coeff contribution
142 : c(j_ind) = c(j_ind) &
143 : + 2*REAL(aup *CONJG(cup)) * usdus%uulon(ilo,iType,1) &
144 : + 2*REAL(adown*CONJG(cdown)) * usdus%uulon(ilo,iType,spin) &
145 : + 2*REAL(bup *CONJG(cup)) * usdus%dulon(ilo,iType,1) &
146 : + 2*REAL(bdown*CONJG(cdown)) * usdus%dulon(ilo,iType,spin) &
147 : + 2*REAL(cup *CONJG(adown)) * denCoeffsOffdiag%uulo21n(ilo,iType) &
148 : + 2*REAL(cdown*CONJG(aup)) * denCoeffsOffdiag%ulou21n(ilo,iType) &
149 : + 2*REAL(cup *CONJG(bdown)) * denCoeffsOffdiag%dulo21n(ilo,iType) &
150 144 : + 2*REAL(cdown*CONJG(bup)) * denCoeffsOffdiag%ulod21n(ilo,iType)
151 :
152 : !Local orbital times Local orbital contribution
153 1008 : DO ilop = 1, atoms%nlo(iType)
154 144 : IF(atoms%llo(ilop,iType) /= l) CYCLE
155 :
156 144 : IF(ABS(mup) <= l) THEN
157 120 : cupp = facup * eigVecCoeffs%ccof(INT(mup),iBand,ilop,iAtom,1)
158 : ELSE
159 : cupp = 0.0
160 : ENDIF
161 :
162 144 : IF(ABS(mdown) <= l) THEN
163 120 : cdownp = - facdown * eigVecCoeffs%ccof(INT(mdown),iBand,ilop,iAtom,spin)
164 : ELSE
165 : cdownp = 0.0
166 : ENDIF
167 :
168 : c(j_ind) = c(j_ind) &
169 : + cup *CONJG(cupp) * usdus%uloulopn(ilo,ilop,iType,1) &
170 : + cdown*CONJG(cdownp) * usdus%uloulopn(ilo,ilop,iType,spin) &
171 864 : + 2*REAL(cup *CONJG(cdownp)) * denCoeffsOffDiag%uloulop21n(ilo,ilop,iType)
172 : ENDDO
173 : ENDDO
174 :
175 864 : mj = mj + 1
176 : ENDDO
177 : ENDDO
178 : ENDIF
179 : ENDDO
180 192 : summed = SUM(c(0:2*lmax))
181 24 : cf = 100.0/summed
182 24 : j_ind=0
183 122 : DO l = 0, 3
184 312 : DO jj = 1, 2
185 192 : IF(l /= 0) j_ind = j_ind+1
186 192 : jDOS%comp(ev_list(iBand),l,jj,n_dos,ikpt) = c(j_ind)*cf
187 192 : jDOS%qmtp(ev_list(iBand),n_dos,ikpt) = 100.0*summed
188 288 : jDOS%occ(l,jj,iAtom) = jDOS%occ(l,jj,n_dos) + we(iBand) * c(j_ind)
189 : ENDDO
190 : ENDDO
191 : ENDDO
192 : ENDDO
193 :
194 2 : END SUBROUTINE jDOS_comp
195 : END MODULE m_jDOS
|
