Line data Source code
1 : MODULE m_qal21
2 : !***********************************************************************
3 : ! Calculates qal21 needed to determine the off-diagonal parts of the
4 : ! DOS
5 : !***********************************************************************
6 : !
7 : CONTAINS
8 374 : SUBROUTINE qal_21(atoms,banddos,input,noccbd,ev_list,nococonv,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
9 : use m_types_nococonv
10 : USE m_types_setup
11 : USE m_types_dos
12 : USE m_types_cdnval, ONLY: t_eigVecCoeffs
13 : USE m_types_denCoeffsOffdiag
14 : USE m_rotdenmat
15 : use m_constants
16 : IMPLICIT NONE
17 :
18 : TYPE(t_input), INTENT(IN) :: input
19 : TYPE(t_nococonv), INTENT(IN) :: nococonv
20 : TYPE(t_atoms), INTENT(IN) :: atoms
21 : TYPE(t_banddos), INTENT(IN) :: banddos
22 : TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
23 : TYPE(t_denCoeffsOffdiag), INTENT(IN) :: denCoeffsOffdiag
24 : TYPE(t_dos), INTENT(INOUT) :: dos
25 :
26 : ! .. Scalar Arguments ..
27 : INTEGER, INTENT (IN) :: noccbd,ikpt
28 :
29 : INTEGER, INTENT (IN) :: ev_list(noccbd)
30 :
31 : ! .. Local Scalars ..
32 : INTEGER i,l,lo,lop ,natom,nn,ntyp
33 : INTEGER nt1,nt2,lm,ll1,ipol,icore,index,m,n_dos
34 : REAL fac
35 : COMPLEX sumaa,sumbb,sumab,sumba
36 :
37 : ! .. Local Arrays ..
38 374 : COMPLEX qlo(noccbd,atoms%nlod,atoms%nlod,atoms%ntype)
39 374 : COMPLEX qaclo(noccbd,atoms%nlod,atoms%ntype),qbclo(noccbd,atoms%nlod,atoms%ntype)
40 374 : COMPLEX qcloa(noccbd,atoms%nlod,atoms%ntype),qclob(noccbd,atoms%nlod,atoms%ntype)
41 374 : COMPLEX qal21(0:3,size(banddos%dos_typelist),input%neig)
42 : COMPLEX q_loc(2,2),q_hlp(2,2),chi(2,2)
43 : REAL qmat(0:3,atoms%ntype,input%neig,4)
44 :
45 : ! .. Intrinsic Functions ..
46 : INTRINSIC conjg
47 12242 : qal21=0.0
48 : !---> initialize qlo
49 :
50 35748 : qlo(:,:,:,:) = CMPLX(0.,0.)
51 17838 : qaclo(:,:,:) = CMPLX(0.,0.)
52 17838 : qcloa(:,:,:) = CMPLX(0.,0.)
53 17838 : qclob(:,:,:) = CMPLX(0.,0.)
54 17838 : qbclo(:,:,:) = CMPLX(0.,0.)
55 : !---> l-decomposed density for each occupied state
56 5821 : states : DO i = 1, noccbd
57 5821 : DO n_dos=1,size(banddos%dos_typelist)
58 0 : ntyp=banddos%dos_typelist(n_dos)
59 0 : nt1 = atoms%firstAtom(ntyp)
60 0 : nt2 = nt1 + atoms%neq(ntyp) - 1
61 5447 : ls : DO l = 0,3
62 : IF (i==1) THEN
63 : ENDIF
64 0 : sumaa = CMPLX(0.,0.) ; sumab = CMPLX(0.,0.)
65 0 : sumbb = CMPLX(0.,0.) ; sumba = CMPLX(0.,0.)
66 0 : ll1 = l* (l+1)
67 0 : ms : DO m = -l,l
68 0 : lm = ll1 + m
69 0 : atoms_loop : DO natom = nt1,nt2
70 0 : sumaa = sumaa + eigVecCoeffs%abcof(i,lm,0,natom,1)* CONJG(eigVecCoeffs%abcof(i,lm,0,natom,input%jspins))
71 0 : sumbb = sumbb + eigVecCoeffs%abcof(i,lm,1,natom,1)* CONJG(eigVecCoeffs%abcof(i,lm,1,natom,input%jspins))
72 0 : sumba = sumba + eigVecCoeffs%abcof(i,lm,0,natom,1) * CONJG(eigVecCoeffs%abcof(i,lm,1,natom,input%jspins))
73 0 : sumab = sumab + eigVecCoeffs%abcof(i,lm,1,natom,1) * CONJG(eigVecCoeffs%abcof(i,lm,0,natom,input%jspins))
74 : ENDDO atoms_loop
75 : ENDDO ms
76 : qal21(l,n_dos,i) = sumaa * denCoeffsOffdiag%uu21n(l,ntyp) + sumbb * denCoeffsOffdiag%dd21n(l,ntyp) +&
77 0 : sumba * denCoeffsOffdiag%du21n(l,ntyp) + sumab * denCoeffsOffdiag%ud21n(l,ntyp)
78 : ENDDO ls
79 : ENDDO
80 : ENDDO states
81 :
82 :
83 :
84 : !---> density for each local orbital and occupied state
85 :
86 374 : DO n_dos=1,SIZE(banddos%dos_typelist)
87 0 : ntyp = banddos%dos_typelist(n_dos)
88 0 : natom = atoms%firstAtom(ntyp) - 1
89 0 : DO nn = 1,atoms%neq(ntyp)
90 0 : natom = natom + 1
91 0 : DO lo = 1,atoms%nlo(ntyp)
92 0 : l = atoms%llo(lo,ntyp)
93 0 : ll1 = l* (l+1)
94 0 : DO m = -l,l
95 0 : lm = ll1 + m
96 0 : DO i = 1, noccbd
97 : qbclo(i,lo,n_dos) = qbclo(i,lo,n_dos) + &
98 0 : eigVecCoeffs%abcof(i,lm,1,natom,1)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins))
99 : qbclo(i,lo,n_dos) = qbclo(i,lo,n_dos) + &
100 0 : eigVecCoeffs%ccof(m,i,lo,natom,1)*CONJG(eigVecCoeffs%abcof(i,lm,1,natom,input%jspins))
101 : qaclo(i,lo,n_dos) = qaclo(i,lo,n_dos) + &
102 0 : eigVecCoeffs%abcof(i,lm,0,natom,1)*CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins))
103 : qaclo(i,lo,n_dos) = qaclo(i,lo,n_dos) + &
104 0 : eigVecCoeffs%ccof(m,i,lo,natom,1)*CONJG(eigVecCoeffs%abcof(i,lm,0,natom,input%jspins))
105 : ENDDO
106 : ENDDO
107 0 : DO lop = 1,atoms%nlo(ntyp)
108 0 : IF (atoms%llo(lop,ntyp).EQ.l) THEN
109 0 : DO m = -l,l
110 0 : DO i = 1, noccbd
111 : qlo(i,lop,lo,n_dos) = qlo(i,lop,lo,n_dos) + &
112 : CONJG(eigVecCoeffs%ccof(m,i,lop,natom,input%jspins))*eigVecCoeffs%ccof(m,i,lo,natom,1) +&
113 0 : CONJG(eigVecCoeffs%ccof(m,i,lo,natom,input%jspins))*eigVecCoeffs%ccof(m,i,lop,natom,1)
114 : ENDDO
115 : ENDDO
116 : ENDIF
117 : ENDDO
118 : ENDDO
119 : ENDDO
120 :
121 : !---> perform brillouin zone integration and sum over bands
122 :
123 0 : DO lo = 1,atoms%nlo(ntyp)
124 0 : l = atoms%llo(lo,ntyp)
125 0 : DO i = 1, noccbd
126 : qal21(l,n_dos,i)= qal21(l,n_dos,i) + &
127 : qaclo(i,lo,n_dos)*denCoeffsOffdiag%uulo21n(lo,ntyp) +&
128 : qcloa(i,lo,n_dos)*denCoeffsOffdiag%ulou21n(lo,ntyp) +&
129 : qclob(i,lo,n_dos)*denCoeffsOffdiag%ulod21n(lo,ntyp) +&
130 0 : qbclo(i,lo,n_dos)*denCoeffsOffdiag%dulo21n(lo,ntyp)
131 : END DO
132 0 : DO lop = 1,atoms%nlo(ntyp)
133 0 : IF (atoms%llo(lop,ntyp).EQ.l) THEN
134 0 : DO i = 1, noccbd
135 : qal21(l,n_dos,i)= qal21(l,n_dos,i) + &
136 0 : qlo(i,lop,lo,n_dos)*denCoeffsOffdiag%uloulop21n(lop,lo,ntyp)
137 : ENDDO
138 : ENDIF
139 : ENDDO
140 : END DO
141 0 : qal21(:,n_dos,:) = qal21(:,n_dos,:)/atoms%neq(ntyp)
142 : !
143 : ! rotate into global frame
144 : !
145 : !chi(1,1) = EXP(-ImagUnit*nococonv%alph(ntyp)/2)*COS(nococonv%beta(ntyp)/2)
146 : !chi(1,2) = -EXP(-ImagUnit*nococonv%alph(ntyp)/2)*SIN(nococonv%beta(ntyp)/2)
147 : !chi(2,1) = EXP( ImagUnit*nococonv%alph(ntyp)/2)*SIN(nococonv%beta(ntyp)/2)
148 : !chi(2,2) = EXP( ImagUnit*nococonv%alph(ntyp)/2)*COS(nococonv%beta(ntyp)/2)
149 0 : chi=nococonv%chi(ntyp)
150 374 : state : DO i = 1, noccbd
151 0 : lls : DO l = 0,3
152 : CALL rot_den_mat(nococonv%alph(ntyp),nococonv%beta(ntyp),&
153 0 : dos%qal(l,n_dos,ev_list(i),ikpt,1),dos%qal(l,n_dos,ev_list(i),ikpt,2),qal21(l,n_dos,i))
154 : ENDDO lls
155 : ENDDO state
156 : ENDDO
157 :
158 374 : END SUBROUTINE qal_21
159 : END MODULE m_qal21
|
