Line data Source code
1 : MODULE m_types_scalarGF
2 :
3 : !This module contains a generic scalarproduct type, which is used to construct
4 : !the spherical averages for the intersite and l-offdiagonal elements of the GF
5 :
6 : USE m_constants
7 : USE m_juDFT
8 : USE m_types_atoms
9 : USE m_types_input
10 :
11 : IMPLICIT NONE
12 :
13 : PRIVATE
14 :
15 : TYPE t_scalarGF
16 :
17 : LOGICAL :: done
18 :
19 : REAL, ALLOCATABLE :: uun(:,:)
20 : REAL, ALLOCATABLE :: udn(:,:)
21 : REAL, ALLOCATABLE :: dun(:,:)
22 : REAL, ALLOCATABLE :: ddn(:,:)
23 :
24 : REAL, ALLOCATABLE :: uulon(:,:,:)
25 : REAL, ALLOCATABLE :: uloun(:,:,:)
26 : REAL, ALLOCATABLE :: dulon(:,:,:)
27 : REAL, ALLOCATABLE :: ulodn(:,:,:)
28 :
29 : REAL, ALLOCATABLE :: uloulopn(:,:,:,:)
30 :
31 : CONTAINS
32 : PROCEDURE, PASS :: init => init_scalarGF
33 : PROCEDURE :: addOffdScalarProduct
34 : END TYPE t_scalarGF
35 :
36 : PUBLIC t_scalarGF
37 :
38 : CONTAINS
39 :
40 3046 : SUBROUTINE init_scalarGF(this,atoms,input)
41 :
42 : CLASS(t_scalarGF), INTENT(INOUT) :: this
43 : TYPE(t_atoms), INTENT(IN) :: atoms
44 : TYPE(t_input), INTENT(IN) :: input
45 :
46 3046 : this%done =.FALSE.
47 3046 : IF(ALLOCATED(this%uun)) DEALLOCATE(this%uun)
48 3046 : IF(ALLOCATED(this%udn)) DEALLOCATE(this%udn)
49 3046 : IF(ALLOCATED(this%dun)) DEALLOCATE(this%dun)
50 3046 : IF(ALLOCATED(this%ddn)) DEALLOCATE(this%ddn)
51 :
52 3046 : IF(ALLOCATED(this%uulon)) DEALLOCATE(this%uulon)
53 3046 : IF(ALLOCATED(this%uloun)) DEALLOCATE(this%uloun)
54 3046 : IF(ALLOCATED(this%dulon)) DEALLOCATE(this%dulon)
55 3046 : IF(ALLOCATED(this%ulodn)) DEALLOCATE(this%ulodn)
56 :
57 3046 : IF(ALLOCATED(this%uloulopn)) DEALLOCATE(this%uloulopn)
58 :
59 30460 : ALLOCATE(this%uun(input%jspins,input%jspins),source=0.0)
60 27414 : ALLOCATE(this%udn(input%jspins,input%jspins),source=0.0)
61 27414 : ALLOCATE(this%dun(input%jspins,input%jspins),source=0.0)
62 27414 : ALLOCATE(this%ddn(input%jspins,input%jspins),source=0.0)
63 :
64 58018 : ALLOCATE(this%uulon(atoms%nlod,input%jspins,input%jspins),source=0.0)
65 54972 : ALLOCATE(this%uloun(atoms%nlod,input%jspins,input%jspins),source=0.0)
66 54972 : ALLOCATE(this%dulon(atoms%nlod,input%jspins,input%jspins),source=0.0)
67 54972 : ALLOCATE(this%ulodn(atoms%nlod,input%jspins,input%jspins),source=0.0)
68 :
69 110616 : ALLOCATE(this%uloulopn(atoms%nlod,atoms%nlod,input%jspins,input%jspins),source=0.0)
70 :
71 3046 : END SUBROUTINE init_scalarGF
72 :
73 594 : SUBROUTINE addOffdScalarProduct(this,l,lp,atomType,atomTypep,l_intersite,l_mperp,atoms,input,f,g,flo)
74 :
75 : USE m_intgr
76 :
77 : CLASS(t_scalarGF), INTENT(INOUT) :: this
78 : INTEGER, INTENT(IN) :: l,lp
79 : INTEGER, INTENT(IN) :: atomType,atomTypep
80 : LOGICAL, INTENT(IN) :: l_mperp
81 : LOGICAL, INTENT(IN) :: l_intersite !Is there a non-zero interstitial phase
82 : !(meaning we have to treat r and r' independently)
83 : TYPE(t_atoms), INTENT(IN) :: atoms
84 : TYPE(t_input), INTENT(IN) :: input
85 : REAL, INTENT(IN) :: f(:,:,0:,:,:)
86 : REAL, INTENT(IN) :: g(:,:,0:,:,:)
87 : REAL, INTENT(IN) :: flo(:,:,:,:,:)
88 :
89 594 : REAL :: uu_tmp(atoms%jmtd),uu_tmp2(atoms%jmtd)
90 : INTEGER :: j1,j2,j2_start,j2_end,ilo,ilop,jri
91 :
92 594 : IF(this%done) RETURN !Already calculated
93 :
94 594 : CALL timestart("Offdiagonal Scalar Product")
95 1782 : DO j1 = 1, input%jspins
96 1188 : j2_start = MERGE(1,j1,l_mperp)
97 1188 : j2_end = MERGE(input%jspins,j1,l_mperp)
98 2970 : DO j2 = j2_start, j2_end
99 2376 : IF(.NOT.l_intersite) THEN
100 : !Only l/=lp
101 : uu_tmp(:atoms%jri(atomType)) = f(:atoms%jri(atomType),1,lp,j1,atomTypep)*f(:atoms%jri(atomType),1,l,j2,atomType)&
102 66672 : + f(:atoms%jri(atomType),2,lp,j1,atomTypep)*f(:atoms%jri(atomType),2,l,j2,atomType)
103 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),&
104 72 : this%uun(j1,j2))
105 : uu_tmp(:atoms%jri(atomType)) = f(:atoms%jri(atomType),1,lp,j1,atomTypep)*g(:atoms%jri(atomType),1,l,j2,atomType)&
106 66672 : + f(:atoms%jri(atomType),2,lp,j1,atomTypep)*g(:atoms%jri(atomType),2,l,j2,atomType)
107 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),&
108 72 : this%udn(j1,j2))
109 : uu_tmp(:atoms%jri(atomType)) = g(:atoms%jri(atomType),1,lp,j1,atomTypep)*f(:atoms%jri(atomType),1,l,j2,atomType)&
110 66672 : + g(:atoms%jri(atomType),2,lp,j1,atomTypep)*f(:atoms%jri(atomType),2,l,j2,atomType)
111 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),&
112 72 : this%dun(j1,j2))
113 : uu_tmp(:atoms%jri(atomType)) = g(:atoms%jri(atomType),1,lp,j1,atomTypep)*g(:atoms%jri(atomType),1,l,j2,atomType)&
114 66672 : + g(:atoms%jri(atomType),2,lp,j1,atomTypep)*g(:atoms%jri(atomType),2,l,j2,atomType)
115 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),&
116 72 : this%ddn(j1,j2))
117 :
118 216 : DO ilo = 1, atoms%nlo(atomType)
119 144 : IF(atoms%llo(ilo,atomType).NE.l) CYCLE
120 : uu_tmp(:atoms%jri(atomType)) = f(:atoms%jri(atomType),1,lp,j1,atomTypep)*flo(:atoms%jri(atomType),1,ilo,j2,atomType)&
121 22224 : + f(:atoms%jri(atomType),2,lp,j1,atomTypep)*flo(:atoms%jri(atomType),2,ilo,j2,atomType)
122 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),&
123 24 : this%uulon(ilo,j1,j2))
124 : uu_tmp(:atoms%jri(atomType)) = g(:atoms%jri(atomType),1,lp,j1,atomTypep)*flo(:atoms%jri(atomType),1,ilo,j2,atomType)&
125 22224 : + g(:atoms%jri(atomType),2,lp,j1,atomTypep)*flo(:atoms%jri(atomType),2,ilo,j2,atomType)
126 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),&
127 216 : this%dulon(ilo,j1,j2))
128 : ENDDO
129 :
130 216 : DO ilo = 1, atoms%nlo(atomType)
131 144 : IF(atoms%llo(ilo,atomType).NE.lp) CYCLE
132 : uu_tmp(:atoms%jri(atomType)) = flo(:atoms%jri(atomType),1,ilo,j1,atomTypep)*f(:atoms%jri(atomType),1,l,j2,atomType)&
133 22224 : + flo(:atoms%jri(atomType),2,ilo,j1,atomTypep)*f(:atoms%jri(atomType),2,l,j2,atomType)
134 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),&
135 24 : this%uloun(ilo,j1,j2))
136 : uu_tmp(:atoms%jri(atomType)) = flo(:atoms%jri(atomType),1,ilo,j1,atomTypep)*g(:atoms%jri(atomType),1,l,j2,atomType)&
137 22224 : + flo(:atoms%jri(atomType),2,ilo,j1,atomTypep)*g(:atoms%jri(atomType),2,l,j2,atomType)
138 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),&
139 216 : this%ulodn(ilo,j1,j2))
140 : ENDDO
141 :
142 216 : DO ilo = 1, atoms%nlo(atomType)
143 144 : IF(atoms%llo(ilo,atomType).NE.l) CYCLE
144 144 : DO ilop = 1, atoms%nlo(atomType)
145 48 : IF(atoms%llo(ilop,atomType).NE.lp) CYCLE
146 : uu_tmp(:atoms%jri(atomType)) = flo(:atoms%jri(atomType),1,ilo,j1,atomTypep)*flo(:atoms%jri(atomType),1,ilop,j2,atomType)&
147 0 : + flo(:atoms%jri(atomType),2,ilo,j1,atomTypep)*flo(:atoms%jri(atomType),2,ilop,j2,atomType)
148 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),&
149 192 : this%uloulopn(ilo,ilop,j1,j2))
150 : ENDDO
151 : ENDDO
152 : ELSE
153 : !Full radial dependence (We need to multiply each term with rmesh(atomtype)*rmesh(atomtypep) to get the right normalization)
154 956808 : DO jri = 1, atoms%jri(atomTypep)
155 : uu_tmp2(:atoms%jri(atomType)) = (f(jri,1,lp,j1,atomTypep)*f(:atoms%jri(atomType),1,l,j2,atomType)&
156 : + f(jri,2,lp,j1,atomTypep)*f(:atoms%jri(atomType),2,l,j2,atomType)) &
157 826978536 : * atoms%rmsh(jri,atomTypep) * atoms%rmsh(:atoms%jri(atomType),atomType)
158 956808 : CALL intgr3(uu_tmp2,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),uu_tmp(jri))
159 : ENDDO
160 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomTypep),atoms%dx(atomTypep),atoms%jri(atomTypep), &
161 1116 : this%uun(j1,j2))
162 956808 : DO jri = 1, atoms%jri(atomTypep)
163 : uu_tmp2(:atoms%jri(atomType)) = (f(jri,1,lp,j1,atomTypep)*g(:atoms%jri(atomType),1,l,j2,atomType)&
164 : + f(jri,2,lp,j1,atomTypep)*g(:atoms%jri(atomType),2,l,j2,atomType)) &
165 826978536 : * atoms%rmsh(jri,atomTypep) * atoms%rmsh(:atoms%jri(atomType),atomType)
166 956808 : CALL intgr3(uu_tmp2,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),uu_tmp(jri))
167 : ENDDO
168 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomTypep),atoms%dx(atomTypep),atoms%jri(atomTypep), &
169 1116 : this%udn(j1,j2))
170 956808 : DO jri = 1, atoms%jri(atomTypep)
171 : uu_tmp2(:atoms%jri(atomType)) = (g(jri,1,lp,j1,atomTypep)*f(:atoms%jri(atomType),1,l,j2,atomType)&
172 : + g(jri,2,lp,j1,atomTypep)*f(:atoms%jri(atomType),2,l,j2,atomType)) &
173 826978536 : * atoms%rmsh(jri,atomTypep) * atoms%rmsh(:atoms%jri(atomType),atomType)
174 956808 : CALL intgr3(uu_tmp2,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),uu_tmp(jri))
175 : ENDDO
176 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomTypep),atoms%dx(atomTypep),atoms%jri(atomTypep), &
177 1116 : this%dun(j1,j2))
178 956808 : DO jri = 1, atoms%jri(atomTypep)
179 : uu_tmp2(:atoms%jri(atomType)) = (g(jri,1,lp,j1,atomTypep)*g(:atoms%jri(atomType),1,l,j2,atomType)&
180 : + g(jri,2,lp,j1,atomTypep)*g(:atoms%jri(atomType),2,l,j2,atomType)) &
181 826978536 : * atoms%rmsh(jri,atomTypep) * atoms%rmsh(:atoms%jri(atomType),atomType)
182 956808 : CALL intgr3(uu_tmp2,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),uu_tmp(jri))
183 : ENDDO
184 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomTypep),atoms%dx(atomTypep),atoms%jri(atomTypep), &
185 1116 : this%ddn(j1,j2))
186 3348 : DO ilo = 1, atoms%nlo(atomType)
187 2232 : IF(atoms%llo(ilo,atomType).NE.l) CYCLE
188 :
189 0 : DO jri = 1, atoms%jri(atomTypep)
190 : uu_tmp2(:atoms%jri(atomType)) = (f(jri,1,lp,j1,atomTypep)*flo(:atoms%jri(atomType),1,ilo,j2,atomType)&
191 : + f(jri,2,lp,j1,atomTypep)*flo(:atoms%jri(atomType),2,ilo,j2,atomType)) &
192 0 : * atoms%rmsh(jri,atomTypep) * atoms%rmsh(:atoms%jri(atomType),atomType)
193 0 : CALL intgr3(uu_tmp2,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),uu_tmp(jri))
194 : ENDDO
195 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomTypep),atoms%dx(atomTypep),atoms%jri(atomTypep), &
196 0 : this%uulon(ilo,j1,j2))
197 0 : DO jri = 1, atoms%jri(atomTypep)
198 : uu_tmp2(:atoms%jri(atomType)) = (g(jri,1,lp,j1,atomTypep)*flo(:atoms%jri(atomType),1,ilo,j2,atomType)&
199 : + g(jri,2,lp,j1,atomTypep)*flo(:atoms%jri(atomType),2,ilo,j2,atomType)) &
200 0 : * atoms%rmsh(jri,atomTypep) * atoms%rmsh(:atoms%jri(atomType),atomType)
201 0 : CALL intgr3(uu_tmp2,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),uu_tmp(jri))
202 : ENDDO
203 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomTypep),atoms%dx(atomTypep),atoms%jri(atomTypep), &
204 3348 : this%dulon(ilo,j1,j2))
205 : ENDDO
206 3348 : DO ilo = 1, atoms%nlo(atomTypep)
207 2232 : IF(atoms%llo(ilo,atomTypep).NE.lp) CYCLE
208 :
209 0 : DO jri = 1, atoms%jri(atomTypep)
210 : uu_tmp2(:atoms%jri(atomType)) = (flo(jri,1,ilo,j1,atomTypep)*f(:atoms%jri(atomType),1,l,j2,atomType)&
211 : + flo(jri,2,ilo,j1,atomTypep)*f(:atoms%jri(atomType),2,l,j2,atomType)) &
212 0 : * atoms%rmsh(jri,atomTypep) * atoms%rmsh(:atoms%jri(atomType),atomType)
213 0 : CALL intgr3(uu_tmp2,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),uu_tmp(jri))
214 : ENDDO
215 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomTypep),atoms%dx(atomTypep),atoms%jri(atomTypep), &
216 0 : this%uloun(ilo,j1,j2))
217 0 : DO jri = 1, atoms%jri(atomTypep)
218 : uu_tmp2(:atoms%jri(atomType)) = (flo(jri,1,ilo,j1,atomTypep)*g(:atoms%jri(atomType),1,l,j2,atomType)&
219 : + flo(jri,2,ilo,j1,atomTypep)*g(:atoms%jri(atomType),2,l,j2,atomType)) &
220 0 : * atoms%rmsh(jri,atomTypep) * atoms%rmsh(:atoms%jri(atomType),atomType)
221 0 : CALL intgr3(uu_tmp2,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),uu_tmp(jri))
222 : ENDDO
223 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomTypep),atoms%dx(atomTypep),atoms%jri(atomTypep), &
224 3348 : this%ulodn(ilo,j1,j2))
225 : ENDDO
226 :
227 3348 : DO ilo = 1, atoms%nlo(atomType)
228 2232 : IF(atoms%llo(ilo,atomType).NE.l) CYCLE
229 1116 : DO ilop = 1, atoms%nlo(atomTypep)
230 0 : IF(atoms%llo(ilop,atomTypep).NE.lp) CYCLE
231 0 : DO jri = 1, atoms%jri(atomTypep)
232 : uu_tmp2(:atoms%jri(atomType)) = (flo(jri,1,ilop,j1,atomTypep)*flo(:atoms%jri(atomType),1,ilo,j2,atomType)&
233 : + flo(jri,2,ilop,j1,atomTypep)*flo(:atoms%jri(atomType),2,ilo,j2,atomType)) &
234 0 : * atoms%rmsh(jri,atomTypep) * atoms%rmsh(:atoms%jri(atomType),atomType)
235 0 : CALL intgr3(uu_tmp2,atoms%rmsh(:,atomType),atoms%dx(atomType),atoms%jri(atomType),uu_tmp(jri))
236 : ENDDO
237 : CALL intgr3(uu_tmp,atoms%rmsh(:,atomTypep),atoms%dx(atomTypep),atoms%jri(atomTypep), &
238 2232 : this%uloulopn(ilo,ilop,j1,j2))
239 : ENDDO
240 : ENDDO
241 : ENDIF
242 : ENDDO
243 : ENDDO
244 :
245 594 : this%done = .TRUE.
246 594 : CALL timestop("Offdiagonal Scalar Product")
247 :
248 : END SUBROUTINE addOffdScalarProduct
249 :
250 0 : END MODULE m_types_scalarGF
|
