Line data Source code
1 : !!****m* ABINIT/m_paw_an
2 : !! NAME
3 : !! m_paw_an
4 : !!
5 : !! FUNCTION
6 : !! This module contains the definition of the paw_an_type structured datatype,
7 : !! as well as related functions and methods.
8 : !! paw_an_type variables contain various arrays given on ANgular mesh or ANgular moments
9 : !! for a given atom.
10 : !!
11 : !! COPYRIGHT
12 : !! Copyright (C) 2013-2026 ABINIT group (MT, FJ)
13 : !! This file is distributed under the terms of the
14 : !! GNU General Public License, see ~abinit/COPYING
15 : !! or http://www.gnu.org/copyleft/gpl.txt .
16 : !!
17 : !! NOTES
18 : !! FOR DEVELOPPERS: in order to preserve the portability of libPAW library,
19 : !! please consult ~abinit/src/??_libpaw/libpaw-coding-rules.txt
20 : !!
21 : !! SOURCE
22 :
23 : #include "libpaw.h"
24 :
25 : MODULE m_paw_an
26 :
27 : USE_DEFS
28 : USE_MSG_HANDLING
29 : USE_MPI_WRAPPERS
30 : USE_MEMORY_PROFILING
31 :
32 : use m_paral_atom, only : get_my_atmtab, free_my_atmtab, get_my_natom
33 : use m_pawang, only : pawang_type
34 : use m_pawtab, only : pawtab_type
35 :
36 : implicit none
37 :
38 : private
39 :
40 : !public procedures.
41 : public :: paw_an_init
42 : public :: paw_an_free
43 : public :: paw_an_nullify
44 : public :: paw_an_copy
45 : public :: paw_an_print
46 : public :: paw_an_gather
47 : public :: paw_an_redistribute
48 : public :: paw_an_reset_flags
49 :
50 : !private procedures.
51 : private :: paw_an_isendreceive_getbuffer
52 : private :: paw_an_isendreceive_fillbuffer
53 : !!***
54 :
55 : !----------------------------------------------------------------------
56 :
57 : !!****t* m_paw_an/paw_an_type
58 : !! NAME
59 : !! paw_an_type
60 : !!
61 : !! FUNCTION
62 : !! For PAW, various arrays given on ANgular mesh or ANgular moments
63 : !!
64 : !! SOURCE
65 :
66 : type,public :: paw_an_type
67 :
68 : ! WARNING : if you modify this datatype, please check whether there might be creation/destruction/copy routines,
69 : ! declared in another part of ABINIT, that might need to take into account your modification.
70 :
71 : !Integer scalars
72 :
73 : integer :: angl_size
74 : ! Dimension of paw angular mesh (angl_size=ntheta*nphi)
75 :
76 : integer :: cplex
77 : ! cplex=1 if potentials/densities are real, 2 if they are complex
78 :
79 : integer :: has_kxc
80 : ! set to 1 if xc kernels kxc1 and kxct1 are allocated and used
81 : ! 2 if they are already computed
82 :
83 : integer :: has_k3xc
84 : ! set to 1 if xc kernel derivatives k3xc1 and k3xct1 are allocated and used
85 : ! 2 if it is already computed
86 :
87 : integer :: has_vhartree
88 : ! set to 1 if vh1 and vht1 are allocated and used
89 : ! 2 if they are already computed
90 :
91 : integer :: has_vxc
92 : ! set to 1 if vxc1 and vxct1 are allocated and used
93 : ! 2 if they are already computed
94 :
95 : integer :: has_vxctau
96 : ! set to 1 if vxctau1 and vxcttau1 are allocated and used
97 : ! 2 if they are already computed
98 :
99 : integer :: has_vxcval
100 : ! set to 1 if vxc1_val and vxct1_val are allocated and used
101 : ! 2 if they are already computed
102 :
103 : integer :: has_vxc_ex
104 : ! set to 1 if vxc_ex and is allocated and used
105 : ! 2 if it is already computed
106 :
107 : integer :: itypat
108 : ! itypat=type of the atom
109 :
110 : integer :: lm_size
111 : ! lm_size=(l_size)**2
112 : ! l is Maximum value of l+1 leading to non zero Gaunt coeffs (l_size=2*l_max+1)
113 :
114 : integer :: mesh_size
115 : ! Dimension of radial mesh for arrays contained in this paw_an datastructure
116 : ! May be different from pawrad%mesh_size
117 :
118 : integer :: nkxc1
119 : ! number of independent components of Kxc1 and Kxct1
120 : ! (usually 3 for LDA, 23 for GGA)
121 :
122 : integer :: nk3xc1
123 : ! number of independent components of K3xc1 and K3xct1
124 : ! (usually 4 for LDA, not available for GGA)
125 :
126 : integer :: nspden
127 : ! Number of spin-density components
128 :
129 : !Logical arrays
130 :
131 : logical, allocatable :: lmselect(:)
132 : ! lmselect(lm_size)
133 : ! lmselect(ilm)=select the non-zero LM-moments of "one-center" densities/potentials
134 :
135 : !Real (real(dp)) arrays
136 :
137 : real(dp), allocatable :: kxc1 (:,:,:)
138 : ! kxc1(cplex*mesh_size,lm_size or angl_size,nkxc1)
139 : ! Gives xc kernel inside the sphere
140 : ! (theta,phi) values of kernel if pawxcdev=0
141 : ! LM-moments of kernel if pawxcdev/=0
142 :
143 : real(dp), allocatable :: kxct1 (:,:,:)
144 : ! kxct1(cplex*mesh_size,lm_size or angl_size,nkxc1)
145 : ! Gives xc pseudo kernel inside the sphere
146 : ! (theta,phi) values of kernel if pawxcdev=0
147 : ! LM-moments of kernel if pawxcdev/=0
148 :
149 : real(dp), allocatable :: k3xc1 (:,:,:)
150 : ! k3xc1(cplex*mesh_size,lm_size or angl_size,nk3xc1)
151 : ! Gives xc kernel derivative inside the sphere
152 : ! (theta,phi) values of kernel derivative if pawxcdev=0
153 : ! LM-moments of kernel derivative if pawxcdev/=0 => NOT AVAILABLE YET
154 :
155 : real(dp), allocatable :: k3xct1 (:,:,:)
156 : ! k3xct1(cplex*mesh_size,lm_size or angl_size,nk3xc1)
157 : ! Gives xc pseudo kernel derivative inside the sphere
158 : ! (theta,phi) values of kernel derivative if pawxcdev=0
159 : ! LM-moments of kernel derivative if pawxcdev/=0 => NOT AVAILABLE YET
160 :
161 : real(dp), allocatable :: vh1 (:,:,:)
162 : ! vh1(cplex*mesh_size,lm_size,nspden)
163 : ! Gives Hartree potential LM-moments inside the sphere
164 :
165 : real(dp), allocatable :: vht1 (:,:,:)
166 : ! vht1(cplex*mesh_size,lm_size,nspden)
167 : ! Gives Hartree tilde potential LM-moments inside the sphere
168 :
169 : real(dp), allocatable :: vxc1 (:,:,:)
170 : ! vxc1(cplex*mesh_size,lm_size or angl_size,nspden)
171 : ! Gives xc potential inside the sphere
172 : ! (theta,phi) values of potential if pawxcdev=0
173 : ! LM-moments of potential if pawxcdev/=0
174 :
175 : real(dp), allocatable :: vxctau1 (:,:,:)
176 : ! vxctau1(cplex*mesh_size,lm_size or angl_size,nspden)
177 : ! Gives xc potential inside the sphere
178 : ! (theta,phi) values of potential if pawxcdev=0
179 : ! LM-moments of potential if pawxcdev/=0
180 :
181 : real(dp), allocatable :: vxc1_val (:,:,:)
182 : ! vxc1_val(cplex*mesh_size,lm_size or angl_size,nspden) (Usually real, Mainly used for GW)
183 : ! Gives xc potential inside the sphere arising from valence only electrons
184 : ! (theta,phi) values of potential if pawxcdev=0
185 : ! LM-moments of potential if pawxcdev/=0
186 :
187 : real(dp), allocatable :: vxct1 (:,:,:)
188 : ! vxct1(cplex*mesh_size,angl_size,nspden)
189 : ! Gives xc pseudo potential inside the sphere
190 : ! (theta,phi) values of potential if pawxcdev=0
191 : ! LM-moments of potential if pawxcdev/=0
192 :
193 : real(dp), allocatable :: vxcttau1 (:,:,:)
194 : ! vxcttau1(cplex*mesh_size,angl_size,nspden)
195 : ! Gives xc pseudo potential inside the sphere
196 : ! (theta,phi) values of potential if pawxcdev=0
197 : ! LM-moments of potential if pawxcdev/=0
198 :
199 : real(dp), allocatable :: vxct1_val (:,:,:)
200 : ! vxct1_val(cplex*mesh_size,angl_size,nspden) (Usually real, Mainly used for GW)
201 : ! Gives xc pseudo potential inside the sphere
202 : ! (theta,phi) values of potential if pawxcdev=0
203 : ! LM-moments of potential if pawxcdev/=0
204 :
205 : real(dp), allocatable :: vxc_ex (:,:,:)
206 : ! vxc_ex(cplex*mesh_size,angl_size,nspden)
207 : ! Gives xc potential for local exact exchange inside the sphere
208 : ! (theta,phi) values of potential if pawxcdev=0
209 : ! LM-moments of potential if pawxcdev/=0
210 :
211 : end type paw_an_type
212 : !!***
213 :
214 : CONTAINS
215 :
216 : !===========================================================
217 : !!***
218 :
219 : !----------------------------------------------------------------------
220 :
221 : !!****f* m_paw_an/paw_an_init
222 : !! NAME
223 : !! paw_an_init
224 : !!
225 : !! FUNCTION
226 : !! Initialize a paw_an data type.
227 : !!
228 : !! INPUTS
229 : !! mpi_atmtab(:)=--optional-- indexes of the atoms treated by current proc
230 : !! comm_atom=--optional-- MPI communicator over atoms
231 : !!
232 : !! SIDE EFFECTS
233 : !! Paw_an(:)<type(paw_an_type)>=PAW arrays given on ANgular mesh or ANgular moments.
234 : !! Initialized in output
235 : !!
236 : !! SOURCE
237 :
238 2059 : subroutine paw_an_init(Paw_an,natom,ntypat,nkxc1,nk3xc1,nspden,cplex,pawxcdev,typat,Pawang,Pawtab,&
239 : & has_vhartree,has_vxc,has_vxctau,has_vxcval,has_kxc,has_k3xc,has_vxc_ex, & ! optional arguments
240 2059 : & mpi_atmtab,comm_atom) ! optional arguments (parallelism)
241 :
242 : !Arguments ------------------------------------
243 : !scalars
244 : integer,intent(in) :: natom,nkxc1,nk3xc1,ntypat,cplex,nspden,pawxcdev
245 : integer,optional,intent(in) :: has_vhartree,has_vxc,has_vxctau,has_vxcval,has_kxc,has_k3xc,has_vxc_ex
246 : integer,optional,intent(in) :: comm_atom
247 : !arrays
248 : integer,intent(in) :: typat(natom)
249 : integer,optional,target,intent(in) :: mpi_atmtab(:)
250 : type(Pawang_type),intent(in) :: Pawang
251 : type(Pawtab_type),intent(in) :: Pawtab(ntypat)
252 : type(Paw_an_type),intent(inout) :: Paw_an(:)
253 :
254 : !Local variables-------------------------------
255 : !scalars
256 : integer :: iat,iat1,itypat,lm_size,my_comm_atom,my_natom,v_size
257 : logical :: my_atmtab_allocated,paral_atom
258 : !arrays
259 2059 : integer,pointer :: my_atmtab(:)
260 :
261 : ! *************************************************************************
262 :
263 : !@Paw_an_type
264 :
265 : !Set up parallelism over atoms
266 160 : my_natom=size(Paw_an);if (my_natom==0) return
267 1899 : paral_atom=(present(comm_atom).and.(my_natom/=natom))
268 1899 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
269 1899 : my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom
270 1899 : call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,my_natom_ref=my_natom)
271 :
272 6064 : do iat=1,my_natom
273 4165 : iat1=iat;if (paral_atom) iat1=my_atmtab(iat)
274 4165 : itypat=typat(iat1)
275 :
276 4165 : lm_size =Pawtab(itypat)%lcut_size**2
277 4165 : Paw_an(iat)%angl_size =Pawang%angl_size
278 4165 : Paw_an(iat)%cplex =cplex
279 4165 : Paw_an(iat)%itypat =itypat
280 4165 : Paw_an(iat)%lm_size =lm_size
281 4165 : Paw_an(iat)%mesh_size =Pawtab(itypat)%mesh_size
282 4165 : Paw_an(iat)%nkxc1 =nkxc1
283 4165 : Paw_an(iat)%nk3xc1 =nk3xc1
284 4165 : Paw_an(iat)%nspden =nspden
285 :
286 : ! === Non-zero LM-moments of "one-center" densities/potentials ===
287 : ! * Filled in pawdenpot.
288 12495 : LIBPAW_ALLOCATE(Paw_an(iat)%lmselect,(lm_size))
289 :
290 4165 : v_size=Paw_an(iat)%lm_size ; if (pawxcdev==0) v_size=Paw_an(iat)%angl_size
291 :
292 : ! === XC potential inside the sphere ===
293 : ! * LM-moments of potential if pawxcdev/=0
294 : ! * (theta,phi) values of potential if pawxcdev=0
295 4165 : Paw_an(iat)%has_vxc=0
296 4165 : if (PRESENT(has_vxc)) then
297 4165 : if (has_vxc>0) then
298 4165 : Paw_an(iat)%has_vxc=1
299 20825 : LIBPAW_ALLOCATE(Paw_an(iat)%vxc1 ,(cplex*Paw_an(iat)%mesh_size,v_size,nspden))
300 16660 : LIBPAW_ALLOCATE(Paw_an(iat)%vxct1,(cplex*Paw_an(iat)%mesh_size,v_size,nspden))
301 301908291 : Paw_an(iat)%vxc1=zero;Paw_an(iat)%vxct1=zero
302 : end if
303 : end if
304 :
305 4165 : Paw_an(iat)%has_vxctau=0
306 4165 : if (PRESENT(has_vxctau)) then
307 4083 : if (has_vxctau>0) then
308 48 : Paw_an(iat)%has_vxctau=1
309 240 : LIBPAW_ALLOCATE(Paw_an(iat)%vxctau1 ,(cplex*Paw_an(iat)%mesh_size,v_size,nspden))
310 192 : LIBPAW_ALLOCATE(Paw_an(iat)%vxcttau1,(cplex*Paw_an(iat)%mesh_size,v_size,nspden))
311 21274800 : Paw_an(iat)%vxctau1=zero;Paw_an(iat)%vxcttau1=zero
312 : end if
313 : end if
314 :
315 : ! ==========================
316 : ! === Optional arguments ===
317 : ! ==========================
318 :
319 : ! * XC potential inside PAW spheres generated by valence electrons
320 4165 : Paw_an(iat)%has_vxcval=0
321 4165 : if (PRESENT(has_vxcval)) then
322 66 : if (has_vxcval>0) then
323 31 : Paw_an(iat)%has_vxcval=1
324 155 : LIBPAW_ALLOCATE(Paw_an(iat)%vxc1_val ,(cplex*Paw_an(iat)%mesh_size,v_size,nspden))
325 124 : LIBPAW_ALLOCATE(Paw_an(iat)%vxct1_val,(cplex*Paw_an(iat)%mesh_size,v_size,nspden))
326 788079 : Paw_an(iat)%vxc1_val=zero;Paw_an(iat)%vxct1_val=zero
327 : end if
328 : end if
329 :
330 : ! * Hartree potential LM-moments inside the sphere
331 4165 : Paw_an(iat)%has_vhartree=0
332 4165 : if (PRESENT(has_vhartree)) then
333 3311 : if (has_vhartree>0) then
334 48 : Paw_an(iat)%has_vhartree=1
335 240 : LIBPAW_ALLOCATE(Paw_an(iat)%vh1,(cplex*Paw_an(iat)%mesh_size,v_size,nspden))
336 192 : LIBPAW_ALLOCATE(Paw_an(iat)%vht1,(cplex*Paw_an(iat)%mesh_size,v_size,nspden))
337 2950734 : Paw_an(iat)%vh1=zero;Paw_an(iat)%vht1=zero
338 : end if
339 : end if
340 :
341 : ! xc kernels inside the sphere
342 4165 : Paw_an(iat)%has_kxc=0
343 4165 : if (PRESENT(has_kxc)) then
344 196 : if (has_kxc>0) then
345 95 : Paw_an(iat)%has_kxc=1
346 475 : LIBPAW_ALLOCATE(Paw_an(iat)%kxc1 ,(cplex*Paw_an(iat)%mesh_size,v_size,nkxc1))
347 380 : LIBPAW_ALLOCATE(Paw_an(iat)%kxct1,(cplex*Paw_an(iat)%mesh_size,v_size,nkxc1))
348 95 : if (nkxc1>0) then
349 45783403 : Paw_an(iat)%kxc1=zero;Paw_an(iat)%kxct1=zero
350 : end if
351 : end if
352 : end if
353 :
354 : ! xc kernel derivatives inside the sphere
355 4165 : Paw_an(iat)%has_k3xc=0
356 4165 : if (PRESENT(has_k3xc)) then
357 8 : if (has_k3xc>0) then
358 8 : Paw_an(iat)%has_k3xc=1
359 40 : LIBPAW_ALLOCATE(Paw_an(iat)%k3xc1 ,(cplex*Paw_an(iat)%mesh_size,v_size,nk3xc1))
360 32 : LIBPAW_ALLOCATE(Paw_an(iat)%k3xct1,(cplex*Paw_an(iat)%mesh_size,v_size,nk3xc1))
361 8 : if (nk3xc1>0) then
362 9985932 : Paw_an(iat)%k3xc1=zero;Paw_an(iat)%k3xct1=zero
363 : end if
364 : end if
365 : end if
366 :
367 : ! local exact-exchange potential inside the sphere
368 4165 : Paw_an(iat)%has_vxc_ex=0
369 6064 : if (PRESENT(has_vxc_ex)) then
370 3319 : if (has_vxc_ex>0.and.Pawtab(itypat)%useexexch/=0) then
371 2 : Paw_an(iat)%has_vxc_ex=1
372 10 : LIBPAW_ALLOCATE(Paw_an(iat)%vxc_ex,(cplex*Paw_an(iat)%mesh_size,v_size,nspden))
373 108106 : Paw_an(iat)%vxc_ex=zero
374 : end if
375 : end if
376 :
377 : end do !iat
378 :
379 : !Destroy atom table used for parallelism
380 1899 : call free_my_atmtab(my_atmtab,my_atmtab_allocated)
381 :
382 2059 : end subroutine paw_an_init
383 : !!***
384 :
385 : !----------------------------------------------------------------------
386 :
387 : !!****f* m_paw_an/paw_an_free
388 : !! NAME
389 : !! paw_an_free
390 : !!
391 : !! FUNCTION
392 : !! Deallocate pointers and nullify flags in a paw_an structure
393 : !!
394 : !! SIDE EFFECTS
395 : !! Paw_an(:)<type(Paw_an_type)>=various arrays given on ANgular mesh or ANgular moments
396 : !!
397 : !! All associated pointers in Paw_an(:) are deallocated
398 : !!
399 : !! SOURCE
400 :
401 2186 : subroutine paw_an_free(Paw_an)
402 :
403 : !Arguments ------------------------------------
404 : !arrays
405 : type(Paw_an_type),intent(inout) :: Paw_an(:)
406 :
407 : !Local variables-------------------------------
408 : integer :: iat,natom
409 :
410 : ! *************************************************************************
411 :
412 : !@Paw_an_type
413 :
414 2186 : natom=SIZE(Paw_an);if (natom==0) return
415 :
416 6269 : do iat=1,natom
417 4267 : if (allocated(Paw_an(iat)%lmselect )) then
418 4219 : LIBPAW_DEALLOCATE(Paw_an(iat)%lmselect)
419 : end if
420 4267 : if (allocated(Paw_an(iat)%vh1 )) then
421 48 : LIBPAW_DEALLOCATE(Paw_an(iat)%vh1)
422 : end if
423 4267 : if (allocated(Paw_an(iat)%vht1 )) then
424 222 : LIBPAW_DEALLOCATE(Paw_an(iat)%vht1)
425 : end if
426 4267 : if (allocated(Paw_an(iat)%vxc1 )) then
427 4219 : LIBPAW_DEALLOCATE(Paw_an(iat)%vxc1)
428 : end if
429 4267 : if (allocated(Paw_an(iat)%vxctau1 )) then
430 48 : LIBPAW_DEALLOCATE(Paw_an(iat)%vxctau1)
431 : end if
432 4267 : if (allocated(Paw_an(iat)%vxc1_val )) then
433 31 : LIBPAW_DEALLOCATE(Paw_an(iat)%vxc1_val)
434 : end if
435 4267 : if (allocated(Paw_an(iat)%vxct1 )) then
436 4219 : LIBPAW_DEALLOCATE(Paw_an(iat)%vxct1)
437 : end if
438 4267 : if (allocated(Paw_an(iat)%vxcttau1 )) then
439 48 : LIBPAW_DEALLOCATE(Paw_an(iat)%vxcttau1)
440 : end if
441 4267 : if (allocated(Paw_an(iat)%vxct1_val)) then
442 31 : LIBPAW_DEALLOCATE(Paw_an(iat)%vxct1_val)
443 : end if
444 4267 : if (allocated(Paw_an(iat)%kxc1 )) then
445 139 : LIBPAW_DEALLOCATE(Paw_an(iat)%kxc1)
446 : end if
447 4267 : if (allocated(Paw_an(iat)%kxct1 )) then
448 139 : LIBPAW_DEALLOCATE(Paw_an(iat)%kxct1)
449 : end if
450 4267 : if (allocated(Paw_an(iat)%k3xc1 )) then
451 8 : LIBPAW_DEALLOCATE(Paw_an(iat)%k3xc1)
452 : end if
453 4267 : if (allocated(Paw_an(iat)%k3xct1 )) then
454 8 : LIBPAW_DEALLOCATE(Paw_an(iat)%k3xct1)
455 : end if
456 4267 : if (allocated(Paw_an(iat)%vxc_ex )) then
457 2 : LIBPAW_DEALLOCATE(Paw_an(iat)%vxc_ex)
458 : end if
459 :
460 : ! === Reset all has_* flags ===
461 4267 : Paw_an(iat)%has_kxc =0
462 4267 : Paw_an(iat)%has_k3xc =0
463 4267 : Paw_an(iat)%has_vhartree=0
464 4267 : Paw_an(iat)%has_vxc =0
465 4267 : Paw_an(iat)%has_vxctau =0
466 4267 : Paw_an(iat)%has_vxcval =0
467 6269 : Paw_an(iat)%has_vxc_ex =0
468 : end do !iat
469 :
470 : end subroutine paw_an_free
471 : !!***
472 :
473 : !----------------------------------------------------------------------
474 :
475 : !!****f* m_paw_an/paw_an_nullify
476 : !! NAME
477 : !! paw_an_nullify
478 : !!
479 : !! FUNCTION
480 : !! Nullify pointers and flags in a paw_an structure
481 : !!
482 : !! INPUTS
483 : !!
484 : !! SIDE EFFECTS
485 : !! Paw_an(:)<type(paw_an_type)>=PAW arrays given on ANgular mesh or ANgular moments.
486 : !! Nullified in output
487 : !!
488 : !! SOURCE
489 :
490 2175 : subroutine paw_an_nullify(Paw_an)
491 :
492 : !Arguments ------------------------------------
493 : type(Paw_an_type),intent(inout) :: Paw_an(:)
494 :
495 : !Local variables-------------------------------
496 : integer :: iat,natom
497 :
498 : ! *************************************************************************
499 :
500 : !@Paw_an_type
501 : ! MGPAW: This one could be removed/renamed,
502 : ! variables can be initialized in the datatype declaration
503 : ! Do we need to expose this in the public API?
504 :
505 2175 : natom=SIZE(Paw_an(:));if (natom==0) return
506 :
507 6272 : do iat=1,natom
508 : ! Set all has_* flags to zero.
509 4269 : Paw_an(iat)%has_kxc =0
510 4269 : Paw_an(iat)%has_k3xc =0
511 4269 : Paw_an(iat)%has_vhartree =0
512 4269 : Paw_an(iat)%has_vxc =0
513 4269 : Paw_an(iat)%has_vxctau =0
514 4269 : Paw_an(iat)%has_vxcval =0
515 6272 : Paw_an(iat)%has_vxc_ex =0
516 : end do
517 :
518 : end subroutine paw_an_nullify
519 : !!***
520 :
521 : !----------------------------------------------------------------------
522 :
523 : !!****f* m_paw_an/paw_an_copy
524 : !! NAME
525 : !! paw_an_copy
526 : !!
527 : !! FUNCTION
528 : !! Copy one paw_an datastructure into another
529 : !! Can take into accound changes of dimensions
530 : !! Can copy a shared paw_an into distributed ones (when parallelism is activated)
531 : !!
532 : !! INPUTS
533 : !! mpi_atmtab(:)=--optional-- indexes of the atoms treated by current proc
534 : !! comm_atom=--optional-- MPI communicator over atoms
535 : !! paw_an_in(:)<type(paw_an_type)>= input paw_an datastructure
536 : !!
537 : !! SIDE EFFECTS
538 : !! paw_an_cpy(:)<type(paw_an_type)>= output paw_an datastructure
539 : !!
540 : !! NOTES
541 : !! paw_an_cpy must have been allocated in the calling function.
542 : !!
543 : !! SOURCE
544 :
545 60 : subroutine paw_an_copy(paw_an_in,paw_an_cpy,&
546 60 : & mpi_atmtab,comm_atom) ! optional arguments (parallelism)
547 :
548 : !Arguments ------------------------------------
549 : !scalars
550 : integer,optional,intent(in) :: comm_atom
551 : !arrays
552 : integer,optional,target,intent(in) :: mpi_atmtab(:)
553 : type(Paw_an_type),intent(in),target :: paw_an_in(:)
554 : type(Paw_an_type),intent(inout),target :: paw_an_cpy(:)
555 :
556 : !Local variables-------------------------------
557 : !scalars
558 : integer :: cplx_mesh_size,ij,ij1,lm_size,my_comm_atom,my_natom,nkxc1,nk3xc1,npaw_an_in
559 : integer :: npaw_an_max,npaw_an_out,nspden,paral_case,v_size,sz1
560 : logical :: my_atmtab_allocated,paral_atom
561 : character(len=500) :: msg
562 : type(Paw_an_type),pointer :: paw_an_in1, paw_an_out1
563 : !arrays
564 60 : integer,pointer :: my_atmtab(:)
565 60 : type(Paw_an_type), pointer :: paw_an_out(:)
566 :
567 : ! *************************************************************************
568 :
569 : !@Paw_an_type
570 :
571 : !Retrieve sizes
572 60 : npaw_an_in=size(paw_an_in);npaw_an_out=size(paw_an_cpy)
573 :
574 : !Set up parallelism over atoms
575 0 : paral_atom=(present(comm_atom));if (paral_atom) paral_atom=(xmpi_comm_size(comm_atom)>1)
576 60 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
577 60 : my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom
578 60 : my_atmtab_allocated=.false.
579 :
580 : !Determine in which case we are (parallelism, ...)
581 : !No parallelism: a single copy operation
582 60 : paral_case=0;npaw_an_max=npaw_an_in
583 60 : paw_an_out => paw_an_cpy
584 60 : if (paral_atom) then
585 0 : if (npaw_an_out<npaw_an_in) then ! Parallelism: the copy operation is a scatter
586 0 : call get_my_natom(my_comm_atom,my_natom,npaw_an_in)
587 0 : if (my_natom==npaw_an_out) then
588 0 : call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,npaw_an_in)
589 0 : paral_case=1;npaw_an_max=npaw_an_out
590 0 : paw_an_out => paw_an_cpy
591 : else
592 0 : msg=' npaw_an_out should be equal to my_natom !'
593 0 : LIBPAW_BUG(msg)
594 : end if
595 : else ! Parallelism: the copy operation is a gather
596 0 : call get_my_natom(my_comm_atom,my_natom,npaw_an_out)
597 0 : if (my_natom==npaw_an_in) then
598 : paral_case=2;npaw_an_max=npaw_an_in
599 : else
600 0 : msg=' npaw_ij_in should be equal to my_natom !'
601 0 : LIBPAW_BUG(msg)
602 : end if
603 : end if
604 : end if
605 :
606 : !First case: a simple copy or a scatter
607 60 : if (npaw_an_max>0.and.((paral_case==0).or.(paral_case==1))) then
608 48 : call paw_an_free(paw_an_cpy)
609 48 : call paw_an_nullify(paw_an_cpy)
610 :
611 : ! Loop on paw_ij components
612 96 : do ij1=1,npaw_an_max
613 48 : ij=ij1; if (paral_case==1) ij=my_atmtab(ij1)
614 :
615 48 : paw_an_in1=>paw_an_in(ij)
616 48 : paw_an_out1=>paw_an_out(ij1)
617 48 : paw_an_out1%angl_size =paw_an_in1%angl_size
618 48 : paw_an_out1%cplex =paw_an_in1%cplex
619 48 : paw_an_out1%has_kxc =paw_an_in1%has_kxc
620 48 : paw_an_out1%has_k3xc =paw_an_in1%has_k3xc
621 48 : paw_an_out1%has_vhartree =paw_an_in1%has_vhartree
622 48 : paw_an_out1%has_vxc =paw_an_in1%has_vxc
623 48 : paw_an_out1%has_vxctau =paw_an_in1%has_vxctau
624 48 : paw_an_out1%has_vxcval =paw_an_in1%has_vxcval
625 48 : paw_an_out1%has_vxc_ex =paw_an_in1%has_vxc_ex
626 48 : paw_an_out1%itypat =paw_an_in1%itypat
627 48 : paw_an_out1%lm_size =paw_an_in1%lm_size
628 48 : paw_an_out1%mesh_size =paw_an_in1%mesh_size
629 48 : paw_an_out1%nkxc1 =paw_an_in1%nkxc1
630 48 : paw_an_out1%nk3xc1 =paw_an_in1%nk3xc1
631 48 : paw_an_out1%nspden =paw_an_in1%nspden
632 48 : if (allocated(paw_an_in1%lmselect)) then
633 48 : sz1=size(paw_an_in1%lmselect)
634 144 : LIBPAW_ALLOCATE(paw_an_out1%lmselect,(sz1))
635 960 : paw_an_out1%lmselect(:)=paw_an_in1%lmselect(:)
636 : end if
637 48 : v_size=0
638 48 : if (paw_an_in1%has_vxc>0) then
639 48 : v_size=size(paw_an_in1%vxc1,2)
640 0 : else if (paw_an_in1%has_vxctau>0) then
641 0 : v_size=size(paw_an_in1%vxctau1,2)
642 0 : else if (paw_an_in1%has_kxc>0) then
643 0 : v_size=size(paw_an_in1%kxc1,2)
644 0 : else if (paw_an_in1%has_k3xc>0) then
645 0 : v_size=size(paw_an_in1%k3xc1,2)
646 0 : else if (paw_an_in1%has_vxcval>0) then
647 0 : v_size=size(paw_an_in1%vxc1_val,2)
648 0 : else if (paw_an_in1%has_vxc_ex>0) then
649 0 : v_size=size(paw_an_in1%vxc_ex,2)
650 0 : else if (paw_an_in1%has_vhartree>0) then
651 0 : v_size=size(paw_an_in1%vh1,2)
652 : end if
653 48 : nspden=paw_an_in1%nspden
654 48 : lm_size=paw_an_in1%lm_size
655 48 : cplx_mesh_size=paw_an_in1%cplex*paw_an_in1%mesh_size
656 48 : nkxc1=paw_an_in1%nkxc1
657 48 : if (paw_an_in1%has_kxc>0) then
658 190 : LIBPAW_ALLOCATE(paw_an_out1%kxc1,(cplx_mesh_size,v_size,nkxc1))
659 152 : LIBPAW_ALLOCATE(paw_an_out1%kxct1,(cplx_mesh_size,v_size,nkxc1))
660 38 : if (paw_an_in1%has_kxc==2.and.nkxc1>0) then
661 331892 : paw_an_out1%kxc1(:,:,:)=paw_an_in1%kxc1(:,:,:)
662 331892 : paw_an_out1%kxct1(:,:,:)=paw_an_in1%kxct1(:,:,:)
663 : end if
664 : end if
665 48 : nk3xc1=paw_an_in1%nk3xc1
666 48 : if (paw_an_in1%has_k3xc>0) then
667 0 : LIBPAW_ALLOCATE(paw_an_out1%k3xc1,(cplx_mesh_size,v_size,nk3xc1))
668 0 : LIBPAW_ALLOCATE(paw_an_out1%k3xct1,(cplx_mesh_size,v_size,nk3xc1))
669 0 : if (paw_an_in1%has_k3xc==2.and.nk3xc1>0) then
670 0 : paw_an_out1%k3xc1(:,:,:)=paw_an_in1%k3xc1(:,:,:)
671 0 : paw_an_out1%k3xct1(:,:,:)=paw_an_in1%k3xct1(:,:,:)
672 : end if
673 : end if
674 48 : if (paw_an_in1%has_vhartree>0) then
675 0 : LIBPAW_ALLOCATE(paw_an_out1%vh1,(cplx_mesh_size,lm_size,nspden))
676 0 : LIBPAW_ALLOCATE(paw_an_out1%vht1,(cplx_mesh_size,lm_size,nspden))
677 0 : if (paw_an_in1%has_vhartree==2) then
678 0 : paw_an_out1%vh1(:,:,:)=paw_an_in1%vh1(:,:,:)
679 0 : paw_an_out1%vht1(:,:,:)=paw_an_in1%vht1(:,:,:)
680 : end if
681 : end if
682 48 : if (paw_an_in1%has_vxc>0) then
683 240 : LIBPAW_ALLOCATE(paw_an_out1%vxc1,(cplx_mesh_size,v_size,nspden))
684 192 : LIBPAW_ALLOCATE(paw_an_out1%vxct1,(cplx_mesh_size,v_size,nspden))
685 48 : if (paw_an_in1%has_vxc==2) then
686 419232 : paw_an_out1%vxc1(:,:,:)=paw_an_in1%vxc1(:,:,:)
687 419232 : paw_an_out1%vxct1(:,:,:)=paw_an_in1%vxct1(:,:,:)
688 : end if
689 : end if
690 48 : if (paw_an_in1%has_vxctau>0) then
691 0 : LIBPAW_ALLOCATE(paw_an_out1%vxctau1,(cplx_mesh_size,v_size,nspden))
692 0 : LIBPAW_ALLOCATE(paw_an_out1%vxcttau1,(cplx_mesh_size,v_size,nspden))
693 0 : if (paw_an_in1%has_vxc==2) then
694 0 : paw_an_out1%vxctau1(:,:,:)=paw_an_in1%vxctau1(:,:,:)
695 0 : paw_an_out1%vxcttau1(:,:,:)=paw_an_in1%vxcttau1(:,:,:)
696 : end if
697 : end if
698 48 : if (paw_an_in1%has_vxcval>0) then
699 0 : LIBPAW_ALLOCATE(paw_an_out1%vxc1_val,(cplx_mesh_size,v_size,nspden))
700 0 : LIBPAW_ALLOCATE(paw_an_out1%vxct1_val,(cplx_mesh_size,v_size,nspden))
701 0 : if (paw_an_in1%has_vxcval==2) then
702 0 : paw_an_out1%vxc1_val(:,:,:)=paw_an_in1%vxc1_val(:,:,:)
703 0 : paw_an_out1%vxct1_val(:,:,:)=paw_an_in1%vxct1_val(:,:,:)
704 : end if
705 : end if
706 96 : if (paw_an_in1%has_vxc_ex>0) then
707 0 : LIBPAW_ALLOCATE(paw_an_out1%vxc_ex,(cplx_mesh_size,v_size,nspden))
708 0 : if (paw_an_in1%has_vxc_ex==2) then
709 0 : paw_an_out1%vxc_ex(:,:,:)=paw_an_in1%vxc_ex(:,:,:)
710 : end if
711 : end if
712 : end do
713 : end if
714 :
715 : !Second case: a gather
716 60 : if (paral_case==2) then
717 0 : call paw_an_gather(paw_an_in,paw_an_cpy,-1,my_comm_atom,my_atmtab)
718 : end if
719 :
720 : !Destroy atom table used for parallelism
721 60 : call free_my_atmtab(my_atmtab,my_atmtab_allocated)
722 :
723 60 : end subroutine paw_an_copy
724 : !!***
725 :
726 : !----------------------------------------------------------------------
727 :
728 : !!****f* m_paw_an/paw_an_print
729 : !! NAME
730 : !! paw_an_print
731 : !!
732 : !! FUNCTION
733 : !! Reports basic info on a paw_an datastructure
734 : !!
735 : !! INPUTS
736 : !! [unit]=the unit number for output
737 : !! [mode_paral]=either "COLL" or "PERS"
738 : !! [mpi_atmtab(:)]=indexes of the atoms treated by current proc (can be computed here)
739 : !! [comm_atom]=MPI communicator over atoms (needed if parallelism over atoms is activated)
740 : !! [natom]=total number of atom (needed if parallelism over atoms is activated)
741 : !! if Paw_an is distributed, natom is different from size(Paw_an).
742 : !!
743 : !! OUTPUT
744 : !! (only writing)
745 : !!
746 : !! SOURCE
747 :
748 0 : subroutine paw_an_print(Paw_an,unit,mode_paral, &
749 0 : & mpi_atmtab,comm_atom,natom)
750 :
751 : !Arguments ------------------------------------
752 : !scalars
753 : integer,optional,intent(in) :: comm_atom,natom,unit
754 : character(len=4),optional,intent(in) :: mode_paral
755 : !arrays
756 : integer,optional,target,intent(in) :: mpi_atmtab(:)
757 : type(Paw_an_type),intent(in) :: Paw_an(:)
758 :
759 : !Local variables-------------------------------
760 : !scalars
761 : integer :: iatom,iatom_tot,my_comm_atom,my_natom,my_unt,size_paw_an
762 : logical :: my_atmtab_allocated,paral_atom
763 : character(len=4) :: my_mode
764 : character(len=500) :: msg
765 : !arrays
766 0 : integer,pointer :: my_atmtab(:)
767 :
768 : ! *************************************************************************
769 :
770 : !@Paw_an_type
771 :
772 0 : size_paw_an=SIZE(Paw_an)
773 0 : my_unt =std_out; if (PRESENT(unit )) my_unt =unit
774 0 : my_mode ='PERS' ; if (PRESENT(mode_paral)) my_mode =mode_paral
775 0 : my_natom=size_paw_an; if (PRESENT(natom)) my_natom=natom
776 :
777 : !Set up parallelism over atoms
778 0 : paral_atom=(present(comm_atom).and.my_natom/=size_paw_an)
779 0 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
780 0 : my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom
781 0 : call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,my_natom,my_natom_ref=size_paw_an)
782 :
783 0 : write(msg,'(3a)')ch10,' === Content of the pawfgrtab datatype === ',ch10
784 0 : call wrtout(my_unt,msg,my_mode)
785 :
786 0 : do iatom=1,my_natom
787 0 : iatom_tot=iatom;if (paral_atom) iatom_tot=my_atmtab(iatom)
788 0 : write(msg,'(a)')' '
789 0 : call wrtout(my_unt,msg,my_mode)
790 0 : write(msg,'(a,i4)')' ****************************** iatom= ' , iatom_tot
791 0 : call wrtout(my_unt,msg,my_mode)
792 0 : write(msg,'(a,i4)')' Dimension of paw angular mesh= ',paw_an(iatom)%angl_size
793 0 : call wrtout(my_unt,msg,my_mode)
794 0 : write(msg,'(a,i4)')' cplex (1 if potentials/densities are real, 2 if they are complex)= ',&
795 0 : & paw_an(iatom)%cplex
796 0 : call wrtout(my_unt,msg,my_mode)
797 0 : write(msg,'(a,i4)')' has_kxc = ',paw_an(iatom)%has_kxc
798 0 : call wrtout(my_unt,msg,my_mode)
799 0 : write(msg,'(a,i4)')' has_k3xc = ',paw_an(iatom)%has_k3xc
800 0 : call wrtout(my_unt,msg,my_mode)
801 0 : write(msg,'(a,i4)')' has_vhartree= ',paw_an(iatom)%has_vhartree
802 0 : call wrtout(my_unt,msg,my_mode)
803 0 : write(msg,'(a,i4)')' has_vxc = ',paw_an(iatom)%has_vxc
804 0 : call wrtout(my_unt,msg,my_mode)
805 0 : write(msg,'(a,i4)')' has_vxctau = ',paw_an(iatom)%has_vxctau
806 0 : call wrtout(my_unt,msg,my_mode)
807 0 : write(msg,'(a,i4)')' has_vxcval = ',paw_an(iatom)%has_vxcval
808 0 : call wrtout(my_unt,msg,my_mode)
809 0 : write(msg,'(a,i4)')' has_vxc_ex = ',paw_an(iatom)%has_vxc_ex
810 0 : call wrtout(my_unt,msg,my_mode)
811 0 : write(msg,'(a,i4)')' Atome type = ',paw_an(iatom)%itypat
812 0 : call wrtout(my_unt,msg,my_mode)
813 0 : write(msg,'(a,i4)')' lm_size = ',paw_an(iatom)%lm_size
814 0 : call wrtout(my_unt,msg,my_mode)
815 0 : write(msg,'(a,i4)')' mesh_size = ',paw_an(iatom)%mesh_size
816 0 : call wrtout(my_unt,msg,my_mode)
817 0 : write(msg,'(a,i4)')' nkxc1 = ',paw_an(iatom)%nkxc1
818 0 : call wrtout(my_unt,msg,my_mode)
819 0 : write(msg,'(a,i4)')' nk3xc1 = ',paw_an(iatom)%nk3xc1
820 0 : call wrtout(my_unt,msg,my_mode)
821 0 : write(msg,'(a,i4)')' nspden = ',paw_an(iatom)%nspden
822 0 : call wrtout(my_unt,msg,my_mode)
823 : end do
824 :
825 0 : end subroutine paw_an_print
826 : !!***
827 :
828 : !----------------------------------------------------------------------
829 :
830 : !!****f* m_paw_an/paw_an_gather
831 : !! NAME
832 : !! paw_an_gather
833 : !!
834 : !! FUNCTION
835 : !! (All)Gather paw_an datastructures
836 : !!
837 : !! INPUTS
838 : !! master=master communicator receiving data ; if -1 do a ALLGATHER
839 : !! comm_atom= communicator over atom
840 : !! mpi_atmtab(:)=--optional-- indexes of the atoms treated by current calling proc
841 : !! paw_an_in(:)<type(paw_an_type)>= input paw_an datastructures on every process
842 : !!
843 : !! OUTPUT
844 : !! paw_an_gathered(:)<type(paw_an_type)>= output paw_an datastructure
845 : !!
846 : !! SOURCE
847 :
848 0 : subroutine paw_an_gather(Paw_an_in,paw_an_gathered,master,comm_atom,mpi_atmtab)
849 :
850 : !Arguments ------------------------------------
851 : integer,intent(in) :: master,comm_atom
852 : !arrays
853 : integer,optional,target,intent(in) :: mpi_atmtab(:)
854 : type(Paw_an_type),target,intent(in) :: Paw_an_in(:)
855 : type(Paw_an_type),target,intent(inout) :: Paw_an_gathered(:)
856 :
857 : !Local variables-------------------------------
858 : !scalars
859 : integer :: buf_dp_size,buf_dp_size_all,buf_int_size,buf_int_size_all,cplx_mesh_size
860 : integer :: iat,iatot,ierr,has_lm_select,i1,i2,ij,indx_int,indx_dp
861 : integer :: lm_size,me_atom
862 : integer :: my_natom,natom,nkxc1,nk3xc1,npaw_an_in_sum,nproc_atom,nspden,v_size,sz1,sz2,sz3
863 : logical :: my_atmtab_allocated,paral_atom
864 : character(len=500) :: msg
865 : type(Paw_an_type),pointer :: paw_an_in1,paw_an_gathered1
866 : !arrays
867 : integer :: bufsz(2)
868 0 : integer,allocatable :: buf_int(:),buf_int_all(:)
869 0 : integer,allocatable :: count_dp(:),count_int(:),count_tot(:),displ_dp(:),displ_int(:)
870 0 : integer,pointer :: my_atmtab(:)
871 0 : real(dp),allocatable :: buf_dp(:),buf_dp_all(:)
872 :
873 : ! *************************************************************************
874 :
875 : !@Paw_an_type
876 :
877 0 : if (master/=-1) then
878 0 : msg='simple gather (master/=-1) not yet implemented !'
879 0 : LIBPAW_BUG(msg)
880 : end if
881 :
882 0 : my_natom=size(paw_an_in);natom=size(paw_an_gathered)
883 :
884 : !Set up parallelism over atoms
885 0 : paral_atom=(my_natom/=natom)
886 0 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
887 0 : call get_my_atmtab(comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,my_natom_ref=my_natom)
888 0 : nproc_atom=xmpi_comm_size(comm_atom)
889 0 : me_atom=xmpi_comm_rank(comm_atom)
890 :
891 : !Special case: one process (simple copy)
892 0 : if (nproc_atom==1) then
893 0 : if (master==-1.or.me_atom==master) then
894 0 : call paw_an_free(paw_an_gathered)
895 0 : call paw_an_nullify(paw_an_gathered)
896 0 : do iat=1,my_natom
897 0 : paw_an_in1=>paw_an_in(iat)
898 0 : paw_an_gathered1%itypat =paw_an_in1%itypat
899 0 : paw_an_gathered1%nspden =paw_an_in1%nspden
900 0 : paw_an_gathered1%cplex =paw_an_in1%cplex
901 0 : paw_an_gathered1%mesh_size =paw_an_in1%mesh_size
902 0 : paw_an_gathered1%angl_size =paw_an_in1%angl_size
903 0 : paw_an_gathered1%lm_size =paw_an_in1%lm_size
904 0 : paw_an_gathered1%nkxc1 =paw_an_in1%nkxc1
905 0 : paw_an_gathered1%nk3xc1 =paw_an_in1%nk3xc1
906 0 : paw_an_gathered1%has_vxc =paw_an_in1%has_vxc
907 0 : paw_an_gathered1%has_vxctau =paw_an_in1%has_vxctau
908 0 : paw_an_gathered1%has_kxc =paw_an_in1%has_kxc
909 0 : paw_an_gathered1%has_k3xc =paw_an_in1%has_k3xc
910 0 : paw_an_gathered1%has_vxcval =paw_an_in1%has_vxcval
911 0 : paw_an_gathered1%has_vxc_ex =paw_an_in1%has_vxc_ex
912 0 : paw_an_gathered1%has_vhartree =paw_an_in1%has_vhartree
913 0 : if (allocated(paw_an_in1%lmselect)) then
914 0 : sz1=size(paw_an_in1%lmselect)
915 0 : LIBPAW_ALLOCATE(paw_an_gathered1%lmselect,(sz1))
916 0 : paw_an_gathered1%lmselect(:)=paw_an_in1%lmselect(:)
917 : end if
918 0 : if (allocated(paw_an_in1%vxc1)) then
919 0 : sz1=size(paw_an_in1%vxc1,1);sz2=size(paw_an_in1%vxc1,2)
920 0 : sz3=size(paw_an_in1%vxc1,3)
921 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vxc1,(sz1,sz2,sz3))
922 0 : paw_an_gathered1%vxc1(:,:,:)=paw_an_in1%vxc1(:,:,:)
923 : end if
924 0 : if (allocated(paw_an_in1%vxctau1)) then
925 0 : sz1=size(paw_an_in1%vxctau1,1);sz2=size(paw_an_in1%vxctau1,2)
926 0 : sz3=size(paw_an_in1%vxctau1,3)
927 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vxctau1,(sz1,sz2,sz3))
928 0 : paw_an_gathered1%vxctau1(:,:,:)=paw_an_in1%vxctau1(:,:,:)
929 : end if
930 0 : if (allocated(paw_an_in1%vxcttau1)) then
931 0 : sz1=size(paw_an_in1%vxcttau1,1);sz2=size(paw_an_in1%vxcttau1,2)
932 0 : sz3=size(paw_an_in1%vxcttau1,3)
933 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vxcttau1,(sz1,sz2,sz3))
934 0 : paw_an_gathered1%vxcttau1(:,:,:)=paw_an_in1%vxcttau1(:,:,:)
935 : end if
936 0 : if (allocated(paw_an_in1%kxc1)) then
937 0 : sz1=size(paw_an_in1%kxc1,1);sz2=size(paw_an_in1%kxc1,2)
938 0 : sz3=size(paw_an_in1%kxc1,3)
939 0 : LIBPAW_ALLOCATE(paw_an_gathered1%kxc1,(sz1,sz2,sz3))
940 0 : if (sz3>0) paw_an_gathered1%kxc1(:,:,:)=paw_an_in1%kxc1(:,:,:)
941 : end if
942 0 : if (allocated(paw_an_in1%k3xc1)) then
943 0 : sz1=size(paw_an_in1%k3xc1,1);sz2=size(paw_an_in1%k3xc1,2)
944 0 : sz3=size(paw_an_in1%k3xc1,3)
945 0 : LIBPAW_ALLOCATE(paw_an_gathered1%k3xc1,(sz1,sz2,sz3))
946 0 : if (sz3>0) paw_an_gathered1%k3xc1(:,:,:)=paw_an_in1%k3xc1(:,:,:)
947 : end if
948 0 : if (allocated(paw_an_in1%kxct1)) then
949 0 : sz1=size(paw_an_in1%kxct1,1);sz2=size(paw_an_in1%kxct1,2)
950 0 : sz3=size(paw_an_in1%kxct1,3)
951 0 : LIBPAW_ALLOCATE(paw_an_gathered1%kxct1,(sz1,sz2,sz3))
952 0 : if (sz3>0) paw_an_gathered1%kxct1(:,:,:)=paw_an_in1%kxct1(:,:,:)
953 : end if
954 0 : if (allocated(paw_an_in1%k3xct1)) then
955 0 : sz1=size(paw_an_in1%k3xct1,1);sz2=size(paw_an_in1%k3xct1,2)
956 0 : sz3=size(paw_an_in1%k3xct1,3)
957 0 : LIBPAW_ALLOCATE(paw_an_gathered1%k3xct1,(sz1,sz2,sz3))
958 0 : if (sz3>0) paw_an_gathered1%k3xct1(:,:,:)=paw_an_in1%k3xct1(:,:,:)
959 : end if
960 0 : if (allocated(paw_an_in1%vxc1_val)) then
961 0 : sz1=size(paw_an_in1%vxc1_val,1);sz2=size(paw_an_in1%vxc1_val,2)
962 0 : sz3=size(paw_an_in1%vxc1_val,3)
963 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vxc1_val,(sz1,sz2,sz3))
964 0 : paw_an_gathered1%vxc1_val(:,:,:)=paw_an_in1%vxc1_val(:,:,:)
965 : end if
966 0 : if (allocated(paw_an_in1%vxct1_val)) then
967 0 : sz1=size(paw_an_in1%vxct1_val,1);sz2=size(paw_an_in1%vxct1_val,2)
968 0 : sz3=size(paw_an_in1%vxct1_val,3)
969 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vxct1_val,(sz1,sz2,sz3))
970 0 : paw_an_gathered1%vxct1_val(:,:,:)=paw_an_in1%vxct1_val(:,:,:)
971 : end if
972 0 : if (allocated(paw_an_in1%vxc_ex)) then
973 0 : sz1=size(paw_an_in1%vxc_ex,1);sz2=size(paw_an_in1%vxc_ex,2)
974 0 : sz3=size(paw_an_in1%vxc_ex,3)
975 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vxc_ex,(sz1,sz2,sz3))
976 0 : paw_an_gathered1%vxc_ex(:,:,:)=paw_an_in1%vxc_ex(:,:,:)
977 : end if
978 0 : if (allocated(paw_an_in1%vh1)) then
979 0 : sz1=size(paw_an_in1%vh1,1);sz2=size(paw_an_in1%vh1,2)
980 0 : sz3=size(paw_an_in1%vh1,3)
981 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vh1,(sz1,sz2,sz3))
982 0 : paw_an_gathered1%vh1(:,:,:)=paw_an_in1%vh1(:,:,:)
983 : end if
984 0 : if (allocated(paw_an_in1%vht1)) then
985 0 : sz1=size(paw_an_in1%vht1,1);sz2=size(paw_an_in1%vht1,2)
986 0 : sz3=size(paw_an_in1%vht1,3)
987 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vht1,(sz1,sz2,sz3))
988 0 : paw_an_gathered1%vht1(:,:,:)=paw_an_in1%vht1(:,:,:)
989 : end if
990 : end do
991 : end if
992 0 : return
993 : end if
994 :
995 : !Test on sizes
996 0 : npaw_an_in_sum=my_natom
997 0 : call xmpi_sum(npaw_an_in_sum,comm_atom,ierr)
998 0 : if (master==-1) then
999 0 : if (natom/=npaw_an_in_sum) then
1000 0 : msg='Wrong sizes sum[npaw_an_in]/=natom !'
1001 0 : LIBPAW_BUG(msg)
1002 : end if
1003 : else
1004 0 : if (me_atom==master.and.natom/=npaw_an_in_sum) then
1005 0 : msg='(2) paw_an_gathered wrongly allocated !'
1006 0 : LIBPAW_BUG(msg)
1007 : end if
1008 : end if
1009 :
1010 : !Compute sizes of buffers
1011 0 : buf_int_size=0;buf_dp_size=0
1012 0 : do ij=1,my_natom
1013 0 : buf_int_size=buf_int_size+18+size(paw_an_in(ij)%lmselect)
1014 : end do
1015 0 : do ij=1,my_natom
1016 0 : paw_an_in1=>paw_an_in(ij)
1017 0 : if (paw_an_in1%has_vxc==2) then
1018 0 : buf_dp_size=buf_dp_size+size(paw_an_in1%vxc1)
1019 0 : buf_dp_size=buf_dp_size+size(paw_an_in1%vxct1)
1020 : end if
1021 0 : if (paw_an_in1%has_vxctau==2) then
1022 0 : buf_dp_size=buf_dp_size+size(paw_an_in1%vxctau1)
1023 0 : buf_dp_size=buf_dp_size+size(paw_an_in1%vxcttau1)
1024 : end if
1025 0 : if (paw_an_in1%has_kxc==2) then
1026 0 : buf_dp_size=buf_dp_size+size(paw_an_in1%kxc1)
1027 0 : buf_dp_size=buf_dp_size+size(paw_an_in1%kxct1)
1028 : end if
1029 0 : if (paw_an_in1%has_k3xc==2) then
1030 0 : buf_dp_size=buf_dp_size+size(paw_an_in1%k3xc1)
1031 0 : buf_dp_size=buf_dp_size+size(paw_an_in1%k3xct1)
1032 : end if
1033 0 : if (paw_an_in1%has_vxcval==2) then
1034 0 : buf_dp_size=buf_dp_size+size(paw_an_in1%vxc1_val)
1035 0 : buf_dp_size=buf_dp_size+size(paw_an_in1%vxct1_val)
1036 : end if
1037 0 : if (paw_an_in1%has_vxc_ex==2) then
1038 0 : buf_dp_size=buf_dp_size+size(paw_an_in1%vxc_ex)
1039 : end if
1040 0 : if (paw_an_in1%has_vhartree==2) then
1041 0 : buf_dp_size=buf_dp_size+size(paw_an_in1%vh1)
1042 0 : buf_dp_size=buf_dp_size+size(paw_an_in1%vht1)
1043 : end if
1044 : end do
1045 :
1046 : !Fill in input buffers
1047 0 : LIBPAW_ALLOCATE(buf_int,(buf_int_size))
1048 0 : LIBPAW_ALLOCATE(buf_dp ,(buf_dp_size))
1049 0 : indx_int=1;indx_dp=1
1050 0 : do ij=1, my_natom
1051 0 : paw_an_in1=>paw_an_in(ij)
1052 0 : buf_int(indx_int)=my_atmtab(ij); indx_int=indx_int+1
1053 0 : buf_int(indx_int)=paw_an_in1%itypat; indx_int=indx_int+1
1054 0 : buf_int(indx_int)=paw_an_in1%nspden; indx_int=indx_int+1
1055 0 : buf_int(indx_int)=paw_an_in1%cplex; indx_int=indx_int+1
1056 0 : buf_int(indx_int)=paw_an_in1%mesh_size; indx_int=indx_int+1
1057 0 : buf_int(indx_int)=paw_an_in1%angl_size; indx_int=indx_int+1
1058 0 : buf_int(indx_int)=paw_an_in1%lm_size; indx_int=indx_int+1
1059 0 : buf_int(indx_int)=paw_an_in1%nkxc1; indx_int=indx_int+1
1060 0 : buf_int(indx_int)=paw_an_in1%nk3xc1; indx_int=indx_int+1
1061 0 : buf_int(indx_int)=paw_an_in1%has_vxc; indx_int=indx_int+1
1062 0 : buf_int(indx_int)=paw_an_in1%has_vxctau; indx_int=indx_int+1
1063 0 : buf_int(indx_int)=paw_an_in1%has_kxc; indx_int=indx_int+1
1064 0 : buf_int(indx_int)=paw_an_in1%has_k3xc; indx_int=indx_int+1
1065 0 : buf_int(indx_int)=paw_an_in1%has_vxcval; indx_int=indx_int+1
1066 0 : buf_int(indx_int)=paw_an_in1%has_vxc_ex; indx_int=indx_int+1
1067 0 : buf_int(indx_int)=paw_an_in1%has_vhartree; indx_int=indx_int+1
1068 0 : v_size=0
1069 0 : if (paw_an_in1%has_vxc>0) then
1070 0 : v_size=size(paw_an_in1%vxc1,2)
1071 0 : else if (paw_an_in1%has_vxctau>0) then
1072 0 : v_size=size(paw_an_in1%vxctau1,2)
1073 0 : else if (paw_an_in1%has_kxc>0) then
1074 0 : v_size=size(paw_an_in1%kxc1,2)
1075 0 : else if (paw_an_in1%has_k3xc>0) then
1076 0 : v_size=size(paw_an_in1%k3xc1,2)
1077 0 : else if (paw_an_in1%has_vxcval>0) then
1078 0 : v_size=size(paw_an_in1%vxc1_val,2)
1079 0 : else if (paw_an_in1%has_vxc_ex>0) then
1080 0 : v_size=size(paw_an_in1%vxc_ex,2)
1081 0 : else if (paw_an_in1%has_vhartree>0) then
1082 0 : v_size=size(paw_an_in1%vh1,2)
1083 : end if
1084 0 : buf_int(indx_int)=v_size;indx_int=indx_int+1
1085 0 : if (allocated(paw_an_in1%lmselect)) then
1086 0 : buf_int(indx_int)=1;indx_int=indx_int+1
1087 : else
1088 0 : buf_int(indx_int)=0;indx_int=indx_int+1
1089 : end if
1090 0 : nspden=paw_an_in1%nspden
1091 0 : lm_size=paw_an_in1%lm_size
1092 0 : cplx_mesh_size=paw_an_in1%cplex*paw_an_in1%mesh_size
1093 0 : if (lm_size>0) then
1094 0 : if (allocated(paw_an_in1%lmselect)) then
1095 0 : do i1=1,lm_size
1096 0 : if (paw_an_in1%lmselect(i1)) then
1097 0 : buf_int(indx_int)=1
1098 : else
1099 0 : buf_int(indx_int)=0
1100 : end if
1101 0 : indx_int=indx_int+1
1102 : end do
1103 : end if
1104 : end if
1105 0 : if (paw_an_in1%has_vxc==2) then
1106 0 : do i1=1,nspden
1107 0 : do i2=1,v_size
1108 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxc1(:,i2,i1)
1109 0 : indx_dp=indx_dp+cplx_mesh_size
1110 : end do
1111 : end do
1112 0 : do i1=1,nspden
1113 0 : do i2=1,v_size
1114 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxct1(:,i2,i1)
1115 0 : indx_dp=indx_dp+cplx_mesh_size
1116 : end do
1117 : end do
1118 : end if
1119 0 : if (paw_an_in1%has_vxctau==2) then
1120 0 : do i1=1,nspden
1121 0 : do i2=1,v_size
1122 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxctau1(:,i2,i1)
1123 0 : indx_dp=indx_dp+cplx_mesh_size
1124 : end do
1125 : end do
1126 0 : do i1=1,nspden
1127 0 : do i2=1,v_size
1128 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxcttau1(:,i2,i1)
1129 0 : indx_dp=indx_dp+cplx_mesh_size
1130 : end do
1131 : end do
1132 : end if
1133 0 : if (paw_an_in1%has_kxc==2.and.paw_an_in1%nkxc1>0) then
1134 0 : do i1=1,paw_an_in1%nkxc1
1135 0 : do i2=1,v_size
1136 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%kxc1(:,i2,i1)
1137 0 : indx_dp=indx_dp+cplx_mesh_size
1138 : end do
1139 : end do
1140 0 : do i1=1,paw_an_in1%nkxc1
1141 0 : do i2=1,v_size
1142 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%kxct1(:,i2,i1)
1143 0 : indx_dp=indx_dp+cplx_mesh_size
1144 : end do
1145 : end do
1146 : end if
1147 0 : if (paw_an_in1%has_k3xc==2.and.paw_an_in1%nk3xc1>0) then
1148 0 : do i1=1,paw_an_in1%nk3xc1
1149 0 : do i2=1,v_size
1150 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%k3xc1(:,i2,i1)
1151 0 : indx_dp=indx_dp+cplx_mesh_size
1152 : end do
1153 : end do
1154 0 : do i1=1,paw_an_in1%nk3xc1
1155 0 : do i2=1,v_size
1156 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%k3xct1(:,i2,i1)
1157 0 : indx_dp=indx_dp+cplx_mesh_size
1158 : end do
1159 : end do
1160 : end if
1161 0 : if (paw_an_in1%has_vxcval==2) then
1162 0 : do i1=1,nspden
1163 0 : do i2=1,v_size
1164 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxc1_val(:,i2,i1)
1165 0 : indx_dp=indx_dp+cplx_mesh_size
1166 : end do
1167 : end do
1168 0 : do i1=1,nspden
1169 0 : do i2=1,v_size
1170 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxct1_val(:,i2,i1)
1171 0 : indx_dp=indx_dp+cplx_mesh_size
1172 : end do
1173 : end do
1174 : end if
1175 0 : if (paw_an_in1%has_vxc_ex==2) then
1176 0 : do i1=1,nspden
1177 0 : do i2=1,v_size
1178 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vxc_ex(:,i2,i1)
1179 0 : indx_dp=indx_dp+cplx_mesh_size
1180 : end do
1181 : end do
1182 : end if
1183 0 : if (paw_an_in1%has_vhartree==2) then
1184 0 : do i1=1,nspden
1185 0 : do i2=1,lm_size
1186 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vh1(:,i2,i1)
1187 0 : indx_dp=indx_dp+cplx_mesh_size
1188 : end do
1189 : end do
1190 0 : do i1=1,nspden
1191 0 : do i2=1,lm_size
1192 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an_in1%vht1(:,i2,i1)
1193 0 : indx_dp=indx_dp+cplx_mesh_size
1194 : end do
1195 : end do
1196 : end if
1197 : end do
1198 0 : if (indx_int/=1+buf_int_size) then
1199 0 : msg='Error (1) in paw_an_gather: wrong buffer sizes !'
1200 0 : LIBPAW_BUG(msg)
1201 : end if
1202 0 : if (indx_dp/=1+buf_dp_size) then
1203 0 : msg='Error (2) in paw_an_gather: wrong buffer sizes !'
1204 0 : LIBPAW_BUG(msg)
1205 : end if
1206 :
1207 : !Communicate (1 gather for integers, 1 gather for reals)
1208 0 : LIBPAW_ALLOCATE(count_int,(nproc_atom))
1209 0 : LIBPAW_ALLOCATE(displ_int,(nproc_atom))
1210 0 : LIBPAW_ALLOCATE(count_dp ,(nproc_atom))
1211 0 : LIBPAW_ALLOCATE(displ_dp ,(nproc_atom))
1212 0 : LIBPAW_ALLOCATE(count_tot,(2*nproc_atom))
1213 0 : bufsz(1)=buf_int_size; bufsz(2)=buf_dp_size
1214 0 : call xmpi_allgather(bufsz,2,count_tot,comm_atom,ierr)
1215 0 : do ij=1,nproc_atom
1216 0 : count_int(ij)=count_tot(2*ij-1)
1217 0 : count_dp (ij)=count_tot(2*ij)
1218 : end do
1219 0 : displ_int(1)=0;displ_dp(1)=0
1220 0 : do ij=2,nproc_atom
1221 0 : displ_int(ij)=displ_int(ij-1)+count_int(ij-1)
1222 0 : displ_dp (ij)=displ_dp (ij-1)+count_dp (ij-1)
1223 : end do
1224 0 : buf_int_size_all=sum(count_int)
1225 0 : buf_dp_size_all =sum(count_dp)
1226 0 : LIBPAW_DEALLOCATE(count_tot)
1227 0 : LIBPAW_ALLOCATE(buf_int_all,(buf_int_size_all))
1228 0 : LIBPAW_ALLOCATE(buf_dp_all ,(buf_dp_size_all))
1229 0 : call xmpi_allgatherv(buf_int,buf_int_size,buf_int_all,count_int,displ_int,comm_atom,ierr)
1230 0 : call xmpi_allgatherv(buf_dp ,buf_dp_size ,buf_dp_all ,count_dp ,displ_dp ,comm_atom,ierr)
1231 0 : LIBPAW_DEALLOCATE(count_int)
1232 0 : LIBPAW_DEALLOCATE(displ_int)
1233 0 : LIBPAW_DEALLOCATE(count_dp)
1234 0 : LIBPAW_DEALLOCATE(displ_dp)
1235 :
1236 : !Fill in output datastructure
1237 0 : indx_int=1; indx_dp=1
1238 0 : call paw_an_free(paw_an_gathered)
1239 0 : call paw_an_nullify(paw_an_gathered)
1240 0 : do iat=1,natom
1241 0 : iatot=buf_int_all(indx_int); indx_int=indx_int+1
1242 0 : paw_an_gathered1=>paw_an_gathered(iatot)
1243 0 : paw_an_gathered1%itypat=buf_int_all(indx_int); indx_int=indx_int+1
1244 0 : paw_an_gathered1%nspden=buf_int_all(indx_int); indx_int=indx_int+1
1245 0 : paw_an_gathered1%cplex=buf_int_all(indx_int); indx_int=indx_int+1
1246 0 : paw_an_gathered1%mesh_size=buf_int_all(indx_int); indx_int=indx_int+1
1247 0 : paw_an_gathered1%angl_size=buf_int_all(indx_int); indx_int=indx_int+1
1248 0 : paw_an_gathered1%lm_size=buf_int_all(indx_int); indx_int=indx_int+1
1249 0 : paw_an_gathered1%nkxc1=buf_int_all(indx_int); indx_int=indx_int+1
1250 0 : paw_an_gathered1%nk3xc1=buf_int_all(indx_int); indx_int=indx_int+1
1251 0 : paw_an_gathered1%has_vxc=buf_int_all(indx_int); indx_int=indx_int+1
1252 0 : paw_an_gathered1%has_vxctau=buf_int_all(indx_int); indx_int=indx_int+1
1253 0 : paw_an_gathered1%has_kxc=buf_int_all(indx_int); indx_int=indx_int+1
1254 0 : paw_an_gathered1%has_k3xc=buf_int_all(indx_int); indx_int=indx_int+1
1255 0 : paw_an_gathered1%has_vxcval=buf_int_all(indx_int); indx_int=indx_int+1
1256 0 : paw_an_gathered1%has_vxc_ex=buf_int_all(indx_int); indx_int=indx_int+1
1257 0 : paw_an_gathered1%has_vhartree=buf_int_all(indx_int); indx_int=indx_int+1
1258 0 : v_size=buf_int_all(indx_int); indx_int=indx_int+1
1259 0 : has_lm_select=buf_int_all(indx_int); indx_int=indx_int+1
1260 0 : nspden=paw_an_gathered1%nspden
1261 0 : lm_size=paw_an_gathered1%lm_size
1262 0 : nkxc1=paw_an_gathered1%nkxc1
1263 0 : nk3xc1=paw_an_gathered1%nk3xc1
1264 0 : cplx_mesh_size=paw_an_gathered1%cplex*paw_an_gathered1%mesh_size
1265 0 : if (has_lm_select==1) then
1266 0 : LIBPAW_ALLOCATE(paw_an_gathered1%lmselect,(lm_size))
1267 0 : if (lm_size>0) then
1268 0 : do i1=1,lm_size
1269 0 : if (buf_int_all(indx_int)==1) then
1270 0 : paw_an_gathered1%lmselect(i1)=.TRUE.;indx_int=indx_int+1
1271 : else
1272 0 : paw_an_gathered1%lmselect(i1)=.FALSE.;indx_int=indx_int+1
1273 : end if
1274 : end do
1275 : end if
1276 : end if
1277 0 : if (paw_an_gathered1%has_vxc>0) then
1278 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vxc1,(cplx_mesh_size,v_size,nspden))
1279 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vxct1,(cplx_mesh_size,v_size,nspden))
1280 0 : if (paw_an_gathered1%has_vxc==2) then
1281 0 : do i1=1,nspden
1282 0 : do i2=1,v_size
1283 0 : paw_an_gathered1%vxc1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1)
1284 0 : indx_dp=indx_dp+cplx_mesh_size
1285 : end do
1286 : end do
1287 0 : do i1=1,nspden
1288 0 : do i2=1,v_size
1289 0 : paw_an_gathered1%vxct1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1)
1290 0 : indx_dp=indx_dp+cplx_mesh_size
1291 : end do
1292 : end do
1293 : end if
1294 : end if
1295 0 : if (paw_an_gathered1%has_vxctau>0) then
1296 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vxctau1,(cplx_mesh_size,v_size,nspden))
1297 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vxcttau1,(cplx_mesh_size,v_size,nspden))
1298 0 : if (paw_an_gathered1%has_vxctau==2) then
1299 0 : do i1=1,nspden
1300 0 : do i2=1,v_size
1301 0 : paw_an_gathered1%vxctau1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1)
1302 0 : indx_dp=indx_dp+cplx_mesh_size
1303 : end do
1304 : end do
1305 0 : do i1=1,nspden
1306 0 : do i2=1,v_size
1307 0 : paw_an_gathered1%vxcttau1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1)
1308 0 : indx_dp=indx_dp+cplx_mesh_size
1309 : end do
1310 : end do
1311 : end if
1312 : end if
1313 0 : if (paw_an_gathered1%has_kxc>0) then
1314 0 : LIBPAW_ALLOCATE(paw_an_gathered1%kxc1,(cplx_mesh_size,v_size,nkxc1))
1315 0 : LIBPAW_ALLOCATE(paw_an_gathered1%kxct1,(cplx_mesh_size,v_size,nkxc1))
1316 0 : if (paw_an_gathered1%has_kxc==2.and.nkxc1>0) then
1317 0 : do i1=1,nkxc1
1318 0 : do i2=1,v_size
1319 0 : paw_an_gathered1%kxc1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1)
1320 0 : indx_dp=indx_dp+cplx_mesh_size
1321 : end do
1322 : end do
1323 0 : do i1=1,nkxc1
1324 0 : do i2=1,v_size
1325 0 : paw_an_gathered1%kxct1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1)
1326 0 : indx_dp=indx_dp+cplx_mesh_size
1327 : end do
1328 : end do
1329 : end if
1330 : end if
1331 0 : if (paw_an_gathered1%has_k3xc>0) then
1332 0 : LIBPAW_ALLOCATE(paw_an_gathered1%k3xc1,(cplx_mesh_size,v_size,nk3xc1))
1333 0 : LIBPAW_ALLOCATE(paw_an_gathered1%k3xct1,(cplx_mesh_size,v_size,nk3xc1))
1334 0 : if (paw_an_gathered1%has_k3xc==2.and.nk3xc1>0) then
1335 0 : do i1=1,nk3xc1
1336 0 : do i2=1,v_size
1337 0 : paw_an_gathered1%k3xc1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1)
1338 0 : indx_dp=indx_dp+cplx_mesh_size
1339 : end do
1340 : end do
1341 0 : do i1=1,nk3xc1
1342 0 : do i2=1,v_size
1343 0 : paw_an_gathered1%k3xct1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1)
1344 0 : indx_dp=indx_dp+cplx_mesh_size
1345 : end do
1346 : end do
1347 : end if
1348 : end if
1349 0 : if (paw_an_gathered1%has_vxcval>0) then
1350 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vxc1_val,(cplx_mesh_size,v_size,nspden))
1351 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vxct1_val,(cplx_mesh_size,v_size,nspden))
1352 0 : if (paw_an_gathered1%has_vxcval==2) then
1353 0 : do i1=1,nspden
1354 0 : do i2=1,v_size
1355 0 : paw_an_gathered1%vxc1_val(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1)
1356 0 : indx_dp=indx_dp+cplx_mesh_size
1357 : end do
1358 : end do
1359 0 : do i1=1,nspden
1360 0 : do i2=1,v_size
1361 0 : paw_an_gathered1%vxct1_val(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1)
1362 0 : indx_dp=indx_dp+cplx_mesh_size
1363 : end do
1364 : end do
1365 : end if
1366 : end if
1367 0 : if (paw_an_gathered1%has_vxc_ex>0) then
1368 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vxc_ex,(cplx_mesh_size,v_size,nspden))
1369 0 : if (paw_an_gathered1%has_vxc_ex==2) then
1370 0 : do i1=1,nspden
1371 0 : do i2=1,v_size
1372 0 : paw_an_gathered1%vxc_ex(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1)
1373 0 : indx_dp=indx_dp+cplx_mesh_size
1374 : end do
1375 : end do
1376 : end if
1377 : end if
1378 0 : if (paw_an_gathered1%has_vhartree>0) then
1379 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vh1,(cplx_mesh_size,lm_size,nspden))
1380 0 : LIBPAW_ALLOCATE(paw_an_gathered1%vht1,(cplx_mesh_size,lm_size,nspden))
1381 0 : if (paw_an_gathered1%has_vhartree==2) then
1382 0 : do i1=1,nspden
1383 0 : do i2=1,lm_size
1384 0 : paw_an_gathered1%vh1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1)
1385 0 : indx_dp=indx_dp+cplx_mesh_size
1386 : end do
1387 : end do
1388 0 : do i1=1,nspden
1389 0 : do i2=1,lm_size
1390 0 : paw_an_gathered1%vht1(:,i2,i1)=buf_dp_all(indx_dp:indx_dp+cplx_mesh_size-1)
1391 0 : indx_dp=indx_dp+cplx_mesh_size
1392 : end do
1393 : end do
1394 : end if
1395 : end if
1396 : end do ! iat
1397 :
1398 : !Free buffers
1399 0 : LIBPAW_DEALLOCATE(buf_int)
1400 0 : LIBPAW_DEALLOCATE(buf_int_all)
1401 0 : LIBPAW_DEALLOCATE(buf_dp)
1402 0 : LIBPAW_DEALLOCATE(buf_dp_all)
1403 :
1404 : !Destroy atom table
1405 0 : call free_my_atmtab(my_atmtab,my_atmtab_allocated)
1406 :
1407 0 : end subroutine paw_an_gather
1408 : !!***
1409 :
1410 : !----------------------------------------------------------------------
1411 :
1412 : !!****f* m_paw_an/paw_an_redistribute
1413 : !! NAME
1414 : !! paw_an_redistribute
1415 : !!
1416 : !! FUNCTION
1417 : !! Redistribute an array of paw_an datastructures
1418 : !! Input paw_an is given on a MPI communicator
1419 : !! Output paw_an is redistributed on another MPI communicator
1420 : !!
1421 : !! INPUTS
1422 : !! mpi_comm_in= input MPI (atom) communicator
1423 : !! mpi_comm_out= output MPI (atom) communicator
1424 : !! mpi_atmtab_in= --optional-- indexes of the input paw_an treated by current proc
1425 : !! if not present, will be calculated in the present routine
1426 : !! mpi_atmtab_out= --optional-- indexes of the output paw_an treated by current proc
1427 : !! if not present, will be calculated in the present routine
1428 : !! natom= --optional-- total number of atoms
1429 : !! ----- Optional arguments used only for asynchronous communications -----
1430 : !! RecvAtomProc(:)= rank of processor from which I expect atom (in mpi_comm_in)
1431 : !! RecvAtomList(:)= indexes of atoms to be received by me
1432 : !! RecvAtomList(irecv) are the atoms I expect from RecvAtomProc(irecv)
1433 : !! SendAtomProc(:)= ranks of process destination of atom (in mpi_comm_in)
1434 : !! SendAtomList(:)= indexes of atoms to be sent by me
1435 : !! SendAtomList(isend) are the atoms sent to SendAtomProc(isend)
1436 : !!
1437 : !! OUTPUT
1438 : !! [paw_an_out(:)]<type(paw_an_type)>= --optional--
1439 : !! if present, the redistributed datastructure does not replace
1440 : !! the input one but is delivered in paw_an_out
1441 : !! if not present, input and output datastructure are the same.
1442 : !!
1443 : !! SIDE EFFECTS
1444 : !! paw_an(:)<type(paw_an_type)>= input (and eventually output) paw_an datastructures
1445 : !!
1446 : !! SOURCE
1447 :
1448 40 : subroutine paw_an_redistribute(paw_an,mpi_comm_in,mpi_comm_out,&
1449 40 : & natom,mpi_atmtab_in,mpi_atmtab_out,paw_an_out,&
1450 40 : & SendAtomProc,SendAtomList,RecvAtomProc,RecvAtomList)
1451 :
1452 : !Arguments ------------------------------------
1453 : !scalars
1454 : integer,intent(in) :: mpi_comm_in,mpi_comm_out
1455 : integer,optional,intent(in) :: natom
1456 : !arrays
1457 : integer,intent(in),optional,target :: mpi_atmtab_in(:),mpi_atmtab_out(:)
1458 : type(paw_an_type),allocatable,intent(inout) :: paw_an(:)
1459 : type(paw_an_type),pointer,optional :: paw_an_out(:) !vz_i
1460 : integer,intent(in),optional :: SendAtomProc(:),SendAtomList(:),RecvAtomProc(:),RecvAtomList(:)
1461 :
1462 : !Local variables-------------------------------
1463 : !scalars
1464 :
1465 : integer :: algo_option,i1,iat_in,iat_out,iatom,ierr,iircv,iisend,imsg,imsg_current,imsg1
1466 : integer :: iproc_rcv,iproc_send,ireq,me_exch,mpi_comm_exch,my_natom_in,my_natom_out,my_tag,natom_tot,nb_msg
1467 : integer :: nb_dp,nb_int,nbmsg_incoming,nbrecvmsg,nbsend,nbsendreq,nbsent,nbrecv,next,npaw_an_sent
1468 : integer :: nproc_in,nproc_out
1469 : logical :: flag,in_place,message_yet_prepared,my_atmtab_in_allocated,my_atmtab_out_allocated,paral_atom
1470 : !arrays
1471 : integer :: buf_size(3),request1(3)
1472 40 : integer,pointer :: my_atmtab_in(:),my_atmtab_out(:)
1473 40 : integer,allocatable :: atmtab_send(:),atm_indx_in(:),atm_indx_out(:),buf_int1(:),From(:),request(:)
1474 40 : integer,allocatable,target:: buf_int(:)
1475 40 : integer,pointer :: buf_ints(:)
1476 40 : logical, allocatable :: msg_pick(:)
1477 40 : real(dp),allocatable :: buf_dp1(:)
1478 40 : real(dp),allocatable,target :: buf_dp(:)
1479 40 : real(dp),pointer :: buf_dps(:)
1480 40 : type(coeffi1_type),target,allocatable :: tab_buf_int(:),tab_buf_atom(:)
1481 40 : type(coeff1_type),target,allocatable :: tab_buf_dp(:)
1482 40 : type(paw_an_type),allocatable :: paw_an_all(:)
1483 40 : type(paw_an_type),pointer :: paw_an_out1(:)
1484 :
1485 : ! *************************************************************************
1486 :
1487 : !@paw_an_type
1488 :
1489 40 : in_place=(.not.present(paw_an_out))
1490 40 : my_natom_in=size(paw_an)
1491 :
1492 : !If not "in_place", destroy the output datastructure
1493 40 : if (.not.in_place) then
1494 0 : if (associated(paw_an_out)) then
1495 0 : call paw_an_free(paw_an_out)
1496 0 : LIBPAW_DATATYPE_DEALLOCATE(paw_an_out)
1497 : end if
1498 : end if
1499 :
1500 : !Special sequential case
1501 40 : if (mpi_comm_in==xmpi_comm_self.and.mpi_comm_out==xmpi_comm_self) then
1502 0 : if ((.not.in_place).and.(my_natom_in>0)) then
1503 0 : LIBPAW_DATATYPE_ALLOCATE(paw_an_out,(my_natom_in))
1504 0 : call paw_an_nullify(paw_an_out)
1505 0 : call paw_an_copy(paw_an,paw_an_out)
1506 : end if
1507 0 : return
1508 : end if
1509 :
1510 : !Get total natom
1511 40 : if (present(natom)) then
1512 40 : natom_tot=natom
1513 : else
1514 0 : natom_tot=my_natom_in
1515 0 : call xmpi_sum(natom_tot,mpi_comm_in,ierr)
1516 : end if
1517 :
1518 : !Select input distribution
1519 40 : if (present(mpi_atmtab_in)) then
1520 40 : my_atmtab_in => mpi_atmtab_in
1521 40 : my_atmtab_in_allocated=.false.
1522 : else
1523 : call get_my_atmtab(mpi_comm_in,my_atmtab_in,my_atmtab_in_allocated,&
1524 0 : & paral_atom,natom_tot,my_natom_in)
1525 : end if
1526 :
1527 : !Select output distribution
1528 40 : if (present(mpi_atmtab_out)) then
1529 40 : my_natom_out=size(mpi_atmtab_out)
1530 40 : my_atmtab_out => mpi_atmtab_out
1531 40 : my_atmtab_out_allocated=.false.
1532 : else
1533 0 : call get_my_natom(mpi_comm_out,my_natom_out,natom_tot)
1534 : call get_my_atmtab(mpi_comm_out,my_atmtab_out,my_atmtab_out_allocated,&
1535 0 : & paral_atom,natom_tot)
1536 : end if
1537 :
1538 : !Select algo according to optional input arguments
1539 40 : algo_option=1
1540 : if (present(SendAtomProc).and.present(SendAtomList).and.&
1541 40 : & present(RecvAtomProc).and.present(RecvAtomList)) algo_option=2
1542 :
1543 :
1544 : !Brute force algorithm (allgather + scatter)
1545 : !---------------------------------------------------------
1546 : if (algo_option==1) then
1547 :
1548 0 : LIBPAW_DATATYPE_ALLOCATE(paw_an_all,(natom_tot))
1549 0 : call paw_an_nullify(paw_an_all)
1550 0 : call paw_an_copy(paw_an,paw_an_all,comm_atom=mpi_comm_in,mpi_atmtab=my_atmtab_in)
1551 0 : if (in_place) then
1552 0 : call paw_an_free(paw_an)
1553 0 : LIBPAW_DATATYPE_DEALLOCATE(paw_an)
1554 0 : LIBPAW_DATATYPE_ALLOCATE(paw_an,(my_natom_out))
1555 0 : call paw_an_nullify(paw_an)
1556 0 : call paw_an_copy(paw_an_all,paw_an,comm_atom=mpi_comm_out,mpi_atmtab=my_atmtab_out)
1557 : else
1558 0 : LIBPAW_DATATYPE_ALLOCATE(paw_an_out,(my_natom_out))
1559 0 : call paw_an_nullify(paw_an_out)
1560 0 : call paw_an_copy(paw_an_all,paw_an_out,comm_atom=mpi_comm_out,mpi_atmtab=my_atmtab_out)
1561 : end if
1562 0 : call paw_an_free(paw_an_all)
1563 0 : LIBPAW_DATATYPE_DEALLOCATE(paw_an_all)
1564 :
1565 :
1566 : !Asynchronous algorithm (asynchronous communications)
1567 : !---------------------------------------------------------
1568 : else if (algo_option==2) then
1569 :
1570 40 : nbsend=size(SendAtomProc) ; nbrecv=size(RecvAtomProc)
1571 :
1572 40 : if (in_place) then
1573 40 : if (my_natom_out > 0) then
1574 112 : LIBPAW_DATATYPE_ALLOCATE(paw_an_out1,(my_natom_out))
1575 28 : call paw_an_nullify(paw_an_out1)
1576 : else
1577 12 : LIBPAW_DATATYPE_ALLOCATE(paw_an_out1,(0))
1578 : end if
1579 : else
1580 0 : LIBPAW_DATATYPE_ALLOCATE(paw_an_out,(my_natom_out))
1581 0 : call paw_an_nullify(paw_an_out)
1582 0 : paw_an_out1=>paw_an_out
1583 : end if
1584 :
1585 40 : nproc_in=xmpi_comm_size(mpi_comm_in)
1586 40 : nproc_out=xmpi_comm_size(mpi_comm_out)
1587 40 : if (nproc_in<=nproc_out) mpi_comm_exch=mpi_comm_out
1588 40 : if (nproc_in>nproc_out) mpi_comm_exch=mpi_comm_in
1589 40 : me_exch=xmpi_comm_rank(mpi_comm_exch)
1590 :
1591 : ! Dimension put to the maximum to send
1592 120 : LIBPAW_ALLOCATE(atmtab_send,(nbsend))
1593 120 : LIBPAW_ALLOCATE(atm_indx_in,(natom_tot))
1594 120 : atm_indx_in=-1
1595 68 : do iatom=1,my_natom_in
1596 68 : atm_indx_in(my_atmtab_in(iatom))=iatom
1597 : end do
1598 80 : LIBPAW_ALLOCATE(atm_indx_out,(natom_tot))
1599 120 : atm_indx_out=-1
1600 68 : do iatom=1,my_natom_out
1601 68 : atm_indx_out(my_atmtab_out(iatom))=iatom
1602 : end do
1603 :
1604 148 : LIBPAW_DATATYPE_ALLOCATE(tab_buf_int,(nbsend))
1605 148 : LIBPAW_DATATYPE_ALLOCATE(tab_buf_dp,(nbsend))
1606 108 : LIBPAW_DATATYPE_ALLOCATE(tab_buf_atom,(nbsend))
1607 120 : LIBPAW_ALLOCATE(request,(3*nbsend))
1608 :
1609 : ! A send buffer in an asynchrone communication couldn't be deallocate before it has been receive
1610 40 : nbsent=0 ; ireq=0 ; iisend=0 ; nbsendreq=0 ; nb_msg=0
1611 68 : do iisend=1,nbsend
1612 28 : iproc_rcv=SendAtomProc(iisend)
1613 28 : next=-1
1614 28 : if (iisend < nbsend) next=SendAtomProc(iisend+1)
1615 68 : if (iproc_rcv /= me_exch) then
1616 8 : nbsent=nbsent+1
1617 8 : atmtab_send(nbsent)=SendAtomList(iisend) ! we groups the atoms sends to the same process
1618 8 : if (iproc_rcv /= next) then
1619 8 : if (nbsent > 0) then
1620 : ! Check if message has been yet prepared
1621 : message_yet_prepared=.false.
1622 8 : do imsg=1,nb_msg
1623 8 : if (size(tab_buf_atom(imsg)%value) /= nbsent) then
1624 : cycle
1625 : else
1626 0 : do imsg1=1,nbsent
1627 0 : if (tab_buf_atom(imsg)%value(imsg1)/=atmtab_send(imsg1)) exit
1628 0 : message_yet_prepared=.true.
1629 0 : imsg_current=imsg
1630 : end do
1631 : end if
1632 : end do
1633 : ! Create the message
1634 8 : if (.not.message_yet_prepared) then
1635 8 : nb_msg=nb_msg+1
1636 : call paw_an_isendreceive_fillbuffer( &
1637 8 : & paw_an,atmtab_send,atm_indx_in,nbsent,buf_int,nb_int,buf_dp,nb_dp)
1638 24 : LIBPAW_ALLOCATE(tab_buf_int(nb_msg)%value,(nb_int))
1639 24 : LIBPAW_ALLOCATE(tab_buf_dp(nb_msg)%value,(nb_dp))
1640 224 : tab_buf_int(nb_msg)%value(1:nb_int)=buf_int(1:nb_int)
1641 121976 : tab_buf_dp(nb_msg)%value(1:nb_dp)=buf_dp(1:nb_dp)
1642 8 : LIBPAW_DEALLOCATE(buf_int)
1643 8 : LIBPAW_DEALLOCATE(buf_dp)
1644 24 : LIBPAW_ALLOCATE(tab_buf_atom(nb_msg)%value, (nbsent))
1645 16 : tab_buf_atom(nb_msg)%value(1:nbsent)=atmtab_send(1:nbsent)
1646 : imsg_current=nb_msg
1647 : end if
1648 : ! Communicate
1649 8 : buf_size(1)=size(tab_buf_int(imsg_current)%value)
1650 8 : buf_size(2)=size(tab_buf_dp(imsg_current)%value)
1651 8 : buf_size(3)=nbsent
1652 8 : buf_ints=>tab_buf_int(imsg_current)%value
1653 8 : buf_dps=>tab_buf_dp(imsg_current)%value
1654 8 : my_tag=300
1655 8 : ireq=ireq+1
1656 8 : call xmpi_isend(buf_size,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr)
1657 8 : my_tag=301
1658 8 : ireq=ireq+1
1659 8 : call xmpi_isend(buf_ints,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr)
1660 8 : my_tag=302
1661 8 : ireq=ireq+1
1662 8 : call xmpi_isend(buf_dps,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr)
1663 8 : nbsendreq=ireq
1664 8 : nbsent=0
1665 : end if
1666 : end if
1667 : else ! Just a renumbering, not a sending
1668 20 : iat_in=atm_indx_in(SendAtomList(iisend))
1669 20 : iat_out=atm_indx_out(my_atmtab_in(iat_in))
1670 20 : call paw_an_copy(paw_an(iat_in:iat_in),paw_an_out1(iat_out:iat_out))
1671 20 : nbsent=0
1672 : end if
1673 : end do
1674 :
1675 120 : LIBPAW_ALLOCATE(From,(nbrecv))
1676 68 : From(:)=-1 ; nbrecvmsg=0
1677 68 : do iircv=1,nbrecv
1678 28 : iproc_send=RecvAtomProc(iircv) !receive from ( RcvAtomProc is sorted by growing process )
1679 28 : next=-1
1680 28 : if (iircv < nbrecv) next=RecvAtomProc(iircv+1)
1681 68 : if (iproc_send /= me_exch .and. iproc_send/=next) then
1682 8 : nbrecvmsg=nbrecvmsg+1
1683 8 : From(nbrecvmsg)=iproc_send
1684 : end if
1685 : end do
1686 :
1687 120 : LIBPAW_ALLOCATE(msg_pick,(nbrecvmsg))
1688 48 : msg_pick=.false.
1689 : nbmsg_incoming=nbrecvmsg
1690 1148 : do while (nbmsg_incoming > 0)
1691 2256 : do i1=1,nbrecvmsg
1692 2216 : if (.not.msg_pick(i1)) then
1693 1108 : iproc_send=From(i1)
1694 : flag=.false.
1695 1108 : my_tag=300
1696 1108 : call xmpi_iprobe(iproc_send,my_tag,mpi_comm_exch,flag,ierr)
1697 1108 : if (flag) then
1698 8 : msg_pick(i1)=.true.
1699 8 : call xmpi_irecv(buf_size,iproc_send,my_tag,mpi_comm_exch,request1(1),ierr)
1700 8 : call xmpi_wait(request1(1),ierr)
1701 8 : nb_int=buf_size(1)
1702 8 : nb_dp=buf_size(2)
1703 8 : npaw_an_sent=buf_size(3)
1704 24 : LIBPAW_ALLOCATE(buf_int1,(nb_int))
1705 24 : LIBPAW_ALLOCATE(buf_dp1 ,(nb_dp))
1706 8 : my_tag=301
1707 8 : call xmpi_irecv(buf_int1,iproc_send,my_tag,mpi_comm_exch,request1(2),ierr)
1708 8 : my_tag=302
1709 8 : call xmpi_irecv(buf_dp1,iproc_send,my_tag,mpi_comm_exch,request1(3),ierr)
1710 8 : call xmpi_waitall(request1(2:3),ierr)
1711 8 : call paw_an_isendreceive_getbuffer(paw_an_out1,npaw_an_sent,atm_indx_out,buf_int1,buf_dp1)
1712 8 : nbmsg_incoming=nbmsg_incoming-1
1713 8 : LIBPAW_DEALLOCATE(buf_int1)
1714 24 : LIBPAW_DEALLOCATE(buf_dp1)
1715 : end if
1716 : end if
1717 : end do
1718 : end do
1719 40 : LIBPAW_DEALLOCATE(msg_pick)
1720 :
1721 40 : if (in_place) then
1722 40 : call paw_an_free(paw_an)
1723 68 : LIBPAW_DATATYPE_DEALLOCATE(paw_an)
1724 148 : LIBPAW_DATATYPE_ALLOCATE(paw_an,(my_natom_out))
1725 40 : call paw_an_nullify(paw_an)
1726 40 : call paw_an_copy(paw_an_out1,paw_an)
1727 40 : call paw_an_free(paw_an_out1)
1728 40 : LIBPAW_DATATYPE_DEALLOCATE(paw_an_out1)
1729 : end if
1730 :
1731 : ! Wait for deallocating arrays that all sending operations has been realized
1732 40 : if (nbsendreq > 0) then
1733 8 : call xmpi_waitall(request(1:nbsendreq),ierr)
1734 : end if
1735 :
1736 : ! Deallocate buffers
1737 48 : do i1=1,nb_msg
1738 8 : LIBPAW_DEALLOCATE(tab_buf_int(i1)%value)
1739 8 : LIBPAW_DEALLOCATE(tab_buf_dp(i1)%value)
1740 48 : LIBPAW_DEALLOCATE(tab_buf_atom(i1)%value)
1741 : end do
1742 68 : LIBPAW_DATATYPE_DEALLOCATE(tab_buf_int)
1743 68 : LIBPAW_DATATYPE_DEALLOCATE(tab_buf_dp)
1744 68 : LIBPAW_DATATYPE_DEALLOCATE(tab_buf_atom)
1745 40 : LIBPAW_DEALLOCATE(From)
1746 40 : LIBPAW_DEALLOCATE(request)
1747 40 : LIBPAW_DEALLOCATE(atmtab_send)
1748 40 : LIBPAW_DEALLOCATE(atm_indx_in)
1749 40 : LIBPAW_DEALLOCATE(atm_indx_out)
1750 :
1751 : end if !algo_option
1752 :
1753 : !Eventually release temporary pointers
1754 40 : call free_my_atmtab(my_atmtab_in,my_atmtab_in_allocated)
1755 40 : call free_my_atmtab(my_atmtab_out,my_atmtab_out_allocated)
1756 :
1757 80 : end subroutine paw_an_redistribute
1758 : !!***
1759 :
1760 : !----------------------------------------------------------------------
1761 :
1762 : !!****f* m_paw_an/paw_an_reset_flags
1763 : !! NAME
1764 : !! paw_an_reset_flags
1765 : !!
1766 : !! FUNCTION
1767 : !! Set all paw_an flags to 1 (force the recomputation of all arrays)
1768 : !!
1769 : !! SIDE EFFECTS
1770 : !! Paw_an<type(Paw_an_type)>=paw_an datastructure
1771 : !!
1772 : !! SOURCE
1773 :
1774 25118 : subroutine paw_an_reset_flags(Paw_an)
1775 :
1776 : !Arguments ------------------------------------
1777 : !arrays
1778 : type(Paw_an_type),intent(inout) :: Paw_an(:)
1779 :
1780 : !Local variables-------------------------------
1781 : integer :: iat,natom
1782 :
1783 : ! *************************************************************************
1784 :
1785 : !@Paw_an_type
1786 :
1787 25118 : natom=SIZE(Paw_an);if (natom==0) return
1788 77049 : do iat=1,natom
1789 53707 : if (Paw_an(iat)%has_kxc >0) Paw_an(iat)%has_kxc =1
1790 53707 : if (Paw_an(iat)%has_k3xc >0) Paw_an(iat)%has_k3xc =1
1791 53707 : if (Paw_an(iat)%has_vhartree>0) Paw_an(iat)%has_vhartree=1
1792 53707 : if (Paw_an(iat)%has_vxc >0) Paw_an(iat)%has_vxc =1
1793 53707 : if (Paw_an(iat)%has_vxctau >0) Paw_an(iat)%has_vxctau =1
1794 53707 : if (Paw_an(iat)%has_vxcval >0) Paw_an(iat)%has_vxcval =1
1795 77049 : if (Paw_an(iat)%has_vxc_ex >0) Paw_an(iat)%has_vxc_ex =1
1796 : end do
1797 :
1798 : end subroutine paw_an_reset_flags
1799 : !!***
1800 :
1801 : !----------------------------------------------------------------------
1802 :
1803 : !!****f* m_paw_an/paw_an_isendreceive_getbuffer
1804 : !! NAME
1805 : !! paw_an_isendreceive_getbuffer
1806 : !!
1807 : !! FUNCTION
1808 : !! Fill a paw_an structure with the buffers received in a receive operation
1809 : !! This buffer should have been first extracted by a call to paw_an_isendreceive_fillbuffer
1810 : !!
1811 : !! INPUTS
1812 : !! atm_indx_recv(1:total number of atoms)= array for receive operation
1813 : !! Given an index of atom in global numbering, give its index
1814 : !! in the table of atoms treated by current processor
1815 : !! or -1 if the atoms is not treated by current processor
1816 : !! buf_int= buffer of receive integers
1817 : !! buf_dp= buffer of receive double precision numbers
1818 : !! npaw_an_send= number of sent atoms
1819 : !!
1820 : !! OUTPUT
1821 : !! paw_an= output datastructure filled with buffers receive in a receive operation
1822 : !!
1823 : !! SOURCE
1824 :
1825 8 : subroutine paw_an_isendreceive_getbuffer(paw_an,npaw_an_send,atm_indx_recv,buf_int,buf_dp)
1826 :
1827 : !Arguments ------------------------------------
1828 : !scalars
1829 : integer,intent(in) :: npaw_an_send
1830 : !arrays
1831 : integer,intent(in) ::atm_indx_recv(:),buf_int(:)
1832 : real(dp),intent(in):: buf_dp(:)
1833 : type(paw_an_type),target,intent(inout) :: paw_an(:)
1834 :
1835 : !Local variables-------------------------------
1836 : !scalars
1837 : integer :: buf_int_size,buf_dp_size,cplx_mesh_size,has_lm_select,i1,i2
1838 : integer :: iat,iatot,ij,indx_int,indx_dp,lm_size,nkxc1,nk3xc1,nspden,v_size
1839 : character(len=500) :: msg
1840 : type(paw_an_type),pointer :: paw_an1
1841 : !arrays
1842 :
1843 : ! *********************************************************************
1844 :
1845 8 : buf_int_size=size(buf_int)
1846 8 : buf_dp_size=size(buf_dp)
1847 8 : indx_int=1; indx_dp=1
1848 :
1849 16 : do ij=1,npaw_an_send
1850 8 : iatot=buf_int(indx_int); indx_int=indx_int+1
1851 8 : iat= atm_indx_recv(iatot)
1852 8 : paw_an1=>paw_an(iat)
1853 8 : paw_an1%itypat=buf_int(indx_int); indx_int=indx_int+1
1854 8 : paw_an1%nspden=buf_int(indx_int); indx_int=indx_int+1
1855 8 : paw_an1%cplex=buf_int(indx_int); indx_int=indx_int+1
1856 8 : paw_an1%mesh_size=buf_int(indx_int); indx_int=indx_int+1
1857 8 : paw_an1%angl_size=buf_int(indx_int); indx_int=indx_int+1
1858 8 : paw_an1%lm_size=buf_int(indx_int); indx_int=indx_int+1
1859 8 : paw_an1%nkxc1=buf_int(indx_int); indx_int=indx_int+1
1860 8 : paw_an1%nk3xc1=buf_int(indx_int); indx_int=indx_int+1
1861 8 : paw_an1%has_vxc=buf_int(indx_int); indx_int=indx_int+1
1862 8 : paw_an1%has_vxctau=buf_int(indx_int); indx_int=indx_int+1
1863 8 : paw_an1%has_kxc=buf_int(indx_int); indx_int=indx_int+1
1864 8 : paw_an1%has_k3xc=buf_int(indx_int); indx_int=indx_int+1
1865 8 : paw_an1%has_vxcval=buf_int(indx_int); indx_int=indx_int+1
1866 8 : paw_an1%has_vxc_ex=buf_int(indx_int); indx_int=indx_int+1
1867 8 : paw_an1%has_vhartree=buf_int(indx_int); indx_int=indx_int+1
1868 8 : v_size=buf_int(indx_int); indx_int=indx_int+1
1869 8 : has_lm_select=buf_int(indx_int); indx_int=indx_int+1
1870 8 : nspden=paw_an1%nspden
1871 8 : lm_size=paw_an1%lm_size
1872 8 : nkxc1=paw_an1%nkxc1
1873 8 : nk3xc1=paw_an1%nk3xc1
1874 8 : cplx_mesh_size=paw_an1%cplex*paw_an1%mesh_size
1875 8 : if (has_lm_select==1) then
1876 24 : LIBPAW_ALLOCATE(paw_an1%lmselect,(lm_size))
1877 8 : if (lm_size>0) then
1878 80 : do i1=1,lm_size
1879 80 : if (buf_int(indx_int)==1) then
1880 20 : paw_an1%lmselect(i1)=.TRUE.;indx_int=indx_int+1
1881 : else
1882 52 : paw_an1%lmselect(i1)=.FALSE.;indx_int=indx_int+1
1883 : end if
1884 : end do
1885 : end if
1886 : end if
1887 8 : if (paw_an1%has_vxc>0) then
1888 40 : LIBPAW_ALLOCATE(paw_an1%vxc1,(cplx_mesh_size,v_size,nspden))
1889 32 : LIBPAW_ALLOCATE(paw_an1%vxct1,(cplx_mesh_size,v_size,nspden))
1890 8 : if (paw_an1%has_vxc==2) then
1891 16 : do i1=1,nspden
1892 88 : do i2=1,v_size
1893 34920 : paw_an1%vxc1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)
1894 80 : indx_dp=indx_dp+cplx_mesh_size
1895 : end do
1896 : end do
1897 16 : do i1=1,nspden
1898 88 : do i2=1,v_size
1899 34920 : paw_an1%vxct1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)
1900 80 : indx_dp=indx_dp+cplx_mesh_size
1901 : end do
1902 : end do
1903 : end if
1904 : end if
1905 8 : if (paw_an1%has_vxctau>0) then
1906 0 : LIBPAW_ALLOCATE(paw_an1%vxctau1,(cplx_mesh_size,v_size,nspden))
1907 0 : LIBPAW_ALLOCATE(paw_an1%vxcttau1,(cplx_mesh_size,v_size,nspden))
1908 0 : if (paw_an1%has_vxctau==2) then
1909 0 : do i1=1,nspden
1910 0 : do i2=1,v_size
1911 0 : paw_an1%vxctau1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)
1912 0 : indx_dp=indx_dp+cplx_mesh_size
1913 : end do
1914 : end do
1915 0 : do i1=1,nspden
1916 0 : do i2=1,v_size
1917 0 : paw_an1%vxcttau1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)
1918 0 : indx_dp=indx_dp+cplx_mesh_size
1919 : end do
1920 : end do
1921 : end if
1922 : end if
1923 8 : if (paw_an1%has_kxc>0) then
1924 30 : LIBPAW_ALLOCATE(paw_an1%kxc1,(cplx_mesh_size,v_size,nkxc1))
1925 24 : LIBPAW_ALLOCATE(paw_an1%kxct1,(cplx_mesh_size,v_size,nkxc1))
1926 6 : if (paw_an1%has_kxc==2.and.nkxc1>0) then
1927 12 : do i1=1,nkxc1
1928 66 : do i2=1,v_size
1929 26190 : paw_an1%kxc1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)
1930 60 : indx_dp=indx_dp+cplx_mesh_size
1931 : end do
1932 : end do
1933 12 : do i1=1,nkxc1
1934 66 : do i2=1,v_size
1935 26190 : paw_an1%kxct1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)
1936 60 : indx_dp=indx_dp+cplx_mesh_size
1937 : end do
1938 : end do
1939 : end if
1940 : end if
1941 8 : if (paw_an1%has_k3xc>0) then
1942 0 : LIBPAW_ALLOCATE(paw_an1%k3xc1,(cplx_mesh_size,v_size,nk3xc1))
1943 0 : LIBPAW_ALLOCATE(paw_an1%k3xct1,(cplx_mesh_size,v_size,nk3xc1))
1944 0 : if (paw_an1%has_k3xc==2.and.nk3xc1>0) then
1945 0 : do i1=1,nk3xc1
1946 0 : do i2=1,v_size
1947 0 : paw_an1%k3xc1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)
1948 0 : indx_dp=indx_dp+cplx_mesh_size
1949 : end do
1950 : end do
1951 0 : do i1=1,nk3xc1
1952 0 : do i2=1,v_size
1953 0 : paw_an1%k3xct1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)
1954 0 : indx_dp=indx_dp+cplx_mesh_size
1955 : end do
1956 : end do
1957 : end if
1958 : end if
1959 8 : if (paw_an1%has_vxcval>0) then
1960 0 : LIBPAW_ALLOCATE(paw_an1%vxc1_val,(cplx_mesh_size,v_size,nspden))
1961 0 : LIBPAW_ALLOCATE(paw_an1%vxct1_val,(cplx_mesh_size,v_size,nspden))
1962 0 : if (paw_an1%has_vxcval==2) then
1963 0 : do i1=1,nspden
1964 0 : do i2=1,v_size
1965 0 : paw_an1%vxc1_val(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)
1966 0 : indx_dp=indx_dp+cplx_mesh_size
1967 : end do
1968 : end do
1969 0 : do i1=1,nspden
1970 0 : do i2=1,v_size
1971 0 : paw_an1%vxct1_val(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)
1972 0 : indx_dp=indx_dp+cplx_mesh_size
1973 : end do
1974 : end do
1975 : end if
1976 : end if
1977 8 : if (paw_an1%has_vxc_ex>0) then
1978 0 : LIBPAW_ALLOCATE(paw_an1%vxc_ex,(cplx_mesh_size,v_size,nspden))
1979 0 : if (paw_an1%has_vxc_ex==2) then
1980 0 : do i1=1,nspden
1981 0 : do i2=1,v_size
1982 0 : paw_an1%vxc_ex(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)
1983 0 : indx_dp=indx_dp+cplx_mesh_size
1984 : end do
1985 : end do
1986 : end if
1987 : end if
1988 16 : if (paw_an1%has_vhartree>0) then
1989 0 : LIBPAW_ALLOCATE(paw_an1%vh1,(cplx_mesh_size,lm_size,nspden))
1990 0 : LIBPAW_ALLOCATE(paw_an1%vht1,(cplx_mesh_size,lm_size,nspden))
1991 0 : if (paw_an1%has_vhartree==2) then
1992 0 : do i1=1,nspden
1993 0 : do i2=1,lm_size
1994 0 : paw_an1%vh1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)
1995 0 : indx_dp=indx_dp+cplx_mesh_size
1996 : end do
1997 : end do
1998 0 : do i1=1,nspden
1999 0 : do i2=1,lm_size
2000 0 : paw_an1%vht1(:,i2,i1)=buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)
2001 0 : indx_dp=indx_dp+cplx_mesh_size
2002 : end do
2003 : end do
2004 : end if
2005 : end if
2006 : end do ! iat
2007 8 : if ((indx_int/=1+buf_int_size).or.(indx_dp/=1+buf_dp_size)) then
2008 0 : write(msg,'(a,i10,a,i10)') 'Wrong buffer sizes: buf_int_size=',buf_int_size,' buf_dp_size=',buf_dp_size
2009 0 : LIBPAW_BUG(msg)
2010 : end if
2011 :
2012 8 : end subroutine paw_an_isendreceive_getbuffer
2013 : !!***
2014 :
2015 : !----------------------------------------------------------------------
2016 :
2017 :
2018 : !!****f* m_paw_an/paw_an_isendreceive_fillbuffer
2019 : !! NAME
2020 : !! paw_an_isendreceive_fillbuffer
2021 : !!
2022 : !! FUNCTION
2023 : !! Extract from paw_an and from the global index of atoms
2024 : !! the buffers to send in a sending operation
2025 : !! This function has to be coupled with a call to paw_ij_isendreceive_getbuffer
2026 : !! INPUTS
2027 : !! atm_indx_send(1:total number of atoms)= array for send operation,
2028 : !! Given an index of atom in global numbering, give its index
2029 : !! in the table of atoms treated by current processor
2030 : !! or -1 if the atoms is not treated by current processor
2031 : !! npaw_an_send= number of sent atoms
2032 : !! paw_an= data structure from which are extract buffer int and buffer dp
2033 : !!
2034 : !! OUTPUT
2035 : !! buf_int : buffer of integers to be send in a send operation
2036 : !! buf_int_size : size of buffer of integers to be send in a send operation
2037 : !! buf_dp : buffer of double precision numbers to be send in a send operation
2038 : !! buf_dp_size : size of buffer of double precision numbers to be send in a send operation
2039 : !!
2040 : !! SOURCE
2041 :
2042 8 : subroutine paw_an_isendreceive_fillbuffer(paw_an, atmtab_send,atm_indx_send,npaw_an_send,&
2043 : & buf_int,buf_int_size,buf_dp,buf_dp_size)
2044 :
2045 : !Arguments ------------------------------------
2046 : !scalars
2047 : integer,intent(out) :: buf_int_size,buf_dp_size
2048 : integer,intent(in) :: npaw_an_send
2049 : !arrays
2050 : integer,intent(in) :: atmtab_send(:),atm_indx_send(:)
2051 : integer,allocatable,intent(out) :: buf_int(:)
2052 : real(dp),allocatable,intent(out):: buf_dp(:)
2053 : type(paw_an_type),target,intent(in) :: paw_an(:)
2054 :
2055 : !Local variables-------------------------------
2056 : !scalars
2057 : integer :: cplx_mesh_size,i1,i2,iatom_tot,ij,indx_int,indx_dp
2058 : integer :: ipaw_an_send,lm_size,nspden,v_size
2059 : character(len=500) :: msg
2060 : type(Paw_an_type),pointer :: paw_an1
2061 : !arrays
2062 :
2063 : ! *********************************************************************
2064 :
2065 : !Compute sizes of buffers
2066 8 : buf_int_size=0 ; buf_dp_size=0
2067 16 : do ipaw_an_send=1,npaw_an_send
2068 8 : iatom_tot=atmtab_send(ipaw_an_send)
2069 8 : ij = atm_indx_send(iatom_tot)
2070 8 : paw_an1=>paw_an(ij)
2071 8 : buf_int_size=buf_int_size+18+size(paw_an1%lmselect)
2072 8 : if (paw_an1%has_vxc==2) then
2073 32 : buf_dp_size=buf_dp_size+size(paw_an1%vxc1)
2074 32 : buf_dp_size=buf_dp_size+size(paw_an1%vxct1)
2075 : end if
2076 8 : if (paw_an1%has_vxctau==2) then
2077 0 : buf_dp_size=buf_dp_size+size(paw_an1%vxctau1)
2078 0 : buf_dp_size=buf_dp_size+size(paw_an1%vxcttau1)
2079 : end if
2080 8 : if (paw_an1%has_kxc==2) then
2081 24 : buf_dp_size=buf_dp_size+size(paw_an1%kxc1)
2082 24 : buf_dp_size=buf_dp_size+size(paw_an1%kxct1)
2083 : end if
2084 8 : if (paw_an1%has_k3xc==2) then
2085 0 : buf_dp_size=buf_dp_size+size(paw_an1%k3xc1)
2086 0 : buf_dp_size=buf_dp_size+size(paw_an1%k3xct1)
2087 : end if
2088 8 : if (paw_an1%has_vxcval==2) then
2089 0 : buf_dp_size=buf_dp_size+size(paw_an1%vxc1_val)
2090 0 : buf_dp_size=buf_dp_size+size(paw_an1%vxct1_val)
2091 : end if
2092 8 : if (paw_an1%has_vxc_ex==2) then
2093 0 : buf_dp_size=buf_dp_size+size(paw_an1%vxc_ex)
2094 : end if
2095 16 : if (paw_an1%has_vhartree==2) then
2096 0 : buf_dp_size=buf_dp_size+size(paw_an1%vh1)
2097 0 : buf_dp_size=buf_dp_size+size(paw_an1%vht1)
2098 : end if
2099 : end do
2100 :
2101 : !Fill in input buffers
2102 24 : LIBPAW_ALLOCATE(buf_int,(buf_int_size))
2103 24 : LIBPAW_ALLOCATE(buf_dp ,(buf_dp_size))
2104 8 : indx_int=1;indx_dp=1
2105 16 : do ipaw_an_send=1,npaw_an_send
2106 8 : iatom_tot=atmtab_send(ipaw_an_send)
2107 8 : ij = atm_indx_send(iatom_tot)
2108 8 : paw_an1=>paw_an(ij)
2109 8 : buf_int(indx_int)=iatom_tot; indx_int=indx_int+1
2110 8 : buf_int(indx_int)=paw_an1%itypat; indx_int=indx_int+1
2111 8 : buf_int(indx_int)=paw_an1%nspden; indx_int=indx_int+1
2112 8 : buf_int(indx_int)=paw_an1%cplex; indx_int=indx_int+1
2113 8 : buf_int(indx_int)=paw_an1%mesh_size; indx_int=indx_int+1
2114 8 : buf_int(indx_int)=paw_an1%angl_size; indx_int=indx_int+1
2115 8 : buf_int(indx_int)=paw_an1%lm_size; indx_int=indx_int+1
2116 8 : buf_int(indx_int)=paw_an1%nkxc1; indx_int=indx_int+1
2117 8 : buf_int(indx_int)=paw_an1%nk3xc1; indx_int=indx_int+1
2118 8 : buf_int(indx_int)=paw_an1%has_vxc; indx_int=indx_int+1
2119 8 : buf_int(indx_int)=paw_an1%has_vxctau; indx_int=indx_int+1
2120 8 : buf_int(indx_int)=paw_an1%has_kxc; indx_int=indx_int+1
2121 8 : buf_int(indx_int)=paw_an1%has_k3xc; indx_int=indx_int+1
2122 8 : buf_int(indx_int)=paw_an1%has_vxcval; indx_int=indx_int+1
2123 8 : buf_int(indx_int)=paw_an1%has_vxc_ex; indx_int=indx_int+1
2124 8 : buf_int(indx_int)=paw_an1%has_vhartree; indx_int=indx_int+1
2125 8 : v_size=0
2126 8 : if (paw_an1%has_vxc>0) then
2127 8 : v_size=size(paw_an1%vxc1,2)
2128 0 : else if (paw_an1%has_vxctau>0) then
2129 0 : v_size=size(paw_an1%vxctau1,2)
2130 0 : else if (paw_an1%has_kxc>0) then
2131 0 : v_size=size(paw_an1%kxc1,2)
2132 0 : else if (paw_an1%has_k3xc>0) then
2133 0 : v_size=size(paw_an1%k3xc1,2)
2134 0 : else if (paw_an1%has_vxcval>0) then
2135 0 : v_size=size(paw_an1%vxc1_val,2)
2136 0 : else if (paw_an1%has_vxc_ex>0) then
2137 0 : v_size=size(paw_an1%vxc_ex,2)
2138 0 : else if (paw_an1%has_vhartree>0) then
2139 0 : v_size=size(paw_an1%vh1,2)
2140 : end if
2141 8 : buf_int(indx_int)=v_size;indx_int=indx_int+1
2142 8 : if (allocated(paw_an1%lmselect)) then
2143 8 : buf_int(indx_int)=1;indx_int=indx_int+1
2144 : else
2145 0 : buf_int(indx_int)=0;indx_int=indx_int+1
2146 : end if
2147 8 : nspden=paw_an1%nspden
2148 8 : lm_size=paw_an1%lm_size
2149 8 : cplx_mesh_size=paw_an1%cplex*paw_an1%mesh_size
2150 8 : if (lm_size>0) then
2151 8 : if (allocated(paw_an1%lmselect)) then
2152 80 : do i1=1,lm_size
2153 72 : if (paw_an1%lmselect(i1)) then
2154 20 : buf_int(indx_int)=1
2155 : else
2156 52 : buf_int(indx_int)=0
2157 : end if
2158 80 : indx_int=indx_int+1
2159 : end do
2160 : end if
2161 : end if
2162 8 : if (paw_an1%has_vxc==2) then
2163 16 : do i1=1,nspden
2164 88 : do i2=1,v_size
2165 34920 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxc1(:,i2,i1)
2166 80 : indx_dp=indx_dp+cplx_mesh_size
2167 : end do
2168 : end do
2169 16 : do i1=1,nspden
2170 88 : do i2=1,v_size
2171 34920 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxct1(:,i2,i1)
2172 80 : indx_dp=indx_dp+cplx_mesh_size
2173 : end do
2174 : end do
2175 : end if
2176 8 : if (paw_an1%has_vxctau==2) then
2177 0 : do i1=1,nspden
2178 0 : do i2=1,v_size
2179 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxctau1(:,i2,i1)
2180 0 : indx_dp=indx_dp+cplx_mesh_size
2181 : end do
2182 : end do
2183 0 : do i1=1,nspden
2184 0 : do i2=1,v_size
2185 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxcttau1(:,i2,i1)
2186 0 : indx_dp=indx_dp+cplx_mesh_size
2187 : end do
2188 : end do
2189 : end if
2190 8 : if (paw_an1%has_kxc==2.and.paw_an1%nkxc1>0) then
2191 12 : do i1=1,paw_an1%nkxc1
2192 66 : do i2=1,v_size
2193 26190 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%kxc1(:,i2,i1)
2194 60 : indx_dp=indx_dp+cplx_mesh_size
2195 : end do
2196 : end do
2197 12 : do i1=1,paw_an1%nkxc1
2198 66 : do i2=1,v_size
2199 26190 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%kxct1(:,i2,i1)
2200 60 : indx_dp=indx_dp+cplx_mesh_size
2201 : end do
2202 : end do
2203 : end if
2204 8 : if (paw_an1%has_k3xc==2.and.paw_an1%nk3xc1>0) then
2205 0 : do i1=1,paw_an1%nk3xc1
2206 0 : do i2=1,v_size
2207 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%k3xc1(:,i2,i1)
2208 0 : indx_dp=indx_dp+cplx_mesh_size
2209 : end do
2210 : end do
2211 0 : do i1=1,paw_an1%nk3xc1
2212 0 : do i2=1,v_size
2213 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%k3xct1(:,i2,i1)
2214 0 : indx_dp=indx_dp+cplx_mesh_size
2215 : end do
2216 : end do
2217 : end if
2218 8 : if (paw_an1%has_vxcval==2) then
2219 0 : do i1=1,nspden
2220 0 : do i2=1,v_size
2221 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxc1_val(:,i2,i1)
2222 0 : indx_dp=indx_dp+cplx_mesh_size
2223 : end do
2224 : end do
2225 0 : do i1=1,nspden
2226 0 : do i2=1,v_size
2227 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxct1_val(:,i2,i1)
2228 0 : indx_dp=indx_dp+cplx_mesh_size
2229 : end do
2230 : end do
2231 : end if
2232 8 : if (paw_an1%has_vxc_ex==2) then
2233 0 : do i1=1,nspden
2234 0 : do i2=1,v_size
2235 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vxc_ex(:,i2,i1)
2236 0 : indx_dp=indx_dp+cplx_mesh_size
2237 : end do
2238 : end do
2239 : end if
2240 16 : if (paw_an1%has_vhartree==2) then
2241 0 : do i1=1,nspden
2242 0 : do i2=1,lm_size
2243 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vh1(:,i2,i1)
2244 0 : indx_dp=indx_dp+cplx_mesh_size
2245 : end do
2246 : end do
2247 0 : do i1=1,nspden
2248 0 : do i2=1,lm_size
2249 0 : buf_dp(indx_dp:indx_dp+cplx_mesh_size-1)=paw_an1%vht1(:,i2,i1)
2250 0 : indx_dp=indx_dp+cplx_mesh_size
2251 : end do
2252 : end do
2253 : end if
2254 : end do
2255 8 : if ((indx_int-1/=buf_int_size).or.(indx_dp-1/=buf_dp_size)) then
2256 0 : write(msg,'(4(a,i10))') 'Wrong buffer sizes: buf_int =',buf_int_size,'/',indx_int-1,&
2257 0 : & ' buf_dp =',buf_dp_size ,'/',indx_dp-1
2258 0 : LIBPAW_BUG(msg)
2259 : end if
2260 :
2261 8 : end subroutine paw_an_isendreceive_fillbuffer
2262 : !!***
2263 :
2264 : !----------------------------------------------------------------------
2265 :
2266 0 : END MODULE m_paw_an
2267 : !!***
|
