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