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_types_greensfCoeffs
8 :
9 : USE m_juDFT
10 : USE m_types_setup
11 : USE m_constants
12 :
13 : IMPLICIT NONE
14 :
15 : PRIVATE
16 :
17 : TYPE t_greensfBZintCoeffs
18 :
19 : !Contains only the coefficients for each kpt and band handled by the current mpi rank
20 :
21 : COMPLEX, ALLOCATABLE :: sphavg(:,:,:,:)
22 :
23 : ! These arrays are only used in the case we want the green's function with radial dependence
24 : COMPLEX, ALLOCATABLE :: uu(:,:,:,:)
25 : COMPLEX, ALLOCATABLE :: dd(:,:,:,:)
26 : COMPLEX, ALLOCATABLE :: du(:,:,:,:)
27 : COMPLEX, ALLOCATABLE :: ud(:,:,:,:)
28 :
29 : !LO-Valence Contribution
30 : COMPLEX, ALLOCATABLE :: uulo(:,:,:,:,:)
31 : COMPLEX, ALLOCATABLE :: ulou(:,:,:,:,:)
32 : COMPLEX, ALLOCATABLE :: dulo(:,:,:,:,:)
33 : COMPLEX, ALLOCATABLE :: ulod(:,:,:,:,:)
34 :
35 : !LO-LO contribution
36 : !Here we need to compress the (lo,lop) index pair into one index because PGI allows a max of 7 indices
37 : COMPLEX, ALLOCATABLE :: uloulop(:,:,:,:,:)
38 :
39 : CONTAINS
40 : PROCEDURE, PASS :: init => greensfBZintCoeffs_init
41 : PROCEDURE, PASS :: add_contribution => greensfBZintCoeffs_add_contribution
42 : PROCEDURE, PASS :: reset => greensfBZintCoeffs_reset
43 : END TYPE t_greensfBZintCoeffs
44 :
45 :
46 : TYPE t_greensfImagPart
47 :
48 : !Contains the imaginary part of the greens function
49 : INTEGER, ALLOCATABLE :: kkintgr_cutoff(:,:,:)
50 : REAL , ALLOCATABLE :: scalingFactorSphavg(:,:)
51 : REAL , ALLOCATABLE :: scalingFactorRadial(:,:)
52 : REAL , ALLOCATABLE :: scalingFactorSphavgKres(:,:)
53 : LOGICAL :: l_calc = .FALSE.
54 :
55 : COMPLEX, ALLOCATABLE :: sphavg(:,:,:,:,:)
56 :
57 : ! These arrays are only used in the case we want the green's function with radial dependence
58 : COMPLEX, ALLOCATABLE :: uu(:,:,:,:,:)
59 : COMPLEX, ALLOCATABLE :: dd(:,:,:,:,:)
60 : COMPLEX, ALLOCATABLE :: du(:,:,:,:,:)
61 : COMPLEX, ALLOCATABLE :: ud(:,:,:,:,:)
62 :
63 : !LO-Valence Contribution
64 : COMPLEX, ALLOCATABLE :: uulo(:,:,:,:,:,:)
65 : COMPLEX, ALLOCATABLE :: ulou(:,:,:,:,:,:)
66 : COMPLEX, ALLOCATABLE :: dulo(:,:,:,:,:,:)
67 : COMPLEX, ALLOCATABLE :: ulod(:,:,:,:,:,:)
68 :
69 : !LO-LO contribution
70 : !Here the (lo,lop) index pair is explicit again
71 : COMPLEX, ALLOCATABLE :: uloulop(:,:,:,:,:,:,:)
72 :
73 :
74 : !K-resolved greens functions
75 : !(Radially resolved not yet implemented since we hit the indices limit on PGI)
76 : COMPLEX, ALLOCATABLE :: sphavg_k(:,:,:,:,:,:)
77 :
78 : CONTAINS
79 : PROCEDURE, PASS :: init => greensfImagPart_init
80 : PROCEDURE, PASS :: collect => greensfImagPart_collect
81 : PROCEDURE, PASS :: mpi_bc => greensfImagPart_mpi_bc
82 : PROCEDURE :: scale => greensfImagPart_scale
83 : PROCEDURE :: applyCutoff => greensfImagPart_applyCutoff
84 : PROCEDURE :: checkEmpty => greensfImagPart_checkEmpty
85 : END TYPE t_greensfImagPart
86 :
87 : PUBLIC t_greensfBZintCoeffs, t_greensfImagPart
88 :
89 : CONTAINS
90 :
91 80 : SUBROUTINE greensfBZintCoeffs_init(this,gfinp,atoms,noco,nbands)
92 :
93 : CLASS(t_greensfBZintCoeffs), INTENT(INOUT) :: this
94 : TYPE(t_gfinp), INTENT(IN) :: gfinp
95 : TYPE(t_atoms), INTENT(IN) :: atoms
96 : TYPE(t_noco), INTENT(IN) :: noco
97 : INTEGER, INTENT(IN) :: nbands !number of kpts and bands handled by this rank
98 :
99 : INTEGER lmax, uniqueElementsSphavg,uniqueElementsRadial, maxSpin,uniqueElementsLO,maxLO
100 :
101 80 : lmax = lmaxU_const
102 :
103 : !Determine number of unique gf elements
104 80 : uniqueElementsSphavg = gfinp%uniqueElements(atoms,l_sphavg=.TRUE.) !How many spherically averaged elements
105 80 : uniqueElementsRadial = gfinp%uniqueElements(atoms,l_sphavg=.FALSE.) !How many elements with radial dependence
106 :
107 80 : IF(uniqueElementsSphavg>0) THEN
108 1995820 : ALLOCATE (this%sphavg(nbands,-lmax:lmax,-lmax:lmax,uniqueElementsSphavg),source=cmplx_0)
109 : ENDIF
110 80 : IF(uniqueElementsRadial>0) THEN
111 66324 : ALLOCATE (this%uu(nbands,-lmax:lmax,-lmax:lmax,uniqueElementsRadial),source=cmplx_0)
112 66292 : ALLOCATE (this%dd(nbands,-lmax:lmax,-lmax:lmax,uniqueElementsRadial),source=cmplx_0)
113 66292 : ALLOCATE (this%du(nbands,-lmax:lmax,-lmax:lmax,uniqueElementsRadial),source=cmplx_0)
114 66292 : ALLOCATE (this%ud(nbands,-lmax:lmax,-lmax:lmax,uniqueElementsRadial),source=cmplx_0)
115 :
116 16 : uniqueElementsLO = gfinp%uniqueElements(atoms,lo=.TRUE.,l_sphavg=.FALSE.,maxLO=maxLO)
117 :
118 16 : IF(uniqueElementsLO>0) THEN
119 71808 : ALLOCATE (this%uulo(nbands,-lmax:lmax,-lmax:lmax,maxLO,uniqueElementsLO),source=cmplx_0)
120 71796 : ALLOCATE (this%ulou(nbands,-lmax:lmax,-lmax:lmax,maxLO,uniqueElementsLO),source=cmplx_0)
121 71796 : ALLOCATE (this%dulo(nbands,-lmax:lmax,-lmax:lmax,maxLO,uniqueElementsLO),source=cmplx_0)
122 71796 : ALLOCATE (this%ulod(nbands,-lmax:lmax,-lmax:lmax,maxLO,uniqueElementsLO),source=cmplx_0)
123 :
124 122112 : ALLOCATE (this%uloulop(nbands,-lmax:lmax,-lmax:lmax,maxLO**2,uniqueElementsLO),source=cmplx_0)
125 : ENDIF
126 : ENDIF
127 :
128 80 : END SUBROUTINE greensfBZintCoeffs_init
129 :
130 456 : subroutine greensfBZintCoeffs_reset(this)
131 :
132 : class(t_greensfBZintCoeffs), intent(inout) :: this
133 :
134 14593188 : if (allocated(this%sphavg)) this%sphavg = cmplx_0
135 456 : if (allocated(this%uu)) then
136 331300 : this%uu = cmplx_0
137 331300 : this%ud = cmplx_0
138 331300 : this%du = cmplx_0
139 331300 : this%dd = cmplx_0
140 : endif
141 456 : if (allocated(this%uulo)) then
142 358800 : this%uulo = cmplx_0
143 358800 : this%ulou = cmplx_0
144 358800 : this%dulo = cmplx_0
145 358800 : this%ulod = cmplx_0
146 610320 : this%uloulop = cmplx_0
147 : endif
148 :
149 456 : end subroutine
150 :
151 1530578 : SUBROUTINE greensfBZintCoeffs_add_contribution(this, i_elem, i_elemLO, iBand, nLO, imat, l_sphavg, contribution)
152 :
153 : CLASS(t_greensfBZintCoeffs), INTENT(INOUT) :: this
154 : INTEGER, INTENT(IN) :: i_elem,i_elemLO,nLO,iBand,imat
155 : LOGICAL, INTENT(IN) :: l_sphavg
156 : COMPLEX, INTENT(IN) :: contribution(-lmaxU_const:,-lmaxU_const:)
157 :
158 : INTEGER :: iLO
159 :
160 1530578 : IF(l_sphavg) THEN
161 : !Spherically averaged (already multiplied with scalar products)
162 : this%sphavg(iBand,:,:,i_elem) = &
163 84574092 : this%sphavg(iBand,:,:,i_elem) + contribution
164 46822 : ELSE IF(imat.EQ.1) THEN
165 : !imat 1-4: coefficients for Valence-Valence contribution
166 : this%uu(iBand,:,:,i_elem) = &
167 305064 : this%uu(iBand,:,:,i_elem) + contribution
168 41470 : ELSE IF(imat.EQ.2) THEN
169 : this%dd(iBand,:,:,i_elem) = &
170 305064 : this%dd(iBand,:,:,i_elem) + contribution
171 36118 : ELSE IF(imat.EQ.3) THEN
172 : this%ud(iBand,:,:,i_elem) = &
173 305064 : this%ud(iBand,:,:,i_elem) + contribution
174 30766 : ELSE IF(imat.EQ.4) THEN
175 : this%du(iBand,:,:,i_elem) = &
176 305064 : this%du(iBand,:,:,i_elem) + contribution
177 25414 : ELSE IF((imat-4.0)/2.0<=nLO) THEN
178 : !imat 5 - 4+2*numberofLOs: coefficients for Valence-LO contribution
179 9380 : iLO = CEILING(REAL(imat-4.0)/2.0)
180 9380 : IF(MOD(imat-4,2)==1) THEN
181 : this%uulo(iBand,:,:,iLO,i_elemLO) = &
182 267330 : this%uulo(iBand,:,:,iLO,i_elemLO) + contribution
183 4690 : ELSE IF(MOD(imat-4,2)==0) THEN
184 : this%dulo(iBand,:,:,iLO,i_elemLO) = &
185 267330 : this%dulo(iBand,:,:,iLO,i_elemLO) + contribution
186 : ENDIF
187 16034 : ELSE IF((imat-4.0)/2.0<=2.0*nLO) THEN
188 : !imat 4+2*numberofLOs+1 - 4+4*numberofLOs: coefficients for LO-Valence contribution
189 9380 : iLO = CEILING(REAL(imat-4.0-2*nLO)/2.0)
190 9380 : IF(MOD(imat-4-2*nLO,2)==1) THEN
191 : this%ulou(iBand,:,:,iLO,i_elemLO) = &
192 267330 : this%ulou(iBand,:,:,iLO,i_elemLO) + contribution
193 4690 : ELSE IF(MOD(imat-4-2*nLO,2)==0) THEN
194 : this%ulod(iBand,:,:,iLO,i_elemLO) = &
195 267330 : this%ulod(iBand,:,:,iLO,i_elemLO) + contribution
196 : ENDIF
197 : ELSE
198 : !imat 4+4*numberofLOs+1 - 4+4*numberofLOs+numberofLOs**2: coefficients for LO-LO contribution
199 6654 : iLO = imat - 4 - 4*nLO
200 : this%uloulop(iBand,:,:,iLO,i_elemLO) = &
201 379278 : this%uloulop(iBand,:,:,iLO,i_elemLO) + contribution
202 : ENDIF
203 :
204 1530578 : END SUBROUTINE greensfBZintCoeffs_add_contribution
205 :
206 42 : SUBROUTINE greensfImagPart_init(this,gfinp,atoms,input,noco,l_calc,nkpts)
207 :
208 : CLASS(t_greensfImagPart), INTENT(INOUT) :: this
209 : TYPE(t_gfinp), INTENT(IN) :: gfinp
210 : TYPE(t_atoms), INTENT(IN) :: atoms
211 : TYPE(t_input), INTENT(IN) :: input
212 : TYPE(t_noco), INTENT(IN) :: noco
213 : LOGICAL, INTENT(IN) :: l_calc
214 : INTEGER, INTENT(IN) :: nkpts
215 :
216 : INTEGER lmax,spin_dim,uniqueElementsSphavg,uniqueElementsRadial,uniqueElementsLO,maxLO
217 : INTEGER uniqueElementsSphavg_kres
218 :
219 42 : spin_dim = MERGE(3,input%jspins,gfinp%l_mperp)
220 42 : lmax = lmaxU_const
221 :
222 42 : this%l_calc = l_calc
223 :
224 : !Determine number of unique gf elements
225 42 : uniqueElementsSphavg = gfinp%uniqueElements(atoms,l_sphavg=.TRUE.,l_kresolved_int=.FALSE.) !How many spherically averaged elements
226 42 : uniqueElementsRadial = gfinp%uniqueElements(atoms,l_sphavg=.FALSE.,l_kresolved_int=.FALSE.) !How many elements with radial dependence
227 :
228 42 : uniqueElementsSphavg_kres = gfinp%uniqueElements(atoms,l_sphavg=.TRUE.,l_kresolved_int=.TRUE.) !How many spherically averaged elements with k-resolution
229 :
230 4534 : ALLOCATE (this%kkintgr_cutoff(gfinp%n,input%jspins,2),source=0)
231 42 : IF(uniqueElementsSphavg>0) THEN
232 181779836 : ALLOCATE (this%sphavg(gfinp%ne,-lmax:lmax,-lmax:lmax,uniqueElementsSphavg,spin_dim),source=cmplx_0)
233 724 : ALLOCATE (this%scalingFactorSphavg(uniqueElementsSphavg,input%jspins),source=1.0)
234 : ENDIF
235 42 : IF(uniqueElementsRadial>0) THEN
236 6351832 : ALLOCATE (this%uu(gfinp%ne,-lmax:lmax,-lmax:lmax,uniqueElementsRadial,spin_dim),source=cmplx_0)
237 6351816 : ALLOCATE (this%dd(gfinp%ne,-lmax:lmax,-lmax:lmax,uniqueElementsRadial,spin_dim),source=cmplx_0)
238 6351816 : ALLOCATE (this%du(gfinp%ne,-lmax:lmax,-lmax:lmax,uniqueElementsRadial,spin_dim),source=cmplx_0)
239 6351816 : ALLOCATE (this%ud(gfinp%ne,-lmax:lmax,-lmax:lmax,uniqueElementsRadial,spin_dim),source=cmplx_0)
240 72 : ALLOCATE (this%scalingFactorRadial(uniqueElementsRadial,input%jspins),source=1.0)
241 :
242 8 : uniqueElementsLO = gfinp%uniqueElements(atoms,lo=.TRUE.,l_sphavg=.FALSE.,maxLO=maxLO, l_kresolved_int=.FALSE.)
243 8 : IF(uniqueElementsLO>0) THEN
244 6351832 : ALLOCATE (this%uulo(gfinp%ne,-lmax:lmax,-lmax:lmax,maxLO,uniqueElementsLO,spin_dim),source=cmplx_0)
245 6351826 : ALLOCATE (this%ulou(gfinp%ne,-lmax:lmax,-lmax:lmax,maxLO,uniqueElementsLO,spin_dim),source=cmplx_0)
246 6351826 : ALLOCATE (this%dulo(gfinp%ne,-lmax:lmax,-lmax:lmax,maxLO,uniqueElementsLO,spin_dim),source=cmplx_0)
247 6351826 : ALLOCATE (this%ulod(gfinp%ne,-lmax:lmax,-lmax:lmax,maxLO,uniqueElementsLO,spin_dim),source=cmplx_0)
248 :
249 10586374 : ALLOCATE (this%uloulop(gfinp%ne,-lmax:lmax,-lmax:lmax,maxLO,maxLO,uniqueElementsLO,spin_dim),source=cmplx_0)
250 : ENDIF
251 : ENDIF
252 42 : IF(uniqueElementsSphavg_kres>0) THEN
253 0 : ALLOCATE (this%sphavg_k(gfinp%ne,-lmax:lmax,-lmax:lmax,uniqueElementsSphavg_kres,spin_dim,nkpts),source=cmplx_0)
254 0 : ALLOCATE (this%scalingFactorSphavgKres(uniqueElementsSphavg_kres,input%jspins),source=1.0)
255 : ENDIF
256 :
257 42 : END SUBROUTINE greensfImagPart_init
258 :
259 88 : SUBROUTINE greensfImagPart_collect(this,spin_ind,mpi_communicator)
260 :
261 : #ifdef CPP_MPI
262 : USE mpi
263 : #endif
264 :
265 : CLASS(t_greensfImagPart), INTENT(INOUT) :: this
266 : INTEGER, INTENT(IN) :: spin_ind
267 : INTEGER, INTENT(IN) :: mpi_communicator
268 : #ifdef CPP_MPI
269 : INTEGER:: ierr, n, i_batch, start, end, n_elements, elements_per_batch
270 : integer, parameter :: batch_size = 200 !200 Greens functions are collected at one time
271 88 : COMPLEX,ALLOCATABLE::ctmp(:)
272 :
273 88 : if(allocated(this%sphavg)) then
274 80 : elements_per_batch = SIZE(this%sphavg,1)*SIZE(this%sphavg,2)*SIZE(this%sphavg,3)
275 80 : n_elements = SIZE(this%sphavg,4)
276 240 : ALLOCATE(ctmp(elements_per_batch*batch_size))
277 160 : do i_batch = 1, ceiling(n_elements/real(batch_size))
278 80 : start = (i_batch-1) * batch_size + 1
279 80 : end = min(i_batch*batch_size,n_elements)
280 :
281 80 : n = (end-start+1) * elements_per_batch
282 80 : call mpi_allreduce(this%sphavg(:,:,:,start:end,spin_ind),ctmp(:n),n,MPI_DOUBLE_COMPLEX,MPI_SUM, mpi_communicator,ierr)
283 160 : call zcopy(n,ctmp(:n),1,this%sphavg(:,:,:,start:end,spin_ind),1)
284 : enddo
285 80 : deallocate(ctmp)
286 : endif
287 :
288 88 : if(allocated(this%uu)) then
289 16 : elements_per_batch = SIZE(this%uu,1)*SIZE(this%uu,2)*SIZE(this%uu,3)
290 16 : n_elements = SIZE(this%uu,4)
291 48 : ALLOCATE(ctmp(elements_per_batch*batch_size))
292 32 : do i_batch = 1, ceiling(n_elements/real(batch_size))
293 16 : start = (i_batch-1) * batch_size + 1
294 16 : end = min(i_batch*batch_size,n_elements)
295 :
296 16 : n = (end-start+1) * elements_per_batch
297 16 : call mpi_allreduce(this%uu(:,:,:,start:end,spin_ind),ctmp(:n),n,MPI_DOUBLE_COMPLEX,MPI_SUM, mpi_communicator,ierr)
298 16 : call zcopy(n,ctmp(:n),1,this%uu(:,:,:,start:end,spin_ind),1)
299 16 : call mpi_allreduce(this%ud(:,:,:,start:end,spin_ind),ctmp(:n),n,MPI_DOUBLE_COMPLEX,MPI_SUM, mpi_communicator,ierr)
300 16 : call zcopy(n,ctmp(:n),1,this%ud(:,:,:,start:end,spin_ind),1)
301 16 : call mpi_allreduce(this%du(:,:,:,start:end,spin_ind),ctmp(:n),n,MPI_DOUBLE_COMPLEX,MPI_SUM, mpi_communicator,ierr)
302 16 : call zcopy(n,ctmp(:n),1,this%du(:,:,:,start:end,spin_ind),1)
303 16 : call mpi_allreduce(this%dd(:,:,:,start:end,spin_ind),ctmp(:n),n,MPI_DOUBLE_COMPLEX,MPI_SUM, mpi_communicator,ierr)
304 32 : call zcopy(n,ctmp(:n),1,this%dd(:,:,:,start:end,spin_ind),1)
305 : enddo
306 16 : deallocate(ctmp)
307 : endif
308 :
309 88 : if(allocated(this%uulo)) then
310 12 : elements_per_batch = SIZE(this%uulo,1)*SIZE(this%uulo,2)*SIZE(this%uulo,3)*SIZE(this%uulo,4)
311 12 : n_elements = SIZE(this%uulo,5)
312 36 : ALLOCATE(ctmp(elements_per_batch*batch_size))
313 24 : do i_batch = 1, ceiling(n_elements/real(batch_size))
314 12 : start = (i_batch-1) * batch_size + 1
315 12 : end = min(i_batch*batch_size,n_elements)
316 :
317 12 : n = (end-start+1) * elements_per_batch
318 12 : call mpi_allreduce(this%uulo(:,:,:,:,start:end,spin_ind),ctmp(:n),n,MPI_DOUBLE_COMPLEX,MPI_SUM, mpi_communicator,ierr)
319 12 : call zcopy(n,ctmp(:n),1,this%uulo(:,:,:,:,start:end,spin_ind),1)
320 12 : call mpi_allreduce(this%ulou(:,:,:,:,start:end,spin_ind),ctmp(:n),n,MPI_DOUBLE_COMPLEX,MPI_SUM, mpi_communicator,ierr)
321 12 : call zcopy(n,ctmp(:n),1,this%ulou(:,:,:,:,start:end,spin_ind),1)
322 12 : call mpi_allreduce(this%dulo(:,:,:,:,start:end,spin_ind),ctmp(:n),n,MPI_DOUBLE_COMPLEX,MPI_SUM, mpi_communicator,ierr)
323 12 : call zcopy(n,ctmp(:n),1,this%dulo(:,:,:,:,start:end,spin_ind),1)
324 12 : call mpi_allreduce(this%ulod(:,:,:,:,start:end,spin_ind),ctmp(:n),n,MPI_DOUBLE_COMPLEX,MPI_SUM, mpi_communicator,ierr)
325 24 : call zcopy(n,ctmp(:n),1,this%ulod(:,:,:,:,start:end,spin_ind),1)
326 : enddo
327 12 : deallocate(ctmp)
328 : endif
329 :
330 88 : if(allocated(this%uloulop)) then
331 : elements_per_batch = SIZE(this%uloulop,1)*SIZE(this%uloulop,2)*SIZE(this%uloulop,3)*SIZE(this%uloulop,4)&
332 12 : *SIZE(this%uloulop,5)
333 12 : n_elements = SIZE(this%uloulop,6)
334 36 : ALLOCATE(ctmp(elements_per_batch*batch_size))
335 24 : do i_batch = 1, ceiling(n_elements/real(batch_size))
336 12 : start = (i_batch-1) * batch_size + 1
337 12 : end = min(i_batch*batch_size,n_elements)
338 :
339 12 : n = (end-start+1) * elements_per_batch
340 12 : call mpi_allreduce(this%uloulop(:,:,:,:,:,start:end,spin_ind),ctmp(:n),n,MPI_DOUBLE_COMPLEX,MPI_SUM, mpi_communicator,ierr)
341 24 : call zcopy(n,ctmp(:n),1,this%uloulop(:,:,:,:,:,start:end,spin_ind),1)
342 : enddo
343 12 : deallocate(ctmp)
344 : endif
345 : #endif
346 :
347 88 : END SUBROUTINE greensfImagPart_collect
348 :
349 42 : SUBROUTINE greensfImagPart_mpi_bc(this,mpi_comm,irank)
350 : USE m_mpi_bc_tool
351 : CLASS(t_greensfImagPart), INTENT(INOUT)::this
352 : INTEGER, INTENT(IN):: mpi_comm
353 : INTEGER, INTENT(IN), OPTIONAL::irank
354 : INTEGER ::rank
355 42 : IF (PRESENT(irank)) THEN
356 0 : rank = irank
357 : ELSE
358 42 : rank = 0
359 : END IF
360 :
361 42 : CALL mpi_bc(this%l_calc,rank,mpi_comm)
362 :
363 42 : IF(ALLOCATED(this%kkintgr_cutoff)) CALL mpi_bc(this%kkintgr_cutoff,rank,mpi_comm)
364 42 : IF(ALLOCATED(this%scalingFactorSphavg)) CALL mpi_bc(this%scalingFactorSphavg,rank,mpi_comm)
365 42 : IF(ALLOCATED(this%scalingFactorRadial)) CALL mpi_bc(this%scalingFactorRadial,rank,mpi_comm)
366 42 : IF(ALLOCATED(this%scalingFactorSphavgKres)) CALL mpi_bc(this%scalingFactorSphavgKres,rank,mpi_comm)
367 42 : IF(ALLOCATED(this%sphavg)) CALL mpi_bc(this%sphavg,rank,mpi_comm)
368 42 : IF(ALLOCATED(this%uu)) CALL mpi_bc(this%uu,rank,mpi_comm)
369 42 : IF(ALLOCATED(this%ud)) CALL mpi_bc(this%ud,rank,mpi_comm)
370 42 : IF(ALLOCATED(this%du)) CALL mpi_bc(this%du,rank,mpi_comm)
371 42 : IF(ALLOCATED(this%dd)) CALL mpi_bc(this%dd,rank,mpi_comm)
372 42 : IF(ALLOCATED(this%uulo)) CALL mpi_bc(this%uulo,rank,mpi_comm)
373 42 : IF(ALLOCATED(this%ulou)) CALL mpi_bc(this%ulou,rank,mpi_comm)
374 42 : IF(ALLOCATED(this%dulo)) CALL mpi_bc(this%dulo,rank,mpi_comm)
375 42 : IF(ALLOCATED(this%ulod)) CALL mpi_bc(this%ulod,rank,mpi_comm)
376 42 : IF(ALLOCATED(this%uloulop)) CALL mpi_bc(this%uloulop,rank,mpi_comm)
377 :
378 42 : END SUBROUTINE greensfImagPart_mpi_bc
379 :
380 130 : SUBROUTINE greensfImagPart_scale(this,i_elem,i_elemLO,l_sphavg,nLO,k_resolved)
381 :
382 : CLASS(t_greensfImagPart), INTENT(INOUT):: this
383 : INTEGER, INTENT(IN) :: i_elem
384 : INTEGER, INTENT(IN) :: i_elemLO
385 : LOGICAL, INTENT(IN) :: l_sphavg
386 : INTEGER, INTENT(IN) :: nLO
387 : LOGICAL, OPTIONAL, INTENT(IN) :: k_resolved
388 :
389 : INTEGER :: jspin
390 : LOGICAL :: k_resolved_arg
391 :
392 130 : k_resolved_arg = .FALSE.
393 130 : IF(PRESENT(k_resolved)) k_resolved_arg = k_resolved
394 :
395 130 : IF(l_sphavg.AND..NOT.k_resolved_arg) THEN
396 124 : IF(ALLOCATED(this%sphavg)) THEN
397 124 : IF(SIZE(this%sphavg,5)==2) THEN
398 360 : DO jspin = 1, SIZE(this%sphavg,5)
399 : this%sphavg(:,-lmaxU_const:,-lmaxU_const:,i_elem,jspin) = this%scalingFactorSphavg(i_elem,jspin) &
400 89301600 : * this%sphavg(:,-lmaxU_const:,-lmaxU_const:,i_elem,jspin)
401 : ENDDO
402 : ENDIF
403 : ENDIF
404 6 : ELSE IF(.NOT.k_resolved_arg) THEN
405 6 : IF(ALLOCATED(this%uu)) THEN
406 6 : IF(SIZE(this%uu,5)==2) THEN
407 18 : DO jspin = 1, SIZE(this%uu,5)
408 : this%uu(:,-lmaxU_const:,-lmaxU_const:,i_elem,jspin) = this%scalingFactorRadial(i_elem,jspin) &
409 3175884 : * this%uu(:,-lmaxU_const:,-lmaxU_const:,i_elem,jspin)
410 : this%dd(:,-lmaxU_const:,-lmaxU_const:,i_elem,jspin) = this%scalingFactorRadial(i_elem,jspin) &
411 3175884 : * this%dd(:,-lmaxU_const:,-lmaxU_const:,i_elem,jspin)
412 : this%ud(:,-lmaxU_const:,-lmaxU_const:,i_elem,jspin) = this%scalingFactorRadial(i_elem,jspin) &
413 3175884 : * this%ud(:,-lmaxU_const:,-lmaxU_const:,i_elem,jspin)
414 : this%du(:,-lmaxU_const:,-lmaxU_const:,i_elem,jspin) = this%scalingFactorRadial(i_elem,jspin) &
415 3175890 : * this%du(:,-lmaxU_const:,-lmaxU_const:,i_elem,jspin)
416 : ENDDO
417 : ENDIF
418 : ENDIF
419 6 : IF(ALLOCATED(this%uulo)) THEN
420 5 : IF(nLO>0) THEN
421 4 : IF(SIZE(this%uulo,6)==2) THEN
422 12 : DO jspin = 1, SIZE(this%uulo,6)
423 : this%uulo(:,-lmaxU_const:,-lmaxU_const:,:,i_elemLO,jspin) = this%scalingFactorRadial(i_elem,jspin) &
424 3175892 : * this%uulo(:,-lmaxU_const:,-lmaxU_const:,:,i_elemLO,jspin)
425 : this%ulou(:,-lmaxU_const:,-lmaxU_const:,:,i_elemLO,jspin) = this%scalingFactorRadial(i_elem,jspin) &
426 3175892 : * this%ulou(:,-lmaxU_const:,-lmaxU_const:,:,i_elemLO,jspin)
427 : this%dulo(:,-lmaxU_const:,-lmaxU_const:,:,i_elemLO,jspin) = this%scalingFactorRadial(i_elem,jspin) &
428 3175892 : * this%dulo(:,-lmaxU_const:,-lmaxU_const:,:,i_elemLO,jspin)
429 : this%ulod(:,-lmaxU_const:,-lmaxU_const:,:,i_elemLO,jspin) = this%scalingFactorRadial(i_elem,jspin) &
430 3175892 : * this%ulod(:,-lmaxU_const:,-lmaxU_const:,:,i_elemLO,jspin)
431 :
432 : this%uloulop(:,-lmaxU_const:,-lmaxU_const:,:,:,i_elemLO,jspin) = this%scalingFactorRadial(i_elem,jspin) &
433 5293164 : * this%uloulop(:,-lmaxU_const:,-lmaxU_const:,:,:,i_elemLO,jspin)
434 : ENDDO
435 : ENDIF
436 : ENDIF
437 : ENDIF
438 : ELSE
439 0 : IF(ALLOCATED(this%sphavg_k)) THEN
440 0 : IF(SIZE(this%sphavg_k,5)==2) THEN
441 0 : DO jspin = 1, SIZE(this%sphavg_k,5)
442 : this%sphavg_k(:,-lmaxU_const:,-lmaxU_const:,i_elem,jspin,:) = this%scalingFactorSphavgKres(i_elem,jspin) &
443 0 : * this%sphavg_k(:,-lmaxU_const:,-lmaxU_const:,i_elem,jspin,:)
444 : ENDDO
445 : ENDIF
446 : ENDIF
447 : ENDIF
448 :
449 130 : END SUBROUTINE greensfImagPart_scale
450 :
451 844 : PURE FUNCTION greensfImagPart_applyCutoff(this,i_elem,i_gf,spin,l_sphavg,imat,iLO,iLOp,ikpt) Result(imagpartCut)
452 :
453 : CLASS(t_greensfImagPart), INTENT(IN) :: this
454 : INTEGER, INTENT(IN) :: i_elem
455 : INTEGER, INTENT(IN) :: i_gf
456 : INTEGER, INTENT(IN) :: spin
457 : LOGICAL, INTENT(IN) :: l_sphavg
458 : INTEGER, OPTIONAL, INTENT(IN) :: imat !which radial dependence array
459 : INTEGER, OPTIONAL, INTENT(IN) :: iLO,iLOp !which local orbitals
460 : INTEGER, OPTIONAL, INTENT(IN) :: ikpt
461 :
462 : COMPLEX, ALLOCATABLE :: imagpartCut(:,:,:)
463 :
464 : INTEGER :: spin_ind, kkcut, ne
465 :
466 844 : ne = -1
467 844 : IF(ALLOCATED(this%sphavg)) THEN
468 632 : ne = SIZE(this%sphavg,1)
469 212 : ELSE IF(ALLOCATED(this%uu)) THEN
470 212 : ne = SIZE(this%uu,1)
471 0 : ELSE IF(ALLOCATED(this%sphavg_k)) THEN
472 0 : ne = SIZE(this%sphavg_k,1)
473 : ENDIF
474 844 : IF(ne<0) RETURN
475 :
476 275293440 : IF(.NOT.ALLOCATED(imagpartCut)) ALLOCATE(imagpartCut(ne,-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const),source=cmplx_0)
477 :
478 :
479 844 : IF(PRESENT(ikpt)) THEN
480 0 : IF(ALLOCATED(this%sphavg_k)) THEN
481 0 : imagpartCut = this%sphavg_k(:,:,:,i_elem,spin,ikpt)
482 : ENDIF
483 844 : ELSE IF(l_sphavg) THEN
484 562 : IF(ALLOCATED(this%sphavg)) THEN
485 200658196 : imagpartCut = this%sphavg(:,:,:,i_elem,spin)
486 : ENDIF
487 282 : ELSE IF(.NOT.PRESENT(iLO).AND..NOT.PRESENT(iLOp)) THEN
488 : !Valence-Valence arrays
489 120 : IF(ALLOCATED(this%uu)) THEN
490 120 : IF(PRESENT(imat)) THEN
491 120 : IF(imat.EQ.1) THEN
492 9527688 : imagpartCut = this%uu(:,:,:,i_elem,spin)
493 84 : ELSE IF(imat.EQ.2) THEN
494 9527688 : imagpartCut = this%dd(:,:,:,i_elem,spin)
495 48 : ELSE IF(imat.EQ.3) THEN
496 6351792 : imagpartCut = this%ud(:,:,:,i_elem,spin)
497 24 : ELSE IF(imat.EQ.4) THEN
498 6351792 : imagpartCut = this%du(:,:,:,i_elem,spin)
499 : ENDIF
500 : ENDIF
501 : ENDIF
502 162 : ELSE IF(.NOT.PRESENT(iLOp)) THEN
503 : !LO-Valence arrays
504 120 : IF(ALLOCATED(this%uulo)) THEN
505 120 : IF(PRESENT(imat)) THEN
506 120 : IF(imat.EQ.1) THEN
507 7939740 : imagpartCut = this%uulo(:,:,:,iLO,i_elem,spin)
508 90 : ELSE IF(imat.EQ.2) THEN
509 7939740 : imagpartCut = this%ulou(:,:,:,iLO,i_elem,spin)
510 60 : ELSE IF(imat.EQ.3) THEN
511 7939740 : imagpartCut = this%dulo(:,:,:,iLO,i_elem,spin)
512 30 : ELSE IF(imat.EQ.4) THEN
513 7939740 : imagpartCut = this%ulod(:,:,:,iLO,i_elem,spin)
514 : ENDIF
515 : ENDIF
516 : ENDIF
517 : ELSE
518 : !LO-LO arrays
519 42 : IF(ALLOCATED(this%uloulop)) THEN
520 11115636 : imagpartCut = this%uloulop(:,:,:,iLO,iLOp,i_elem,spin)
521 : ENDIF
522 : ENDIF
523 :
524 844 : IF(ALLOCATED(imagpartCut)) THEN
525 : !Apply Cutoff
526 844 : spin_ind = MERGE(1,spin,spin>2)
527 844 : kkcut = this%kkintgr_cutoff(i_gf,spin_ind,2)
528 40916453 : IF(kkcut.ne.SIZE(imagpartCut,1)) imagpartCut(kkcut+1:,-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const) = cmplx_0
529 : ENDIF
530 :
531 : END FUNCTION greensfImagPart_applyCutoff
532 :
533 0 : PURE FUNCTION greensfImagPart_checkEmpty(this,i_elem,i_elemLO,nLO,spin,l_sphavg,ikpt) Result(l_empty)
534 :
535 : CLASS(t_greensfImagPart), INTENT(IN) :: this
536 : INTEGER, INTENT(IN) :: i_elem
537 : INTEGER, INTENT(IN) :: i_elemLO
538 : INTEGER, INTENT(IN) :: nLO
539 : INTEGER, INTENT(IN) :: spin
540 : LOGICAL, INTENT(IN) :: l_sphavg
541 : INTEGER, OPTIONAL, INTENT(IN) :: ikpt
542 :
543 : LOGICAL :: l_empty
544 :
545 0 : IF(PRESENT(ikpt)) THEN
546 0 : IF(ALLOCATED(this%sphavg_k)) THEN
547 0 : l_empty = ALL(ABS(this%sphavg_k(:,:,:,i_elem,spin,ikpt)).LT.1e-12)
548 : ENDIF
549 0 : ELSE IF(l_sphavg) THEN
550 0 : IF(ALLOCATED(this%sphavg)) THEN
551 0 : l_empty = ALL(ABS(this%sphavg(:,:,:,i_elem,spin)).LT.1e-12)
552 : ENDIF
553 : ELSE
554 0 : IF(ALLOCATED(this%uu)) THEN
555 : l_empty = ALL(ABS(this%uu(:,:,:,i_elem,spin)).LT.1e-12) &
556 : .AND.ALL(ABS(this%dd(:,:,:,i_elem,spin)).LT.1e-12) &
557 : .AND.ALL(ABS(this%ud(:,:,:,i_elem,spin)).LT.1e-12) &
558 0 : .AND.ALL(ABS(this%du(:,:,:,i_elem,spin)).LT.1e-12)
559 0 : IF(ALLOCATED(this%uulo).AND.nLO>0) THEN
560 : l_empty = l_empty .AND. ALL(ABS(this%uulo(:,:,:,:nLO,i_elemLO,spin)).LT.1e-12) &
561 : .AND.ALL(ABS(this%ulou(:,:,:,:nLO,i_elemLO,spin)).LT.1e-12) &
562 : .AND.ALL(ABS(this%dulo(:,:,:,:nLO,i_elemLO,spin)).LT.1e-12) &
563 : .AND.ALL(ABS(this%dulo(:,:,:,:nLO,i_elemLO,spin)).LT.1e-12) &
564 0 : .AND.ALL(ABS(this%uloulop(:,:,:,:nLO,:nLO,i_elemLO,spin)).LT.1e-12)
565 : ENDIF
566 : ENDIF
567 : ENDIF
568 :
569 0 : END FUNCTION greensfImagPart_checkEmpty
570 :
571 0 : END MODULE m_types_greensfCoeffs
|
