Line data Source code
1 : !!****m* ABINIT/m_pawfgrtab
2 : !! NAME
3 : !! m_pawfgrtab
4 : !!
5 : !! FUNCTION
6 : !! This module contains the definition of the pawfgrtab_type structured datatype,
7 : !! as well as related functions and methods.
8 : !! pawfgrtab_type variables contain various data expressed on the fine grid
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_pawfgrtab
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 :
34 : implicit none
35 :
36 : private
37 : !!***
38 :
39 : !----------------------------------------------------------------------
40 :
41 :
42 : !!****t* m_pawfgrtab/pawfgrtab_type
43 : !! NAME
44 : !! pawfgrtab_type
45 : !!
46 : !! FUNCTION
47 : !! For PAW, various arrays giving data related to fine grid for a given atom
48 : !!
49 : !! SOURCE
50 :
51 : type,public :: pawfgrtab_type
52 :
53 : !Integer scalars
54 :
55 : integer :: cplex
56 : ! cplex=1 if potentials/densities are real, 2 if they are complex
57 :
58 : integer :: expiqr_allocated
59 : ! 1 if expiqr() is allocated (and computed)
60 :
61 : integer :: itypat
62 : ! itypat=type of the atom
63 :
64 : integer :: l_size
65 : ! 1+maximum value of l leading to non zero Gaunt coeffs
66 : ! for the considered atom type
67 :
68 : integer :: gylm_allocated
69 : ! 1 if gylm() is allocated (and computed)
70 :
71 : integer :: gylmgr_allocated
72 : ! 1 if gylmgr() is allocated (and computed)
73 :
74 : integer :: gylmgr2_allocated
75 : ! 1 if gylmgr2() is allocated (and computed)
76 :
77 : integer :: nfgd
78 : ! Number of Fine rectangular GriD points
79 : ! in the paw sphere around considered atom
80 :
81 : integer :: nhatfr_allocated
82 : ! 1 if nhatfr() is allocated (and computed)
83 :
84 : integer :: nhatfrgr_allocated
85 : ! 1 if nhatfrgr() is allocated (and computed)
86 :
87 : integer :: nspden
88 : ! Number of spin-density components
89 :
90 : integer :: rfgd_allocated
91 : ! 1 if rfgd() is allocated (and computed)
92 :
93 : !Integer arrays
94 : !integer :: ngfftf(18)
95 : ! Info on the dense FFT mesh.
96 :
97 : integer, allocatable :: ifftsph(:)
98 : ! ifftsph(nfgd)
99 : ! Array giving the FFT index (fine grid) of a point in the paw
100 : ! sphere around considered atom (ifftsph=ix+n1*(iy-1+n2*(iz-1))
101 :
102 : !Real (real(dp)) arrays
103 :
104 : real(dp), allocatable :: expiqr(:,:)
105 : ! expiqr(2,nfgd)
106 : ! Gives exp(-i.q.r) on the fine rectangular grid
107 : ! where q is the phonons wavevector
108 :
109 : real(dp), allocatable :: gylm(:,:)
110 : ! gylm(nfgd,l_size*l_size)
111 : ! Gives g_l(r)*Y_lm(r) on the fine rectangular grid
112 : ! around considered atom
113 :
114 : real(dp), allocatable :: gylmgr(:,:,:)
115 : ! gylmgr(3,nfgd,l_size*l_size)
116 : ! Gives the gradient of g_l(r)*Y_lm(r) wrt cart. coordinates
117 : ! on the fine rectangular grid around considered atom
118 :
119 : real(dp), allocatable :: gylmgr2(:,:,:)
120 : ! gylmgr(6,nfgd,l_size*l_size)
121 : ! Gives the second gradient of g_l(r)*Y_lm(r) wrt cart. coordinates
122 : ! on the fine rectangular grid around considered atom
123 :
124 : real(dp), allocatable :: nhatfr(:,:)
125 : ! nhatfr(nfgd,nspden)
126 : ! Gives the "frozen part" of 1st-order compensation charge density
127 : ! on the fine rectangular grid around considered atom
128 : ! Only used in response function calculations
129 :
130 : real(dp), allocatable :: nhatfrgr(:,:,:)
131 : ! nhatfrgr(3,nfgd,nspden)
132 : ! Gives the gradients (wrt cart. coordinates)
133 : ! of "frozen part" of 1st-order compensation charge density
134 : ! on the fine rectangular grid around considered atom
135 : ! Only used in response function calculations
136 :
137 : real(dp), allocatable :: rfgd(:,:)
138 : ! r(3,nfgd)
139 : ! Gives all R vectors (r-r_atom) on the Fine rectangular GriD
140 : ! around considered atom in Cartesian coordinates.
141 :
142 : end type pawfgrtab_type
143 :
144 : !public procedures.
145 : public :: pawfgrtab_init ! Constructor
146 : public :: pawfgrtab_free ! Free memory
147 : public :: pawfgrtab_nullify
148 : public :: pawfgrtab_copy ! Copy the object
149 : public :: pawfgrtab_print ! Print the content of the object.
150 : public :: pawfgrtab_gather ! MPI gather
151 : public :: pawfgrtab_redistribute ! MPI redistribution
152 :
153 : !private procedures.
154 : private :: pawfgrtab_isendreceive_getbuffer
155 : private :: pawfgrtab_isendreceive_fillbuffer
156 : !!***
157 :
158 : CONTAINS
159 :
160 : !===========================================================
161 : !!***
162 :
163 : !----------------------------------------------------------------------
164 :
165 : !!****f* m_pawfgrtab/pawfgrtab_init
166 : !! NAME
167 : !! pawfgrtab_init
168 : !!
169 : !! FUNCTION
170 : !! Initialize a pawfgrtab datastructure
171 : !!
172 : !! OUTPUT
173 : !! Pawfgrtab(natom) <type(pawfgrtab_type)>=atomic data given on fine rectangular grid
174 : !!
175 : !! SOURCE
176 :
177 1557 : subroutine pawfgrtab_init(Pawfgrtab,cplex,l_size_atm,nspden,typat,&
178 1557 : & mpi_atmtab,comm_atom) ! optional arguments (parallelism)
179 :
180 : !Arguments ------------------------------------
181 : !scalars
182 : integer,intent(in) :: cplex,nspden
183 : !arrays
184 : integer,intent(in) :: l_size_atm(:),typat(:)
185 : integer,optional,intent(in) :: comm_atom
186 : integer,optional,target,intent(in) :: mpi_atmtab(:)
187 : type(Pawfgrtab_type),intent(inout) :: Pawfgrtab(:)
188 :
189 : !Local variables-------------------------------
190 : !scalars
191 : integer :: iat,iatom_tot,my_comm_atom,my_natom,natom
192 : logical :: my_atmtab_allocated,paral_atom
193 : character(len=500) :: msg
194 : !arrays
195 1557 : integer,pointer :: my_atmtab(:)
196 :
197 : ! *************************************************************************
198 :
199 : !@Pawfgrtab_type
200 :
201 4 : my_natom=SIZE(Pawfgrtab);if (my_natom==0) return
202 1553 : natom=SIZE(typat)
203 1553 : if (my_natom/=SIZE(l_size_atm)) then
204 0 : msg='Sizes of assumed shape arrays do not match'
205 0 : LIBPAW_BUG(msg)
206 : end if
207 :
208 : !Set up parallelism over atoms
209 1553 : paral_atom=(present(comm_atom).and.(my_natom/=natom))
210 1553 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
211 1553 : my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom
212 1553 : call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,my_natom_ref=my_natom)
213 :
214 1553 : call pawfgrtab_nullify(Pawfgrtab)
215 :
216 5039 : do iat=1,my_natom
217 3486 : iatom_tot=iat; if (paral_atom) iatom_tot=my_atmtab(iat)
218 :
219 3486 : Pawfgrtab(iat)%cplex = cplex
220 3486 : Pawfgrtab(iat)%itypat = typat(iatom_tot)
221 3486 : Pawfgrtab(iat)%nspden = nspden
222 3486 : Pawfgrtab(iat)%l_size = l_size_atm(iat)
223 3486 : Pawfgrtab(iat)%nfgd = 0
224 3486 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%ifftsph,(0))
225 3486 : Pawfgrtab(iat)%gylm_allocated = 0
226 3486 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%gylm,(0,0))
227 3486 : Pawfgrtab(iat)%gylmgr_allocated = 0
228 3486 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%gylmgr,(0,0,0))
229 3486 : Pawfgrtab(iat)%gylmgr2_allocated = 0
230 3486 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%gylmgr2,(0,0,0))
231 3486 : Pawfgrtab(iat)%nhatfr_allocated = 0
232 3486 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%nhatfr,(0,0))
233 3486 : Pawfgrtab(iat)%nhatfrgr_allocated = 0
234 3486 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%nhatfrgr,(0,0,0))
235 3486 : Pawfgrtab(iat)%rfgd_allocated = 0
236 3486 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%rfgd,(0,0))
237 3486 : Pawfgrtab(iat)%expiqr_allocated = 0
238 5039 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%expiqr,(0,0))
239 : end do
240 :
241 : !Destroy atom table used for parallelism
242 1553 : call free_my_atmtab(my_atmtab,my_atmtab_allocated)
243 :
244 1557 : end subroutine pawfgrtab_init
245 : !!***
246 :
247 : !----------------------------------------------------------------------
248 :
249 : !!****f* m_pawfgrtab/pawfgrtab_free
250 : !! NAME
251 : !! pawfgrtab_free
252 : !!
253 : !! FUNCTION
254 : !! Free all dynamic memory stored in a pawfgrtab datastructure
255 : !!
256 : !! SIDE EFFECTS
257 : !! Pawfgrtab(natom) <type(pawfgrtab_type)>=atomic data given on fine rectangular grid
258 : !!
259 : !! SOURCE
260 :
261 1794 : subroutine pawfgrtab_free(Pawfgrtab)
262 :
263 : !Arguments ------------------------------------
264 : !arrays
265 : type(Pawfgrtab_type),intent(inout) :: Pawfgrtab(:)
266 :
267 : !Local variables-------------------------------
268 : !scalars
269 : integer :: iat,natom
270 :
271 : ! *************************************************************************
272 :
273 : !@Pawfgrtab_type
274 :
275 1794 : natom=SIZE(Pawfgrtab);if (natom==0) return
276 5148 : do iat=1,natom
277 3540 : if (allocated(Pawfgrtab(iat)%ifftsph)) then
278 3540 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%ifftsph)
279 : end if
280 3540 : if (allocated(Pawfgrtab(iat)%gylm )) then
281 3540 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%gylm)
282 : end if
283 3540 : if (allocated(Pawfgrtab(iat)%gylmgr )) then
284 3528 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%gylmgr)
285 : end if
286 3540 : if (allocated(Pawfgrtab(iat)%gylmgr2)) then
287 3422 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%gylmgr2)
288 : end if
289 3540 : if (allocated(Pawfgrtab(iat)%nhatfr )) then
290 3413 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%nhatfr)
291 : end if
292 3540 : if (allocated(Pawfgrtab(iat)%nhatfrgr)) then
293 3484 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%nhatfrgr)
294 : end if
295 3540 : if (allocated(Pawfgrtab(iat)%rfgd )) then
296 3516 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%rfgd)
297 : end if
298 3540 : if (allocated(Pawfgrtab(iat)%expiqr)) then
299 3508 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%expiqr)
300 : end if
301 3540 : Pawfgrtab(iat)%gylm_allocated=0
302 3540 : Pawfgrtab(iat)%gylmgr_allocated=0
303 3540 : Pawfgrtab(iat)%gylmgr2_allocated=0
304 3540 : Pawfgrtab(iat)%nhatfr_allocated=0
305 3540 : Pawfgrtab(iat)%nhatfrgr_allocated=0
306 3540 : Pawfgrtab(iat)%rfgd_allocated=0
307 5148 : Pawfgrtab(iat)%expiqr_allocated=0
308 : end do
309 :
310 : end subroutine pawfgrtab_free
311 : !!***
312 :
313 : !----------------------------------------------------------------------
314 :
315 : !!****f* m_pawfgrtab/pawfgrtab_nullify
316 : !! NAME
317 : !! pawfgrtab_nullify
318 : !!
319 : !! FUNCTION
320 : !! Nullify the pointers in a pawfgrtab datastructure
321 : !!
322 : !! SIDE EFFECTS
323 : !! Pawfgrtab(:) <type(pawfgrtab_type)>=atomic data given on fine rectangular grid
324 : !!
325 : !! SOURCE
326 :
327 1695 : subroutine pawfgrtab_nullify(Pawfgrtab)
328 :
329 : !Arguments ------------------------------------
330 : !arrays
331 : type(Pawfgrtab_type),intent(inout) :: Pawfgrtab(:)
332 :
333 : !Local variables-------------------------------
334 : !scalars
335 : integer :: iat,natom
336 :
337 : ! *************************************************************************
338 :
339 : !@Pawfgrtab_type
340 :
341 : ! MGPAW: This one could be removed/renamed,
342 : ! variables can be initialized in the datatype declaration
343 : ! Do we need to expose this in the public API?
344 :
345 1695 : natom=SIZE(Pawfgrtab);if (natom==0) return
346 5325 : do iat=1,natom
347 3642 : Pawfgrtab(iat)%nfgd = 0
348 3642 : Pawfgrtab(iat)%gylm_allocated = 0
349 3642 : Pawfgrtab(iat)%gylmgr_allocated = 0
350 3642 : Pawfgrtab(iat)%gylmgr2_allocated = 0
351 3642 : Pawfgrtab(iat)%nhatfr_allocated = 0
352 3642 : Pawfgrtab(iat)%nhatfrgr_allocated= 0
353 3642 : Pawfgrtab(iat)%rfgd_allocated = 0
354 5325 : Pawfgrtab(iat)%expiqr_allocated = 0
355 : end do
356 :
357 : end subroutine pawfgrtab_nullify
358 : !!***
359 :
360 : !----------------------------------------------------------------------
361 :
362 : !!****f* m_pawfgrtab/pawfgrtab_copy
363 : !! NAME
364 : !! pawfgrtab_copy
365 : !!
366 : !! FUNCTION
367 : !! Copy one pawfgrtab datastructure into another
368 : !! Can take into accound changes of dimensions
369 : !! Can copy a shared pawfgrtab into distributed ones (when parallelism is activated)
370 : !!
371 : !! INPUTS
372 : !! mpi_atmtab(:)=--optional-- indexes of the atoms treated by current proc
373 : !! comm_atom=--optional-- MPI communicator over atoms
374 : !! pawfgrtab_in(:)<type(pawfgrtab_type)>= input paw_an datastructure
375 : !!
376 : !! SIDE EFFECTS
377 : !! pawfgrtab_copy(:)<type(pawfgrtab_type)>= output pawfgrtab datastructure
378 : !!
379 : !! NOTES
380 : !! paw_fgrtab_copy must have been allocated in the calling function.
381 : !!
382 : !! SOURCE
383 :
384 60 : subroutine pawfgrtab_copy(pawfgrtab_in,pawfgrtab_cp, &
385 60 : & mpi_atmtab,comm_atom) ! optional arguments
386 :
387 : !Arguments ------------------------------------
388 : !scalars
389 : integer,optional,intent(in) :: comm_atom
390 : !arrays
391 : integer,optional,target,intent(in) :: mpi_atmtab(:)
392 : type(Pawfgrtab_type),intent(in) :: pawfgrtab_in(:)
393 : type(Pawfgrtab_type),intent(inout),target :: pawfgrtab_cp(:)
394 :
395 : !Local variables-------------------------------
396 : !scalars
397 : integer :: ij,ij1,istat,l_size,l_size2,my_comm_atom,my_natom,nfgd,nspden,paral_case
398 : integer :: siz_in, siz_max, siz_out
399 : logical :: my_atmtab_allocated,paral_atom
400 : character(len=500) :: msg
401 : !arrays
402 60 : integer,pointer :: my_atmtab(:)
403 60 : type(Pawfgrtab_type), pointer :: pawfgrtab_out(:)
404 :
405 : ! *************************************************************************
406 :
407 : !@Pawfgrtab_type
408 :
409 : !Retrieve sizes
410 60 : siz_in=size(pawfgrtab_in);siz_out=size(pawfgrtab_cp)
411 :
412 : !Set up parallelism over atoms
413 0 : paral_atom=(present(comm_atom));if (paral_atom) paral_atom=(xmpi_comm_size(comm_atom)>1)
414 60 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
415 60 : my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom
416 60 : my_atmtab_allocated=.false.
417 :
418 : !Determine in which case we are (parallelism, ...)
419 : !No parallelism: a single copy operation
420 60 : paral_case=0;siz_max=siz_in
421 60 : pawfgrtab_out => pawfgrtab_cp
422 60 : if (paral_atom) then
423 0 : if (siz_out<siz_in) then ! Parallelism: the copy operation is a scatter
424 0 : call get_my_natom(my_comm_atom,my_natom,siz_in)
425 0 : if (my_natom==siz_out) then
426 0 : call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,siz_in)
427 0 : paral_case=1;siz_max=siz_out
428 0 : pawfgrtab_out => pawfgrtab_cp
429 : else
430 0 : msg=' siz_out should be equal to my_natom !'
431 0 : LIBPAW_BUG(msg)
432 : end if
433 : else ! Parallelism: the copy operation is a gather
434 0 : call get_my_natom(my_comm_atom,my_natom,siz_out)
435 0 : if (my_natom==siz_in) then
436 : paral_case=2;siz_max=siz_in
437 : else
438 0 : msg=' siz_in should be equal to my_natom !'
439 0 : LIBPAW_BUG(msg)
440 : end if
441 : end if
442 : end if
443 :
444 : !First case: a simple copy or a scatter
445 60 : if (siz_max > 0 .and. ((paral_case== 0).or.(paral_case==1))) then
446 48 : call pawfgrtab_nullify(pawfgrtab_out)
447 :
448 : ! Loop on pawfgrtab components
449 96 : do ij1=1,siz_max
450 48 : ij=ij1; if (paral_case==1)ij=my_atmtab(ij1)
451 :
452 48 : pawfgrtab_out(ij1)%cplex=pawfgrtab_in(ij)%cplex
453 48 : pawfgrtab_out(ij1)%expiqr_allocated=pawfgrtab_in(ij)%expiqr_allocated
454 48 : pawfgrtab_out(ij1)%itypat=pawfgrtab_in(ij)%itypat
455 48 : l_size=pawfgrtab_in(ij)%l_size
456 48 : l_size2=l_size*l_size
457 48 : pawfgrtab_out(ij1)%l_size=l_size
458 48 : pawfgrtab_out(ij1)%gylm_allocated=pawfgrtab_in(ij)%gylm_allocated
459 48 : pawfgrtab_out(ij1)%gylmgr_allocated=pawfgrtab_in(ij)%gylmgr_allocated
460 48 : pawfgrtab_out(ij1)%gylmgr2_allocated=pawfgrtab_in(ij)%gylmgr2_allocated
461 48 : pawfgrtab_out(ij1)%nfgd=pawfgrtab_in(ij)%nfgd
462 48 : pawfgrtab_out(ij1)%nhatfr_allocated=pawfgrtab_in(ij)%nhatfr_allocated
463 48 : pawfgrtab_out(ij1)%nhatfrgr_allocated=pawfgrtab_in(ij)%nhatfrgr_allocated
464 48 : nspden=pawfgrtab_in(ij)%nspden
465 48 : pawfgrtab_out(ij1)%nspden=nspden
466 48 : pawfgrtab_out(ij1)%rfgd_allocated=pawfgrtab_in(ij)%rfgd_allocated
467 48 : nfgd=pawfgrtab_in(ij)%nfgd
468 144 : LIBPAW_ALLOCATE(pawfgrtab_out(ij1)%ifftsph,(nfgd))
469 87552 : pawfgrtab_out(ij1)%ifftsph(:)=pawfgrtab_in(ij)%ifftsph(:)
470 48 : if (pawfgrtab_out(ij1)%expiqr_allocated>0) then
471 60 : LIBPAW_ALLOCATE(pawfgrtab_out(ij1)%expiqr,(2,nfgd))
472 109400 : pawfgrtab_out(ij1)%expiqr(:,:)=pawfgrtab_in(ij)%expiqr(:,:)
473 : end if
474 48 : if (pawfgrtab_out(ij1)%gylm_allocated>0) then
475 192 : LIBPAW_ALLOCATE(pawfgrtab_out(ij1)%gylm,(nfgd,l_size2))
476 788016 : pawfgrtab_out(ij1)%gylm(:,:)=pawfgrtab_in(ij)%gylm(:,:)
477 : end if
478 48 : if (pawfgrtab_out(ij1)%gylmgr_allocated>0) then
479 152 : LIBPAW_ALLOCATE(pawfgrtab_out(ij1)%gylmgr,(3,nfgd,l_size2))
480 2494244 : pawfgrtab_out(ij1)%gylmgr(:,:,:)=pawfgrtab_in(ij)%gylmgr(:,:,:)
481 : end if
482 48 : if (pawfgrtab_out(ij1)%gylmgr2_allocated>0) then
483 32 : LIBPAW_ALLOCATE(pawfgrtab_out(ij1)%gylmgr2,(6,nfgd,l_size2))
484 918872 : pawfgrtab_out(ij1)%gylmgr2(:,:,:)=pawfgrtab_in(ij)%gylmgr2(:,:,:)
485 : end if
486 48 : if (pawfgrtab_out(ij1)%nhatfrgr_allocated>0) then
487 0 : LIBPAW_ALLOCATE(pawfgrtab_out(ij1)%nhatfrgr,(3,nfgd,nspden))
488 0 : pawfgrtab_out(ij1)%nhatfrgr(:,:,:)=pawfgrtab_in(ij)%nhatfrgr(:,:,:)
489 : end if
490 96 : if (pawfgrtab_out(ij1)%rfgd_allocated>0) then
491 84 : LIBPAW_ALLOCATE(pawfgrtab_out(ij1)%rfgd,(3,nfgd))
492 204204 : pawfgrtab_out(ij1)%rfgd(:,:)=pawfgrtab_in(ij)%rfgd(:,:)
493 : end if
494 :
495 : end do
496 : end if
497 :
498 : !Second case: a gather
499 60 : if (paral_case==2) then
500 0 : call pawfgrtab_gather(pawfgrtab_in,pawfgrtab_cp,my_comm_atom,istat,my_atmtab)
501 : end if
502 :
503 : !Destroy atom table used for parallelism
504 60 : call free_my_atmtab(my_atmtab,my_atmtab_allocated)
505 :
506 60 : end subroutine pawfgrtab_copy
507 : !!***
508 :
509 : !----------------------------------------------------------------------
510 :
511 : !!****f* m_pawfgrtab/pawfgrtab_print
512 : !! NAME
513 : !! pawfgrtab_print
514 : !!
515 : !! FUNCTION
516 : !! Reports basic info on the pawfgrtab datatype.
517 : !!
518 : !! INPUTS
519 : !! Pawfgrtab<pawfgrtab_type>=The datatype to be printed
520 : !! [mode_paral]=either "COLL" or "PERS", "COLL" if None.
521 : !! [unit]=Unit number for output, std_out if None.
522 : !! [prtvol]=Verbosity level, lowest if None.
523 : !! [mpi_atmtab(:)]=indexes of the atoms treated by current proc
524 : !! [comm_atom]=MPI communicator over atoms
525 : !! [natom]=total number of atom (needed if parallelism over atoms is activated)
526 : !! if Pawfgrtab is distributed, natom is different from size(Pawfgrtab).
527 : !!
528 : !! OUTPUT
529 : !! (only writing)
530 : !!
531 : !! SOURCE
532 :
533 7 : subroutine pawfgrtab_print(Pawfgrtab,natom,unit,prtvol,mode_paral,mpi_atmtab,comm_atom)
534 :
535 : !Arguments ------------------------------------
536 : !scalars
537 : integer,optional,intent(in) :: comm_atom,natom,prtvol,unit
538 : character(len=4),optional,intent(in) :: mode_paral
539 : !arrays
540 : type(Pawfgrtab_type),intent(inout) :: Pawfgrtab(:)
541 : integer,optional,target,intent(in) :: mpi_atmtab(:)
542 :
543 : !Local variables-------------------------------
544 : !scalars
545 : integer :: iat,iatom_tot,my_comm_atom,my_natom,my_unt,my_prtvol,size_Pawfgrtab
546 : logical :: my_atmtab_allocated,paral_atom
547 : character(len=4) :: my_mode
548 : character(len=500) :: msg
549 : !arrays
550 7 : integer,pointer :: my_atmtab(:)
551 :
552 : ! *************************************************************************
553 :
554 : !@Pawfgrtab_type
555 :
556 0 : size_Pawfgrtab=SIZE(Pawfgrtab);if (size_Pawfgrtab==0) return
557 :
558 7 : my_prtvol=0 ; if (PRESENT(prtvol )) my_prtvol=prtvol
559 7 : my_unt =std_out; if (PRESENT(unit )) my_unt =unit
560 7 : my_mode ='PERS' ; if (PRESENT(mode_paral)) my_mode =mode_paral
561 7 : my_natom=size_Pawfgrtab; if (PRESENT(natom)) my_natom=natom
562 :
563 : !Set up parallelism over atoms
564 7 : paral_atom=(present(comm_atom).and.my_natom/=size_Pawfgrtab)
565 7 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
566 7 : my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom
567 : call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,&
568 7 : & my_natom,my_natom_ref=size_Pawfgrtab)
569 :
570 7 : write(msg,'(3a)')ch10,' === Content of the pawfgrtab datatype === ',ch10
571 7 : call wrtout(my_unt,msg,my_mode)
572 41 : do iat=1,my_natom
573 34 : iatom_tot=iat;if(paral_atom) iatom_tot=my_atmtab(iat)
574 :
575 34 : write(msg,'(6(2a,i0))')ch10,&
576 34 : & ' > For atom number : ',iatom_tot,ch10,&
577 34 : & ' cplex= ',Pawfgrtab(iat)%cplex,ch10,&
578 34 : & ' # of spins components for density= ',Pawfgrtab(iat)%nspden,ch10,&
579 34 : & ' Type of atom= ',Pawfgrtab(iat)%itypat,ch10,&
580 34 : & ' 1+ Max l in Gaunt coefficients= ',Pawfgrtab(iat)%l_size,ch10,&
581 68 : & ' Number of fine FFT points in PAW sphere= ',Pawfgrtab(iat)%nfgd
582 34 : call wrtout(my_unt,msg,my_mode)
583 :
584 41 : if (my_prtvol>=3) then
585 4 : write(msg,'(a,7(a,i2,a))')ch10,&
586 4 : & ' rfgd_allocated : ',Pawfgrtab(iat)%rfgd_allocated,ch10,&
587 4 : & ' gylm_allocated : ',Pawfgrtab(iat)%gylm_allocated,ch10,&
588 4 : & ' gylmgr_allocated : ',Pawfgrtab(iat)%gylmgr_allocated,ch10,&
589 4 : & ' gylmgr2_allocated : ',Pawfgrtab(iat)%gylmgr2_allocated,ch10,&
590 4 : & ' nhatgr_allocated : ',Pawfgrtab(iat)%nhatfr_allocated,ch10,&
591 4 : & ' nhatfrgr_allocated: ',Pawfgrtab(iat)%nhatfrgr_allocated,ch10,&
592 8 : & ' expiqr_allocated : ',Pawfgrtab(iat)%expiqr_allocated,ch10
593 4 : call wrtout(my_unt,msg,my_mode)
594 :
595 : end if
596 :
597 : ! These huge arrays are not printed out!
598 : ! Pawfgrtab(iat)%ifftsph
599 : ! Pawfgrtab(iat)%rfgd
600 : ! Pawfgrtab(iat)%gylm
601 : ! Pawfgrtab(iat)%gylmgr
602 : ! Pawfgrtab(iat)%gylmgr2
603 : ! Pawfgrtab(ia)%nhatfr
604 : ! Pawfgrtab(ia)%nhatfrgr
605 : ! Pawfgrtab(ia)%expiqr
606 : end do
607 :
608 : !Destroy atom table
609 7 : call free_my_atmtab(my_atmtab,my_atmtab_allocated)
610 :
611 7 : end subroutine pawfgrtab_print
612 : !!***
613 :
614 : !----------------------------------------------------------------------
615 :
616 : !!****f* m_pawfgrtab/pawfgrtab_gather
617 : !! NAME
618 : !! pawfgrtab_gather
619 : !!
620 : !! FUNCTION
621 : !! gather a pawfgrtab
622 : !! istat =1 if pawfgrtab is yet gathered
623 : !!
624 : !! INPUTS
625 : !! mpi_atmtab(:)=--optional-- indexes of the atoms treated by current proc
626 : !! mpicomm=MPI communicator
627 : !! pawfgrtab(:) = pawfgrtab to be gathered
628 : !!
629 : !! OUTPUT
630 : !! istat : 1 if yet gathered in that case, pawfgrtab_gathered contains nothing
631 : !! pawfgrtab_gathered : pawfgrtab gathered between comm_atom
632 : !!
633 : !! SOURCE
634 :
635 0 : subroutine pawfgrtab_gather(pawfgrtab,pawfgrtab_gathered,comm_atom,istat, &
636 0 : & mpi_atmtab) ! optional argument
637 :
638 : !Arguments ------------------------------------
639 : !scalars
640 : integer,intent(in) :: comm_atom
641 : integer, intent(out) :: istat
642 : !arrays
643 : integer,optional,target,intent(in) :: mpi_atmtab(:)
644 : type(pawfgrtab_type),intent(in) :: pawfgrtab(:)
645 : type(pawfgrtab_type),intent(inout) :: pawfgrtab_gathered(:)
646 :
647 : !Local variables-------------------------------
648 : !scalars
649 : integer :: buf_int_size,buf_int_size_all,buf_dp_size,buf_dp_size_all,i1,i2,iat,iatot
650 : integer :: ierr,ij,indx_int,indx_dp,l_size,l_size2,my_natom,natom,nfgd,nproc_atom,nspden
651 : logical :: my_atmtab_allocated,paral_atom
652 : character(len=500) :: msg
653 : !arrays
654 : integer :: bufsz(2)
655 0 : integer,allocatable :: buf_int(:),buf_int_all(:)
656 0 : integer,allocatable :: count_dp(:),count_int(:),count_tot(:),displ_dp(:),displ_int(:)
657 0 : integer,pointer :: my_atmtab(:)
658 0 : real(dp),allocatable :: buf_dp(:),buf_dp_all(:)
659 :
660 : ! *************************************************************************
661 :
662 : !@Pawfgrtab_type
663 :
664 0 : istat=0
665 0 : my_natom=size(pawfgrtab);natom=size(pawfgrtab_gathered)
666 :
667 : !Set up parallelism over atoms
668 0 : paral_atom=(my_natom/=natom)
669 0 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
670 0 : my_atmtab_allocated = .False.
671 0 : if (paral_atom) then
672 0 : call get_my_atmtab(comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,my_natom_ref=my_natom)
673 : end if
674 0 : nproc_atom=xmpi_comm_size(comm_atom)
675 :
676 : !Without parallelism, just copy input to output
677 0 : if (.not.paral_atom) then
678 0 : istat=1;return
679 : end if
680 :
681 : !Compute size of buffers
682 0 : buf_int_size=0
683 0 : do iat=1,my_natom
684 0 : buf_int_size=buf_int_size+pawfgrtab(iat)%nfgd+13
685 : end do
686 0 : buf_dp_size=0
687 0 : do iat=1,my_natom
688 0 : if (pawfgrtab(iat)%expiqr_allocated>0) then
689 0 : buf_dp_size=buf_dp_size + size(pawfgrtab(iat)%expiqr(:,:))
690 : end if
691 0 : if (pawfgrtab(iat)%gylm_allocated>0) then
692 0 : buf_dp_size=buf_dp_size+size(pawfgrtab(iat)%gylm(:,:))
693 : end if
694 0 : if (pawfgrtab(iat)%gylmgr_allocated>0) then
695 0 : buf_dp_size=buf_dp_size+size(pawfgrtab(iat)%gylmgr(:,:,:))
696 : end if
697 0 : if (pawfgrtab(iat)%gylmgr2_allocated>0) then
698 0 : buf_dp_size=buf_dp_size+size(pawfgrtab(iat)%gylmgr2(:,:,:))
699 : end if
700 0 : if (pawfgrtab(iat)%nhatfr_allocated>0) then
701 0 : buf_dp_size=buf_dp_size+size(pawfgrtab(iat)%nhatfr(:,:))
702 : end if
703 0 : if (pawfgrtab(iat)%nhatfrgr_allocated>0) then
704 0 : buf_dp_size=buf_dp_size+size(pawfgrtab(iat)%nhatfrgr(:,:,:))
705 : end if
706 0 : if (pawfgrtab(iat)%rfgd_allocated>0) then
707 0 : buf_dp_size=buf_dp_size+size(pawfgrtab(iat)%rfgd(:,:))
708 : end if
709 : end do
710 :
711 : !Fill in input buffers
712 0 : LIBPAW_ALLOCATE(buf_int,(buf_int_size))
713 0 : LIBPAW_ALLOCATE(buf_dp,(buf_dp_size))
714 0 : indx_int=1;indx_dp=1
715 0 : do iat=1,my_natom
716 0 : l_size=pawfgrtab(iat)%l_size
717 0 : nfgd=pawfgrtab(iat)%nfgd
718 0 : nspden=pawfgrtab(iat)%nspden
719 0 : buf_int(indx_int)=my_atmtab(iat); indx_int=indx_int+1;
720 0 : buf_int(indx_int)=pawfgrtab(iat)%cplex; indx_int=indx_int+1;
721 0 : buf_int(indx_int)=pawfgrtab(iat)%itypat; indx_int=indx_int+1;
722 0 : buf_int(indx_int)=pawfgrtab(iat)%expiqr_allocated; indx_int=indx_int+1;
723 0 : buf_int(indx_int)=pawfgrtab(iat)%l_size; indx_int=indx_int+1;
724 0 : buf_int(indx_int)=pawfgrtab(iat)%gylm_allocated; indx_int=indx_int+1;
725 0 : buf_int(indx_int)=pawfgrtab(iat)%gylmgr_allocated; indx_int=indx_int+1;
726 0 : buf_int(indx_int)=pawfgrtab(iat)%gylmgr2_allocated; indx_int=indx_int+1;
727 0 : buf_int(indx_int)=pawfgrtab(iat)%nfgd; indx_int=indx_int+1;
728 0 : buf_int(indx_int)=pawfgrtab(iat)%nhatfr_allocated; indx_int=indx_int+1;
729 0 : buf_int(indx_int)=pawfgrtab(iat)%nhatfrgr_allocated; indx_int=indx_int+1;
730 0 : buf_int(indx_int)=pawfgrtab(iat)%nspden; indx_int=indx_int+1;
731 0 : buf_int(indx_int)=pawfgrtab(iat)%rfgd_allocated; indx_int=indx_int+1;
732 0 : if (nfgd>0) then
733 0 : buf_int(indx_int:indx_int+nfgd-1)=pawfgrtab(iat)%ifftsph(1:nfgd)
734 : indx_int=indx_int+nfgd;
735 : end if
736 0 : if (pawfgrtab(iat)%expiqr_allocated>0) then
737 0 : do i1=1,nfgd
738 0 : buf_dp(indx_dp:indx_dp+1)=pawfgrtab(iat)%expiqr(1:2,i1)
739 0 : indx_dp=indx_dp+2
740 : end do
741 : end if
742 0 : l_size2=l_size*l_size
743 0 : if (pawfgrtab(iat)%gylm_allocated>0) then
744 0 : do i1=1,l_size2
745 0 : buf_dp(indx_dp:indx_dp+nfgd-1)=pawfgrtab(iat)%gylm(1:nfgd,i1)
746 0 : indx_dp=indx_dp+nfgd
747 : end do
748 : end if
749 0 : if (pawfgrtab(iat)%gylmgr_allocated>0) then
750 0 : do i1=1,l_size2
751 0 : do i2=1,nfgd
752 0 : buf_dp(indx_dp:indx_dp+2)=pawfgrtab(iat)%gylmgr(1:3,i2,i1)
753 0 : indx_dp=indx_dp+3
754 : end do
755 : end do
756 : end if
757 0 : if (pawfgrtab(iat)%gylmgr2_allocated>0) then
758 0 : do i1=1,l_size2
759 0 : do i2=1,nfgd
760 0 : buf_dp(indx_dp:indx_dp+5)=pawfgrtab(iat)%gylmgr2(1:6,i2,i1)
761 0 : indx_dp=indx_dp+6
762 : end do
763 : end do
764 : end if
765 0 : if (pawfgrtab(iat)%nhatfr_allocated>0) then
766 0 : do i1=1,nspden
767 0 : buf_dp(indx_dp:indx_dp+nfgd-1)=pawfgrtab(iat)%nhatfr(1:nfgd,i1)
768 0 : indx_dp=indx_dp+nfgd
769 : end do
770 : end if
771 0 : if (pawfgrtab(iat)%nhatfrgr_allocated>0) then
772 0 : do i1=1,nspden
773 0 : do i2=1,nfgd
774 0 : buf_dp(indx_dp:indx_dp+2)=pawfgrtab(iat)%nhatfrgr(1:3,i2,i1)
775 0 : indx_dp=indx_dp+3
776 : end do
777 : end do
778 : end if
779 0 : if (pawfgrtab(iat)%rfgd_allocated>0) then
780 0 : do i1=1,nfgd
781 0 : buf_dp(indx_dp:indx_dp+2)=pawfgrtab(iat)%rfgd(1:3,i1)
782 0 : indx_dp=indx_dp+3
783 : end do
784 : end if
785 : end do
786 0 : if (indx_int/=1+buf_int_size) then
787 0 : msg='Error (1) in pawfgrtab_gather: wrong buffer sizes !'
788 0 : LIBPAW_BUG(msg)
789 : end if
790 0 : if (indx_dp/=1+buf_dp_size) then
791 0 : msg='Error (2) in pawfgrtab_gather: wrong buffer sizes !'
792 0 : LIBPAW_BUG(msg)
793 : end if
794 :
795 : !Communicate (1 gather for integers, 1 gather for reals)
796 0 : LIBPAW_ALLOCATE(count_int,(nproc_atom))
797 0 : LIBPAW_ALLOCATE(displ_int,(nproc_atom))
798 0 : LIBPAW_ALLOCATE(count_dp ,(nproc_atom))
799 0 : LIBPAW_ALLOCATE(displ_dp ,(nproc_atom))
800 0 : LIBPAW_ALLOCATE(count_tot,(2*nproc_atom))
801 0 : bufsz(1)=buf_int_size; bufsz(2)=buf_dp_size
802 0 : call xmpi_allgather(bufsz,2,count_tot,comm_atom,ierr)
803 0 : do ij=1,nproc_atom
804 0 : count_int(ij)=count_tot(2*ij-1)
805 0 : count_dp (ij)=count_tot(2*ij)
806 : end do
807 0 : displ_int(1)=0;displ_dp(1)=0
808 0 : do ij=2,nproc_atom
809 0 : displ_int(ij)=displ_int(ij-1)+count_int(ij-1)
810 0 : displ_dp (ij)=displ_dp (ij-1)+count_dp (ij-1)
811 : end do
812 0 : buf_int_size_all=sum(count_int)
813 0 : buf_dp_size_all =sum(count_dp)
814 0 : LIBPAW_DEALLOCATE(count_tot)
815 0 : LIBPAW_ALLOCATE(buf_int_all,(buf_int_size_all))
816 0 : LIBPAW_ALLOCATE(buf_dp_all ,(buf_dp_size_all))
817 0 : call xmpi_allgatherv(buf_int,buf_int_size,buf_int_all,count_int,displ_int,comm_atom,ierr)
818 0 : call xmpi_allgatherv(buf_dp ,buf_dp_size ,buf_dp_all ,count_dp ,displ_dp ,comm_atom,ierr)
819 0 : LIBPAW_DEALLOCATE(count_int)
820 0 : LIBPAW_DEALLOCATE(displ_int)
821 0 : LIBPAW_DEALLOCATE(count_dp)
822 0 : LIBPAW_DEALLOCATE(displ_dp)
823 :
824 : !Retrieve output datastructures
825 0 : indx_int=1; indx_dp=1
826 0 : call pawfgrtab_free(pawfgrtab_gathered)
827 0 : call pawfgrtab_nullify(pawfgrtab_gathered)
828 0 : do iat=1,natom
829 0 : iatot=buf_int_all(indx_int); indx_int=indx_int+1
830 0 : pawfgrtab_gathered(iatot)%cplex=buf_int_all(indx_int); indx_int=indx_int+1;
831 0 : pawfgrtab_gathered(iatot)%itypat=buf_int_all(indx_int); indx_int=indx_int+1;
832 0 : pawfgrtab_gathered(iatot)%expiqr_allocated=buf_int_all(indx_int); indx_int=indx_int+1;
833 0 : pawfgrtab_gathered(iatot)%l_size=buf_int_all(indx_int); indx_int=indx_int+1;
834 0 : pawfgrtab_gathered(iatot)%gylm_allocated=buf_int_all(indx_int); indx_int=indx_int+1;
835 0 : pawfgrtab_gathered(iatot)%gylmgr_allocated=buf_int_all(indx_int); indx_int=indx_int+1;
836 0 : pawfgrtab_gathered(iatot)%gylmgr2_allocated=buf_int_all(indx_int); indx_int=indx_int+1;
837 0 : pawfgrtab_gathered(iatot)%nfgd=buf_int_all(indx_int); indx_int=indx_int+1;
838 0 : pawfgrtab_gathered(iatot)%nhatfr_allocated=buf_int_all(indx_int); indx_int=indx_int+1;
839 0 : pawfgrtab_gathered(iatot)%nhatfrgr_allocated=buf_int_all(indx_int); indx_int=indx_int+1;
840 0 : pawfgrtab_gathered(iatot)%nspden=buf_int_all(indx_int); indx_int=indx_int+1;
841 0 : pawfgrtab_gathered(iatot)%rfgd_allocated=buf_int_all(indx_int); indx_int=indx_int+1;
842 0 : nfgd=pawfgrtab_gathered(iatot)%nfgd
843 0 : l_size=pawfgrtab_gathered(iatot)%l_size
844 0 : nspden= pawfgrtab_gathered(iatot)%nspden
845 0 : l_size2=l_size*l_size
846 0 : if (nfgd>0) then
847 0 : LIBPAW_ALLOCATE(pawfgrtab_gathered(iatot)%ifftsph,(nfgd))
848 0 : pawfgrtab_gathered(iatot)%ifftsph(1:nfgd)=buf_int_all(indx_int:indx_int+nfgd-1)
849 : indx_int=indx_int+nfgd
850 : end if
851 0 : if (pawfgrtab_gathered(iatot)%expiqr_allocated>0) then
852 0 : LIBPAW_ALLOCATE(pawfgrtab_gathered(iatot)%expiqr,(2,nfgd))
853 0 : do i1=1,nfgd
854 0 : pawfgrtab_gathered(iatot)%expiqr(1:2,i1)= buf_dp_all(indx_dp:indx_dp+1)
855 0 : indx_dp=indx_dp+2
856 : end do
857 : end if
858 0 : if (pawfgrtab_gathered(iatot)%gylm_allocated>0) then
859 0 : LIBPAW_ALLOCATE(pawfgrtab_gathered(iatot)%gylm,(nfgd,l_size2))
860 0 : do i1=1,l_size2
861 0 : pawfgrtab_gathered(iatot)%gylm(1:nfgd,i1)=buf_dp_all(indx_dp:indx_dp+nfgd-1)
862 0 : indx_dp=indx_dp+nfgd
863 : end do
864 : end if
865 0 : if (pawfgrtab_gathered(iatot)%gylmgr_allocated>0) then
866 0 : LIBPAW_ALLOCATE(pawfgrtab_gathered(iatot)%gylmgr,(3,nfgd,l_size2))
867 0 : do i1=1,l_size2
868 0 : do i2=1,nfgd
869 0 : pawfgrtab_gathered(iatot)%gylmgr(1:3,i2,i1)=buf_dp_all(indx_dp:indx_dp+2)
870 0 : indx_dp=indx_dp+3
871 : end do
872 : end do
873 : end if
874 0 : if (pawfgrtab_gathered(iatot)%gylmgr2_allocated>0) then
875 0 : LIBPAW_ALLOCATE(pawfgrtab_gathered(iatot)%gylmgr2,(6,nfgd,l_size2))
876 0 : do i1=1,l_size2
877 0 : do i2=1,nfgd
878 0 : pawfgrtab_gathered(iatot)%gylmgr2(1:6,i2,i1)=buf_dp_all(indx_dp:indx_dp+5)
879 0 : indx_dp=indx_dp+6
880 : end do
881 : end do
882 : end if
883 0 : if (pawfgrtab_gathered(iatot)%nhatfr_allocated>0) then
884 0 : LIBPAW_ALLOCATE(pawfgrtab_gathered(iatot)%nhatfr,(nfgd,nspden))
885 0 : do i1=1,nspden
886 0 : pawfgrtab_gathered(iatot)%nhatfr(1:nfgd,i1)=buf_dp_all(indx_dp:indx_dp+nfgd-1)
887 0 : indx_dp=indx_dp+nfgd
888 : end do
889 : end if
890 0 : if (pawfgrtab_gathered(iatot)%nhatfrgr_allocated>0) then
891 0 : LIBPAW_ALLOCATE(pawfgrtab_gathered(iatot)%nhatfrgr,(3,nfgd,nspden))
892 0 : do i1=1,nspden
893 0 : do i2=1,nfgd
894 0 : pawfgrtab_gathered(iatot)%nhatfrgr(1:3,i2,i1)=buf_dp_all(indx_dp:indx_dp+2)
895 0 : indx_dp=indx_dp+3
896 : end do
897 : end do
898 : end if
899 0 : if (pawfgrtab_gathered(iatot)%rfgd_allocated>0) then
900 0 : LIBPAW_ALLOCATE(pawfgrtab_gathered(iatot)%rfgd,(3,nfgd))
901 0 : do i1=1,nfgd
902 0 : pawfgrtab_gathered(iatot)%rfgd(1:3,i1)=buf_dp_all(indx_dp:indx_dp+2)
903 0 : indx_dp=indx_dp+3
904 : end do
905 : end if
906 : end do
907 :
908 : !Free memory
909 0 : LIBPAW_DEALLOCATE(buf_int)
910 0 : LIBPAW_DEALLOCATE(buf_int_all)
911 0 : LIBPAW_DEALLOCATE(buf_dp)
912 0 : LIBPAW_DEALLOCATE(buf_dp_all)
913 :
914 : !Destroy atom table
915 0 : call free_my_atmtab(my_atmtab,my_atmtab_allocated)
916 :
917 0 : end subroutine pawfgrtab_gather
918 : !!***
919 :
920 : !----------------------------------------------------------------------
921 :
922 : !!****f* m_pawfgrtab/pawfgrtab_redistribute
923 : !! NAME
924 : !! pawfgrtab_redistribute
925 : !!
926 : !! FUNCTION
927 : !! Redistribute an array of pawfgrtab datastructures
928 : !! Input pawfgrtab is given on a MPI communicator
929 : !! Output pawfgrtab is redistributed on another MPI communicator
930 : !!
931 : !! INPUTS
932 : !! mpi_comm_in= input MPI (atom) communicator
933 : !! mpi_comm_out= output MPI (atom) communicator
934 : !! mpi_atmtab_in= --optional-- indexes of the input pawfgrtab treated by current proc
935 : !! if not present, will be calculated in the present routine
936 : !! mpi_atmtab_out= --optional-- indexes of the output pawfgrtab treated by current proc
937 : !! if not present, will be calculated in the present routine
938 : !! natom= --optional-- total number of atoms
939 : !! ----- Optional arguments used only for asynchronous communications -----
940 : !! RecvAtomProc(:)= rank of processor from which I expect atom (in mpi_comm_in)
941 : !! RecvAtomList(:)= indexes of atoms to be received by me
942 : !! RecvAtomList(irecv) are the atoms I expect from RecvAtomProc(irecv)
943 : !! SendAtomProc(:)= ranks of process destination of atom (in mpi_comm_in)
944 : !! SendAtomList(:)= indexes of atoms to be sent by me
945 : !! SendAtomList(isend) are the atoms sent to SendAtomProc(isend)
946 :
947 : !! OUTPUT
948 : !! [pawfgrtab_out(:)]<type(pawfgrtab_type)>= --optional--
949 : !! if present, the redistributed datastructure does not replace
950 : !! the input one but is delivered in pawfgrtab_out
951 : !! if not present, input and output datastructure are the same.
952 : !!
953 : !! SIDE EFFECTS
954 : !! pawfgrtab(:)<type(pawfgrtab_type)>= input (and eventually output) pawfgrtab datastructures
955 : !!
956 : !! SOURCE
957 :
958 40 : subroutine pawfgrtab_redistribute(pawfgrtab,mpi_comm_in,mpi_comm_out,&
959 40 : & natom,mpi_atmtab_in,mpi_atmtab_out,pawfgrtab_out,&
960 40 : & SendAtomProc,SendAtomList,RecvAtomProc,RecvAtomList)
961 :
962 : !Arguments ------------------------------------
963 : !scalars
964 : integer,intent(in) :: mpi_comm_in,mpi_comm_out
965 : integer,optional,intent(in) :: natom
966 : !arrays
967 : integer,intent(in),optional,target :: mpi_atmtab_in(:),mpi_atmtab_out(:)
968 : integer,intent(in),optional :: SendAtomProc(:),SendAtomList(:),RecvAtomProc(:),RecvAtomList(:)
969 : type(pawfgrtab_type),allocatable,intent(inout) :: pawfgrtab(:)
970 : type(pawfgrtab_type),pointer,optional :: pawfgrtab_out(:)
971 :
972 : !Local variables-------------------------------
973 : !scalars
974 : integer :: algo_option,iat_in,iat_out,iatom,i1,ierr,iircv,iisend,imsg,imsg1,imsg_current
975 : integer :: iproc_rcv,iproc_send,ireq,me_exch,mpi_comm_exch,my_natom_in,my_natom_out,my_tag,natom_tot,nb_dp
976 : integer :: nb_int,nb_msg,nbmsg_incoming,nbrecvmsg,nbsendreq,nbsend,nbsent,nbrecv,next,npawfgrtab_sent
977 : integer :: nproc_in,nproc_out
978 : logical :: flag,in_place,message_yet_prepared,my_atmtab_in_allocated,my_atmtab_out_allocated,paral_atom
979 : !arrays
980 : integer :: buf_size(3),request1(3)
981 40 : integer,pointer :: my_atmtab_in(:),my_atmtab_out(:)
982 40 : integer,allocatable :: atmtab_send(:),atm_indx_in(:),atm_indx_out(:),buf_int1(:),From(:),request(:)
983 40 : integer,allocatable,target:: buf_int(:)
984 40 : integer,pointer :: buf_ints(:)
985 40 : logical,allocatable :: msg_pick(:)
986 40 : real(dp),allocatable :: buf_dp1(:)
987 40 : real(dp),allocatable,target :: buf_dp(:)
988 40 : real(dp),pointer :: buf_dps(:)
989 40 : type(coeffi1_type),target,allocatable :: tab_buf_int(:),tab_buf_atom(:)
990 40 : type(coeff1_type),target,allocatable :: tab_buf_dp(:)
991 40 : type(pawfgrtab_type),allocatable :: pawfgrtab_all(:)
992 40 : type(pawfgrtab_type),pointer :: pawfgrtab_out1(:)
993 :
994 : ! *************************************************************************
995 :
996 : !@pawfgrtab_type
997 :
998 40 : in_place=(.not.present(pawfgrtab_out))
999 40 : my_natom_in=size(pawfgrtab)
1000 :
1001 : !If not "in_place", destroy ) then
1002 40 : if (.not.in_place) then
1003 0 : if (associated(pawfgrtab_out)) then
1004 0 : call pawfgrtab_free(pawfgrtab_out)
1005 0 : LIBPAW_DATATYPE_DEALLOCATE(pawfgrtab_out)
1006 : end if
1007 : end if
1008 :
1009 : !Special sequential case
1010 40 : if (mpi_comm_in==xmpi_comm_self.and.mpi_comm_out==xmpi_comm_self) then
1011 0 : if ((.not.in_place).and.(my_natom_in>0)) then
1012 0 : LIBPAW_DATATYPE_ALLOCATE(pawfgrtab_out,(my_natom_in))
1013 0 : call pawfgrtab_nullify(pawfgrtab_out)
1014 0 : call pawfgrtab_copy(pawfgrtab,pawfgrtab_out)
1015 : end if
1016 0 : return
1017 : end if
1018 :
1019 : !Get total natom
1020 40 : if (present(natom)) then
1021 40 : natom_tot=natom
1022 : else
1023 0 : natom_tot=my_natom_in
1024 0 : call xmpi_sum(natom_tot,mpi_comm_in,ierr)
1025 : end if
1026 :
1027 : !Select input distribution
1028 40 : if (present(mpi_atmtab_in)) then
1029 40 : my_atmtab_in => mpi_atmtab_in
1030 40 : my_atmtab_in_allocated=.false.
1031 : else
1032 : call get_my_atmtab(mpi_comm_in,my_atmtab_in,my_atmtab_in_allocated,&
1033 0 : & paral_atom,natom_tot,my_natom_in)
1034 : end if
1035 :
1036 : !Select output distribution
1037 40 : if (present(mpi_atmtab_out)) then
1038 40 : my_natom_out=size(mpi_atmtab_out)
1039 40 : my_atmtab_out => mpi_atmtab_out
1040 40 : my_atmtab_out_allocated=.false.
1041 : else
1042 0 : call get_my_natom(mpi_comm_out,my_natom_out,natom_tot)
1043 : call get_my_atmtab(mpi_comm_out,my_atmtab_out,my_atmtab_out_allocated,&
1044 0 : & paral_atom,natom_tot)
1045 : end if
1046 :
1047 : !Select algo according to optional input arguments
1048 40 : algo_option=1
1049 : if (present(SendAtomProc).and.present(SendAtomList).and.&
1050 40 : & present(RecvAtomProc).and.present(RecvAtomList)) algo_option=2
1051 :
1052 :
1053 : !Brute force algorithm (allgather + scatter)
1054 : !---------------------------------------------------------
1055 : if (algo_option==1) then
1056 :
1057 0 : LIBPAW_DATATYPE_ALLOCATE(pawfgrtab_all,(natom_tot))
1058 0 : call pawfgrtab_nullify(pawfgrtab_all)
1059 0 : call pawfgrtab_copy(pawfgrtab,pawfgrtab_all,comm_atom=mpi_comm_in,mpi_atmtab=my_atmtab_in)
1060 0 : if (in_place) then
1061 0 : call pawfgrtab_free(pawfgrtab)
1062 0 : LIBPAW_DATATYPE_DEALLOCATE(pawfgrtab)
1063 0 : LIBPAW_DATATYPE_ALLOCATE(pawfgrtab,(my_natom_out))
1064 0 : call pawfgrtab_nullify(pawfgrtab)
1065 0 : call pawfgrtab_copy(pawfgrtab_all,pawfgrtab,comm_atom=mpi_comm_out,mpi_atmtab=my_atmtab_out)
1066 : else
1067 0 : LIBPAW_DATATYPE_ALLOCATE(pawfgrtab_out,(my_natom_out))
1068 0 : call pawfgrtab_nullify(pawfgrtab_out)
1069 0 : call pawfgrtab_copy(pawfgrtab_all,pawfgrtab_out,comm_atom=mpi_comm_out,mpi_atmtab=my_atmtab_out)
1070 : end if
1071 0 : call pawfgrtab_free(pawfgrtab_all)
1072 0 : LIBPAW_DATATYPE_DEALLOCATE(pawfgrtab_all)
1073 :
1074 :
1075 : !Asynchronous algorithm (asynchronous communications)
1076 : !---------------------------------------------------------
1077 : else if (algo_option==2) then
1078 :
1079 40 : nbsend=size(SendAtomProc) ; nbrecv=size(RecvAtomProc)
1080 :
1081 40 : if (in_place) then
1082 40 : if (my_natom_out > 0) then
1083 112 : LIBPAW_DATATYPE_ALLOCATE(pawfgrtab_out1,(my_natom_out))
1084 28 : call pawfgrtab_nullify(pawfgrtab_out1)
1085 : else
1086 12 : LIBPAW_DATATYPE_ALLOCATE(pawfgrtab_out1,(0))
1087 : end if
1088 : else
1089 0 : LIBPAW_DATATYPE_ALLOCATE(pawfgrtab_out,(my_natom_out))
1090 0 : call pawfgrtab_nullify(pawfgrtab_out)
1091 0 : pawfgrtab_out1=>pawfgrtab_out
1092 : end if
1093 :
1094 40 : nproc_in=xmpi_comm_size(mpi_comm_in)
1095 40 : nproc_out=xmpi_comm_size(mpi_comm_out)
1096 40 : if (nproc_in<=nproc_out) mpi_comm_exch=mpi_comm_out
1097 40 : if (nproc_in>nproc_out) mpi_comm_exch=mpi_comm_in
1098 40 : me_exch=xmpi_comm_rank(mpi_comm_exch)
1099 :
1100 : ! Dimension put to the maximum to send
1101 120 : LIBPAW_ALLOCATE(atmtab_send,(nbsend))
1102 120 : LIBPAW_ALLOCATE(atm_indx_in,(natom_tot))
1103 120 : atm_indx_in=-1
1104 68 : do iatom=1,my_natom_in
1105 68 : atm_indx_in(my_atmtab_in(iatom))=iatom
1106 : end do
1107 80 : LIBPAW_ALLOCATE(atm_indx_out,(natom_tot))
1108 120 : atm_indx_out=-1
1109 68 : do iatom=1,my_natom_out
1110 68 : atm_indx_out(my_atmtab_out(iatom))=iatom
1111 : end do
1112 :
1113 148 : LIBPAW_DATATYPE_ALLOCATE(tab_buf_int,(nbsend))
1114 148 : LIBPAW_DATATYPE_ALLOCATE(tab_buf_dp,(nbsend))
1115 108 : LIBPAW_DATATYPE_ALLOCATE(tab_buf_atom,(nbsend))
1116 120 : LIBPAW_ALLOCATE(request,(3*nbsend))
1117 :
1118 : ! A send buffer in an asynchrone communication couldn't be deallocate before it has been receive
1119 40 : nbsent=0 ; ireq=0 ; iisend=0 ; nbsendreq=0 ; nb_msg=0
1120 68 : do iisend=1,nbsend
1121 28 : iproc_rcv=SendAtomProc(iisend)
1122 28 : next=-1
1123 28 : if (iisend < nbsend) next=SendAtomProc(iisend+1)
1124 68 : if (iproc_rcv /= me_exch) then
1125 8 : nbsent=nbsent+1
1126 8 : atmtab_send(nbsent)=SendAtomList(iisend) ! we groups the atoms sends to the same process
1127 8 : if (iproc_rcv /= next) then
1128 8 : if (nbsent > 0) then
1129 : ! Check if message has been yet prepared
1130 : message_yet_prepared=.false.
1131 8 : do imsg=1,nb_msg
1132 8 : if (size(tab_buf_atom(imsg)%value) /= nbsent) then
1133 : cycle
1134 : else
1135 0 : do imsg1=1,nbsent
1136 0 : if (tab_buf_atom(imsg)%value(imsg1)/=atmtab_send(imsg1)) exit
1137 0 : message_yet_prepared=.true.
1138 0 : imsg_current=imsg
1139 : end do
1140 : end if
1141 : enddo
1142 : ! Create the message
1143 8 : if (.not.message_yet_prepared) then
1144 8 : nb_msg=nb_msg+1
1145 : call pawfgrtab_isendreceive_fillbuffer( &
1146 8 : & pawfgrtab,atmtab_send,atm_indx_in,nbsent,buf_int,nb_int,buf_dp,nb_dp)
1147 24 : LIBPAW_ALLOCATE(tab_buf_int(nb_msg)%value,(nb_int))
1148 24 : LIBPAW_ALLOCATE(tab_buf_dp(nb_msg)%value,(nb_dp))
1149 14696 : tab_buf_int(nb_msg)%value(1:nb_int)=buf_int(1:nb_int)
1150 463050 : tab_buf_dp(nb_msg)%value(1:nb_dp)=buf_dp(1:nb_dp)
1151 8 : LIBPAW_DEALLOCATE(buf_int)
1152 8 : LIBPAW_DEALLOCATE(buf_dp)
1153 24 : LIBPAW_ALLOCATE(tab_buf_atom(nb_msg)%value, (nbsent))
1154 16 : tab_buf_atom(nb_msg)%value(1:nbsent)=atmtab_send(1:nbsent)
1155 : imsg_current=nb_msg
1156 : end if
1157 : ! Communicate
1158 8 : buf_size(1)=size(tab_buf_int(imsg_current)%value)
1159 8 : buf_size(2)=size(tab_buf_dp(imsg_current)%value)
1160 8 : buf_size(3)=nbsent
1161 8 : buf_ints=>tab_buf_int(imsg_current)%value
1162 8 : buf_dps=>tab_buf_dp(imsg_current)%value
1163 8 : my_tag=400
1164 8 : ireq=ireq+1
1165 8 : call xmpi_isend(buf_size,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr)
1166 8 : my_tag=401
1167 8 : ireq=ireq+1
1168 8 : call xmpi_isend(buf_ints,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr)
1169 8 : my_tag=402
1170 8 : ireq=ireq+1
1171 8 : call xmpi_isend(buf_dps,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr)
1172 8 : nbsendreq=ireq
1173 8 : nbsent=0
1174 : end if
1175 : end if
1176 : else ! Just a renumbering, not a sending
1177 20 : iat_in=atm_indx_in(SendAtomList(iisend))
1178 20 : iat_out=atm_indx_out(my_atmtab_in(iat_in))
1179 20 : call pawfgrtab_copy(pawfgrtab(iat_in:iat_in),pawfgrtab_out1(iat_out:iat_out))
1180 20 : nbsent=0
1181 : end if
1182 : end do
1183 :
1184 120 : LIBPAW_ALLOCATE(From,(nbrecv))
1185 68 : From(:)=-1 ; nbrecvmsg=0
1186 68 : do iircv=1,nbrecv
1187 28 : iproc_send=RecvAtomProc(iircv) !receive from (RcvAtomProc is sorted by growing process)
1188 28 : next=-1
1189 28 : if (iircv < nbrecv) next=RecvAtomProc(iircv+1)
1190 68 : if (iproc_send /= me_exch .and. iproc_send/=next) then
1191 8 : nbrecvmsg=nbrecvmsg+1
1192 8 : From(nbrecvmsg)=iproc_send
1193 : end if
1194 : end do
1195 :
1196 120 : LIBPAW_ALLOCATE(msg_pick,(nbrecvmsg))
1197 48 : msg_pick=.false.
1198 : nbmsg_incoming=nbrecvmsg
1199 3567 : do while (nbmsg_incoming > 0)
1200 7094 : do i1=1,nbrecvmsg
1201 7054 : if (.not.msg_pick(i1)) then
1202 3527 : iproc_send=From(i1)
1203 : flag=.false.
1204 3527 : my_tag=400
1205 3527 : call xmpi_iprobe(iproc_send,my_tag,mpi_comm_exch,flag,ierr)
1206 3527 : if (flag) then
1207 8 : msg_pick(i1)=.true.
1208 8 : call xmpi_irecv(buf_size,iproc_send,my_tag,mpi_comm_exch,request1(1),ierr)
1209 8 : call xmpi_wait(request1(1),ierr)
1210 8 : nb_int=buf_size(1)
1211 8 : nb_dp=buf_size(2)
1212 8 : npawfgrtab_sent=buf_size(3)
1213 24 : LIBPAW_ALLOCATE(buf_int1,(nb_int))
1214 24 : LIBPAW_ALLOCATE(buf_dp1,(nb_dp))
1215 8 : my_tag=401
1216 8 : call xmpi_irecv(buf_int1,iproc_send,my_tag,mpi_comm_exch,request1(2),ierr)
1217 8 : my_tag=402
1218 8 : call xmpi_irecv(buf_dp1,iproc_send,my_tag,mpi_comm_exch,request1(3),ierr)
1219 8 : call xmpi_waitall(request1(2:3),ierr)
1220 8 : call pawfgrtab_isendreceive_getbuffer(pawfgrtab_out1,npawfgrtab_sent,atm_indx_out, buf_int1,buf_dp1)
1221 8 : nbmsg_incoming=nbmsg_incoming-1
1222 8 : LIBPAW_DEALLOCATE(buf_int1)
1223 24 : LIBPAW_DEALLOCATE(buf_dp1)
1224 : end if
1225 : end if
1226 : end do
1227 : end do
1228 40 : LIBPAW_DEALLOCATE(msg_pick)
1229 :
1230 40 : if (in_place) then
1231 40 : call pawfgrtab_free(pawfgrtab)
1232 68 : LIBPAW_DATATYPE_DEALLOCATE(pawfgrtab)
1233 148 : LIBPAW_DATATYPE_ALLOCATE(pawfgrtab,(my_natom_out))
1234 40 : call pawfgrtab_nullify(pawfgrtab)
1235 40 : call pawfgrtab_copy(pawfgrtab_out1,pawfgrtab)
1236 40 : call pawfgrtab_free(pawfgrtab_out1)
1237 40 : LIBPAW_DATATYPE_DEALLOCATE(pawfgrtab_out1)
1238 : end if
1239 :
1240 : ! Wait for deallocating arrays that all sending operations has been realized
1241 40 : if (nbsendreq > 0) then
1242 8 : call xmpi_waitall(request(1:nbsendreq),ierr)
1243 : end if
1244 :
1245 : ! Deallocate buffers
1246 48 : do i1=1,nb_msg
1247 8 : LIBPAW_DEALLOCATE(tab_buf_int(i1)%value)
1248 8 : LIBPAW_DEALLOCATE(tab_buf_dp(i1)%value)
1249 48 : LIBPAW_DEALLOCATE(tab_buf_atom(i1)%value)
1250 : end do
1251 68 : LIBPAW_DATATYPE_DEALLOCATE(tab_buf_int)
1252 68 : LIBPAW_DATATYPE_DEALLOCATE(tab_buf_dp)
1253 68 : LIBPAW_DATATYPE_DEALLOCATE(tab_buf_atom)
1254 40 : LIBPAW_DEALLOCATE(From)
1255 40 : LIBPAW_DEALLOCATE(request)
1256 40 : LIBPAW_DEALLOCATE(atmtab_send)
1257 40 : LIBPAW_DEALLOCATE(atm_indx_in)
1258 40 : LIBPAW_DEALLOCATE(atm_indx_out)
1259 :
1260 : end if !algo_option
1261 :
1262 : !Eventually release temporary pointers
1263 40 : call free_my_atmtab(my_atmtab_in,my_atmtab_in_allocated)
1264 40 : call free_my_atmtab(my_atmtab_out,my_atmtab_out_allocated)
1265 :
1266 80 : end subroutine pawfgrtab_redistribute
1267 : !!***
1268 :
1269 : !----------------------------------------------------------------------
1270 :
1271 : !!****f* m_pawfgrtab/pawfgrtab_isendreceive_getbuffer
1272 : !! NAME
1273 : !! pawfgrtab_isendreceive_getbuffer
1274 : !!
1275 : !! FUNCTION
1276 : !! Fill a pawfgrtab structure with the buffers received in a receive operation
1277 : !! This buffer should have been first extracted by a call to pawfgrtab_isendreceive_fillbuffer
1278 : !!
1279 : !! INPUTS
1280 : !! atm_indx_recv(1:total number of atoms)= array for receive operation
1281 : !! Given an index of atom in global numbering, give its index
1282 : !! in the table of atoms treated by current processor
1283 : !! or -1 if the atoms is not treated by current processor
1284 : !! buf_int= buffer of receive integers
1285 : !! buf_dp= buffer of receive double precision numbers
1286 : !! npawfgrtab_send= number of sent atoms
1287 : !!
1288 : !! OUTPUT
1289 : !! pawfgrtab= output datastructure filled with buffers receive in a receive operation
1290 : !!
1291 : !! SOURCE
1292 :
1293 8 : subroutine pawfgrtab_isendreceive_getbuffer(pawfgrtab,npawfgrtab_send,atm_indx_recv,buf_int,buf_dp)
1294 :
1295 : !Arguments ------------------------------------
1296 : !scalars
1297 : integer,intent(in) :: npawfgrtab_send
1298 : !arrays
1299 : integer,intent(in) ::atm_indx_recv(:),buf_int(:)
1300 : real(dp),intent(in) :: buf_dp(:)
1301 : type(pawfgrtab_type),target,intent(inout) :: pawfgrtab(:)
1302 :
1303 : !Local variables-------------------------------
1304 : !scalars
1305 : integer :: buf_dp_size,buf_int_size,i1,i2,iat,iatom_tot,ij,indx_int,indx_dp
1306 : integer :: l_size,l_size2,nfgd,nspden
1307 : character(len=500) :: msg
1308 : type(pawfgrtab_type),pointer :: pawfgrtab1
1309 :
1310 : ! *********************************************************************
1311 :
1312 8 : buf_int_size=size(buf_int)
1313 8 : buf_dp_size=size(buf_dp)
1314 8 : indx_int=1; indx_dp=1
1315 :
1316 16 : do ij=1,npawfgrtab_send
1317 8 : iatom_tot=buf_int(indx_int); indx_int=indx_int+1
1318 8 : iat= atm_indx_recv(iatom_tot)
1319 8 : pawfgrtab1=>pawfgrtab(iat)
1320 8 : pawfgrtab1%cplex=buf_int(indx_int); indx_int=indx_int+1;
1321 8 : pawfgrtab1%itypat=buf_int(indx_int); indx_int=indx_int+1;
1322 8 : pawfgrtab1%expiqr_allocated=buf_int(indx_int); indx_int=indx_int+1;
1323 8 : pawfgrtab1%l_size=buf_int(indx_int); indx_int=indx_int+1;
1324 8 : pawfgrtab1%gylm_allocated=buf_int(indx_int); indx_int=indx_int+1;
1325 8 : pawfgrtab1%gylmgr_allocated=buf_int(indx_int); indx_int=indx_int+1;
1326 8 : pawfgrtab1%gylmgr2_allocated=buf_int(indx_int); indx_int=indx_int+1;
1327 8 : pawfgrtab1%nfgd=buf_int(indx_int); indx_int=indx_int+1;
1328 8 : pawfgrtab1%nhatfr_allocated=buf_int(indx_int); indx_int=indx_int+1;
1329 8 : pawfgrtab1%nhatfrgr_allocated=buf_int(indx_int); indx_int=indx_int+1;
1330 8 : pawfgrtab1%nspden=buf_int(indx_int); indx_int=indx_int+1;
1331 8 : pawfgrtab1%rfgd_allocated=buf_int(indx_int); indx_int=indx_int+1;
1332 8 : nfgd=pawfgrtab1%nfgd
1333 8 : l_size=pawfgrtab1%l_size
1334 8 : nspden= pawfgrtab1%nspden
1335 8 : l_size2=l_size*l_size
1336 8 : if (nfgd>0) then
1337 24 : LIBPAW_ALLOCATE(pawfgrtab1%ifftsph,(nfgd))
1338 14592 : pawfgrtab1%ifftsph(1:nfgd)=buf_int(indx_int:indx_int+nfgd-1)
1339 : indx_int=indx_int+nfgd
1340 : end if
1341 8 : if (pawfgrtab1%expiqr_allocated>0) then
1342 12 : LIBPAW_ALLOCATE(pawfgrtab1%expiqr,(2,nfgd))
1343 7296 : do i1=1,nfgd
1344 21876 : pawfgrtab1%expiqr(1:2,i1)= buf_dp(indx_dp:indx_dp+1)
1345 7296 : indx_dp=indx_dp+2
1346 : end do
1347 : end if
1348 8 : if (pawfgrtab1%gylm_allocated>0) then
1349 32 : LIBPAW_ALLOCATE(pawfgrtab1%gylm,(nfgd,l_size2))
1350 80 : do i1=1,l_size2
1351 131328 : pawfgrtab1%gylm(1:nfgd,i1)=buf_dp(indx_dp:indx_dp+nfgd-1)
1352 80 : indx_dp=indx_dp+nfgd
1353 : end do
1354 : end if
1355 8 : if (pawfgrtab1%gylmgr_allocated>0) then
1356 24 : LIBPAW_ALLOCATE(pawfgrtab1%gylmgr,(3,nfgd,l_size2))
1357 60 : do i1=1,l_size2
1358 98502 : do i2=1,nfgd
1359 393768 : pawfgrtab1%gylmgr(1:3,i2,i1)=buf_dp(indx_dp:indx_dp+2)
1360 98496 : indx_dp=indx_dp+3
1361 : end do
1362 : end do
1363 : end if
1364 8 : if (pawfgrtab1%gylmgr2_allocated>0) then
1365 0 : LIBPAW_ALLOCATE(pawfgrtab1%gylmgr2,(6,nfgd,l_size2))
1366 0 : do i1=1,l_size2
1367 0 : do i2=1,nfgd
1368 0 : pawfgrtab1%gylmgr2(1:6,i2,i1)=buf_dp(indx_dp:indx_dp+5)
1369 0 : indx_dp=indx_dp+6
1370 : end do
1371 : end do
1372 : end if
1373 8 : if (pawfgrtab1%nhatfr_allocated>0) then
1374 0 : LIBPAW_ALLOCATE(pawfgrtab1%nhatfr,(nfgd,nspden))
1375 0 : do i1=1,nspden
1376 0 : pawfgrtab1%nhatfr(1:nfgd,i1)=buf_dp(indx_dp:indx_dp+nfgd-1)
1377 0 : indx_dp=indx_dp+nfgd
1378 : end do
1379 : end if
1380 8 : if (pawfgrtab1%nhatfrgr_allocated>0) then
1381 0 : LIBPAW_ALLOCATE(pawfgrtab1%nhatfrgr,(3,nfgd,nspden))
1382 0 : do i1=1,nspden
1383 0 : do i2=1,nfgd
1384 0 : pawfgrtab1%nhatfrgr(1:3,i2,i1)=buf_dp(indx_dp:indx_dp+2)
1385 0 : indx_dp=indx_dp+3
1386 : end do
1387 : end do
1388 : end if
1389 16 : if (pawfgrtab1%rfgd_allocated>0) then
1390 12 : LIBPAW_ALLOCATE(pawfgrtab1%rfgd,(3,nfgd))
1391 7296 : do i1=1,nfgd
1392 29168 : pawfgrtab1%rfgd(1:3,i1)=buf_dp(indx_dp:indx_dp+2)
1393 7296 : indx_dp=indx_dp+3
1394 : end do
1395 : end if
1396 : end do
1397 8 : if ((indx_int/=1+buf_int_size).or.(indx_dp/=1+buf_dp_size)) then
1398 0 : write(msg,'(a,i10,a,i10)') 'Wrong buffer sizes: buf_int_size=',buf_int_size,' buf_dp_size=',buf_dp_size
1399 0 : LIBPAW_BUG(msg)
1400 : end if
1401 :
1402 8 : end subroutine pawfgrtab_isendreceive_getbuffer
1403 : !!***
1404 :
1405 : !----------------------------------------------------------------------
1406 : !!****f* m_pawfgrtab/pawfgrtab_isendreceive_fillbuffer
1407 : !! NAME
1408 : !! pawfgrtab_isendreceive_fillbuffer
1409 : !!
1410 : !! FUNCTION
1411 : !! Extract from pawfgrtab and from the global index of atoms
1412 : !! the buffers to send in a sending operation
1413 : !! This function has to be coupled with a call to pawfgrtab_isendreceive_getbuffer
1414 : !!
1415 : !! INPUTS
1416 : !! atm_indx_send(1:total number of atoms)= array for send operation,
1417 : !! Given an index of atom in global numbering, give its index
1418 : !! in the table of atoms treated by current processor
1419 : !! or -1 if the atoms is not treated by current processor
1420 : !! npawfgrtab_send= number of sent atoms
1421 : !! pawfgrtab= data structure from which are extract buffer int and buffer dp
1422 : !!
1423 : !! OUTPUT
1424 : !! buf_int= buffer of integers to be sent
1425 : !! buf_int_size= size of buffer of integers
1426 : !! buf_dp= buffer of double precision numbers to be sent
1427 : !! buf_dp_size= size of buffer of double precision numbers
1428 : !!
1429 : !! SOURCE
1430 : !!
1431 8 : subroutine pawfgrtab_isendreceive_fillbuffer(pawfgrtab, atmtab_send,atm_indx_send,npawfgrtab_send,&
1432 : & buf_int,buf_int_size,buf_dp,buf_dp_size)
1433 :
1434 : !Arguments ------------------------------------
1435 : !scalars
1436 : integer,intent(out) :: buf_int_size,buf_dp_size
1437 : integer,intent(in) :: npawfgrtab_send
1438 : !arrays
1439 : integer,intent(in) :: atmtab_send(:),atm_indx_send(:)
1440 : integer,intent(out),allocatable :: buf_int(:)
1441 : real(dp),intent(out),allocatable :: buf_dp(:)
1442 : type(pawfgrtab_type),target,intent(inout) :: pawfgrtab(:)
1443 :
1444 : !Local variables-------------------------------
1445 : !scalars
1446 : integer :: i1,i2,iat,iat1,iatom_tot,indx_int,indx_dp,l_size,l_size2,nfgd,nspden
1447 : character(len=500) :: msg
1448 : type(pawfgrtab_type),pointer :: pawfgrtab1
1449 :
1450 : ! *********************************************************************
1451 :
1452 : !Compute size of buffers
1453 8 : buf_int_size=0;buf_dp_size=0
1454 16 : do iat1=1,npawfgrtab_send
1455 8 : iatom_tot=atmtab_send(iat1)
1456 8 : iat=atm_indx_send(iatom_tot)
1457 8 : pawfgrtab1=>pawfgrtab(iat)
1458 8 : buf_int_size=buf_int_size+pawfgrtab1%nfgd+13
1459 8 : if (pawfgrtab1%expiqr_allocated>0) then
1460 12 : buf_dp_size=buf_dp_size + size(pawfgrtab1%expiqr(:,:))
1461 : end if
1462 8 : if (pawfgrtab1%gylm_allocated>0) then
1463 24 : buf_dp_size=buf_dp_size+size(pawfgrtab1%gylm(:,:))
1464 : end if
1465 8 : if (pawfgrtab1%gylmgr_allocated>0) then
1466 24 : buf_dp_size=buf_dp_size+size(pawfgrtab1%gylmgr(:,:,:))
1467 : end if
1468 8 : if (pawfgrtab1%gylmgr2_allocated>0 ) then
1469 0 : buf_dp_size=buf_dp_size+size(pawfgrtab1%gylmgr2(:,:,:))
1470 : end if
1471 8 : if (pawfgrtab1%nhatfr_allocated>0) then
1472 0 : buf_dp_size=buf_dp_size+size(pawfgrtab1%nhatfr(:,:))
1473 : end if
1474 8 : if (pawfgrtab1%nhatfrgr_allocated>0) then
1475 0 : buf_dp_size=buf_dp_size+size(pawfgrtab1%nhatfrgr(:,:,:))
1476 : end if
1477 16 : if (pawfgrtab1%rfgd_allocated>0) then
1478 12 : buf_dp_size=buf_dp_size+size(pawfgrtab1%rfgd(:,:))
1479 : end if
1480 : end do
1481 :
1482 : !Fill in input buffers
1483 24 : LIBPAW_ALLOCATE(buf_int,(buf_int_size))
1484 24 : LIBPAW_ALLOCATE(buf_dp,(buf_dp_size))
1485 8 : indx_int=1;indx_dp=1
1486 16 : do iat1=1,npawfgrtab_send
1487 8 : iatom_tot=atmtab_send(iat1)
1488 8 : iat=atm_indx_send(iatom_tot)
1489 8 : pawfgrtab1=>pawfgrtab(iat)
1490 8 : l_size=pawfgrtab1%l_size
1491 8 : nfgd=pawfgrtab1%nfgd
1492 8 : nspden=pawfgrtab1%nspden
1493 8 : buf_int(indx_int)=iatom_tot; indx_int=indx_int+1;
1494 8 : buf_int(indx_int)=pawfgrtab1%cplex; indx_int=indx_int+1;
1495 8 : buf_int(indx_int)=pawfgrtab1%itypat; indx_int=indx_int+1;
1496 8 : buf_int(indx_int)=pawfgrtab1%expiqr_allocated; indx_int=indx_int+1;
1497 8 : buf_int(indx_int)=pawfgrtab1%l_size; indx_int=indx_int+1;
1498 8 : buf_int(indx_int)=pawfgrtab1%gylm_allocated; indx_int=indx_int+1;
1499 8 : buf_int(indx_int)=pawfgrtab1%gylmgr_allocated; indx_int=indx_int+1;
1500 8 : buf_int(indx_int)=pawfgrtab1%gylmgr2_allocated; indx_int=indx_int+1;
1501 8 : buf_int(indx_int)=pawfgrtab1%nfgd; indx_int=indx_int+1;
1502 8 : buf_int(indx_int)=pawfgrtab1%nhatfr_allocated; indx_int=indx_int+1;
1503 8 : buf_int(indx_int)=pawfgrtab1%nhatfrgr_allocated; indx_int=indx_int+1;
1504 8 : buf_int(indx_int)=pawfgrtab1%nspden; indx_int=indx_int+1;
1505 8 : buf_int(indx_int)=pawfgrtab1%rfgd_allocated; indx_int=indx_int+1;
1506 8 : if (nfgd>0) then
1507 14592 : buf_int(indx_int:indx_int+nfgd-1)=pawfgrtab1%ifftsph(1:nfgd)
1508 : indx_int=indx_int+nfgd;
1509 : end if
1510 8 : if (pawfgrtab1%expiqr_allocated>0) then
1511 7296 : do i1=1,nfgd
1512 21876 : buf_dp(indx_dp:indx_dp+1)=pawfgrtab1%expiqr(1:2,i1)
1513 7296 : indx_dp=indx_dp+2
1514 : end do
1515 : end if
1516 8 : l_size2=l_size*l_size
1517 8 : if (pawfgrtab1%gylm_allocated>0) then
1518 80 : do i1=1,l_size2
1519 131328 : buf_dp(indx_dp:indx_dp+nfgd-1)=pawfgrtab1%gylm(1:nfgd,i1)
1520 80 : indx_dp=indx_dp+nfgd
1521 : end do
1522 : end if
1523 8 : if (pawfgrtab1%gylmgr_allocated>0) then
1524 60 : do i1=1,l_size2
1525 98502 : do i2=1,nfgd
1526 393768 : buf_dp(indx_dp:indx_dp+2)=pawfgrtab1%gylmgr(1:3,i2,i1)
1527 98496 : indx_dp=indx_dp+3
1528 : end do
1529 : end do
1530 : end if
1531 8 : if (pawfgrtab1%gylmgr2_allocated>0) then
1532 0 : do i1=1,l_size2
1533 0 : do i2=1,nfgd
1534 0 : buf_dp(indx_dp:indx_dp+5)=pawfgrtab1%gylmgr2(1:6,i2,i1)
1535 0 : indx_dp=indx_dp+6
1536 : end do
1537 : end do
1538 : end if
1539 8 : if (pawfgrtab1%nhatfr_allocated>0) then
1540 0 : do i1=1,nspden
1541 0 : buf_dp(indx_dp:indx_dp+nfgd-1)=pawfgrtab1%nhatfr(1:nfgd,i1)
1542 0 : indx_dp=indx_dp+nfgd
1543 : end do
1544 : end if
1545 8 : if (pawfgrtab1%nhatfrgr_allocated>0) then
1546 0 : do i1=1,nspden
1547 0 : do i2=1,nfgd
1548 0 : buf_dp(indx_dp:indx_dp+2)=pawfgrtab1%nhatfrgr(1:3,i2,i1)
1549 0 : indx_dp=indx_dp+3
1550 : end do
1551 : end do
1552 : end if
1553 16 : if (pawfgrtab1%rfgd_allocated>0) then
1554 7296 : do i1=1,nfgd
1555 29168 : buf_dp(indx_dp:indx_dp+2)=pawfgrtab1%rfgd(1:3,i1)
1556 7296 : indx_dp=indx_dp+3
1557 : end do
1558 : end if
1559 : end do
1560 8 : if ((indx_int-1/=buf_int_size).or.(indx_dp-1/=buf_dp_size)) then
1561 0 : write(msg,'(a,i10,a,i10)') 'Wrong buffer sizes: buf_int_size=',buf_int_size,' buf_dp_size=',buf_dp_size
1562 0 : LIBPAW_BUG(msg)
1563 : end if
1564 :
1565 8 : end subroutine pawfgrtab_isendreceive_fillbuffer
1566 : !!***
1567 :
1568 : !----------------------------------------------------------------------
1569 :
1570 0 : END MODULE m_pawfgrtab
1571 : !!***
|
