Branch data 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 [ - + - + : 1594 : subroutine pawfgrtab_init(Pawfgrtab,cplex,l_size_atm,nspden,typat,&
- + ]
178 [ + + + + : 1594 : & 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 : 1594 : integer,pointer :: my_atmtab(:)
196 : :
197 : : ! *************************************************************************
198 : :
199 : : !@Pawfgrtab_type
200 : :
201 : 4 : my_natom=SIZE(Pawfgrtab);if (my_natom==0) return
202 : 1590 : natom=SIZE(typat)
203 [ - + ]: 1590 : 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 : 1590 : paral_atom=(present(comm_atom).and.(my_natom/=natom))
210 [ + + ]: 1590 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
211 [ + + ]: 1590 : my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom
212 : 1590 : call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,my_natom_ref=my_natom)
213 : :
214 : 1590 : call pawfgrtab_nullify(Pawfgrtab)
215 : :
216 [ + + ]: 5154 : do iat=1,my_natom
217 [ + + ]: 3564 : iatom_tot=iat; if (paral_atom) iatom_tot=my_atmtab(iat)
218 : :
219 : 3564 : Pawfgrtab(iat)%cplex = cplex
220 : 3564 : Pawfgrtab(iat)%itypat = typat(iatom_tot)
221 : 3564 : Pawfgrtab(iat)%nspden = nspden
222 : 3564 : Pawfgrtab(iat)%l_size = l_size_atm(iat)
223 : 3564 : Pawfgrtab(iat)%nfgd = 0
224 [ - + - + ]: 3564 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%ifftsph,(0))
225 : 3564 : Pawfgrtab(iat)%gylm_allocated = 0
226 [ - + - + ]: 3564 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%gylm,(0,0))
227 : 3564 : Pawfgrtab(iat)%gylmgr_allocated = 0
228 [ - + - + ]: 3564 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%gylmgr,(0,0,0))
229 : 3564 : Pawfgrtab(iat)%gylmgr2_allocated = 0
230 [ - + - + ]: 3564 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%gylmgr2,(0,0,0))
231 : 3564 : Pawfgrtab(iat)%nhatfr_allocated = 0
232 [ - + - + ]: 3564 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%nhatfr,(0,0))
233 : 3564 : Pawfgrtab(iat)%nhatfrgr_allocated = 0
234 [ - + - + ]: 3564 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%nhatfrgr,(0,0,0))
235 : 3564 : Pawfgrtab(iat)%rfgd_allocated = 0
236 [ - + - + ]: 3564 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%rfgd,(0,0))
237 : 3564 : Pawfgrtab(iat)%expiqr_allocated = 0
238 [ - + - + ]: 5154 : LIBPAW_ALLOCATE(Pawfgrtab(iat)%expiqr,(0,0))
239 : : end do
240 : :
241 : : !Destroy atom table used for parallelism
242 : 1590 : call free_my_atmtab(my_atmtab,my_atmtab_allocated)
243 : :
244 [ + + ]: 1594 : 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 [ - + ]: 1831 : 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 [ + + ]: 1831 : natom=SIZE(Pawfgrtab);if (natom==0) return
276 [ + + ]: 5263 : do iat=1,natom
277 [ + - ]: 3618 : if (allocated(Pawfgrtab(iat)%ifftsph)) then
278 : 3618 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%ifftsph)
279 : : end if
280 [ + - ]: 3618 : if (allocated(Pawfgrtab(iat)%gylm )) then
281 : 3618 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%gylm)
282 : : end if
283 [ + + ]: 3618 : if (allocated(Pawfgrtab(iat)%gylmgr )) then
284 : 3606 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%gylmgr)
285 : : end if
286 [ + + ]: 3618 : if (allocated(Pawfgrtab(iat)%gylmgr2)) then
287 : 3496 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%gylmgr2)
288 : : end if
289 [ + + ]: 3618 : if (allocated(Pawfgrtab(iat)%nhatfr )) then
290 : 3487 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%nhatfr)
291 : : end if
292 [ + + ]: 3618 : if (allocated(Pawfgrtab(iat)%nhatfrgr)) then
293 : 3562 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%nhatfrgr)
294 : : end if
295 [ + + ]: 3618 : if (allocated(Pawfgrtab(iat)%rfgd )) then
296 : 3594 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%rfgd)
297 : : end if
298 [ + + ]: 3618 : if (allocated(Pawfgrtab(iat)%expiqr)) then
299 : 3586 : LIBPAW_DEALLOCATE(Pawfgrtab(iat)%expiqr)
300 : : end if
301 : 3618 : Pawfgrtab(iat)%gylm_allocated=0
302 : 3618 : Pawfgrtab(iat)%gylmgr_allocated=0
303 : 3618 : Pawfgrtab(iat)%gylmgr2_allocated=0
304 : 3618 : Pawfgrtab(iat)%nhatfr_allocated=0
305 : 3618 : Pawfgrtab(iat)%nhatfrgr_allocated=0
306 : 3618 : Pawfgrtab(iat)%rfgd_allocated=0
307 : 5263 : 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 [ - + ]: 1732 : 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 [ + + ]: 1732 : natom=SIZE(Pawfgrtab);if (natom==0) return
346 [ + + ]: 5440 : do iat=1,natom
347 : 3720 : Pawfgrtab(iat)%nfgd = 0
348 : 3720 : Pawfgrtab(iat)%gylm_allocated = 0
349 : 3720 : Pawfgrtab(iat)%gylmgr_allocated = 0
350 : 3720 : Pawfgrtab(iat)%gylmgr2_allocated = 0
351 : 3720 : Pawfgrtab(iat)%nhatfr_allocated = 0
352 : 3720 : Pawfgrtab(iat)%nhatfrgr_allocated= 0
353 : 3720 : Pawfgrtab(iat)%rfgd_allocated = 0
354 : 5440 : 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 [ - + - + : 9 : 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 : 9 : integer,pointer :: my_atmtab(:)
551 : :
552 : : ! *************************************************************************
553 : :
554 : : !@Pawfgrtab_type
555 : :
556 : 0 : size_Pawfgrtab=SIZE(Pawfgrtab);if (size_Pawfgrtab==0) return
557 : :
558 [ + - ]: 9 : my_prtvol=0 ; if (PRESENT(prtvol )) my_prtvol=prtvol
559 [ + - ]: 9 : my_unt =std_out; if (PRESENT(unit )) my_unt =unit
560 [ + + ]: 9 : my_mode ='PERS' ; if (PRESENT(mode_paral)) my_mode =mode_paral
561 [ + - ]: 9 : my_natom=size_Pawfgrtab; if (PRESENT(natom)) my_natom=natom
562 : :
563 : : !Set up parallelism over atoms
564 : 9 : paral_atom=(present(comm_atom).and.my_natom/=size_Pawfgrtab)
565 [ - + ]: 9 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
566 [ - + ]: 9 : 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 : 9 : & my_natom,my_natom_ref=size_Pawfgrtab)
569 : :
570 : 9 : write(msg,'(3a)')ch10,' === Content of the pawfgrtab datatype === ',ch10
571 : 9 : call wrtout(my_unt,msg,my_mode)
572 [ + + ]: 47 : do iat=1,my_natom
573 [ - + ]: 38 : iatom_tot=iat;if(paral_atom) iatom_tot=my_atmtab(iat)
574 : :
575 : 38 : write(msg,'(6(2a,i0))')ch10,&
576 : 38 : & ' > For atom number : ',iatom_tot,ch10,&
577 : 38 : & ' cplex= ',Pawfgrtab(iat)%cplex,ch10,&
578 : 38 : & ' # of spins components for density= ',Pawfgrtab(iat)%nspden,ch10,&
579 : 38 : & ' Type of atom= ',Pawfgrtab(iat)%itypat,ch10,&
580 : 38 : & ' 1+ Max l in Gaunt coefficients= ',Pawfgrtab(iat)%l_size,ch10,&
581 : 76 : & ' Number of fine FFT points in PAW sphere= ',Pawfgrtab(iat)%nfgd
582 : 38 : call wrtout(my_unt,msg,my_mode)
583 : :
584 [ + + ]: 47 : 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 : 9 : call free_my_atmtab(my_atmtab,my_atmtab_allocated)
610 : :
611 [ - + ]: 9 : 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 [ + + ]: 3438 : do while (nbmsg_incoming > 0)
1200 [ + + ]: 6836 : do i1=1,nbrecvmsg
1201 [ - + ]: 6796 : if (.not.msg_pick(i1)) then
1202 : 3398 : iproc_send=From(i1)
1203 : : flag=.false.
1204 : 3398 : my_tag=400
1205 : 3398 : call xmpi_iprobe(iproc_send,my_tag,mpi_comm_exch,flag,ierr)
1206 [ + + ]: 3398 : 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 : : !!***
|
