Line data Source code
1 : !!****m* ABINIT/m_paw_ij
2 : !! NAME
3 : !! m_paw_ij
4 : !!
5 : !! FUNCTION
6 : !! This module contains the definition of the paw_ij_type structured datatype,
7 : !! as well as related functions and methods.
8 : !! paw_ij_type variables contain various arrays given on (i,j) (partial waves) channels
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_ij
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_pawtab, only : pawtab_type
34 : use m_paw_io, only : pawio_print_ij
35 :
36 : implicit none
37 :
38 : private
39 : !!***
40 :
41 : !----------------------------------------------------------------------
42 :
43 : !!****t* m_paw_ij/paw_ij_type
44 : !! NAME
45 : !! paw_ij_type
46 : !!
47 : !! FUNCTION
48 : !! For PAW, various arrays given on (i,j) (partial waves) channels
49 : !!
50 : !! SOURCE
51 :
52 : type,public :: paw_ij_type
53 :
54 : !Integer scalars
55 :
56 : integer :: cplex_dij
57 : ! cplex_dij=1 if dij are real
58 : ! cplex_dij=2 if dij are complex (spin-orbit, non-collinear magnetism, magnetic field, ...)
59 :
60 : integer :: has_dij=0
61 : ! 1 if dij is allocated
62 : ! 2 if dij is already computed
63 :
64 : integer :: has_dij0=0
65 : ! 1 if dij0 is allocated
66 : ! 2 if dij0 is already computed
67 :
68 : integer :: has_dijexxc=0
69 : ! 1 if dijexxc is associated and used, 0 otherwise
70 : ! 2 if dijexxc is already computed
71 :
72 : integer :: has_dijfock=0
73 : ! 1 if dijfock is allocated
74 : ! 2 if dijfock is already computed
75 :
76 : integer :: has_dijfr=0
77 : ! 1 if dijfr is allocated
78 : ! 2 if dijfr is already computed
79 :
80 : integer :: has_dijhartree=0
81 : ! 1 if dijhartree is allocated
82 : ! 2 if dijhartree is already computed
83 :
84 : integer :: has_dijhat=0
85 : ! 1 if dijhat is allocated
86 : ! 2 if dijhat is already computed
87 :
88 : integer :: has_dijnd=0
89 : ! on site term due to nuclear dipole moment
90 : ! 1 if dijnd is associated and used, 0 otherwise
91 : ! 2 if dijnd is already computed
92 :
93 : integer :: has_dijso=0
94 : ! 1 if dijso is associated and used, 0 otherwise
95 : ! 2 if dijso is already computed
96 :
97 : integer :: has_dijU=0
98 : ! 1 if dijU is associated and used, 0 otherwise
99 : ! 2 if dijU is already computed
100 :
101 : integer :: has_dijxc=0
102 : ! 1 if dijxc is associated and used, 0 otherwise
103 : ! 2 if dijxc is already computed
104 :
105 : integer :: has_dijxc_hat=0
106 : ! 1 if dijxc_hat is associated and used, 0 otherwise
107 : ! 2 if dijxc_hat is already computed
108 :
109 : integer :: has_dijxc_val=0
110 : ! 1 if dijxc_val is associated and used, 0 otherwise
111 : ! 2 if dijxc_val is already computed
112 :
113 : integer :: has_exexch_pot=0
114 : ! 1 if PAW+(local exact exchange) potential is allocated
115 :
116 : integer :: has_pawu_occ=0
117 : ! 1 if PAW+U occupations are allocated
118 :
119 : integer :: itypat
120 : ! itypat=type of the atom
121 :
122 : integer :: lmn_size
123 : ! Number of (l,m,n) elements for the paw basis
124 :
125 : integer :: lmn2_size
126 : ! lmn2_size=lmn_size*(lmn_size+1)/2
127 : ! where lmn_size is the number of (l,m,n) elements for the paw basis
128 :
129 : integer :: ndij
130 : ! Number of components of dij
131 : ! Usually ndij=nspden, except for nspinor==2 (where ndij=nspinor**2)
132 :
133 : integer :: nspden
134 : ! Number of spin-density components (may be different from dtset%nspden if spin-orbit)
135 :
136 : integer :: nsppol
137 : ! Number of independant spin-components
138 :
139 : integer :: qphase
140 : ! qphase=2 if dij contain a exp(-i.q.r) phase (as in the q<>0 RF case), 1 if not
141 : ! (this may change the ij symmetry)
142 :
143 : integer :: zora = 0
144 : ! zora=1 use zora terms where possible, currently only nuclear dipole terms
145 :
146 : !Real (real(dp)) arrays
147 :
148 : real(dp), allocatable :: dij(:,:)
149 : ! dij(cplex_dij*qphase*lmn2_size,ndij)
150 : ! Dij term (non-local operator)
151 : ! May be complex if cplex_dij=2 or qphase=2
152 : ! ==== Storage for the 1st dimension ====
153 : ! For each klmn=ij:
154 : ! When Dij is complex (cplex_dij=2):
155 : ! dij(2*ij-1,:) contains the real part
156 : ! dij(2*ij ,:) contains the imaginary part
157 : ! When a exp(-i.q.r) phase is included (qphase=2):
158 : ! dij(1:cplex_dij*lmn2_size,:)
159 : ! contains the real part of the phase, i.e. D_ij*cos(q.r)
160 : ! dij(cplex_dij*lmn2_size+1:2*cplex_dij*lmn2_size,:)
161 : ! contains the imaginary part of the phase, i.e. D_ij*sin(q.r)
162 : ! ==== Storage for the 2nd dimension ====
163 : ! dij(:,1) contains Dij^up-up
164 : ! dij(:,2) contains Dij^dn-dn
165 : ! dij(:,3) contains Dij^up-dn (only if nspinor=2)
166 : ! dij(:,4) contains Dij^dn-up (only if nspinor=2)
167 :
168 : real(dp), allocatable :: dij0(:)
169 : ! dij0(lmn2_size)
170 : ! Atomic part of Dij (read from PAW dataset)
171 : ! Same storage as Dij (see above); always real, spin independent
172 :
173 : real(dp), allocatable :: dijexxc(:,:)
174 : ! dijexxc(cplex_dij*lmn2_size,ndij)
175 : ! On-site matrix elements of the Fock operator (Local Exact exchange implementation)
176 : ! Same storage as Dij (see above); not available for RF (i.e. qphase=2)
177 :
178 : real(dp), allocatable :: dijfock(:,:)
179 : ! dijfock(cplex_dij*lmn2_size,ndij)
180 : ! Dij_fock term
181 : ! Contains all contributions to Dij from Fock exchange
182 : ! Same storage as Dij (see above); not available for RF (i.e. qphase=2)
183 :
184 : real(dp), allocatable :: dijfr(:,:)
185 : ! dijhat(cplex_dij*qphase*lmn2_size,ndij)
186 : ! For response function calculation only
187 : ! RF Frozen part of Dij (depends on q vector but not on 1st-order wave function)
188 : ! Same storage as Dij (see above)
189 :
190 : real(dp), allocatable :: dijhartree(:)
191 : ! dijhartree(qphase*lmn2_size)
192 : ! Dij_hartree term; contains all contributions to Dij from hartree
193 : ! Warning: dimensioned only by qphase (exp(-iqr)), not cplex_dij
194 : ! Same storage as Dij (see above); spin independent
195 :
196 : real(dp), allocatable :: dijhat(:,:)
197 : ! dijhat(cplex_dij*qphase*lmn2_size,ndij)
198 : ! Dij_hat term (non-local operator) i.e \sum_LM \int_FFT Q_{ij}^{LM} vtrial
199 : ! Same storage as Dij (see above)
200 : ! Same storage as Dij (see above)
201 :
202 : real(dp), allocatable :: dijnd(:,:)
203 : ! dijnd(cplex_dij*lmn2_size,ndij)
204 : ! On-site matrix elements of -\frac{1}{c}\mu\cdot L/r^3
205 : ! Same storage as Dij (see above)
206 :
207 : real(dp), allocatable :: dijso(:,:)
208 : ! dijso(cplex_dij*qphase*lmn2_size,ndij)
209 : ! On-site matrix elements of L.S i.e <phi_i|L.S|phi_j>
210 : ! Same storage as Dij (see above)
211 : ! Same storage as Dij (see above); not available for RF (i.e. qphase=2)
212 :
213 : real(dp), allocatable :: dijU(:,:)
214 : ! dijU(cplex_dij*qphase*lmn2_size,ndij)
215 : ! On-site matrix elements of the U part of the PAW Hamiltonian.
216 : ! Same storage as Dij (see above); not available for RF (i.e. qphase=2)
217 :
218 : real(dp), allocatable :: dijxc(:,:)
219 : ! dijxc(cplex_dij*qphase*lmn2_size,ndij)
220 : ! On-site matrix elements of vxc i.e
221 : ! <phi_i|vxc[n1+nc]|phi_j> - <tphi_i|vxc(tn1+nhat+tnc]|tphi_j>
222 : ! Same storage as Dij (see above)
223 :
224 : real(dp), allocatable :: dijxc_hat(:,:)
225 : ! dijxc_hat(cplex_dij*lmn2_size,ndij)
226 : ! Dij_hat term i.e \sum_LM \int_FFT Q_{ij}^{LM} Vxc
227 : ! Same storage as Dij (see above); not available for RF (i.e. qphase=2)
228 :
229 : real(dp), allocatable :: dijxc_val(:,:)
230 : ! dijxc_val(cplex_dij*lmn2_size,ndij)
231 : ! Onsite matrix elements of valence-only vxc i.e
232 : ! <phi_i|vxc[n1]|phi_j> - <tphi_i|vxc(tn1+nhat]|tphi_j>
233 : ! Same storage as Dij (see above); not available for RF (i.e. qphase=2)
234 :
235 : real(dp), allocatable :: noccmmp(:,:,:,:)
236 : ! noccmmp(cplex_dij,2*lpawu+1,2*lpawu+1,nocc_nspden)
237 : ! cplex_dij=1 if collinear
238 : ! cplex_dij=2 if spin orbit is used
239 : ! cplex_dij=2 is used if non-collinear (for coherence, it is not necessary in this case, however)
240 : ! gives occupation matrix for lda+u (computed in setnoccmmp)
241 : ! Stored as: noccmmp(:,:,1)= n^{up,up}_{m,mp}
242 : ! noccmmp(:,:,2)= n^{dn,dn}_{m,mp}
243 : ! noccmmp(:,:,3)= n^{up,dn}_{m,mp}
244 : ! noccmmp(:,:,4)= n^{dn,up}_{m,mp}
245 : ! noccmmp(m,mp,:) is computed from rhoij(klmn) with m=klmntomn(2)>mp=klmntomn(1)
246 :
247 : real(dp), allocatable :: nocctot(:)
248 : ! nocctot(ndij)
249 : ! gives trace of occupation matrix for lda+u (computed in pawdenpot)
250 : ! for each value of ispden (1 or 2)
251 :
252 : real(dp), allocatable :: vpawx(:,:,:)
253 : ! vpawx(1,2*lexexch+1,nspden)
254 : ! exact exchange potential
255 :
256 : end type paw_ij_type
257 :
258 : !public procedures.
259 : public :: paw_ij_init ! Creation method
260 : public :: paw_ij_free ! Free memory
261 : public :: paw_ij_nullify
262 : public :: paw_ij_copy ! Copy object
263 : public :: paw_ij_print ! Printout of the object
264 : public :: paw_ij_gather ! MPI gather
265 : public :: paw_ij_redistribute ! MPI redistribute
266 : public :: paw_ij_reset_flags ! Resent the internal flags.
267 :
268 : !private procedures.
269 : private :: paw_ij_isendreceive_getbuffer
270 : private :: paw_ij_isendreceive_fillbuffer
271 : !!***
272 :
273 : CONTAINS
274 :
275 : !===========================================================
276 : !!***
277 :
278 : !----------------------------------------------------------------------
279 :
280 : !!****f* m_paw_ij/paw_ij_init
281 : !! NAME
282 : !! paw_ij_init
283 : !!
284 : !! FUNCTION
285 : !! Initialize a Paw_ij data type.
286 : !!
287 : !! INPUTS
288 : !! cplex=1 if no phase is applied (GS), 2 if a exp(-iqr) phase is applied (Response Function at q<>0)
289 : !! natom=Number of atoms.
290 : !! ntypat=Number of types of atoms in cell.
291 : !! nspinor=number of spinor components
292 : !! nsppol=Number of independent spin polarizations.
293 : !! nspden=Number of spin-density components
294 : !! pawspnorb=1 if spin-orbit coupling is activated
295 : !! typat(natom)=Type of each atom
296 : !! Pawtab(ntypat)<type(pawtab_type)>=PAW tabulated starting data
297 : !!
298 : !! OPTIONAL INPUTS
299 : !! has_dij=1 to allocate Paw_ij%dij, 0 otherwise (default)
300 : !! has_dij0=1 to allocate Paw_ij%dij0, 0 otherwise (default)
301 : !! has_dijfr=1 to allocate Paw_ij%dijfr, 0 otherwise (default)
302 : !! has_dijhat=1 to allocate Paw_ij%dijhat, 0 otherwise (default)
303 : !! has_dijxc=1 to allocate Paw_ij%dijxc, 0 otherwise (default)
304 : !! has_dijxc_hat=1 to allocate Paw_ij%dijxc_hat, 0 otherwise (default)
305 : !! has_dijxc_val=1 to allocate Paw_ij%dijxc_val, 0 otherwise (default)
306 : !! has_dijhartree=1 to allocate Paw_ij%dijhartree, 0 otherwise (default)
307 : !! has_dijfock=1 to allocate Paw_ij%dijfock, 0 otherwise (default)
308 : !! has_dijnd=1 to allocate Paw_ij%dijnd, used only if some nucdipmom /= 0; otherwise 0 (default)
309 : !! has_dijso=1 to allocate Paw_ij%dijso, used only if pawspnorb>0. 0 otherwise (default)
310 : !! has_dijU=1 to allocate Paw_ij%dijU, used only if Pawtab(itypat)%usepawu/=0. 0 otherwise (default).
311 : !! has_dijexxc=to allocate Paw_ij%dijxx, 0 otherwise (default)
312 : !! has_exexch_pot=1 to allocate potential used in PAW+(local exact exchange) formalism, 0 otherwise (default)
313 : !! has_pawu_occ=1 to allocate occupations used in PAW+U formalism, 0 otherwise (default)
314 : !! nucdipmom(3,natom)= (optional) array of nuclear dipole moments at atomic sites
315 : !! mpi_atmtab(:)=indexes of the atoms treated by current proc
316 : !! comm_atom=MPI communicator over atoms
317 : !!
318 : !! OUTPUT
319 : !! Paw_ij(natom)<type(paw_ij_type)>=data structure containing PAW arrays given on (i,j) channels.
320 : !! In output all the basic dimensions are defined and the arrays are allocated
321 : !! according to the input variables.
322 : !!
323 : !! SOURCE
324 :
325 5549 : subroutine paw_ij_init(Paw_ij,cplex,nspinor,nsppol,nspden,pawspnorb,natom,ntypat,typat,Pawtab,&
326 : & has_dij,has_dij0,has_dijfock,has_dijfr,has_dijhartree,has_dijhat,& ! Optional
327 : & has_dijxc,has_dijxc_hat,has_dijxc_val,has_dijnd,has_dijso,has_dijU,has_dijexxc,& ! Optional
328 1646 : & has_exexch_pot,has_pawu_occ,nucdipmom,zora,& ! Optional
329 5549 : & mpi_atmtab,comm_atom) ! optional arguments (parallelism)
330 :
331 : !Arguments ------------------------------------
332 : !scalars
333 : integer,intent(in) :: cplex,nspinor,nspden,nsppol,natom,ntypat,pawspnorb
334 : integer,optional,intent(in) :: has_dij,has_dij0,has_dijfr,has_dijhat,has_dijxc,has_dijxc_hat,has_dijxc_val
335 : integer,optional,intent(in) :: has_dijnd,has_dijso,has_dijhartree,has_dijfock,has_dijU,has_dijexxc
336 : integer,optional,intent(in) :: has_exexch_pot,has_pawu_occ,zora
337 : integer,optional,intent(in) :: comm_atom
338 :
339 : !arrays
340 : integer,intent(in) :: typat(natom)
341 : integer,optional,target,intent(in) :: mpi_atmtab(:)
342 : real(dp),optional,intent(in) :: nucdipmom(3,natom)
343 : type(Paw_ij_type),intent(inout) :: Paw_ij(:)
344 : type(Pawtab_type),intent(in) :: Pawtab(ntypat)
345 :
346 : !Local variables-------------------------------
347 : !scalars
348 : integer :: cplex_dij,iat,iat_tot,itypat,lmn2_size,my_comm_atom,my_natom,ndij,qphase,zora_
349 : logical :: my_atmtab_allocated,paral_atom,with_nucdipmom
350 : !arrays
351 5549 : integer,pointer :: my_atmtab(:)
352 :
353 : ! *************************************************************************
354 :
355 : !@Paw_ij_type
356 :
357 19158 : with_nucdipmom=.false.;if (present(nucdipmom)) with_nucdipmom=any(abs(nucdipmom)>tol8)
358 5549 : zora_=0; if(present(zora)) zora_=zora
359 :
360 : !Set up parallelism over atoms
361 5549 : my_natom=size(paw_ij);if (my_natom==0) return
362 5355 : paral_atom=(present(comm_atom).and.(my_natom/=natom))
363 5355 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
364 5355 : my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom
365 5355 : call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,my_natom_ref=my_natom)
366 :
367 16871 : do iat=1,my_natom
368 11516 : iat_tot=iat;if (paral_atom) iat_tot=my_atmtab(iat)
369 11516 : itypat=typat(iat_tot)
370 :
371 11516 : cplex_dij=1;if ((nspinor==2).or.(with_nucdipmom)) cplex_dij=2
372 11516 : qphase=cplex
373 :
374 11516 : lmn2_size =Pawtab(itypat)%lmn2_size
375 11516 : Paw_ij(iat)%qphase =qphase
376 11516 : Paw_ij(iat)%cplex_dij =cplex_dij
377 11516 : Paw_ij(iat)%itypat =itypat
378 11516 : Paw_ij(iat)%nspden =nspden
379 11516 : Paw_ij(iat)%nsppol =nsppol
380 11516 : Paw_ij(iat)%zora =zora_
381 11516 : Paw_ij(iat)%lmn_size =Pawtab(itypat)%lmn_size
382 11516 : Paw_ij(iat)%lmn2_size =lmn2_size
383 11516 : Paw_ij(iat)%ndij =MAX(nspinor**2,nspden)
384 :
385 11516 : ndij=Paw_ij(iat)%ndij
386 :
387 : ! ==================================
388 : ! === Allocations (all optional) ===
389 : ! ==================================
390 :
391 : ! === Allocation for total Dij ===
392 11516 : Paw_ij(iat)%has_dij=0
393 11516 : if (PRESENT(has_dij)) then
394 4165 : if (has_dij/=0) then
395 4165 : Paw_ij(iat)%has_dij=1
396 16660 : LIBPAW_ALLOCATE(Paw_ij(iat)%dij,(cplex_dij*qphase*lmn2_size,ndij))
397 498329 : Paw_ij(iat)%dij(:,:)=zero
398 : end if
399 : end if
400 :
401 : ! === Allocation for atomic Dij ===
402 11516 : Paw_ij(iat)%has_dij0=0
403 11516 : if (PRESENT(has_dij0)) then
404 0 : if (has_dij0/=0) then
405 0 : Paw_ij(iat)%has_dij0=1
406 0 : LIBPAW_ALLOCATE(Paw_ij(iat)%dij0,(lmn2_size))
407 0 : Paw_ij(iat)%dij0(:)=zero
408 : end if
409 : end if
410 :
411 : ! === Allocation for Dij local exact exchange ===
412 11516 : Paw_ij(iat)%has_dijexxc=0
413 11516 : if (PRESENT(has_dijexxc)) then
414 0 : if (has_dijexxc/=0.and.Pawtab(itypat)%useexexch/=0) then
415 0 : Paw_ij(iat)%has_dijexxc=1
416 0 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijexxc,(cplex_dij*lmn2_size,ndij))
417 0 : Paw_ij(iat)%dijexxc(:,:)=zero
418 : end if
419 : end if
420 :
421 : ! === Allocation for Dij_Fock ===
422 11516 : Paw_ij(iat)%has_dijfock=0
423 11516 : if (PRESENT(has_dijfock)) then
424 3123 : if (has_dijfock/=0) then
425 52 : Paw_ij(iat)%has_dijfock=1
426 208 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijfock,(cplex_dij*lmn2_size,ndij))
427 1999 : Paw_ij(iat)%dijfock(:,:)=zero
428 : end if
429 : end if
430 :
431 : ! === Allocation for frozen part of 1st-order Dij ===
432 11516 : Paw_ij(iat)%has_dijfr=0
433 11516 : if (PRESENT(has_dijfr)) then
434 8131 : if (has_dijfr/=0) then
435 7854 : Paw_ij(iat)%has_dijfr=1
436 31416 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijfr,(cplex_dij*qphase*lmn2_size,ndij))
437 350002 : Paw_ij(iat)%dijfr(:,:)=zero
438 : end if
439 : end if
440 :
441 : ! === Allocation for Dij_Hartree ===
442 11516 : Paw_ij(iat)%has_dijhartree=0
443 11516 : if (PRESENT(has_dijhartree)) then
444 4165 : if (has_dijhartree/=0) then
445 4165 : Paw_ij(iat)%has_dijhartree=1
446 12495 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijhartree,(qphase*lmn2_size))
447 246343 : Paw_ij(iat)%dijhartree(:)=zero
448 : end if
449 : end if
450 :
451 : ! === Allocation for Dij_hat ===
452 11516 : Paw_ij(iat)%has_dijhat=0
453 11516 : if (PRESENT(has_dijhat)) then
454 3158 : if (has_dijhat/=0) then
455 35 : Paw_ij(iat)%has_dijhat=1
456 140 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijhat,(cplex_dij*qphase*lmn2_size,ndij))
457 1878 : Paw_ij(iat)%dijhat(:,:)=zero
458 : end if
459 : end if
460 :
461 : ! === Allocation for Dij nuclear dipole moment ===
462 11516 : Paw_ij(iat)%has_dijnd=0
463 11516 : if (PRESENT(has_dijnd)) then
464 3319 : if (has_dijnd/=0.and.with_nucdipmom) then
465 68 : Paw_ij(iat)%has_dijnd=1
466 272 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijnd,(cplex_dij*lmn2_size,ndij))
467 11456 : Paw_ij(iat)%dijnd(:,:)=zero
468 : end if
469 : end if
470 :
471 : ! === Allocation for Dij_SO ===
472 11516 : Paw_ij(iat)%has_dijso=0
473 11516 : if (PRESENT(has_dijso)) then
474 3354 : if (has_dijso/=0.and.pawspnorb>0) then
475 170 : Paw_ij(iat)%has_dijso=1
476 680 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijso,(cplex_dij*qphase*lmn2_size,ndij))
477 137714 : Paw_ij(iat)%dijso(:,:)=zero
478 : end if
479 : end if
480 :
481 : ! === Allocation for Dij_U_val ===
482 11516 : Paw_ij(iat)%has_dijU=0
483 11516 : if (PRESENT(has_dijU)) then
484 4134 : if (has_dijU/=0) then
485 2799 : Paw_ij(iat)%has_dijU=1
486 11196 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijU,(cplex_dij*qphase*lmn2_size,ndij))
487 263361 : Paw_ij(iat)%dijU(:,:)=zero
488 : end if
489 : end if
490 :
491 : ! === Allocation for total Dij_XC ===
492 11516 : Paw_ij(iat)%has_dijxc=0
493 11516 : if (PRESENT(has_dijxc)) then
494 35 : if (has_dijxc/=0) then
495 31 : Paw_ij(iat)%has_dijxc=1
496 124 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijxc,(cplex_dij*qphase*lmn2_size,ndij))
497 1673 : Paw_ij(iat)%dijxc(:,:)=zero
498 : end if
499 : end if
500 :
501 : ! === Allocation for total Dij_XC_hat ===
502 11516 : Paw_ij(iat)%has_dijxc_hat=0
503 11516 : if (PRESENT(has_dijxc_hat)) then
504 35 : if (has_dijxc_hat/=0) then
505 31 : Paw_ij(iat)%has_dijxc_hat=1
506 124 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijxc_hat,(cplex_dij*lmn2_size,ndij))
507 1673 : Paw_ij(iat)%dijxc_hat(:,:)=zero
508 : end if
509 : end if
510 :
511 : ! === Allocation for total Dij_XC_val ===
512 11516 : Paw_ij(iat)%has_dijxc_val=0
513 11516 : if (PRESENT(has_dijxc_val)) then
514 35 : if (has_dijxc_val/=0) then
515 31 : Paw_ij(iat)%has_dijxc_val=1
516 124 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijxc_val,(cplex_dij*lmn2_size,ndij))
517 1673 : Paw_ij(iat)%dijxc_val(:,:)=zero
518 : end if
519 : end if
520 :
521 : ! === Allocation for PAW+U occupations ===
522 11516 : Paw_ij(iat)%has_pawu_occ=0
523 11516 : if (PRESENT(has_pawu_occ)) then
524 3385 : if (has_pawu_occ/=0.and.Pawtab(itypat)%usepawu/=0) then
525 213 : Paw_ij(iat)%has_pawu_occ=1
526 1278 : LIBPAW_ALLOCATE(Paw_ij(iat)%noccmmp,(cplex_dij,2*Pawtab(itypat)%lpawu+1,2*Pawtab(itypat)%lpawu+1,ndij))
527 639 : LIBPAW_ALLOCATE(Paw_ij(iat)%nocctot,(ndij))
528 30935 : Paw_ij(iat)%noccmmp(:,:,:,:)=zero
529 679 : Paw_ij(iat)%nocctot(:)=zero
530 : end if
531 : end if
532 :
533 : ! === Allocation for PAW+LEXX potential ===
534 11516 : Paw_ij(iat)%has_exexch_pot=0
535 16871 : if (PRESENT(has_exexch_pot)) then
536 3385 : if (has_exexch_pot/=0.and.Pawtab(itypat)%useexexch/=0) then
537 2 : Paw_ij(iat)%has_exexch_pot=1
538 : ! TODO solve issue with first dimension
539 8 : LIBPAW_ALLOCATE(Paw_ij(iat)%vpawx,(1,lmn2_size,nspden))
540 1374 : Paw_ij(iat)%vpawx(:,:,:)=zero
541 : end if
542 : end if
543 :
544 : end do
545 :
546 : !Destroy atom table used for parallelism
547 5355 : call free_my_atmtab(my_atmtab,my_atmtab_allocated)
548 :
549 11098 : end subroutine paw_ij_init
550 : !!***
551 :
552 : !----------------------------------------------------------------------
553 :
554 : !!****f* m_paw_ij/paw_ij_free
555 : !! NAME
556 : !! paw_ij_free
557 : !!
558 : !! FUNCTION
559 : !! Deallocate pointers and nullify flags in a paw_ij structure
560 : !!
561 : !! SIDE EFFECTS
562 : !! paw_ij(:)<type(paw_ij_type)>=paw arrays given on (i,j) channels
563 : !!
564 : !! SOURCE
565 :
566 6209 : subroutine paw_ij_free(Paw_ij)
567 :
568 : !Arguments ------------------------------------
569 : !arrays
570 : type(Paw_ij_type),intent(inout) :: Paw_ij(:)
571 :
572 : !Local variables-------------------------------
573 : integer :: iat,natom
574 :
575 : ! *************************************************************************
576 :
577 : !@Paw_ij_type
578 :
579 6209 : natom=SIZE(Paw_ij);if (natom==0) return
580 :
581 18018 : do iat=1,natom
582 12330 : if (allocated(Paw_ij(iat)%dij )) then
583 4599 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dij)
584 : end if
585 12330 : if (allocated(Paw_ij(iat)%dij0 )) then
586 0 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dij0)
587 : end if
588 12330 : if (allocated(Paw_ij(iat)%dijexxc )) then
589 0 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijexxc)
590 : end if
591 12330 : if (allocated(Paw_ij(iat)%dijfock )) then
592 52 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijfock)
593 : end if
594 12330 : if (allocated(Paw_ij(iat)%dijfr )) then
595 7854 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijfr)
596 : end if
597 12330 : if (allocated(Paw_ij(iat)%dijhartree)) then
598 4599 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijhartree)
599 : end if
600 12330 : if (allocated(Paw_ij(iat)%dijhat )) then
601 35 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijhat)
602 : end if
603 12330 : if (allocated(Paw_ij(iat)%dijnd )) then
604 68 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijnd)
605 : end if
606 12330 : if (allocated(Paw_ij(iat)%dijU )) then
607 3168 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijU)
608 : end if
609 12330 : if (allocated(Paw_ij(iat)%dijso )) then
610 198 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijso)
611 : end if
612 12330 : if (allocated(Paw_ij(iat)%dijxc )) then
613 31 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijxc)
614 : end if
615 12330 : if (allocated(Paw_ij(iat)%dijxc_hat )) then
616 31 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijxc_hat)
617 : end if
618 12330 : if (allocated(Paw_ij(iat)%dijxc_val )) then
619 31 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijxc_val)
620 : end if
621 12330 : if (allocated(Paw_ij(iat)%noccmmp )) then
622 216 : LIBPAW_DEALLOCATE(Paw_ij(iat)%noccmmp)
623 : end if
624 12330 : if (allocated(Paw_ij(iat)%nocctot )) then
625 216 : LIBPAW_DEALLOCATE(Paw_ij(iat)%nocctot)
626 : end if
627 12330 : if (allocated(Paw_ij(iat)%vpawx )) then
628 2 : LIBPAW_DEALLOCATE(Paw_ij(iat)%vpawx)
629 : end if
630 :
631 : ! === Reset all has_* flags ===
632 12330 : Paw_ij(iat)%has_dij =0
633 12330 : Paw_ij(iat)%has_dij0 =0
634 12330 : Paw_ij(iat)%has_dijexxc =0
635 12330 : Paw_ij(iat)%has_dijfock =0
636 12330 : Paw_ij(iat)%has_dijfr =0
637 12330 : Paw_ij(iat)%has_dijhartree=0
638 12330 : Paw_ij(iat)%has_dijhat =0
639 12330 : Paw_ij(iat)%has_dijnd =0
640 12330 : Paw_ij(iat)%has_dijso =0
641 12330 : Paw_ij(iat)%has_dijU =0
642 12330 : Paw_ij(iat)%has_dijxc =0
643 12330 : Paw_ij(iat)%has_dijxc_hat =0
644 12330 : Paw_ij(iat)%has_dijxc_val =0
645 12330 : Paw_ij(iat)%has_exexch_pot=0
646 18018 : Paw_ij(iat)%has_pawu_occ =0
647 : end do
648 :
649 : !call paw_ij_nullify(Paw_ij)
650 :
651 : end subroutine paw_ij_free
652 : !!***
653 :
654 : !----------------------------------------------------------------------
655 :
656 : !!****f* m_paw_ij/paw_ij_nullify
657 : !! NAME
658 : !! paw_ij_nullify
659 : !!
660 : !! FUNCTION
661 : !! Reset all flags in a paw_ij structure
662 : !!
663 : !! SIDE EFFECTS
664 : !! Paw_ij(:)<type(paw_ij_type)>=PAW arrays given on (i,j) channels.
665 : !!
666 : !! SOURCE
667 :
668 5921 : subroutine paw_ij_nullify(Paw_ij)
669 :
670 : !Arguments ------------------------------------
671 : !arrays
672 : type(Paw_ij_type),intent(inout) :: Paw_ij(:)
673 :
674 : !Local variables-------------------------------
675 : integer :: iat,natom
676 :
677 : ! *************************************************************************
678 :
679 : !@Paw_ij_type
680 :
681 : ! MGPAW: This one could be removed/renamed,
682 : ! variables can be initialized in the datatype declaration
683 : ! Do we need to expose this in the public API?
684 :
685 5921 : natom=SIZE(Paw_ij(:));if (natom==0) return
686 :
687 : ! Set all has_* flags to zero.
688 18151 : do iat=1,natom
689 : ! === Set all has_* flags to zero ===
690 12424 : Paw_ij(iat)%has_dij =0
691 12424 : Paw_ij(iat)%has_dij0 =0
692 12424 : Paw_ij(iat)%has_dijexxc =0
693 12424 : Paw_ij(iat)%has_dijfock =0
694 12424 : Paw_ij(iat)%has_dijfr =0
695 12424 : Paw_ij(iat)%has_dijhartree=0
696 12424 : Paw_ij(iat)%has_dijhat =0
697 12424 : Paw_ij(iat)%has_dijnd =0
698 12424 : Paw_ij(iat)%has_dijso =0
699 12424 : Paw_ij(iat)%has_dijU =0
700 12424 : Paw_ij(iat)%has_dijxc =0
701 12424 : Paw_ij(iat)%has_dijxc_hat =0
702 12424 : Paw_ij(iat)%has_dijxc_val =0
703 12424 : Paw_ij(iat)%has_exexch_pot=0
704 18151 : Paw_ij(iat)%has_pawu_occ =0
705 : end do !iat
706 :
707 : end subroutine paw_ij_nullify
708 : !!***
709 :
710 : !----------------------------------------------------------------------
711 :
712 : !!****f* m_paw_ij/paw_ij_copy
713 : !! NAME
714 : !! paw_ij_copy
715 : !!
716 : !! FUNCTION
717 : !! Copy one paw_ij datastructure into another
718 : !! Can take into accound changes of dimensions
719 : !! Can copy a shared paw_ij into distributed ones (when parallelism is activated)
720 : !!
721 : !! INPUTS
722 : !! mpi_atmtab(:)=--optional-- indexes of the atoms treated by current proc
723 : !! comm_atom=--optional-- MPI communicator over atoms
724 : !! paw_ij_in(:)<type(paw_ij_type)>= input paw_ij datastructure
725 : !!
726 : !! SIDE EFFECTS
727 : !! paw_ij_cpy(:)<type(paw_ij_type)>= output paw_ij datastructure
728 : !!
729 : !! NOTES
730 : !! paw_ij_cpy must have been allocated in the calling function.
731 : !!
732 : !! SOURCE
733 :
734 60 : subroutine paw_ij_copy(paw_ij_in,paw_ij_cpy, &
735 60 : & mpi_atmtab,comm_atom) ! optional arguments (parallelism)
736 :
737 : !Arguments ------------------------------------
738 : !scalars
739 : integer,optional,intent(in) :: comm_atom
740 : !arrays
741 : integer,optional,target,intent(in) :: mpi_atmtab(:)
742 : type(paw_ij_type),intent(in) :: paw_ij_in(:)
743 : type(paw_ij_type),intent(inout),target :: paw_ij_cpy(:)
744 :
745 : !Local variables-------------------------------
746 : !scalars
747 : integer :: ij,ij1,my_comm_atom,my_paw_ij,npaw_ij_in,npaw_ij_max,npaw_ij_out,paral_case,sz1,sz2,sz3,sz4
748 : logical :: my_atmtab_allocated,paral_atom
749 : character(len=500) :: msg
750 : !arrays
751 60 : integer,pointer :: my_atmtab(:)
752 60 : type(paw_ij_type),pointer :: paw_ij_out(:)
753 :
754 : ! *************************************************************************
755 :
756 : !@Paw_ij_type
757 :
758 : !Retrieve sizes
759 60 : npaw_ij_in=size(paw_ij_in);npaw_ij_out=size(paw_ij_cpy)
760 :
761 : !Set up parallelism over atoms
762 0 : paral_atom=(present(comm_atom));if (paral_atom) paral_atom=(xmpi_comm_size(comm_atom)>1)
763 60 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
764 60 : my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom
765 60 : my_atmtab_allocated=.false.
766 :
767 : !Determine in which case we are (parallelism, ...)
768 : !No parallelism: a single copy operation
769 60 : paral_case=0;npaw_ij_max=npaw_ij_in
770 60 : paw_ij_out => paw_ij_cpy
771 60 : if (paral_atom) then
772 0 : if (npaw_ij_out<npaw_ij_in) then ! Parallelism: the copy operation is a scatter
773 0 : call get_my_natom(my_comm_atom,my_paw_ij,npaw_ij_in)
774 0 : if (my_paw_ij==npaw_ij_out) then
775 0 : call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,npaw_ij_in)
776 0 : paral_case=1;npaw_ij_max=npaw_ij_out
777 0 : paw_ij_out => paw_ij_cpy
778 : else
779 0 : msg=' npaw_ij_out should be equal to my_paw_ij !'
780 0 : LIBPAW_BUG(msg)
781 : end if
782 : else ! Parallelism: the copy operation is a gather
783 0 : call get_my_natom(my_comm_atom,my_paw_ij,npaw_ij_out)
784 0 : if (my_paw_ij==npaw_ij_in) then
785 : paral_case=2;npaw_ij_max=npaw_ij_in
786 : else
787 0 : msg=' npaw_ij_in should be equal to my_paw_ij !'
788 0 : LIBPAW_BUG(msg)
789 : end if
790 : end if
791 : end if
792 :
793 : !First case: a simple copy or a scatter
794 60 : if (npaw_ij_max>0.and.((paral_case==0).or.(paral_case==1))) then
795 48 : call paw_ij_nullify(paw_ij_out)
796 :
797 : ! Loop on paw_ij components
798 96 : do ij1=1,npaw_ij_max
799 48 : ij=ij1; if (paral_case==1) ij=my_atmtab(ij1)
800 :
801 48 : paw_ij_out(ij1)%qphase=paw_ij_in(ij)%qphase
802 48 : paw_ij_out(ij1)%cplex_dij=paw_ij_in(ij)%cplex_dij
803 48 : paw_ij_out(ij1)%has_dij=paw_ij_in(ij)%has_dij
804 48 : paw_ij_out(ij1)%has_dij0=paw_ij_in(ij)%has_dij0
805 48 : paw_ij_out(ij1)%has_dijexxc=paw_ij_in(ij)%has_dijexxc
806 48 : paw_ij_out(ij1)%has_dijfock=paw_ij_in(ij)%has_dijfock
807 48 : paw_ij_out(ij1)%has_dijfr=paw_ij_in(ij)%has_dijfr
808 48 : paw_ij_out(ij1)%has_dijhartree=paw_ij_in(ij)%has_dijhartree
809 48 : paw_ij_out(ij1)%has_dijhat=paw_ij_in(ij)%has_dijhat
810 48 : paw_ij_out(ij1)%has_dijnd=paw_ij_in(ij)%has_dijnd
811 48 : paw_ij_out(ij1)%has_dijso=paw_ij_in(ij)%has_dijso
812 48 : paw_ij_out(ij1)%has_dijU=paw_ij_in(ij)%has_dijU
813 48 : paw_ij_out(ij1)%has_dijxc=paw_ij_in(ij)%has_dijxc
814 48 : paw_ij_out(ij1)%has_dijxc_hat=paw_ij_in(ij)%has_dijxc_hat
815 48 : paw_ij_out(ij1)%has_dijxc_val=paw_ij_in(ij)%has_dijxc_val
816 48 : paw_ij_out(ij1)%has_exexch_pot=paw_ij_in(ij)%has_exexch_pot
817 48 : paw_ij_out(ij1)%has_pawu_occ=paw_ij_in(ij)%has_pawu_occ
818 48 : paw_ij_out(ij1)%itypat=paw_ij_in(ij)%itypat
819 48 : paw_ij_out(ij1)%lmn_size=paw_ij_in(ij)%lmn_size
820 48 : paw_ij_out(ij1)%lmn2_size=paw_ij_in(ij)%lmn2_size
821 48 : paw_ij_out(ij1)%ndij=paw_ij_in(ij)%ndij
822 48 : paw_ij_out(ij1)%nspden=paw_ij_in(ij)%nspden
823 48 : paw_ij_out(ij1)%nsppol=paw_ij_in(ij)%nsppol
824 48 : paw_ij_out(ij1)%zora=paw_ij_in(ij)%zora
825 48 : if (paw_ij_in(ij)%has_dij>=1) then
826 48 : sz1=size(paw_ij_in(ij)%dij,1);sz2=size(paw_ij_in(ij)%dij,2)
827 192 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%dij,(sz1,sz2))
828 48 : if (paw_ij_in(ij)%has_dij==2) &
829 1824 : & paw_ij_out(ij1)%dij(:,:)=paw_ij_in(ij)%dij(:,:)
830 : end if
831 48 : if (paw_ij_in(ij)%has_dij0>=1) then
832 0 : sz1=size(paw_ij_in(ij)%dij0,1)
833 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%dij0,(sz1))
834 0 : if (paw_ij_in(ij)%has_dij0 ==2) &
835 0 : & paw_ij_out(ij1)%dij0(:)=paw_ij_in(ij)%dij0(:)
836 : end if
837 48 : if (paw_ij_in(ij)%has_dijexxc>=1) then
838 0 : sz1=size(paw_ij_in(ij)%dijexxc,1);sz2=size(paw_ij_in(ij)%dijexxc,2)
839 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%dijexxc,(sz1,sz2))
840 0 : if (paw_ij_in(ij)%has_dijexxc==2) &
841 0 : & paw_ij_out(ij1)%dijexxc(:,:)=paw_ij_in(ij)%dijexxc(:,:)
842 : end if
843 48 : if (paw_ij_in(ij)%has_dijfock>=1) then
844 0 : sz1=size(paw_ij_in(ij)%dijfock,1);sz2=size(paw_ij_in(ij)%dijfock,2)
845 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%dijfock,(sz1,sz2))
846 0 : if (paw_ij_in(ij)%has_dijfock==2) &
847 0 : & paw_ij_out(ij1)%dijfock(:,:)=paw_ij_in(ij)%dijfock(:,:)
848 : end if
849 48 : if (paw_ij_in(ij)%has_dijfr>=1) then
850 0 : sz1=size(paw_ij_in(ij)%dijfr,1);sz2=size(paw_ij_in(ij)%dijfr,2)
851 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%dijfr,(sz1,sz2))
852 0 : if (paw_ij_in(ij)%has_dijfr==2) &
853 0 : & paw_ij_out(ij1)%dijfr(:,:)=paw_ij_in(ij)%dijfr(:,:)
854 : end if
855 48 : if (paw_ij_in(ij)%has_dijhartree>=1) then
856 48 : sz1=size(paw_ij_in(ij)%dijhartree,1)
857 144 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%dijhartree,(sz1))
858 48 : if (paw_ij_in(ij)%has_dijhartree==2) &
859 1776 : & paw_ij_out(ij1)%dijhartree(:)=paw_ij_in(ij)%dijhartree(:)
860 : end if
861 48 : if (paw_ij_in(ij)%has_dijhat>=1) then
862 0 : sz1=size(paw_ij_in(ij)%dijhat,1);sz2=size(paw_ij_in(ij)%dijhat,2)
863 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%dijhat,(sz1,sz2))
864 0 : if (paw_ij_in(ij)%has_dijhat==2) &
865 0 : & paw_ij_out(ij1)%dijhat(:,:)=paw_ij_in(ij)%dijhat(:,:)
866 : end if
867 48 : if (paw_ij_in(ij)%has_dijnd>=1) then
868 0 : sz1=size(paw_ij_in(ij)%dijnd,1);sz2=size(paw_ij_in(ij)%dijnd,2)
869 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%dijnd,(sz1,sz2))
870 0 : if (paw_ij_in(ij)%has_dijnd==2) &
871 0 : & paw_ij_out(ij1)%dijnd(:,:)=paw_ij_in(ij)%dijnd(:,:)
872 : end if
873 48 : if (paw_ij_in(ij)%has_dijU>=1) then
874 0 : sz1=size(paw_ij_in(ij)%dijU,1);sz2=size(paw_ij_in(ij)%dijU,2)
875 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%dijU,(sz1,sz2))
876 0 : if (paw_ij_in(ij)%has_dijU==2) &
877 0 : & paw_ij_out(ij1)%dijU(:,:)=paw_ij_in(ij)%dijU(:,:)
878 : end if
879 48 : if (paw_ij_in(ij)%has_dijso>=1) then
880 0 : sz1=size(paw_ij_in(ij)%dijso,1);sz2=size(paw_ij_in(ij)%dijso,2)
881 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%dijso,(sz1,sz2))
882 0 : if (paw_ij_in(ij)%has_dijso==2) &
883 0 : & paw_ij_out(ij1)%dijso(:,:)=paw_ij_in(ij)%dijso(:,:)
884 : end if
885 48 : if (paw_ij_in(ij)%has_dijxc>=1) then
886 0 : sz1=size(paw_ij_in(ij)%dijxc,1);sz2=size(paw_ij_in(ij)%dijxc,2)
887 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%dijxc,(sz1,sz2))
888 0 : if (paw_ij_in(ij)%has_dijxc==2) &
889 0 : & paw_ij_out(ij1)%dijxc(:,:)=paw_ij_in(ij)%dijxc(:,:)
890 : end if
891 48 : if (paw_ij_in(ij)%has_dijxc_hat>=1) then
892 0 : sz1=size(paw_ij_in(ij)%dijxc_hat,1);sz2=size(paw_ij_in(ij)%dijxc_hat,2)
893 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%dijxc_hat,(sz1,sz2))
894 0 : if (paw_ij_in(ij)%has_dijxc_hat==2) &
895 0 : & paw_ij_out(ij1)%dijxc_hat(:,:)=paw_ij_in(ij)%dijxc_hat(:,:)
896 : end if
897 48 : if (paw_ij_in(ij)%has_dijxc_val>=1) then
898 0 : sz1=size(paw_ij_in(ij)%dijxc_val,1);sz2=size(paw_ij_in(ij)%dijxc_val,2)
899 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%dijxc_val,(sz1,sz2))
900 0 : if (paw_ij_in(ij)%has_dijxc_val==2) &
901 0 : & paw_ij_out(ij1)%dijxc_val(:,:)=paw_ij_in(ij)%dijxc_val(:,:)
902 : end if
903 48 : if (paw_ij_in(ij)%has_pawu_occ>=1) then
904 0 : sz1=size(paw_ij_in(ij)%noccmmp,1);sz2=size(paw_ij_in(ij)%noccmmp,2)
905 0 : sz3=size(paw_ij_in(ij)%noccmmp,3);sz4=size(paw_ij_in(ij)%noccmmp,4)
906 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%noccmmp,(sz1,sz2,sz3,sz4))
907 0 : sz1=size(paw_ij_in(ij)%nocctot,1)
908 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%nocctot,(sz1))
909 0 : if (paw_ij_in(ij)%has_pawu_occ==2) then
910 0 : paw_ij_out(ij1)%noccmmp(:,:,:,:)=paw_ij_in(ij)%noccmmp(:,:,:,:)
911 0 : paw_ij_out(ij1)%nocctot(:)=paw_ij_in(ij)%nocctot(:)
912 : end if
913 : end if
914 96 : if (paw_ij_in(ij)%has_exexch_pot >= 1) then
915 0 : sz1=size(paw_ij_in(ij)%vpawx,1);sz2=size(paw_ij_in(ij)%vpawx,2)
916 0 : sz3=size(paw_ij_in(ij)%vpawx,3)
917 0 : LIBPAW_ALLOCATE(paw_ij_out(ij1)%vpawx,(sz1,sz2,sz3))
918 0 : if (paw_ij_in(ij)%has_exexch_pot==2) &
919 0 : & paw_ij_out(ij1)%vpawx(:,:,:)=paw_ij_in(ij)%vpawx(:,:,:)
920 : end if
921 :
922 : end do
923 : end if
924 :
925 : !Second case: a gather
926 60 : if (paral_case==2) then
927 0 : call paw_ij_gather(paw_ij_in,paw_ij_cpy,-1,my_comm_atom)
928 : end if
929 :
930 : !Destroy atom table used for parallelism
931 60 : call free_my_atmtab(my_atmtab,my_atmtab_allocated)
932 :
933 60 : end subroutine paw_ij_copy
934 : !!***
935 :
936 : !----------------------------------------------------------------------
937 :
938 : !!****f* m_paw_ij/paw_ij_print
939 : !! NAME
940 : !! paw_ij_print
941 : !!
942 : !! FUNCTION
943 : !! Print out the content of a paw_ij datastructure (Dij only)
944 : !!
945 : !! INPUTS
946 : !! [enunit]=governs the units to be used for the output of total Dij (0:Ha, 1:Ha+eV)
947 : !! [ipert]=only for DFPT: index of the perturbation (0 for ground state)
948 : !! [unit]=the unit number for output
949 : !! [pawprtvol]=verbosity level
950 : !! [pawspnorb]=1 if spin-orbit coupling is activated
951 : !! [mode_paral]=either "COLL" or "PERS"
952 : !! [mpi_atmtab(:)]=indexes of the atoms treated by current proc (can be computed here)
953 : !! [comm_atom]=MPI communicator over atoms (needed if parallelism over atoms is activated)
954 : !! [natom]=total number of atom (needed if parallelism over atoms is activated)
955 : !! if Paw_ij is distributed, natom is different from size(Paw_ij).
956 : !!
957 : !! OUTPUT
958 : !! (Only writing)
959 : !!
960 : !! NOTES
961 : !!
962 : !! SOURCE
963 :
964 19725 : subroutine paw_ij_print(Paw_ij,unit,pawprtvol,pawspnorb,mode_paral,enunit,ipert, &
965 19725 : & mpi_atmtab,comm_atom,natom)
966 :
967 : !Arguments ------------------------------------
968 : !scalars
969 : integer,optional,intent(in) :: enunit,ipert
970 : integer,optional,intent(in) :: comm_atom,natom
971 : integer,optional,intent(in) :: pawprtvol,pawspnorb
972 : integer,optional,intent(in) :: unit
973 : character(len=4),optional,intent(in) :: mode_paral
974 : !arrays
975 : integer,optional,target,intent(in) :: mpi_atmtab(:)
976 : type(Paw_ij_type),target,intent(in) :: Paw_ij(:)
977 :
978 : !Local variables-------------------------------
979 : character(len=7),parameter :: dspin(6)=(/"up ","down ","up-up ","dwn-dwn","up-dwn ","dwn-up "/)
980 : !scalars
981 : integer :: cplex_dij,iatom,iatom_tot,idij,idij_sym,lmn2_size,lmn_size,my_comm_atom,my_natom,nspden !klmn,
982 : integer :: nsploop,nsppol,my_unt,ndij,qphase,tmp_cplex_dij,my_ipert,my_enunit,my_prtvol,size_paw_ij
983 : logical :: my_atmtab_allocated,paral_atom
984 : character(len=4) :: my_mode
985 : character(len=4000) :: msg
986 : !arrays
987 : integer :: idum(0)
988 19725 : integer,pointer :: my_atmtab(:)
989 19725 : real(dp),allocatable,target :: dijh(:,:)
990 19725 : real(dp),allocatable :: dij2p(:),dij2p_(:)
991 :
992 : ! *************************************************************************
993 :
994 : if (.False.) write(std_out,*)"pawspnorb:",pawspnorb
995 :
996 : !@Paw_ij_type
997 19725 : size_paw_ij=SIZE(Paw_ij);if (size_paw_ij==0) return
998 :
999 17961 : my_unt =std_out ; if (PRESENT(unit )) my_unt =unit
1000 17961 : my_prtvol=0 ; if (PRESENT(pawprtvol )) my_prtvol=pawprtvol
1001 17961 : my_mode ='COLL' ; if (PRESENT(mode_paral)) my_mode =mode_paral
1002 17961 : my_ipert =0 ; if (PRESENT(ipert)) my_ipert =ipert
1003 17961 : my_enunit=0 ; if (PRESENT(enunit)) my_enunit=enunit
1004 17961 : my_natom=size_paw_ij; if (PRESENT(natom)) my_natom=natom
1005 :
1006 : !Set up parallelism over atoms
1007 17961 : paral_atom=(present(comm_atom).and.my_natom/=size_paw_ij)
1008 17961 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
1009 17961 : my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom
1010 17961 : call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,my_natom,my_natom_ref=size_paw_ij)
1011 :
1012 17961 : if (abs(my_prtvol)>=1) then
1013 1620 : if (my_ipert==0) then
1014 1620 : write(msg,'(4a)')ch10,' ==== Values of psp strength Dij (Hartree) ============'
1015 : else
1016 0 : write(msg,'(4a)')ch10,' ==== Values of psp strength Dij(1) (Hartree) ========='
1017 : end if
1018 1620 : call wrtout(my_unt,msg,my_mode)
1019 : end if
1020 :
1021 17961 : nsppol = Paw_ij(1)%nsppol
1022 17961 : nspden = Paw_ij(1)%nspden
1023 17961 : nsploop= nsppol; if (Paw_ij(1)%ndij==4) nsploop=4
1024 :
1025 61466 : do iatom=1,size_paw_ij
1026 :
1027 43505 : iatom_tot=iatom;if (paral_atom) iatom_tot=my_atmtab(iatom)
1028 :
1029 43505 : lmn_size = Paw_ij(iatom)%lmn_size
1030 43505 : lmn2_size = Paw_ij(iatom)%lmn2_size
1031 43505 : cplex_dij = Paw_ij(iatom)%cplex_dij
1032 43505 : qphase = Paw_ij(iatom)%qphase
1033 43505 : ndij = Paw_ij(iatom)%ndij
1034 130515 : LIBPAW_ALLOCATE(dij2p,(2*lmn2_size))
1035 87010 : LIBPAW_ALLOCATE(dij2p_,(2*lmn2_size))
1036 :
1037 : ! ====================================
1038 : ! === Loop over density components ===
1039 : ! ====================================
1040 101078 : do idij=1,nsploop
1041 :
1042 57573 : idij_sym=idij;if (ndij==4.and.idij>2) idij_sym=7-idij
1043 :
1044 : ! =================== Detailed output =====================================
1045 57573 : if (ABS(my_prtvol)>=1.and.(iatom_tot==1.or.iatom_tot==my_natom.or.my_prtvol<0)) then
1046 :
1047 : !Title
1048 4962 : if (nspden==2.and.nsppol==1) then
1049 30 : write(msg,'(2a,i3,3a)')ch10,&
1050 30 : & ' >>>>>>>>>> Atom ',iatom_tot,':',ch10,&
1051 60 : & ' (antiferromagnetism case: only one spin component)'
1052 4932 : else if (paw_ij(iatom)%ndij==1) then
1053 500 : write(msg, '(2a,i3,a)') ch10,&
1054 1000 : & ' >>>>>>>>>> Atom ',iatom_tot,':'
1055 : else
1056 4432 : write(msg,'(2a,i3,3a)') ch10,&
1057 8864 : & ' >>>>>>>>>> Atom ',iatom_tot,' (component ',TRIM(dspin(idij+2*(nsploop/4))),'):'
1058 : end if
1059 4962 : call wrtout(my_unt,msg,my_mode)
1060 :
1061 : !Dij atomic
1062 4962 : if (Paw_ij(iatom)%has_dij0/=0.and.idij<=2.and.my_ipert<=0) then
1063 3464 : write(msg,'(a)') ' ************ Dij atomic (Dij0) ***********'
1064 3464 : call wrtout(my_unt,msg,my_mode)
1065 : call pawio_print_ij(my_unt,Paw_ij(iatom)%dij0,lmn2_size,1,lmn_size,-1,idum,0,my_prtvol,idum,-1.d0,1,&
1066 3464 : & opt_sym=2,mode_paral=my_mode)
1067 : end if
1068 :
1069 : !Dij Local Exact Exchange
1070 4962 : if (Paw_ij(iatom)%has_dijexxc/=0.and.(idij<=2.or.nspden==4).and.my_ipert<=0) then
1071 0 : write(msg,'(a)') ' ************* Dij_Local Exact exchange **********'
1072 0 : call wrtout(my_unt,msg,my_mode)
1073 0 : call get_dij_parts(cplex_dij,1,Paw_ij(iatom)%dijexxc,dij2p,dij2p_)
1074 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,&
1075 0 : & my_prtvol,idum,-1.d0,1,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode)
1076 : end if
1077 :
1078 : !Dij Fock
1079 4962 : if (Paw_ij(iatom)%has_dijfock/=0.and.(idij<=2.or.nspden==4).and.my_ipert<=0) then
1080 0 : write(msg,'(a)') ' ************* Dij_Fock **********'
1081 0 : call wrtout(my_unt,msg,my_mode)
1082 0 : call get_dij_parts(cplex_dij,1,Paw_ij(iatom)%dijfock,dij2p,dij2p_)
1083 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,&
1084 0 : & my_prtvol,idum,-1.d0,1,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode)
1085 : end if
1086 :
1087 : !Dij Frozen (RF)
1088 4962 : if (Paw_ij(iatom)%has_dijfr/=0.and.(idij<=2.or.nspden==4).and.my_ipert>0) then
1089 0 : write(msg,'(a)') ' ************** Dij(1) Frozen **************'
1090 0 : call wrtout(my_unt,msg,my_mode)
1091 0 : call get_dij_parts(cplex_dij,qphase,Paw_ij(iatom)%dijfr,dij2p,dij2p_)
1092 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,&
1093 0 : & my_prtvol,idum,-1.d0,1,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode)
1094 : end if
1095 :
1096 : !Dij Hartree
1097 4962 : if (Paw_ij(iatom)%has_dijhartree/=0.and.idij<=2) then
1098 3464 : if (my_ipert==0) then
1099 3464 : write(msg,'(a)') ' ************** Dij Hartree ***************'
1100 : else
1101 0 : write(msg,'(a)') ' ************* Dij(1) Hartree *************'
1102 : end if
1103 3464 : call wrtout(my_unt,msg,my_mode)
1104 10392 : LIBPAW_ALLOCATE(dijh,(qphase*lmn2_size,1))
1105 658138 : dijh(:,1)=Paw_ij(iatom)%dijhartree(:)
1106 3464 : call get_dij_parts(1,qphase,dijh,dij2p,dij2p_)
1107 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0, &
1108 3464 : & my_prtvol,idum,-1.d0,1,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode)
1109 3464 : LIBPAW_DEALLOCATE(dijh)
1110 : end if
1111 :
1112 : !Dij Hat
1113 4962 : if (Paw_ij(iatom)%has_dijhat/=0.and.(idij<=2.or.nspden==4)) then
1114 4834 : if (my_ipert==0) then
1115 4834 : write(msg,'(a)') ' **************** Dij_hat *****************'
1116 : else
1117 0 : write(msg,'(a)') ' ***** Dij_hat(1) (incl. frozen Dij) ******'
1118 : end if
1119 4834 : call wrtout(my_unt,msg,my_mode)
1120 4834 : call get_dij_parts(cplex_dij,qphase,Paw_ij(iatom)%dijhat,dij2p,dij2p_)
1121 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,&
1122 4834 : & my_prtvol,idum,-1.d0,1,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode)
1123 : end if
1124 :
1125 : !Dij nuclear dipole
1126 4962 : if (Paw_ij(iatom)%has_dijnd/=0) then
1127 22 : write(msg,'(a)') ' *********** Dij Nuclear Dipole **********'
1128 22 : call wrtout(my_unt,msg,my_mode)
1129 22 : call get_dij_parts(cplex_dij,1,Paw_ij(iatom)%dijnd,dij2p,dij2p_,always_img=.true.)
1130 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,&
1131 22 : & my_prtvol,idum,-1.d0,1,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode)
1132 : end if
1133 :
1134 : !Dij spin-orbit
1135 4962 : if (Paw_ij(iatom)%has_dijso/=0.and.my_ipert<=0) then
1136 2804 : write(msg,'(a)') ' ************** Dij SpinOrbit ************'
1137 2804 : call wrtout(my_unt,msg,my_mode)
1138 2804 : call get_dij_parts(cplex_dij,qphase,Paw_ij(iatom)%dijso,dij2p,dij2p_,always_img=.true.)
1139 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,&
1140 2804 : & my_prtvol,idum,-1.d0,1,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode)
1141 : end if
1142 :
1143 : !Dij DFT+U
1144 4962 : if (Paw_ij(iatom)%has_dijU/=0.and.(idij<=2.or.nspden==4).and.my_ipert<=0) then
1145 4111 : write(msg,'(a)') ' ************* Dij_DFT+U (dijpawu) **********'
1146 4111 : call wrtout(my_unt,msg,my_mode)
1147 4111 : call get_dij_parts(cplex_dij,qphase,Paw_ij(iatom)%diju,dij2p,dij2p_)
1148 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,&
1149 4111 : & my_prtvol,idum,-1.d0,1,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode)
1150 : end if
1151 :
1152 : !Dij XC
1153 4962 : if (Paw_ij(iatom)%has_dijxc/=0.and.(idij<=2.or.nspden==4)) then
1154 4834 : if (my_ipert<=0) then
1155 4834 : write(msg,'(a)') ' ***************** Dij_xc *****************'
1156 : else
1157 0 : write(msg,'(a)') ' **************** Dij(1)_xc ***************'
1158 : end if
1159 4834 : call wrtout(my_unt,msg,my_mode)
1160 4834 : call get_dij_parts(cplex_dij,qphase,Paw_ij(iatom)%dijxc,dij2p,dij2p_)
1161 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,&
1162 4834 : & my_prtvol,idum,-1.d0,1,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode)
1163 : end if
1164 :
1165 : !Dij hat XC
1166 4962 : if (Paw_ij(iatom)%has_dijxc_hat/=0.and.(idij<=2.or.nspden==4).and.my_ipert<=0) then
1167 : if (my_ipert<=0) then
1168 4 : write(msg,'(a)') ' *************** Dijhat_xc ****************'
1169 : else
1170 : write(msg,'(a)') ' ************** Dij(1)hat_xc **************'
1171 : end if
1172 4 : call wrtout(my_unt,msg,my_mode)
1173 4 : call get_dij_parts(cplex_dij,1,Paw_ij(iatom)%dijxc_hat,dij2p,dij2p_)
1174 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,&
1175 4 : & my_prtvol,idum,-1.d0,1,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode)
1176 : end if
1177 :
1178 : !Dij XC val
1179 4962 : if (Paw_ij(iatom)%has_dijxc_val/=0.and.(idij<=2.or.nspden==4).and.my_ipert<=0) then
1180 4 : write(msg, '(a)') ' *************** Dij_xc_val ***************'
1181 4 : call wrtout(my_unt,msg,my_mode)
1182 4 : call get_dij_parts(cplex_dij,1,Paw_ij(iatom)%dijxc_val,dij2p,dij2p_)
1183 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,&
1184 4 : & my_prtvol,idum,-1.d0,1,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode)
1185 : end if
1186 :
1187 : !Dij TOTAL
1188 4962 : if (Paw_ij(iatom)%has_dij/=0) then
1189 4962 : if (my_ipert<=0) then
1190 4962 : write(msg,'(a)') ' ********** TOTAL Dij in Ha **********'
1191 : else
1192 0 : write(msg,'(a)') ' ********** TOTAL Dij(1) in Ha **********'
1193 : end if
1194 4962 : call wrtout(my_unt,msg,my_mode)
1195 4962 : call get_dij_parts(cplex_dij,qphase,Paw_ij(iatom)%dij,dij2p,dij2p_,always_img=.true.)
1196 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,&
1197 4962 : & my_prtvol,idum,50.d0*dble(3-2*idij),1,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode)
1198 4962 : if (my_enunit>0) then
1199 0 : if (my_ipert<=0) then
1200 0 : write(msg,'(a)') ' ********** TOTAL Dij in eV **********'
1201 : else
1202 0 : write(msg,'(a)') ' ********** TOTAL Dij(1) in eV **********'
1203 : end if
1204 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,&
1205 0 : & my_prtvol,idum,-1._dp,2,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode)
1206 : end if
1207 : end if
1208 :
1209 : end if !(ABS(my_prtvol)>=1.and.(iatom_tot==1.or.iatom_tot==my_natom.or.my_prtvol<0)
1210 :
1211 : ! =================== Standard output =====================================
1212 101078 : if ((abs(my_prtvol)==0).and.(iatom_tot==1.or.iatom_tot==my_natom)) then
1213 :
1214 : !Title
1215 36016 : if (idij==1) then
1216 26475 : if (my_ipert<=0) then
1217 22366 : write(msg, '(2a,i6,a)') ch10,' ****** Psp strength Dij in Ha (atom ',iatom_tot,') *****'
1218 : else
1219 4109 : write(msg, '(2a,i6,a)') ch10,' **** Psp strength Dij(1) in Ha (atom ',iatom_tot,') *****'
1220 : end if
1221 26475 : if (nspden==2.and.nsppol==1) then
1222 300 : write(msg,'(4a)') trim(msg),') *****',ch10,' (antiferromagnetism case: only one spin component)'
1223 : end if
1224 : end if
1225 36016 : if (paw_ij(iatom)%ndij/=1) then
1226 15476 : write(msg,'(4a)') trim(msg),' Component ',trim(dspin(idij+2*(nsploop/4))),':'
1227 : end if
1228 :
1229 : !Dij TOTAL
1230 36016 : if (Paw_ij(iatom)%has_dij/=0) then
1231 36016 : call get_dij_parts(cplex_dij,qphase,Paw_ij(iatom)%dij,dij2p,dij2p_,always_img=.true.)
1232 : call pawio_print_ij(my_unt,dij2p,lmn2_size,tmp_cplex_dij,lmn_size,-1,idum,0,&
1233 : & my_prtvol,idum,50.d0*dble(3-2*idij),1,opt_sym=2,asym_ij=dij2p_,mode_paral=my_mode,&
1234 36016 : & title=msg)
1235 : end if
1236 :
1237 : end if
1238 :
1239 : ! =================== End main loops =====================================
1240 :
1241 : end do !idij
1242 43505 : LIBPAW_DEALLOCATE(dij2p)
1243 61466 : LIBPAW_DEALLOCATE(dij2p_)
1244 : end do !iatom
1245 :
1246 37686 : call wrtout(my_unt,' ',my_mode)
1247 :
1248 : !Small helper function
1249 : contains
1250 :
1251 : !Real and imaginary parts of phase.
1252 61055 : subroutine get_dij_parts(my_cplex_dij,my_qphase,my_dij,dij2p,dij2p_,always_img)
1253 :
1254 : integer,intent(in) :: my_cplex_dij,my_qphase
1255 : logical,intent(in),optional :: always_img
1256 : real(dp),intent(in),target :: my_dij(:,:)
1257 : real(dp),intent(out) :: dij2p(:)
1258 : real(dp),intent(out) :: dij2p_(:)
1259 :
1260 : integer :: my_idij,my_idij_sym,kk
1261 : logical :: always_img_
1262 :
1263 61055 : always_img_=.false.;if(present(always_img)) always_img_=always_img
1264 61055 : my_idij=min(size(my_dij,2),idij)
1265 61055 : my_idij_sym=min(size(my_dij,2),idij_sym)
1266 61055 : if (my_qphase==1) then
1267 60479 : if ((idij<=nsppol.or.idij==2).and.(.not.always_img_))then
1268 13221 : tmp_cplex_dij=1
1269 2531162 : do kk=1,lmn2_size
1270 2517941 : dij2p(kk) = my_dij(1+(kk-1)*my_cplex_dij,my_idij)
1271 2531162 : dij2p_(kk) = dij2p(kk)
1272 : enddo
1273 : else
1274 47258 : tmp_cplex_dij=my_cplex_dij
1275 6937267 : do kk=1,my_cplex_dij*lmn2_size
1276 6890009 : dij2p(kk) = my_dij(kk,my_idij)
1277 6937267 : dij2p_(kk) = my_dij(kk,my_idij_sym)
1278 : end do
1279 : end if
1280 : else
1281 576 : tmp_cplex_dij=2
1282 576 : if (my_cplex_dij==1) then
1283 24552 : do kk=1,lmn2_size
1284 23976 : dij2p(2*kk-1)= my_dij(kk,my_idij)
1285 23976 : dij2p(2*kk )= my_dij(kk+lmn2_size,my_idij)
1286 23976 : dij2p_(2*kk-1)= my_dij(kk,my_idij)
1287 24552 : dij2p_(2*kk )=-my_dij(kk+lmn2_size,my_idij)
1288 : end do
1289 : else
1290 0 : do kk=1,lmn2_size
1291 0 : dij2p(2*kk-1)= my_dij(2*kk-1,idij)-my_dij(2*kk +2*lmn2_size,my_idij)
1292 0 : dij2p(2*kk )= my_dij(2*kk ,idij)+my_dij(2*kk-1+2*lmn2_size,my_idij)
1293 0 : dij2p_(2*kk-1)= my_dij(2*kk-1,idij_sym)+my_dij(2*kk +2*lmn2_size,my_idij_sym)
1294 0 : dij2p_(2*kk )= my_dij(2*kk ,idij_sym)-my_dij(2*kk-1+2*lmn2_size,my_idij_sym)
1295 : end do
1296 : end if
1297 : end if
1298 61055 : end subroutine get_dij_parts
1299 :
1300 : end subroutine paw_ij_print
1301 : !!***
1302 :
1303 : !----------------------------------------------------------------------
1304 :
1305 : !!****f* m_paw_ij/paw_ij_gather
1306 : !! NAME
1307 : !! paw_ij_gather
1308 : !!
1309 : !! FUNCTION
1310 : !! (All)Gather paw_ij datastructures
1311 : !!
1312 : !! INPUTS
1313 : !! master=master receiving data ; if -1 do a ALLGATHER
1314 : !! comm_atom= communicator
1315 : !! paw_ij_in(:)<type(paw_ij_type)>= input paw_ij datastructures on every process
1316 : !!
1317 : !! OUTPUT
1318 : !! paw_ij_gathered(:)<type(paw_ij_type)>= output paw_oij datastructure
1319 : !!
1320 : !! SOURCE
1321 :
1322 442 : subroutine paw_ij_gather(paw_ij_in,paw_ij_gathered,master,comm_atom)
1323 :
1324 : !Arguments ------------------------------------
1325 : !scalars
1326 : integer,intent(in) :: master,comm_atom
1327 : !arrays
1328 : type(paw_ij_type),intent(in) :: paw_ij_in(:)
1329 : type(paw_ij_type),intent(inout) :: paw_ij_gathered(:)
1330 :
1331 : !Local variables-------------------------------
1332 : !scalars
1333 : integer :: buf_dp_size,buf_dp_size_all,buf_int_size,buf_int_size_all
1334 : integer :: cplxdij_lmn2_size,cplxdijq_lmn2_size,cplxq_lmn2_size
1335 : integer :: iat,ii,ierr,ij,indx_dp,indx_int,lmn2_size
1336 : integer :: me_atom,ndij,nocc,nocc1,nocc2,nocc3,nocc4,npaw_ij_in,npaw_ij_in_sum
1337 : integer :: npaw_ij_out,nproc_atom,nspden,sz1,sz2,sz3,sz4
1338 : logical :: my_atmtab_allocated,paral_atom
1339 : character(len=500) :: msg
1340 : !arrays
1341 : integer :: bufsz(2)
1342 442 : integer,allocatable :: buf_int(:),buf_int_all(:)
1343 442 : integer,allocatable :: count_dp(:),count_int(:),count_tot(:),displ_dp(:),displ_int(:)
1344 442 : integer,pointer :: my_atmtab(:)
1345 442 : real(dp),allocatable :: buf_dp(:),buf_dp_all(:)
1346 :
1347 : ! *************************************************************************
1348 :
1349 : !@Paw_ij_type
1350 :
1351 442 : npaw_ij_in=size(paw_ij_in);npaw_ij_out=size(paw_ij_gathered)
1352 :
1353 884 : nproc_atom=xmpi_comm_size(comm_atom)
1354 442 : me_atom=xmpi_comm_rank(comm_atom)
1355 :
1356 : !Special case 1 process
1357 442 : if (nproc_atom==1) then
1358 0 : if (master==-1.or.me_atom==master) then
1359 0 : call paw_ij_free(paw_ij_gathered)
1360 0 : call paw_ij_nullify(paw_ij_gathered)
1361 0 : do iat=1,npaw_ij_in
1362 0 : paw_ij_gathered(iat)%cplex_dij =paw_ij_in(iat)%cplex_dij
1363 0 : paw_ij_gathered(iat)%qphase =paw_ij_in(iat)%qphase
1364 0 : Paw_ij_gathered(iat)%has_dij =paw_ij_in(iat)%has_dij
1365 0 : Paw_ij_gathered(iat)%has_dij0 =paw_ij_in(iat)%has_dij0
1366 0 : Paw_ij_gathered(iat)%has_dijexxc =paw_ij_in(iat)%has_dijexxc
1367 0 : Paw_ij_gathered(iat)%has_dijfock =paw_ij_in(iat)%has_dijfock
1368 0 : Paw_ij_gathered(iat)%has_dijfr =paw_ij_in(iat)%has_dijfr
1369 0 : Paw_ij_gathered(iat)%has_dijhartree=paw_ij_in(iat)%has_dijhartree
1370 0 : Paw_ij_gathered(iat)%has_dijhat =paw_ij_in(iat)%has_dijhat
1371 0 : Paw_ij_gathered(iat)%has_dijnd =paw_ij_in(iat)%has_dijnd
1372 0 : Paw_ij_gathered(iat)%has_dijso =paw_ij_in(iat)%has_dijso
1373 0 : Paw_ij_gathered(iat)%has_dijU =paw_ij_in(iat)%has_dijU
1374 0 : Paw_ij_gathered(iat)%has_dijxc =paw_ij_in(iat)%has_dijxc
1375 0 : Paw_ij_gathered(iat)%has_dijxc_hat =paw_ij_in(iat)%has_dijxc_hat
1376 0 : Paw_ij_gathered(iat)%has_dijxc_val =paw_ij_in(iat)%has_dijxc_val
1377 0 : Paw_ij_gathered(iat)%has_exexch_pot=paw_ij_in(iat)%has_exexch_pot
1378 0 : Paw_ij_gathered(iat)%has_pawu_occ =paw_ij_in(iat)%has_pawu_occ
1379 0 : paw_ij_gathered(iat)%itypat =paw_ij_in(iat)%itypat
1380 0 : paw_ij_gathered(iat)%lmn_size =paw_ij_in(iat)%lmn_size
1381 0 : paw_ij_gathered(iat)%lmn2_size =paw_ij_in(iat)%lmn2_size
1382 0 : paw_ij_gathered(iat)%ndij =paw_ij_in(iat)%ndij
1383 0 : paw_ij_gathered(iat)%nspden =paw_ij_in(iat)%nspden
1384 0 : paw_ij_gathered(iat)%nsppol =paw_ij_in(iat)%nsppol
1385 0 : lmn2_size=paw_ij_gathered(iat)%lmn2_size
1386 0 : cplxdij_lmn2_size=paw_ij_gathered(iat)%cplex_dij*lmn2_size
1387 0 : cplxq_lmn2_size=paw_ij_gathered(iat)%qphase*lmn2_size
1388 0 : cplxdijq_lmn2_size=cplxdij_lmn2_size*paw_ij_gathered(iat)%qphase
1389 0 : ndij=paw_ij_gathered(iat)%ndij
1390 0 : nspden=paw_ij_gathered(iat)%nspden
1391 0 : if (paw_ij_gathered(iat)%has_dij>=1) then
1392 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dij,(cplxdijq_lmn2_size,ndij))
1393 0 : if (paw_ij_in(iat)%has_dij==2) then
1394 0 : paw_ij_gathered(iat)%dij=paw_ij_in(iat)%dij
1395 : end if
1396 : end if
1397 0 : if (paw_ij_gathered(iat)%has_dij0 >=1) then
1398 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dij0,(lmn2_size))
1399 0 : if (paw_ij_in(iat)%has_dij0==2) then
1400 0 : paw_ij_gathered(iat)%dij0=paw_ij_in(iat)%dij0
1401 : end if
1402 : end if
1403 0 : if (paw_ij_gathered(iat)%has_dijexxc >=1) then
1404 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijexxc,(cplxdij_lmn2_size,ndij))
1405 0 : if (paw_ij_in(iat)%has_dijexxc==2) then
1406 0 : paw_ij_gathered(iat)%dijexxc(:,:)=paw_ij_in(iat)%dijexxc(:,:)
1407 : end if
1408 : end if
1409 0 : if (paw_ij_gathered(iat)%has_dijfock >=1) then
1410 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijfock,(cplxdij_lmn2_size,ndij))
1411 0 : if (paw_ij_in(iat)%has_dijfock==2) then
1412 0 : paw_ij_gathered(iat)%dijfock(:,:)=paw_ij_in(iat)%dijfock(:,:)
1413 : end if
1414 : end if
1415 0 : if (paw_ij_gathered(iat)%has_dijfr >=1) then
1416 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijfr,(cplxdijq_lmn2_size,ndij))
1417 0 : if (paw_ij_in(iat)%has_dijfr==2) then
1418 0 : paw_ij_gathered(iat)%dijfr(:,:)=paw_ij_in(iat)%dijfr(:,:)
1419 : end if
1420 : end if
1421 0 : if (paw_ij_gathered(iat)%has_dijhartree >=1) then
1422 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijhartree,(cplxq_lmn2_size))
1423 0 : if (paw_ij_in(iat)%has_dijhartree==2) then
1424 0 : paw_ij_gathered(iat)%dijhartree(:)=paw_ij_in(iat)%dijhartree(:)
1425 : end if
1426 : end if
1427 0 : if (paw_ij_gathered(iat)%has_dijhat >=1) then
1428 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijhat,(cplxdijq_lmn2_size,ndij))
1429 0 : if (paw_ij_in(iat)%has_dijhat==2) then
1430 0 : paw_ij_gathered(iat)%dijhat(:,:)=paw_ij_in(iat)%dijhat(:,:)
1431 : end if
1432 : end if
1433 0 : if (paw_ij_gathered(iat)%has_dijnd >=1) then
1434 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijnd,(cplxdij_lmn2_size,ndij))
1435 0 : if (paw_ij_in(iat)%has_dijnd==2) then
1436 0 : paw_ij_gathered(iat)%dijnd(:,:)=paw_ij_in(iat)%dijnd(:,:)
1437 : end if
1438 : end if
1439 0 : if (paw_ij_gathered(iat)%has_dijU >=1) then
1440 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijU,(cplxdijq_lmn2_size,ndij))
1441 0 : if (paw_ij_in(iat)%has_dijU==2) then
1442 0 : paw_ij_gathered(iat)%dijU(:,:)=paw_ij_in(iat)%dijU(:,:)
1443 : end if
1444 : end if
1445 0 : if (paw_ij_gathered(iat)%has_dijso >=1) then
1446 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijso,(cplxdijq_lmn2_size,ndij))
1447 0 : if (paw_ij_in(iat)%has_dijso==2) then
1448 0 : paw_ij_gathered(iat)%dijso(:,:)=paw_ij_in(iat)%dijso(:,:)
1449 : end if
1450 : end if
1451 0 : if (paw_ij_gathered(iat)%has_dijxc >=1) then
1452 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijxc,(cplxdijq_lmn2_size,ndij))
1453 0 : if (paw_ij_in(iat)%has_dijxc==2) then
1454 0 : paw_ij_gathered(iat)%dijxc(:,:)=paw_ij_in(iat)%dijxc(:,:)
1455 : end if
1456 : end if
1457 0 : if (paw_ij_gathered(iat)%has_dijxc_hat >=1) then
1458 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijxc_hat,(cplxdij_lmn2_size,ndij))
1459 0 : if (paw_ij_in(iat)%has_dijxc_hat==2) then
1460 0 : paw_ij_gathered(iat)%dijxc_hat(:,:)=paw_ij_in(iat)%dijxc_hat(:,:)
1461 : end if
1462 : end if
1463 0 : if (paw_ij_gathered(iat)%has_dijxc_val >=1) then
1464 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijxc_val,(cplxdij_lmn2_size,ndij))
1465 0 : if (paw_ij_in(iat)%has_dijxc_val==2) then
1466 0 : paw_ij_gathered(iat)%dijxc_val(:,:)=paw_ij_in(iat)%dijxc_val(:,:)
1467 : end if
1468 : end if
1469 0 : if (paw_ij_gathered(iat)%has_pawu_occ >=1) then
1470 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%nocctot,(ndij))
1471 0 : if (paw_ij_gathered(iat)%has_pawu_occ==2) then
1472 0 : paw_ij_gathered(iat)%nocctot(:)=paw_ij_in(iat)%nocctot(:)
1473 0 : if (allocated(paw_ij_in(iat)%noccmmp)) then
1474 0 : sz1=size(paw_ij_in(iat)%noccmmp,1);sz2=size(paw_ij_in(iat)%noccmmp,2)
1475 0 : sz3=size(paw_ij_in(iat)%noccmmp,3);sz4=size(paw_ij_in(iat)%noccmmp,4)
1476 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%noccmmp,(sz1,sz2,sz3,sz4))
1477 0 : paw_ij_gathered(iat)%noccmmp(:,:,:,:)=paw_ij_in(iat)%noccmmp(:,:,:,:)
1478 : end if
1479 : end if
1480 : end if
1481 0 : if (paw_ij_in(iat)%has_exexch_pot >=1) then
1482 0 : sz1=size(paw_ij_in(iat)%vpawx,1);sz2=size(paw_ij_in(iat)%vpawx,2)
1483 0 : sz3=size(paw_ij_in(iat)%vpawx,3)
1484 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%vpawx,(sz1,sz2,sz3))
1485 0 : if (paw_ij_in(iat)%has_exexch_pot==2) then
1486 0 : paw_ij_gathered(iat)%vpawx(:,:,:)=paw_ij_in(iat)%vpawx(:,:,:)
1487 : end if
1488 : end if
1489 : end do ! iat
1490 : end if
1491 0 : return
1492 : end if !nproc_atom =1
1493 :
1494 : !Test on sizes
1495 442 : npaw_ij_in_sum=npaw_ij_in
1496 :
1497 442 : call xmpi_sum(npaw_ij_in_sum,comm_atom,ierr)
1498 442 : if (master==-1) then
1499 0 : if (npaw_ij_out/=npaw_ij_in_sum) then
1500 0 : msg='Wrong sizes sum[npaw_ij_ij]/=npaw_ij_out !'
1501 0 : LIBPAW_BUG(msg)
1502 : end if
1503 : else
1504 442 : if (me_atom==master.and.npaw_ij_out/=npaw_ij_in_sum) then
1505 0 : msg='(2) paw_ij_gathered wrongly allocated !'
1506 0 : LIBPAW_BUG(msg)
1507 : end if
1508 : end if
1509 :
1510 : !Retrieve table of atoms
1511 442 : paral_atom=.true.;nullify(my_atmtab)
1512 442 : call get_my_atmtab(comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,npaw_ij_in_sum)
1513 :
1514 : !Compute sizes of buffers
1515 442 : buf_int_size=0;buf_dp_size=0
1516 822 : do ij=1,npaw_ij_in
1517 380 : lmn2_size=paw_ij_in(ij)%lmn2_size
1518 380 : cplxdij_lmn2_size=paw_ij_in(ij)%cplex_dij*lmn2_size
1519 380 : cplxq_lmn2_size=paw_ij_in(ij)%qphase*lmn2_size
1520 380 : cplxdijq_lmn2_size=cplxdij_lmn2_size*paw_ij_in(ij)%qphase
1521 380 : ndij=paw_ij_in(ij)%ndij
1522 380 : buf_int_size=buf_int_size+24
1523 380 : if (paw_ij_in(ij)%has_dij==2) then
1524 380 : buf_dp_size=buf_dp_size +cplxdijq_lmn2_size*ndij
1525 : end if
1526 380 : if (paw_ij_in(ij)%has_dij0==2) then
1527 0 : buf_dp_size=buf_dp_size +lmn2_size
1528 : end if
1529 380 : if (paw_ij_in(ij)%has_dijexxc==2) then
1530 0 : buf_dp_size=buf_dp_size +cplxdij_lmn2_size*ndij
1531 : end if
1532 380 : if (paw_ij_in(ij)%has_dijfock==2) then
1533 0 : buf_dp_size=buf_dp_size +cplxdij_lmn2_size*ndij
1534 : end if
1535 380 : if (paw_ij_in(ij)%has_dijfr==2) then
1536 0 : buf_dp_size=buf_dp_size +cplxdijq_lmn2_size*ndij
1537 : end if
1538 380 : if (paw_ij_in(ij)%has_dijhartree==2) then
1539 380 : buf_dp_size=buf_dp_size +cplxq_lmn2_size
1540 : end if
1541 380 : if (paw_ij_in(ij)%has_dijhat==2) then
1542 0 : buf_dp_size=buf_dp_size +cplxdijq_lmn2_size*ndij
1543 : end if
1544 380 : if (paw_ij_in(ij)%has_dijnd==2) then
1545 0 : buf_dp_size=buf_dp_size +cplxdij_lmn2_size*ndij
1546 : end if
1547 380 : if (paw_ij_in(ij)%has_dijso==2) then
1548 28 : buf_dp_size=buf_dp_size +cplxdijq_lmn2_size*ndij
1549 : end if
1550 380 : if (paw_ij_in(ij)%has_dijU==2) then
1551 0 : buf_dp_size=buf_dp_size +cplxdijq_lmn2_size*ndij
1552 : end if
1553 380 : if (paw_ij_in(ij)%has_dijxc==2) then
1554 0 : buf_dp_size=buf_dp_size +cplxdijq_lmn2_size*ndij
1555 : end if
1556 380 : if (paw_ij_in(ij)%has_dijxc_hat==2) then
1557 0 : buf_dp_size=buf_dp_size +cplxdij_lmn2_size*ndij
1558 : end if
1559 380 : if (paw_ij_in(ij)%has_dijxc_val==2) then
1560 0 : buf_dp_size=buf_dp_size +cplxdij_lmn2_size*ndij
1561 : end if
1562 380 : if (paw_ij_in(ij)%has_pawu_occ>=1) then
1563 3 : buf_int_size=buf_int_size+4
1564 : buf_dp_size=buf_dp_size &
1565 : & +size(paw_ij_in(ij)%nocctot) &
1566 15 : & +size(paw_ij_in(ij)%noccmmp)
1567 : end if
1568 822 : if (paw_ij_in(ij)%has_exexch_pot>=1) then
1569 0 : buf_int_size=buf_int_size+3
1570 0 : buf_dp_size=buf_dp_size +size(paw_ij_in(ij)%vpawx)
1571 : end if
1572 : end do
1573 :
1574 : !Fill input buffers
1575 1326 : LIBPAW_ALLOCATE(buf_int,(buf_int_size))
1576 1326 : LIBPAW_ALLOCATE(buf_dp ,(buf_dp_size))
1577 442 : indx_int=1;indx_dp=1
1578 822 : do ij=1,npaw_ij_in
1579 380 : nspden=paw_ij_in(ij)%nspden
1580 380 : buf_int(indx_int)=my_atmtab(ij) ;indx_int=indx_int+1
1581 380 : buf_int(indx_int)=paw_ij_in(ij)%cplex_dij ;indx_int=indx_int+1
1582 380 : buf_int(indx_int)=paw_ij_in(ij)%qphase ;indx_int=indx_int+1
1583 380 : buf_int(indx_int)=paw_ij_in(ij)%itypat ;indx_int=indx_int+1
1584 380 : buf_int(indx_int)=paw_ij_in(ij)%nspden ;indx_int=indx_int+1
1585 380 : buf_int(indx_int)=paw_ij_in(ij)%nsppol ;indx_int=indx_int+1
1586 380 : buf_int(indx_int)=paw_ij_in(ij)%lmn_size ;indx_int=indx_int+1
1587 380 : buf_int(indx_int)=paw_ij_in(ij)%lmn2_size ;indx_int=indx_int+1
1588 380 : buf_int(indx_int)=paw_ij_in(ij)%ndij ;indx_int=indx_int+1
1589 380 : buf_int(indx_int)=paw_ij_in(ij)%has_dij ;indx_int=indx_int+1
1590 380 : buf_int(indx_int)=paw_ij_in(ij)%has_dij0 ;indx_int=indx_int+1
1591 380 : buf_int(indx_int)=paw_ij_in(ij)%has_dijexxc ;indx_int=indx_int+1
1592 380 : buf_int(indx_int)=paw_ij_in(ij)%has_dijfock ;indx_int=indx_int+1
1593 380 : buf_int(indx_int)=paw_ij_in(ij)%has_dijfr ;indx_int=indx_int+1
1594 380 : buf_int(indx_int)=paw_ij_in(ij)%has_dijhartree ;indx_int=indx_int+1
1595 380 : buf_int(indx_int)=paw_ij_in(ij)%has_dijhat ;indx_int=indx_int+1
1596 380 : buf_int(indx_int)=paw_ij_in(ij)%has_dijnd ;indx_int=indx_int+1
1597 380 : buf_int(indx_int)=paw_ij_in(ij)%has_dijso ;indx_int=indx_int+1
1598 380 : buf_int(indx_int)=paw_ij_in(ij)%has_dijU ;indx_int=indx_int+1
1599 380 : buf_int(indx_int)=paw_ij_in(ij)%has_dijxc ;indx_int=indx_int+1
1600 380 : buf_int(indx_int)=paw_ij_in(ij)%has_dijxc_hat ;indx_int=indx_int+1
1601 380 : buf_int(indx_int)=paw_ij_in(ij)%has_dijxc_val ;indx_int=indx_int+1
1602 380 : buf_int(indx_int)=paw_ij_in(ij)%has_exexch_pot ;indx_int=indx_int+1
1603 380 : buf_int(indx_int)=paw_ij_in(ij)%has_pawu_occ ;indx_int=indx_int+1
1604 380 : lmn2_size=paw_ij_in(ij)%lmn2_size
1605 380 : cplxdij_lmn2_size=paw_ij_in(ij)%cplex_dij*lmn2_size
1606 380 : cplxq_lmn2_size=paw_ij_in(ij)%qphase*lmn2_size
1607 380 : cplxdijq_lmn2_size=cplxdij_lmn2_size*paw_ij_in(ij)%qphase
1608 380 : ndij=paw_ij_in(ij)%ndij
1609 380 : if (paw_ij_in(ij)%has_dij==2) then
1610 380 : ii=cplxdijq_lmn2_size*ndij
1611 760 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij_in(ij)%dij,(/ii/))
1612 380 : indx_dp=indx_dp+ii
1613 : end if
1614 380 : if (paw_ij_in(ij)%has_dij0==2) then
1615 0 : ii=lmn2_size
1616 0 : buf_dp(indx_dp:indx_dp+ii-1)=paw_ij_in(ij)%dij0(1:ii)
1617 0 : indx_dp=indx_dp+ii
1618 : end if
1619 380 : if (paw_ij_in(ij)%has_dijexxc==2) then
1620 0 : ii=cplxdij_lmn2_size*ndij
1621 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij_in(ij)%dijexxc,(/ii/))
1622 0 : indx_dp=indx_dp+ii
1623 : end if
1624 380 : if (paw_ij_in(ij)%has_dijfock==2) then
1625 0 : ii=cplxdij_lmn2_size*ndij
1626 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij_in(ij)%dijfock,(/ii/))
1627 0 : indx_dp=indx_dp+ii
1628 : end if
1629 380 : if (paw_ij_in(ij)%has_dijfr==2) then
1630 0 : ii=cplxdijq_lmn2_size*ndij
1631 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij_in(ij)%dijfr,(/ii/))
1632 0 : indx_dp=indx_dp+ii
1633 : end if
1634 380 : if (paw_ij_in(ij)%has_dijhartree==2) then
1635 380 : ii=cplxq_lmn2_size
1636 29052 : buf_dp(indx_dp:indx_dp+ii-1)=paw_ij_in(ij)%dijhartree(1:ii)
1637 380 : indx_dp=indx_dp+ii
1638 : end if
1639 380 : if (paw_ij_in(ij)%has_dijhat==2) then
1640 0 : ii=cplxdijq_lmn2_size*ndij
1641 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij_in(ij)%dijhat,(/ii/))
1642 0 : indx_dp=indx_dp+ii
1643 : end if
1644 380 : if (paw_ij_in(ij)%has_dijnd==2) then
1645 0 : ii=cplxdij_lmn2_size*ndij
1646 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij_in(ij)%dijnd,(/ii/))
1647 0 : indx_dp=indx_dp+ii
1648 : end if
1649 380 : if (paw_ij_in(ij)%has_dijso==2) then
1650 28 : ii=cplxdijq_lmn2_size*ndij
1651 56 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij_in(ij)%dijso,(/ii/))
1652 28 : indx_dp=indx_dp+ii
1653 : end if
1654 380 : if (paw_ij_in(ij)%has_dijU==2) then
1655 0 : ii=cplxdijq_lmn2_size*ndij
1656 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij_in(ij)%dijU,(/ii/))
1657 0 : indx_dp=indx_dp+ii
1658 : end if
1659 380 : if (paw_ij_in(ij)%has_dijxc==2) then
1660 0 : ii=cplxdijq_lmn2_size*ndij
1661 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij_in(ij)%dijxc,(/ii/))
1662 0 : indx_dp=indx_dp+ii
1663 : end if
1664 380 : if (paw_ij_in(ij)%has_dijxc_hat==2) then
1665 0 : ii=cplxdij_lmn2_size*ndij
1666 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij_in(ij)%dijxc_hat,(/ii/))
1667 0 : indx_dp=indx_dp+ii
1668 : end if
1669 380 : if (paw_ij_in(ij)%has_dijxc_val==2) then
1670 0 : ii=cplxdij_lmn2_size*ndij
1671 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij_in(ij)%dijxc_val,(/ii/))
1672 0 : indx_dp=indx_dp+ii
1673 : end if
1674 380 : if (paw_ij_in(ij)%has_pawu_occ>=1)then
1675 3 : buf_int(indx_int)=size(paw_ij_in(ij)%noccmmp,1) ;indx_int=indx_int+1
1676 3 : buf_int(indx_int)=size(paw_ij_in(ij)%noccmmp,2) ;indx_int=indx_int+1
1677 3 : buf_int(indx_int)=size(paw_ij_in(ij)%noccmmp,3) ;indx_int=indx_int+1
1678 3 : buf_int(indx_int)=size(paw_ij_in(ij)%noccmmp,4) ;indx_int=indx_int+1
1679 3 : nocc=paw_ij_in(ij)%ndij
1680 8 : buf_dp(indx_dp:indx_dp+nocc-1)=paw_ij_in(ij)%nocctot(1:nocc)
1681 : indx_dp=indx_dp+nocc
1682 15 : nocc=size(paw_ij_in(ij)%noccmmp)
1683 6 : buf_dp(indx_dp:indx_dp+nocc-1)=reshape(paw_ij_in(ij)%noccmmp,(/nocc/))
1684 3 : indx_dp=indx_dp+nocc
1685 : end if
1686 822 : if (paw_ij_in(ij)%has_exexch_pot>=1) then
1687 0 : sz1=size(paw_ij_in(ij)%vpawx,1);sz2=size(paw_ij_in(ij)%vpawx,2)
1688 0 : sz3=size(paw_ij_in(ij)%vpawx,3)
1689 0 : buf_int(indx_int)=sz1; indx_int=indx_int+1
1690 0 : buf_int(indx_int)=sz2; indx_int=indx_int+1
1691 0 : buf_int(indx_int)=sz3; indx_int=indx_int+1
1692 0 : ii=sz1*sz2*sz3
1693 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij_in(ij)%vpawx,(/(ii)/))
1694 0 : indx_dp=indx_dp+ii
1695 : end if
1696 : end do
1697 :
1698 : !Check
1699 442 : indx_int=indx_int-1;indx_dp=indx_dp-1
1700 442 : if ((indx_int/=buf_int_size).or.(indx_dp/=buf_dp_size)) then
1701 0 : write(msg,*) 'Wrong buffer sizes: buf_int_size=',buf_int_size, &
1702 0 : ' indx_int_size=',indx_int,' buf_dp_size=',buf_dp_size , ' indx_dp=', indx_dp
1703 0 : LIBPAW_BUG(msg)
1704 : end if
1705 :
1706 : !Communicate (1 gather for integers, 1 gather for reals)
1707 1326 : LIBPAW_ALLOCATE(count_int,(nproc_atom))
1708 884 : LIBPAW_ALLOCATE(displ_int,(nproc_atom))
1709 884 : LIBPAW_ALLOCATE(count_dp ,(nproc_atom))
1710 884 : LIBPAW_ALLOCATE(displ_dp ,(nproc_atom))
1711 1326 : LIBPAW_ALLOCATE(count_tot,(2*nproc_atom))
1712 442 : bufsz(1)=buf_int_size; bufsz(2)=buf_dp_size
1713 442 : call xmpi_allgather(bufsz,2,count_tot,comm_atom,ierr)
1714 2006 : do ij=1,nproc_atom
1715 1564 : count_int(ij)=count_tot(2*ij-1)
1716 2006 : count_dp (ij)=count_tot(2*ij)
1717 : end do
1718 442 : displ_int(1)=0;displ_dp(1)=0
1719 1564 : do ij=2,nproc_atom
1720 1122 : displ_int(ij)=displ_int(ij-1)+count_int(ij-1)
1721 1564 : displ_dp (ij)=displ_dp (ij-1)+count_dp (ij-1)
1722 : end do
1723 2006 : buf_int_size_all=sum(count_int)
1724 2006 : buf_dp_size_all =sum(count_dp)
1725 442 : LIBPAW_DEALLOCATE(count_tot)
1726 442 : if (master==-1.or.me_atom==master) then
1727 417 : LIBPAW_ALLOCATE(buf_int_all,(buf_int_size_all))
1728 417 : LIBPAW_ALLOCATE(buf_dp_all ,(buf_dp_size_all))
1729 : else
1730 303 : LIBPAW_ALLOCATE(buf_int_all,(0))
1731 303 : LIBPAW_ALLOCATE(buf_dp_all ,(0))
1732 : end if
1733 442 : if (master==-1) then
1734 0 : call xmpi_allgatherv(buf_int,buf_int_size,buf_int_all,count_int,displ_int,comm_atom,ierr)
1735 0 : call xmpi_allgatherv(buf_dp ,buf_dp_size ,buf_dp_all ,count_dp ,displ_dp ,comm_atom,ierr)
1736 : else
1737 442 : call xmpi_gatherv(buf_int,buf_int_size,buf_int_all,count_int,displ_int,master,comm_atom,ierr)
1738 442 : call xmpi_gatherv(buf_dp ,buf_dp_size ,buf_dp_all ,count_dp ,displ_dp ,master,comm_atom,ierr)
1739 : end if
1740 442 : LIBPAW_DEALLOCATE(count_int)
1741 442 : LIBPAW_DEALLOCATE(displ_int)
1742 442 : LIBPAW_DEALLOCATE(count_dp)
1743 442 : LIBPAW_DEALLOCATE(displ_dp)
1744 :
1745 : !Retrieve data from output buffer
1746 442 : if (master==-1.or.me_atom==master) then
1747 139 : indx_int=1;indx_dp=1
1748 139 : call paw_ij_free(paw_ij_gathered)
1749 139 : call paw_ij_nullify(paw_ij_gathered)
1750 519 : do ij=1,npaw_ij_out
1751 380 : iat=buf_int_all(indx_int) ;indx_int=indx_int+1
1752 380 : paw_ij_gathered(iat)%cplex_dij=buf_int_all(indx_int) ;indx_int=indx_int+1
1753 380 : paw_ij_gathered(iat)%qphase=buf_int_all(indx_int) ;indx_int=indx_int+1
1754 380 : paw_ij_gathered(iat)%itypat=buf_int_all(indx_int) ;indx_int=indx_int+1
1755 380 : paw_ij_gathered(iat)%nspden=buf_int_all(indx_int) ;indx_int=indx_int+1
1756 380 : paw_ij_gathered(iat)%nsppol=buf_int_all(indx_int) ;indx_int=indx_int+1
1757 380 : paw_ij_gathered(iat)%lmn_size=buf_int_all(indx_int) ;indx_int=indx_int+1
1758 380 : paw_ij_gathered(iat)%lmn2_size=buf_int_all(indx_int) ;indx_int=indx_int+1
1759 380 : paw_ij_gathered(iat)%ndij=buf_int_all(indx_int) ;indx_int=indx_int+1
1760 380 : paw_ij_gathered(iat)%has_dij=buf_int_all(indx_int) ;indx_int=indx_int+1
1761 380 : paw_ij_gathered(iat)%has_dij0=buf_int_all(indx_int) ;indx_int=indx_int+1
1762 380 : paw_ij_gathered(iat)%has_dijexxc=buf_int_all(indx_int) ;indx_int=indx_int+1
1763 380 : paw_ij_gathered(iat)%has_dijfock=buf_int_all(indx_int) ;indx_int=indx_int+1
1764 380 : paw_ij_gathered(iat)%has_dijfr=buf_int_all(indx_int) ;indx_int=indx_int+1
1765 380 : paw_ij_gathered(iat)%has_dijhartree=buf_int_all(indx_int) ;indx_int=indx_int+1
1766 380 : paw_ij_gathered(iat)%has_dijhat=buf_int_all(indx_int) ;indx_int=indx_int+1
1767 380 : paw_ij_gathered(iat)%has_dijnd=buf_int_all(indx_int) ;indx_int=indx_int+1
1768 380 : paw_ij_gathered(iat)%has_dijso=buf_int_all(indx_int) ;indx_int=indx_int+1
1769 380 : paw_ij_gathered(iat)%has_dijU=buf_int_all(indx_int) ;indx_int=indx_int+1
1770 380 : paw_ij_gathered(iat)%has_dijxc=buf_int_all(indx_int) ;indx_int=indx_int+1
1771 380 : paw_ij_gathered(iat)%has_dijxc_hat=buf_int_all(indx_int) ;indx_int=indx_int+1
1772 380 : paw_ij_gathered(iat)%has_dijxc_val=buf_int_all(indx_int) ;indx_int=indx_int+1
1773 380 : paw_ij_gathered(iat)%has_exexch_pot=buf_int_all(indx_int) ;indx_int=indx_int+1
1774 380 : paw_ij_gathered(iat)%has_pawu_occ=buf_int_all(indx_int) ;indx_int=indx_int+1
1775 380 : if (paw_ij_gathered(iat)%has_pawu_occ>=1) then
1776 3 : nocc1=buf_int_all(indx_int) ;indx_int=indx_int+1
1777 3 : nocc2=buf_int_all(indx_int) ;indx_int=indx_int+1
1778 3 : nocc3=buf_int_all(indx_int) ;indx_int=indx_int+1
1779 3 : nocc4=buf_int_all(indx_int) ;indx_int=indx_int+1
1780 : else
1781 : nocc1=0;nocc2=0;nocc3=0;nocc4=0
1782 : end if
1783 380 : lmn2_size=paw_ij_gathered(iat)%lmn2_size
1784 380 : cplxdij_lmn2_size=paw_ij_gathered(iat)%cplex_dij*lmn2_size
1785 380 : cplxq_lmn2_size=paw_ij_gathered(iat)%qphase*lmn2_size
1786 380 : cplxdijq_lmn2_size=cplxdij_lmn2_size*paw_ij_gathered(iat)%qphase
1787 380 : ndij=paw_ij_gathered(iat)%ndij
1788 :
1789 380 : if (paw_ij_gathered(iat)%has_dij>=1) then
1790 380 : ii=cplxdijq_lmn2_size
1791 1520 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dij,(ii,ndij))
1792 380 : if (paw_ij_gathered(iat)%has_dij==2) then
1793 : paw_ij_gathered(iat)%dij(:,:)= &
1794 49216 : & reshape(buf_dp_all(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
1795 380 : indx_dp=indx_dp+ii*ndij
1796 : end if
1797 : end if
1798 380 : if (paw_ij_gathered(iat)%has_dij0 >=1) then
1799 0 : ii=lmn2_size
1800 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dij0,(ii))
1801 0 : if (paw_ij_gathered(iat)%has_dij0==2) then
1802 0 : paw_ij_gathered(iat)%dij0(:)=buf_dp_all(indx_dp:indx_dp+ii-1)
1803 0 : indx_dp=indx_dp+ii
1804 : end if
1805 : end if
1806 380 : if (paw_ij_gathered(iat)%has_dijexxc >=1) then
1807 0 : ii=cplxdij_lmn2_size
1808 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijexxc,(ii,ndij))
1809 0 : if (paw_ij_gathered(iat)%has_dijexxc==2) then
1810 : paw_ij_gathered(iat)%dijexxc(:,:)= &
1811 0 : & reshape(buf_dp_all(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
1812 0 : indx_dp=indx_dp+ii*ndij
1813 : end if
1814 : end if
1815 380 : if (paw_ij_gathered(iat)%has_dijfock >=1) then
1816 0 : ii=cplxdij_lmn2_size
1817 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijfock,(ii,ndij))
1818 0 : if (paw_ij_gathered(iat)%has_dijfock==2) then
1819 : paw_ij_gathered(iat)%dijfock(:,:)= &
1820 0 : & reshape(buf_dp_all(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
1821 0 : indx_dp=indx_dp+ii*ndij
1822 : end if
1823 : end if
1824 380 : if (paw_ij_gathered(iat)%has_dijfr >=1) then
1825 0 : ii=cplxdijq_lmn2_size
1826 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijfr,(ii,ndij))
1827 0 : if (paw_ij_gathered(iat)%has_dijfr==2) then
1828 : paw_ij_gathered(iat)%dijfr(:,:)= &
1829 0 : & reshape(buf_dp_all(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
1830 0 : indx_dp=indx_dp+ii*ndij
1831 : end if
1832 : end if
1833 380 : if (paw_ij_gathered(iat)%has_dijhartree >=1) then
1834 380 : ii=cplxq_lmn2_size
1835 1140 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijhartree,(ii))
1836 380 : if (paw_ij_gathered(iat)%has_dijhartree==2) then
1837 29052 : paw_ij_gathered(iat)%dijhartree(:)=buf_dp_all(indx_dp:indx_dp+ii-1)
1838 380 : indx_dp=indx_dp+ii
1839 : end if
1840 : end if
1841 380 : if (paw_ij_gathered(iat)%has_dijhat >=1) then
1842 0 : ii=cplxdijq_lmn2_size
1843 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijhat,(ii,ndij))
1844 0 : if (paw_ij_gathered(iat)%has_dijhat==2) then
1845 : paw_ij_gathered(iat)%dijhat(:,:)= &
1846 0 : & reshape(buf_dp_all(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
1847 0 : indx_dp=indx_dp+ii*ndij
1848 : end if
1849 : endif
1850 380 : if (paw_ij_gathered(iat)%has_dijnd >=1) then
1851 0 : ii=cplxdij_lmn2_size
1852 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijnd,(ii,ndij))
1853 0 : if (paw_ij_gathered(iat)%has_dijnd==2) then
1854 : paw_ij_gathered(iat)%dijnd(:,:)= &
1855 0 : & reshape(buf_dp_all(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
1856 0 : indx_dp=indx_dp+ii*ndij
1857 : end if
1858 : end if
1859 380 : if (paw_ij_gathered(iat)%has_dijso >=1) then
1860 28 : ii=cplxdijq_lmn2_size
1861 112 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijso,(ii,ndij))
1862 28 : if (paw_ij_gathered(iat)%has_dijso==2) then
1863 : paw_ij_gathered(iat)%dijso(:,:)= &
1864 14740 : & reshape(buf_dp_all(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
1865 28 : indx_dp=indx_dp+ii*ndij
1866 : end if
1867 : end if
1868 380 : if (paw_ij_gathered(iat)%has_dijU >=1) then
1869 371 : ii=cplxdijq_lmn2_size
1870 1484 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijU,(ii,ndij))
1871 371 : if (paw_ij_gathered(iat)%has_dijU==2) then
1872 : paw_ij_gathered(iat)%dijU(:,:)= &
1873 0 : & reshape(buf_dp_all(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
1874 0 : indx_dp=indx_dp+ii*ndij
1875 : end if
1876 : end if
1877 380 : if (paw_ij_gathered(iat)%has_dijxc >=1) then
1878 0 : ii=cplxdijq_lmn2_size
1879 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijxc,(ii,ndij))
1880 0 : if (paw_ij_gathered(iat)%has_dijxc==2) then
1881 : paw_ij_gathered(iat)%dijxc(:,:)= &
1882 0 : & reshape(buf_dp_all(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
1883 0 : indx_dp=indx_dp+ii*ndij
1884 : end if
1885 : end if
1886 380 : if (paw_ij_gathered(iat)%has_dijxc_hat >=1) then
1887 0 : ii=cplxdij_lmn2_size
1888 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijxc_hat,(ii,ndij))
1889 0 : if (paw_ij_gathered(iat)%has_dijxc_hat==2) then
1890 : paw_ij_gathered(iat)%dijxc_hat(:,:)= &
1891 0 : & reshape(buf_dp_all(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
1892 0 : indx_dp=indx_dp+ii*ndij
1893 : end if
1894 : end if
1895 380 : if (paw_ij_gathered(iat)%has_dijxc_val >=1) then
1896 0 : ii=cplxdij_lmn2_size
1897 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%dijxc_val,(ii,ndij))
1898 0 : if (paw_ij_gathered(iat)%has_dijxc_val==2) then
1899 : paw_ij_gathered(iat)%dijxc_val(:,:)= &
1900 0 : & reshape(buf_dp_all(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
1901 0 : indx_dp=indx_dp+ii*ndij
1902 : end if
1903 : end if
1904 380 : if (paw_ij_gathered(iat)%has_pawu_occ >=1) then
1905 3 : nocc=paw_ij_gathered(iat)%ndij
1906 9 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%nocctot,(nocc))
1907 8 : paw_ij_gathered(iat)%nocctot(1:nocc)=buf_dp_all(indx_dp:indx_dp+nocc-1)
1908 3 : indx_dp=indx_dp+nocc
1909 3 : nocc=nocc1*nocc2*nocc3*nocc4
1910 18 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%noccmmp,(nocc1,nocc2,nocc3,nocc4))
1911 : paw_ij_gathered(iat)%noccmmp(1:nocc1,1:nocc2,1:nocc3,1:nocc4)= &
1912 295 : & reshape(buf_dp_all(indx_dp:indx_dp+nocc-1),(/nocc1,nocc2,nocc3,nocc4/))
1913 3 : indx_dp=indx_dp+nocc
1914 : end if
1915 519 : if (paw_ij_gathered(iat)%has_exexch_pot >=1) then
1916 0 : sz1=buf_int_all(indx_int);indx_int=indx_int+1
1917 0 : sz2=buf_int_all(indx_int);indx_int=indx_int+1
1918 0 : sz3=buf_int_all(indx_int);indx_int=indx_int+1
1919 0 : LIBPAW_ALLOCATE(paw_ij_gathered(iat)%vpawx,(sz1,sz2,sz3))
1920 0 : if (paw_ij_gathered(iat)%has_exexch_pot == 2) then
1921 : paw_ij_gathered(iat)%vpawx(:,:,:)=&
1922 0 : & reshape(buf_dp_all(indx_dp:indx_dp+sz1*sz2*sz3-1),(/sz1,sz2,sz3/))
1923 0 : indx_dp=indx_dp+sz1*sz2*sz3
1924 : end if
1925 : end if
1926 : end do
1927 139 : indx_int=indx_int-1;indx_dp=indx_dp-1
1928 139 : if ((indx_int/=buf_int_size_all).or.(indx_dp/=buf_dp_size_all)) then
1929 0 : write(msg,*) 'Wrong buffer sizes: buf_int_size_all=',buf_int_size_all, &
1930 0 : & ' indx_int=',indx_int, ' buf_dp_size_all=',buf_dp_size_all,' indx_dp=',indx_dp
1931 0 : LIBPAW_BUG(msg)
1932 : end if
1933 : end if
1934 :
1935 : !Free memory
1936 442 : call free_my_atmtab(my_atmtab,my_atmtab_allocated)
1937 442 : LIBPAW_DEALLOCATE(buf_int)
1938 442 : LIBPAW_DEALLOCATE(buf_dp)
1939 442 : LIBPAW_DEALLOCATE(buf_int_all)
1940 442 : LIBPAW_DEALLOCATE(buf_dp_all)
1941 :
1942 1326 : end subroutine paw_ij_gather
1943 : !!***
1944 :
1945 : !----------------------------------------------------------------------
1946 :
1947 : !!****f* m_paw_ij/paw_ij_redistribute
1948 : !! NAME
1949 : !! paw_ij_redistribute
1950 : !!
1951 : !! FUNCTION
1952 : !! Redistribute an array of paw_ij datastructures
1953 : !! Input paw_ij is given on a MPI communicator
1954 : !! Output paw_ij is redistributed on another MPI communicator
1955 : !!
1956 : !! INPUTS
1957 : !! mpi_comm_in= input MPI (atom) communicator
1958 : !! mpi_comm_out= output MPI (atom) communicator
1959 : !! mpi_atmtab_in= --optional-- indexes of the input paw_ij treated by current proc
1960 : !! if not present, will be calculated in the present routine
1961 : !! mpi_atmtab_out= --optional-- indexes of the output paw_ij treated by current proc
1962 : !! if not present, will be calculated in the present routine
1963 : !! natom= --optional-- total number of atoms
1964 : !! ----- Optional arguments used only for asynchronous communications -----
1965 : !! RecvAtomProc(:)= rank of processor from which I expect atom (in mpi_comm_in)
1966 : !! RecvAtomList(:)= indexes of atoms to be received by me
1967 : !! RecvAtomList(irecv) are the atoms I expect from RecvAtomProc(irecv)
1968 : !! SendAtomProc(:)= ranks of process destination of atom (in mpi_comm_in)
1969 : !! SendAtomList(:)= indexes of atoms to be sent by me
1970 : !! SendAtomList(isend) are the atoms sent to SendAtomProc(isend)
1971 : !!
1972 : !! OUTPUT
1973 : !! [paw_ij_out(:)]<type(paw_ij_type)>= --optional--
1974 : !! if present, the redistributed datastructure does not replace
1975 : !! the input one but is delivered in paw_ij_out
1976 : !! if not present, input and output datastructure are the same.
1977 : !!
1978 : !! SIDE EFFECTS
1979 : !! paw_ij(:)<type(paw_ij_type)>= input (and eventually output) paw_ij datastructures
1980 : !!
1981 : !! SOURCE
1982 :
1983 40 : subroutine paw_ij_redistribute(paw_ij,mpi_comm_in,mpi_comm_out,&
1984 40 : & natom,mpi_atmtab_in,mpi_atmtab_out,paw_ij_out,&
1985 40 : & SendAtomProc,SendAtomList,RecvAtomProc,RecvAtomList)
1986 :
1987 : !Arguments ------------------------------------
1988 : !scalars
1989 : integer,intent(in) :: mpi_comm_in,mpi_comm_out
1990 : integer,optional,intent(in) :: natom
1991 : !arrays
1992 : integer,intent(in),optional,target :: mpi_atmtab_in(:),mpi_atmtab_out(:)
1993 : type(paw_ij_type),allocatable,intent(inout) :: paw_ij(:)
1994 : type(paw_ij_type),pointer,optional :: paw_ij_out(:) !vz_i
1995 : integer,intent(in),optional :: SendAtomProc(:),SendAtomList(:),RecvAtomProc(:),RecvAtomList(:)
1996 :
1997 : !Local variables-------------------------------
1998 : !scalars
1999 : integer :: algo_option,i1,iatom,iat_in,iat_out,ierr,iircv,iisend,imsg,imsg_current
2000 : integer :: imsg1,iproc_rcv,iproc_send,ireq,me_exch,mpi_comm_exch,my_natom_in,my_natom_out,my_tag,natom_tot
2001 : integer :: nb_dp,nb_int,nb_msg,nbmsg_incoming,nbrecv,nbrecvmsg,nbsendreq,nbsent,nbsend,next,npaw_ij_sent
2002 : integer :: nproc_in,nproc_out
2003 : logical :: flag,in_place,message_yet_prepared,my_atmtab_in_allocated,my_atmtab_out_allocated,paral_atom
2004 : !arrays
2005 : integer :: buf_size(3),request1(3)
2006 40 : integer,pointer :: my_atmtab_in(:),my_atmtab_out(:)
2007 40 : integer,allocatable :: atmtab_send(:),atm_indx_in(:),atm_indx_out(:),From(:),buf_int1(:),request(:)
2008 40 : integer,allocatable,target:: buf_int(:)
2009 40 : integer,pointer :: buf_ints(:)
2010 40 : logical,allocatable :: msg_pick(:)
2011 40 : real(dp),allocatable :: buf_dp1(:)
2012 40 : real(dp),allocatable,target :: buf_dp(:)
2013 40 : real(dp),pointer :: buf_dps(:)
2014 40 : type(coeffi1_type),target,allocatable :: tab_buf_int(:),tab_buf_atom(:)
2015 40 : type(coeff1_type),target,allocatable :: tab_buf_dp(:)
2016 40 : type(paw_ij_type),allocatable :: paw_ij_all(:)
2017 40 : type(paw_ij_type),pointer :: paw_ij_out1(:)
2018 :
2019 : ! *************************************************************************
2020 :
2021 : !@Paw_ij_type
2022 :
2023 40 : in_place=(.not.present(paw_ij_out))
2024 40 : my_natom_in=size(paw_ij)
2025 :
2026 : !If not "in_place", destroy the output datastructure
2027 40 : if (.not.in_place) then
2028 0 : if (associated(paw_ij_out)) then
2029 0 : call paw_ij_free(paw_ij_out)
2030 0 : LIBPAW_DATATYPE_DEALLOCATE(paw_ij_out)
2031 : end if
2032 : end if
2033 :
2034 : !Special sequential case
2035 40 : if (mpi_comm_in==xmpi_comm_self.and.mpi_comm_out==xmpi_comm_self) then
2036 0 : if ((.not.in_place).and.(my_natom_in>0)) then
2037 0 : LIBPAW_DATATYPE_ALLOCATE(paw_ij_out,(my_natom_in))
2038 0 : call paw_ij_nullify(paw_ij_out)
2039 0 : call paw_ij_copy(paw_ij,paw_ij_out)
2040 : end if
2041 0 : return
2042 : end if
2043 :
2044 : !Get total natom
2045 40 : if (present(natom)) then
2046 40 : natom_tot=natom
2047 : else
2048 0 : natom_tot=my_natom_in
2049 0 : call xmpi_sum(natom_tot,mpi_comm_in,ierr)
2050 : end if
2051 :
2052 : !Select input distribution
2053 40 : if (present(mpi_atmtab_in)) then
2054 40 : my_atmtab_in => mpi_atmtab_in
2055 40 : my_atmtab_in_allocated=.false.
2056 : else
2057 : call get_my_atmtab(mpi_comm_in,my_atmtab_in,my_atmtab_in_allocated,&
2058 0 : & paral_atom,natom_tot,my_natom_in)
2059 : end if
2060 :
2061 : !Select output distribution
2062 40 : if (present(mpi_atmtab_out)) then
2063 40 : my_natom_out=size(mpi_atmtab_out)
2064 40 : my_atmtab_out => mpi_atmtab_out
2065 40 : my_atmtab_out_allocated=.false.
2066 : else
2067 0 : call get_my_natom(mpi_comm_out,my_natom_out,natom_tot)
2068 : call get_my_atmtab(mpi_comm_out,my_atmtab_out,my_atmtab_out_allocated,&
2069 0 : & paral_atom,natom_tot)
2070 : end if
2071 :
2072 : !Select algo according to optional input arguments
2073 40 : algo_option=1
2074 : if (present(SendAtomProc).and.present(SendAtomList).and.&
2075 40 : & present(RecvAtomProc).and.present(RecvAtomList)) algo_option=2
2076 :
2077 :
2078 : !Brute force algorithm (allgather + scatter)
2079 : !---------------------------------------------------------
2080 : if (algo_option==1) then
2081 :
2082 0 : LIBPAW_DATATYPE_ALLOCATE(paw_ij_all,(natom_tot))
2083 0 : call paw_ij_nullify(paw_ij_all)
2084 0 : call paw_ij_copy(paw_ij,paw_ij_all,comm_atom=mpi_comm_in,mpi_atmtab=my_atmtab_in)
2085 0 : if (in_place) then
2086 0 : call paw_ij_free(paw_ij)
2087 0 : LIBPAW_DATATYPE_DEALLOCATE(paw_ij)
2088 0 : LIBPAW_DATATYPE_ALLOCATE(paw_ij,(my_natom_out))
2089 0 : call paw_ij_nullify(paw_ij)
2090 0 : call paw_ij_copy(paw_ij_all,paw_ij,comm_atom=mpi_comm_out,mpi_atmtab=my_atmtab_out)
2091 : else
2092 0 : LIBPAW_DATATYPE_ALLOCATE(paw_ij_out,(my_natom_out))
2093 0 : call paw_ij_nullify(paw_ij_out)
2094 0 : call paw_ij_copy(paw_ij_all,paw_ij_out,comm_atom=mpi_comm_out,mpi_atmtab=my_atmtab_out)
2095 : end if
2096 0 : call paw_ij_free(paw_ij_all)
2097 0 : LIBPAW_DATATYPE_DEALLOCATE(paw_ij_all)
2098 :
2099 :
2100 : !Asynchronous algorithm (asynchronous communications)
2101 : !---------------------------------------------------------
2102 : else if (algo_option==2) then
2103 :
2104 40 : nbsend=size(SendAtomProc) ; nbrecv=size(RecvAtomProc)
2105 :
2106 40 : if (in_place) then
2107 40 : if (my_natom_out > 0) then
2108 112 : LIBPAW_DATATYPE_ALLOCATE(paw_ij_out1,(my_natom_out))
2109 28 : call paw_ij_nullify(paw_ij_out1)
2110 : else
2111 12 : LIBPAW_DATATYPE_ALLOCATE(paw_ij_out1,(0))
2112 : end if
2113 : else
2114 0 : LIBPAW_DATATYPE_ALLOCATE(paw_ij_out,(my_natom_out))
2115 0 : call paw_ij_nullify(paw_ij_out)
2116 0 : paw_ij_out1=>paw_ij_out
2117 : end if
2118 :
2119 40 : nproc_in=xmpi_comm_size(mpi_comm_in)
2120 40 : nproc_out=xmpi_comm_size(mpi_comm_out)
2121 40 : if (nproc_in<=nproc_out) mpi_comm_exch=mpi_comm_out
2122 40 : if (nproc_in>nproc_out) mpi_comm_exch=mpi_comm_in
2123 40 : me_exch=xmpi_comm_rank(mpi_comm_exch)
2124 :
2125 :
2126 : ! Dimension put to the maximum to send
2127 120 : LIBPAW_ALLOCATE(atmtab_send,(nbsend))
2128 120 : LIBPAW_ALLOCATE(atm_indx_in,(natom_tot))
2129 120 : atm_indx_in=-1
2130 68 : do iatom=1,my_natom_in
2131 68 : atm_indx_in(my_atmtab_in(iatom))=iatom
2132 : end do
2133 80 : LIBPAW_ALLOCATE(atm_indx_out,(natom_tot))
2134 120 : atm_indx_out=-1
2135 68 : do iatom=1,my_natom_out
2136 68 : atm_indx_out(my_atmtab_out(iatom))=iatom
2137 : end do
2138 :
2139 148 : LIBPAW_DATATYPE_ALLOCATE(tab_buf_int,(nbsend))
2140 148 : LIBPAW_DATATYPE_ALLOCATE(tab_buf_dp,(nbsend))
2141 108 : LIBPAW_DATATYPE_ALLOCATE(tab_buf_atom,(nbsend))
2142 120 : LIBPAW_ALLOCATE(request,(3*nbsend))
2143 :
2144 : ! A send buffer in an asynchrone communication couldn't be deallocate before it has been receive
2145 40 : nbsent=0 ; ireq=0 ; iisend=0 ; nbsendreq=0 ; nb_msg=0
2146 68 : do iisend=1,nbsend
2147 28 : iproc_rcv=SendAtomProc(iisend)
2148 28 : next=-1
2149 28 : if (iisend < nbsend) next=SendAtomProc(iisend+1)
2150 68 : if (iproc_rcv /= me_exch) then
2151 8 : nbsent=nbsent+1
2152 8 : atmtab_send(nbsent)=SendAtomList(iisend) ! we groups the atoms sends to the same process
2153 8 : if (iproc_rcv /= next) then
2154 8 : if (nbsent > 0 ) then
2155 : ! Check if message has been yet prepared
2156 : message_yet_prepared=.false.
2157 8 : do imsg=1,nb_msg
2158 8 : if (size(tab_buf_atom(imsg)%value) /= nbsent) then
2159 : cycle
2160 : else
2161 0 : do imsg1=1,nbsent
2162 0 : if (tab_buf_atom(imsg)%value(imsg1)/=atmtab_send(imsg1)) exit
2163 0 : message_yet_prepared=.true.
2164 0 : imsg_current=imsg
2165 : end do
2166 : end if
2167 : enddo
2168 : ! Create the message
2169 8 : if (.not.message_yet_prepared) then
2170 8 : nb_msg=nb_msg+1
2171 : call paw_ij_isendreceive_fillbuffer( &
2172 8 : & paw_ij,atmtab_send,atm_indx_in,nbsent,buf_int,nb_int,buf_dp,nb_dp)
2173 24 : LIBPAW_ALLOCATE(tab_buf_int(nb_msg)%value,(nb_int))
2174 24 : LIBPAW_ALLOCATE(tab_buf_dp(nb_msg)%value,(nb_dp))
2175 200 : tab_buf_int(nb_msg)%value(1:nb_int)=buf_int(1:nb_int)
2176 584 : tab_buf_dp(nb_msg)%value(1:nb_dp)=buf_dp(1:nb_dp)
2177 8 : LIBPAW_DEALLOCATE(buf_int)
2178 8 : LIBPAW_DEALLOCATE(buf_dp)
2179 24 : LIBPAW_ALLOCATE(tab_buf_atom(nb_msg)%value, (nbsent))
2180 16 : tab_buf_atom(nb_msg)%value(1:nbsent)=atmtab_send(1:nbsent)
2181 : imsg_current=nb_msg
2182 : end if
2183 : ! Communicate
2184 8 : buf_size(1)=size(tab_buf_int(imsg_current)%value)
2185 8 : buf_size(2)=size(tab_buf_dp(imsg_current)%value)
2186 8 : buf_size(3)=nbsent
2187 8 : buf_ints=>tab_buf_int(imsg_current)%value
2188 8 : buf_dps=>tab_buf_dp(imsg_current)%value
2189 8 : my_tag=200
2190 8 : ireq=ireq+1
2191 8 : call xmpi_isend(buf_size,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr)
2192 8 : my_tag=201
2193 8 : ireq=ireq+1
2194 8 : call xmpi_isend(buf_ints,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr)
2195 8 : my_tag=202
2196 8 : ireq=ireq+1
2197 8 : call xmpi_isend(buf_dps,iproc_rcv,my_tag,mpi_comm_exch,request(ireq),ierr)
2198 8 : nbsendreq=ireq
2199 8 : nbsent=0
2200 : end if
2201 : end if
2202 : else ! Just a renumbering, not a sending
2203 20 : iat_in=atm_indx_in(SendAtomList(iisend))
2204 20 : iat_out=atm_indx_out(my_atmtab_in(iat_in))
2205 20 : call paw_ij_copy(paw_ij(iat_in:iat_in),paw_ij_out1(iat_out:iat_out))
2206 20 : nbsent=0
2207 : end if
2208 : end do
2209 :
2210 120 : LIBPAW_ALLOCATE(From,(nbrecv))
2211 68 : From(:)=-1 ; nbrecvmsg=0
2212 68 : do iircv=1,nbrecv
2213 28 : iproc_send=RecvAtomProc(iircv) !receive from (RcvAtomProc is sorted by growing process)
2214 28 : next=-1
2215 28 : if (iircv < nbrecv) next=RecvAtomProc(iircv+1)
2216 68 : if (iproc_send /= me_exch .and. iproc_send/=next) then
2217 8 : nbrecvmsg=nbrecvmsg+1
2218 8 : From(nbrecvmsg)=iproc_send
2219 : end if
2220 : end do
2221 :
2222 120 : LIBPAW_ALLOCATE(msg_pick,(nbrecvmsg))
2223 48 : msg_pick=.false.
2224 : nbmsg_incoming=nbrecvmsg
2225 53 : do while (nbmsg_incoming > 0)
2226 66 : do i1=1,nbrecvmsg
2227 26 : if (.not.msg_pick(i1)) then
2228 13 : iproc_send=From(i1)
2229 : flag=.false.
2230 13 : my_tag=200
2231 13 : call xmpi_iprobe(iproc_send,my_tag,mpi_comm_exch,flag,ierr)
2232 13 : if (flag) then
2233 8 : msg_pick(i1)=.true.
2234 8 : call xmpi_irecv(buf_size,iproc_send,my_tag,mpi_comm_exch,request1(1),ierr)
2235 8 : call xmpi_wait(request1(1),ierr)
2236 8 : nb_int=buf_size(1)
2237 8 : nb_dp=buf_size(2)
2238 8 : npaw_ij_sent=buf_size(3)
2239 24 : LIBPAW_ALLOCATE(buf_int1,(nb_int))
2240 24 : LIBPAW_ALLOCATE(buf_dp1,(nb_dp))
2241 8 : my_tag=201
2242 8 : call xmpi_irecv(buf_int1,iproc_send,my_tag,mpi_comm_exch,request1(2),ierr)
2243 8 : my_tag=202
2244 8 : call xmpi_irecv(buf_dp1,iproc_send,my_tag,mpi_comm_exch,request1(3),ierr)
2245 8 : call xmpi_waitall(request1(2:3),ierr)
2246 8 : call paw_ij_isendreceive_getbuffer(paw_ij_out1,npaw_ij_sent,atm_indx_out,buf_int1,buf_dp1)
2247 8 : nbmsg_incoming=nbmsg_incoming-1
2248 8 : LIBPAW_DEALLOCATE(buf_int1)
2249 24 : LIBPAW_DEALLOCATE(buf_dp1)
2250 : end if
2251 : end if
2252 : end do
2253 : end do
2254 40 : LIBPAW_DEALLOCATE(msg_pick)
2255 :
2256 40 : if (in_place) then
2257 40 : call paw_ij_free(paw_ij)
2258 68 : LIBPAW_DATATYPE_DEALLOCATE(paw_ij)
2259 148 : LIBPAW_DATATYPE_ALLOCATE(paw_ij,(my_natom_out))
2260 40 : call paw_ij_copy(paw_ij_out1,paw_ij)
2261 40 : call paw_ij_free(paw_ij_out1)
2262 40 : LIBPAW_DATATYPE_DEALLOCATE(paw_ij_out1)
2263 : end if
2264 :
2265 : ! Wait for deallocating arrays that all sending operations has been realized
2266 40 : if (nbsendreq > 0) then
2267 8 : call xmpi_waitall(request(1:nbsendreq),ierr)
2268 : end if
2269 :
2270 : ! Deallocate buffers
2271 48 : do i1=1,nb_msg
2272 8 : LIBPAW_DEALLOCATE(tab_buf_int(i1)%value)
2273 8 : LIBPAW_DEALLOCATE(tab_buf_dp(i1)%value)
2274 48 : LIBPAW_DEALLOCATE(tab_buf_atom(i1)%value)
2275 : end do
2276 68 : LIBPAW_DATATYPE_DEALLOCATE(tab_buf_int)
2277 68 : LIBPAW_DATATYPE_DEALLOCATE(tab_buf_dp)
2278 68 : LIBPAW_DATATYPE_DEALLOCATE(tab_buf_atom)
2279 40 : LIBPAW_DEALLOCATE(From)
2280 40 : LIBPAW_DEALLOCATE(request)
2281 40 : LIBPAW_DEALLOCATE(atmtab_send)
2282 40 : LIBPAW_DEALLOCATE(atm_indx_in)
2283 40 : LIBPAW_DEALLOCATE(atm_indx_out)
2284 :
2285 : end if !algo_option
2286 :
2287 : !Eventually release temporary pointers
2288 40 : call free_my_atmtab(my_atmtab_in,my_atmtab_in_allocated)
2289 40 : call free_my_atmtab(my_atmtab_out,my_atmtab_out_allocated)
2290 :
2291 80 : end subroutine paw_ij_redistribute
2292 : !!***
2293 :
2294 : !----------------------------------------------------------------------
2295 :
2296 : !!****f* m_paw_ij/paw_ij_reset_flags
2297 : !! NAME
2298 : !! paw_ij_reset_flags
2299 : !!
2300 : !! FUNCTION
2301 : !! Set all paw_ij flags to 1 (force the recomputation of all arrays)
2302 : !!
2303 : !! SIDE EFFECTS
2304 : !! Paw_ij<type(paw_ij_type)>=paw_ij structure
2305 : !!
2306 : !! SOURCE
2307 :
2308 20964 : subroutine paw_ij_reset_flags(Paw_ij,all,dijhartree,self_consistent)
2309 :
2310 : !Arguments ------------------------------------
2311 : !scalars
2312 : logical,optional,intent(in) :: all,dijhartree,self_consistent
2313 : !arrays
2314 : type(Paw_ij_type),intent(inout) :: Paw_ij(:)
2315 :
2316 : !Local variables-------------------------------
2317 : integer :: iat,natom
2318 : logical :: all_,dijhartree_,self_consistent_
2319 :
2320 : ! *************************************************************************
2321 :
2322 : !@Paw_ij_type
2323 :
2324 20964 : natom=SIZE(Paw_ij);if (natom==0) return
2325 19196 : all_=.true.;if (present(all)) all_=all
2326 19196 : dijhartree_=.false.;if (present(dijhartree)) dijhartree_=dijhartree
2327 19196 : self_consistent_=.false.;if (present(self_consistent)) self_consistent_=self_consistent
2328 :
2329 19196 : if (dijhartree_) then
2330 1017 : do iat=1,natom
2331 1017 : if (Paw_ij(iat)%has_dijhartree>0) Paw_ij(iat)%has_dijhartree=1
2332 : end do
2333 :
2334 18851 : else if (self_consistent_) then
2335 57966 : do iat=1,natom
2336 41095 : if (Paw_ij(iat)%has_dij >0) Paw_ij(iat)%has_dij =1
2337 41095 : if (Paw_ij(iat)%has_dijexxc >0) Paw_ij(iat)%has_dijexxc =1
2338 41095 : if (Paw_ij(iat)%has_dijfock >0) Paw_ij(iat)%has_dijfock =1
2339 41095 : if (Paw_ij(iat)%has_dijhartree>0) Paw_ij(iat)%has_dijhartree=1
2340 41095 : if (Paw_ij(iat)%has_dijhat >0) Paw_ij(iat)%has_dijhat =1
2341 41095 : if (Paw_ij(iat)%has_dijnd >0) Paw_ij(iat)%has_dijnd =1
2342 41095 : if (Paw_ij(iat)%has_dijso >0) Paw_ij(iat)%has_dijso =1
2343 41095 : if (Paw_ij(iat)%has_dijU >0) Paw_ij(iat)%has_dijU =1
2344 41095 : if (Paw_ij(iat)%has_dijxc >0) Paw_ij(iat)%has_dijxc =1
2345 41095 : if (Paw_ij(iat)%has_dijxc_hat >0) Paw_ij(iat)%has_dijxc_hat =1
2346 41095 : if (Paw_ij(iat)%has_dijxc_val >0) Paw_ij(iat)%has_dijxc_val =1
2347 41095 : if (Paw_ij(iat)%has_exexch_pot>0) Paw_ij(iat)%has_exexch_pot=1
2348 57966 : if (Paw_ij(iat)%has_pawu_occ >0) Paw_ij(iat)%has_pawu_occ =1
2349 : end do
2350 :
2351 1980 : else if (all_) then
2352 6048 : do iat=1,natom
2353 4068 : if (Paw_ij(iat)%has_dij >0) Paw_ij(iat)%has_dij =1
2354 4068 : if (Paw_ij(iat)%has_dij0 >0) Paw_ij(iat)%has_dij0 =1
2355 4068 : if (Paw_ij(iat)%has_dijexxc >0) Paw_ij(iat)%has_dijexxc =1
2356 4068 : if (Paw_ij(iat)%has_dijfock >0) Paw_ij(iat)%has_dijfock =1
2357 4068 : if (Paw_ij(iat)%has_dijfr >0) Paw_ij(iat)%has_dijfr =1
2358 4068 : if (Paw_ij(iat)%has_dijhartree>0) Paw_ij(iat)%has_dijhartree=1
2359 4068 : if (Paw_ij(iat)%has_dijhat >0) Paw_ij(iat)%has_dijhat =1
2360 4068 : if (Paw_ij(iat)%has_dijnd >0) Paw_ij(iat)%has_dijnd =1
2361 4068 : if (Paw_ij(iat)%has_dijso >0) Paw_ij(iat)%has_dijso =1
2362 4068 : if (Paw_ij(iat)%has_dijU >0) Paw_ij(iat)%has_dijU =1
2363 4068 : if (Paw_ij(iat)%has_dijxc >0) Paw_ij(iat)%has_dijxc =1
2364 4068 : if (Paw_ij(iat)%has_dijxc_hat >0) Paw_ij(iat)%has_dijxc_hat =1
2365 4068 : if (Paw_ij(iat)%has_dijxc_val >0) Paw_ij(iat)%has_dijxc_val =1
2366 4068 : if (Paw_ij(iat)%has_exexch_pot>0) Paw_ij(iat)%has_exexch_pot=1
2367 6048 : if (Paw_ij(iat)%has_pawu_occ >0) Paw_ij(iat)%has_pawu_occ =1
2368 : end do
2369 : end if
2370 :
2371 : end subroutine paw_ij_reset_flags
2372 : !!***
2373 :
2374 : !----------------------------------------------------------------------
2375 :
2376 : !!****f* m_paw_ij/paw_ij_isendreceive_getbuffer
2377 : !! NAME
2378 : !! paw_ij_isendreceive_getbuffer
2379 : !!
2380 : !! FUNCTION
2381 : !! Fill a paw_ij structure with the buffers received in a receive operation
2382 : !! This buffer should have been first extracted by a call to paw_ij_isendreceive_fillbuffer
2383 : !!
2384 : !! INPUTS
2385 : !! atm_indx_recv(1:total number of atoms)= array for receive operation
2386 : !! Given an index of atom in global numbering, give its index
2387 : !! in the table of atoms treated by current processor
2388 : !! or -1 if the atoms is not treated by current processor
2389 : !! buf_int= buffer of receive integers
2390 : !! buf_dp= buffer of receive double precision numbers
2391 : !! npaw_ij_send= number of sent atoms
2392 : !!
2393 : !! OUTPUT
2394 : !! paw_ij= output datastructure filled with buffers receive in a receive operation
2395 : !!
2396 : !! SOURCE
2397 :
2398 8 : subroutine paw_ij_isendreceive_getbuffer(paw_ij,npaw_ij_send,atm_indx_recv,buf_int,buf_dp)
2399 :
2400 : !Arguments ------------------------------------
2401 : !scalars
2402 : integer,intent(in) :: npaw_ij_send
2403 : !arrays
2404 : integer,intent(in):: atm_indx_recv(:),buf_int(:)
2405 : real(dp),intent(in):: buf_dp(:)
2406 : type(paw_ij_type),target,intent(inout) :: paw_ij(:)
2407 :
2408 : !Local variables-------------------------------
2409 : !scalars
2410 : integer :: buf_dp_size,buf_int_size
2411 : integer :: cplxq_lmn2_size,cplxdij_lmn2_size,cplxdijq_lmn2_size
2412 : integer :: iat,iatom_tot,ii,ij,indx_dp,indx_int,ndij,nocc,nocc1,nocc2,nocc3,nocc4
2413 : integer :: lmn2_size,sz1,sz2,sz3
2414 : character(len=500) :: msg
2415 : type(Paw_ij_type),pointer :: paw_ij1
2416 : !arrays
2417 :
2418 : ! *********************************************************************
2419 :
2420 8 : buf_int_size=size(buf_int)
2421 8 : buf_dp_size=size(buf_dp)
2422 8 : indx_int=1;indx_dp=1
2423 :
2424 16 : do ij=1,npaw_ij_send
2425 8 : iatom_tot=buf_int(indx_int) ;indx_int=indx_int+1
2426 8 : iat= atm_indx_recv(iatom_tot)
2427 8 : paw_ij1=>paw_ij(iat)
2428 8 : paw_ij1%cplex_dij=buf_int(indx_int) ;indx_int=indx_int+1
2429 8 : paw_ij1%qphase=buf_int(indx_int) ;indx_int=indx_int+1
2430 8 : paw_ij1%itypat=buf_int(indx_int) ;indx_int=indx_int+1
2431 8 : paw_ij1%nspden=buf_int(indx_int) ;indx_int=indx_int+1
2432 8 : paw_ij1%nsppol=buf_int(indx_int) ;indx_int=indx_int+1
2433 8 : paw_ij1%lmn_size=buf_int(indx_int) ;indx_int=indx_int+1
2434 8 : paw_ij1%lmn2_size=buf_int(indx_int) ;indx_int=indx_int+1
2435 8 : paw_ij1%ndij=buf_int(indx_int) ;indx_int=indx_int+1
2436 8 : paw_ij1%has_dij=buf_int(indx_int) ;indx_int=indx_int+1
2437 8 : paw_ij1%has_dij0=buf_int(indx_int) ;indx_int=indx_int+1
2438 8 : paw_ij1%has_dijexxc=buf_int(indx_int) ;indx_int=indx_int+1
2439 8 : paw_ij1%has_dijfock=buf_int(indx_int) ;indx_int=indx_int+1
2440 8 : paw_ij1%has_dijfr=buf_int(indx_int) ;indx_int=indx_int+1
2441 8 : paw_ij1%has_dijhartree=buf_int(indx_int) ;indx_int=indx_int+1
2442 8 : paw_ij1%has_dijhat=buf_int(indx_int) ;indx_int=indx_int+1
2443 8 : paw_ij1%has_dijnd=buf_int(indx_int) ;indx_int=indx_int+1
2444 8 : paw_ij1%has_dijso=buf_int(indx_int) ;indx_int=indx_int+1
2445 8 : paw_ij1%has_dijU=buf_int(indx_int) ;indx_int=indx_int+1
2446 8 : paw_ij1%has_dijxc=buf_int(indx_int) ;indx_int=indx_int+1
2447 8 : paw_ij1%has_dijxc_hat=buf_int(indx_int) ;indx_int=indx_int+1
2448 8 : paw_ij1%has_dijxc_val=buf_int(indx_int) ;indx_int=indx_int+1
2449 8 : paw_ij1%has_exexch_pot=buf_int(indx_int) ;indx_int=indx_int+1
2450 8 : paw_ij1%has_pawu_occ=buf_int(indx_int) ;indx_int=indx_int+1
2451 8 : if (paw_ij1%has_pawu_occ>=1) then
2452 0 : nocc1=buf_int(indx_int) ;indx_int=indx_int+1
2453 0 : nocc2=buf_int(indx_int) ;indx_int=indx_int+1
2454 0 : nocc3=buf_int(indx_int) ;indx_int=indx_int+1
2455 0 : nocc4=buf_int(indx_int) ;indx_int=indx_int+1
2456 : else
2457 : nocc1=0;nocc2=0;nocc3=0;nocc4=0
2458 : end if
2459 8 : lmn2_size=paw_ij1%lmn2_size
2460 8 : cplxdij_lmn2_size=paw_ij1%cplex_dij*lmn2_size
2461 8 : cplxq_lmn2_size=paw_ij1%qphase*lmn2_size
2462 8 : cplxdijq_lmn2_size=cplxq_lmn2_size*paw_ij1%qphase
2463 8 : ndij=paw_ij1%ndij
2464 :
2465 8 : if (paw_ij1%has_dij>=1) then
2466 8 : ii=cplxdijq_lmn2_size
2467 32 : LIBPAW_ALLOCATE(paw_ij1%dij,(ii,ndij))
2468 8 : if (paw_ij1%has_dij==2) then
2469 : paw_ij1%dij(:,:)= &
2470 320 : & reshape(buf_dp(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
2471 8 : indx_dp=indx_dp+ii*ndij
2472 : end if
2473 : end if
2474 8 : if (paw_ij1%has_dij0 >=1) then
2475 0 : ii=lmn2_size
2476 0 : LIBPAW_ALLOCATE(paw_ij1%dij0,(ii))
2477 0 : if (paw_ij1%has_dij0==2) then
2478 0 : paw_ij1%dij0(:)=buf_dp(indx_dp:indx_dp+ii-1)
2479 : indx_dp=indx_dp+ii
2480 : end if
2481 : end if
2482 8 : if (paw_ij1%has_dijexxc >=1) then
2483 0 : ii=cplxdij_lmn2_size
2484 0 : LIBPAW_ALLOCATE(paw_ij1%dijexxc,(ii,ndij))
2485 0 : if (paw_ij1%has_dijexxc==2) then
2486 : paw_ij1%dijexxc(:,:)= &
2487 0 : & reshape(buf_dp(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
2488 0 : indx_dp=indx_dp+ii*ndij
2489 : end if
2490 : end if
2491 8 : if (paw_ij1%has_dijfock >=1) then
2492 0 : ii=cplxdij_lmn2_size
2493 0 : LIBPAW_ALLOCATE(paw_ij1%dijfock,(ii,ndij))
2494 0 : if (paw_ij1%has_dijfock==2) then
2495 : paw_ij1%dijfock(:,:)= &
2496 0 : & reshape(buf_dp(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
2497 0 : indx_dp=indx_dp+ii*ndij
2498 : end if
2499 : end if
2500 8 : if (paw_ij1%has_dijfr >=1) then
2501 0 : ii=cplxdijq_lmn2_size
2502 0 : LIBPAW_ALLOCATE(paw_ij1%dijfr,(ii,ndij))
2503 0 : if (paw_ij1%has_dijfr==2) then
2504 : paw_ij1%dijfr(:,:)= &
2505 0 : & reshape(buf_dp(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
2506 0 : indx_dp=indx_dp+ii*ndij
2507 : end if
2508 : end if
2509 8 : if (paw_ij1%has_dijhartree >=1) then
2510 8 : ii=cplxq_lmn2_size
2511 24 : LIBPAW_ALLOCATE(paw_ij1%dijhartree,(ii))
2512 8 : if (paw_ij1%has_dijhartree==2) then
2513 296 : paw_ij1%dijhartree(:)=buf_dp(indx_dp:indx_dp+ii-1)
2514 : indx_dp=indx_dp+ii
2515 : end if
2516 : end if
2517 8 : if (paw_ij1%has_dijhat >=1) then
2518 0 : ii=cplxdijq_lmn2_size
2519 0 : LIBPAW_ALLOCATE(paw_ij1%dijhat,(ii,ndij))
2520 0 : if (paw_ij1%has_dijhat==2) then
2521 : paw_ij1%dijhat(:,:)= &
2522 0 : & reshape(buf_dp(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
2523 0 : indx_dp=indx_dp+ii*ndij
2524 : end if
2525 : end if
2526 8 : if (paw_ij1%has_dijnd >=1) then
2527 0 : ii=cplxdij_lmn2_size
2528 0 : LIBPAW_ALLOCATE(paw_ij1%dijnd,(ii,ndij))
2529 0 : if (paw_ij1%has_dijnd==2) then
2530 : paw_ij1%dijnd(:,:)= &
2531 0 : & reshape(buf_dp(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
2532 0 : indx_dp=indx_dp+ii*ndij
2533 : end if
2534 : end if
2535 8 : if (paw_ij1%has_dijso >=1) then
2536 0 : ii=cplxdijq_lmn2_size
2537 0 : LIBPAW_ALLOCATE(paw_ij1%dijso,(ii,ndij))
2538 0 : if (paw_ij1%has_dijso==2) then
2539 : paw_ij1%dijso(:,:)= &
2540 0 : & reshape(buf_dp(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
2541 0 : indx_dp=indx_dp+ii*ndij
2542 : end if
2543 : end if
2544 8 : if (paw_ij1%has_dijU >=1) then
2545 0 : ii=cplxdijq_lmn2_size
2546 0 : LIBPAW_ALLOCATE(paw_ij1%dijU,(ii,ndij))
2547 0 : if (paw_ij1%has_dijU==2) then
2548 : paw_ij1%dijU(:,:)= &
2549 0 : & reshape(buf_dp(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
2550 0 : indx_dp=indx_dp+ii*ndij
2551 : end if
2552 : end if
2553 8 : if (paw_ij1%has_dijxc >=1) then
2554 0 : ii=cplxdijq_lmn2_size
2555 0 : LIBPAW_ALLOCATE(paw_ij1%dijxc,(ii,ndij))
2556 0 : if (paw_ij1%has_dijxc==2) then
2557 : paw_ij1%dijxc(:,:)= &
2558 0 : & reshape(buf_dp(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
2559 0 : indx_dp=indx_dp+ii*ndij
2560 : end if
2561 : end if
2562 8 : if (paw_ij1%has_dijxc_hat >=1) then
2563 0 : ii=cplxdij_lmn2_size
2564 0 : LIBPAW_ALLOCATE(paw_ij1%dijxc_hat,(ii,ndij))
2565 0 : if (paw_ij1%has_dijxc_hat==2) then
2566 : paw_ij1%dijxc_hat(:,:)= &
2567 0 : & reshape(buf_dp(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
2568 0 : indx_dp=indx_dp+ii*ndij
2569 : end if
2570 : end if
2571 8 : if (paw_ij1%has_dijxc_val >=1) then
2572 0 : ii=cplxdij_lmn2_size
2573 0 : LIBPAW_ALLOCATE(paw_ij1%dijxc_val,(ii,ndij))
2574 0 : if (paw_ij1%has_dijxc_val==2) then
2575 : paw_ij1%dijxc_val(:,:)= &
2576 0 : & reshape(buf_dp(indx_dp:indx_dp+ii*ndij-1),(/ii,ndij/))
2577 0 : indx_dp=indx_dp+ii*ndij
2578 : end if
2579 : end if
2580 8 : if (paw_ij1%has_pawu_occ >=1) then
2581 0 : nocc=paw_ij1%ndij
2582 0 : LIBPAW_ALLOCATE(paw_ij1%nocctot,(nocc))
2583 0 : paw_ij1%nocctot(1:nocc)=buf_dp(indx_dp:indx_dp+nocc-1)
2584 0 : indx_dp=indx_dp+nocc
2585 0 : nocc=nocc1*nocc2*nocc3*nocc4
2586 0 : LIBPAW_ALLOCATE(paw_ij1%noccmmp,(nocc1,nocc2,nocc3,nocc4))
2587 : paw_ij1%noccmmp(1:nocc1,1:nocc2,1:nocc3,1:nocc4)= &
2588 0 : & reshape(buf_dp(indx_dp:indx_dp+nocc-1),(/nocc1,nocc2,nocc3,nocc4/))
2589 0 : indx_dp=indx_dp+nocc
2590 : end if
2591 16 : if (paw_ij1%has_exexch_pot >=1) then
2592 0 : sz1=buf_int(indx_int);indx_int=indx_int+1
2593 0 : sz2=buf_int(indx_int);indx_int=indx_int+1
2594 0 : sz3=buf_int(indx_int);indx_int=indx_int+1
2595 0 : LIBPAW_ALLOCATE(paw_ij1%vpawx,(sz1,sz2,sz3))
2596 0 : if (paw_ij1%has_exexch_pot == 2) then
2597 : paw_ij1%vpawx(:,:,:)=&
2598 0 : & reshape(buf_dp(indx_dp:indx_dp+sz1*sz2*sz3-1),(/sz1,sz2,sz3/))
2599 0 : indx_dp=indx_dp+sz1*sz2*sz3
2600 : end if
2601 : end if
2602 : end do
2603 :
2604 8 : if ((indx_int/=1+buf_int_size).or.(indx_dp /=1+buf_dp_size)) then
2605 0 : write(msg,'(a,i10,a,i10)') 'Wrong buffer sizes: buf_int_size=',buf_int_size,' buf_dp_size=',buf_dp_size
2606 0 : LIBPAW_BUG(msg)
2607 : end if
2608 :
2609 8 : end subroutine paw_ij_isendreceive_getbuffer
2610 : !!***
2611 :
2612 : !----------------------------------------------------------------------
2613 :
2614 : !!****f* m_paw_an/paw_ij_isendreceive_fillbuffer
2615 : !! NAME
2616 : !! paw_ij_isendreceive_fillbuffer
2617 : !!
2618 : !! FUNCTION
2619 : !! Extract from paw_ij and from the global index of atoms
2620 : !! the buffers to send in a sending operation
2621 : !! This function has to be coupled with a call to paw_ij_isendreceive_getbuffer
2622 : !!
2623 : !! INPUTS
2624 : !! atm_indx_send(1:total number of atoms)= array for send operation,
2625 : !! Given an index of atom in global numbering, give its index
2626 : !! in the table of atoms treated by current processor
2627 : !! or -1 if the atoms is not treated by current processor
2628 : !! npaw_ij_send= number of sent atoms
2629 : !! paw_ij= data structure from which are extract buffer int and buffer dp
2630 : !!
2631 : !! OUTPUT
2632 : !! buf_int= buffer of integers to be sent
2633 : !! buf_int_size= size of buffer of integers
2634 : !! buf_dp= buffer of double precision numbers to be sent
2635 : !! buf_dp_size= size of buffer of double precision numbers
2636 : !!
2637 : !! SOURCE
2638 :
2639 8 : subroutine paw_ij_isendreceive_fillbuffer(paw_ij,atmtab_send,atm_indx_send,npaw_ij_send,&
2640 : & buf_int,buf_int_size,buf_dp,buf_dp_size)
2641 :
2642 : !Arguments ------------------------------------
2643 : !scalars
2644 : integer,intent(out) :: buf_int_size,buf_dp_size
2645 : integer,intent(in) :: npaw_ij_send
2646 : !arrays
2647 : integer,intent(in) :: atmtab_send(:),atm_indx_send(:)
2648 : integer,allocatable,intent(out) :: buf_int(:)
2649 : real(dp),allocatable,intent(out):: buf_dp(:)
2650 : type(paw_ij_type),target,intent(in) :: paw_ij(:)
2651 :
2652 : !Local variables-------------------------------
2653 : !scalars
2654 : integer :: cplxdij_lmn2_size,cplxdijq_lmn2_size,cplxq_lmn2_size
2655 : integer :: iatom_tot,ii,ij,indx_dp,indx_int,ipaw_ij_send
2656 : integer :: lmn2_size,ndij,nocc,nspden,sz1,sz2,sz3
2657 : character(len=500) :: msg
2658 : type(Paw_ij_type),pointer :: paw_ij1
2659 : !arrays
2660 :
2661 : ! *********************************************************************
2662 :
2663 : !Compute sizes of buffers
2664 8 : buf_int_size=0;buf_dp_size=0
2665 16 : do ipaw_ij_send=1,npaw_ij_send
2666 8 : iatom_tot=atmtab_send(ipaw_ij_send)
2667 8 : ij = atm_indx_send(iatom_tot)
2668 8 : paw_ij1=>paw_ij(ij)
2669 8 : lmn2_size=paw_ij1%lmn2_size
2670 8 : cplxdij_lmn2_size=paw_ij1%cplex_dij*lmn2_size
2671 8 : cplxq_lmn2_size=paw_ij1%qphase*lmn2_size
2672 8 : cplxdijq_lmn2_size=cplxdij_lmn2_size*paw_ij1%qphase
2673 8 : ndij=paw_ij1%ndij
2674 8 : buf_int_size=buf_int_size+24
2675 8 : if (paw_ij1%has_dij==2) then
2676 8 : buf_dp_size=buf_dp_size +cplxdijq_lmn2_size*ndij
2677 : end if
2678 8 : if (paw_ij1%has_dij0==2) then
2679 0 : buf_dp_size=buf_dp_size +lmn2_size
2680 : end if
2681 8 : if (paw_ij1%has_dijexxc==2) then
2682 0 : buf_dp_size=buf_dp_size +cplxdij_lmn2_size*ndij
2683 : end if
2684 8 : if (paw_ij1%has_dijfock==2) then
2685 0 : buf_dp_size=buf_dp_size +cplxdij_lmn2_size*ndij
2686 : end if
2687 8 : if (paw_ij1%has_dijfr==2) then
2688 0 : buf_dp_size=buf_dp_size +cplxdijq_lmn2_size*ndij
2689 : end if
2690 8 : if (paw_ij1%has_dijhartree==2) then
2691 8 : buf_dp_size=buf_dp_size +cplxq_lmn2_size
2692 : end if
2693 8 : if (paw_ij1%has_dijhat==2) then
2694 0 : buf_dp_size=buf_dp_size +cplxdijq_lmn2_size*ndij
2695 : end if
2696 8 : if (paw_ij1%has_dijnd==2) then
2697 0 : buf_dp_size=buf_dp_size +cplxdij_lmn2_size*ndij
2698 : end if
2699 8 : if (paw_ij1%has_dijso==2) then
2700 0 : buf_dp_size=buf_dp_size +cplxdijq_lmn2_size*ndij
2701 : end if
2702 8 : if (paw_ij1%has_dijU==2) then
2703 0 : buf_dp_size=buf_dp_size +cplxdijq_lmn2_size*ndij
2704 : end if
2705 8 : if (paw_ij1%has_dijxc==2) then
2706 0 : buf_dp_size=buf_dp_size +cplxdijq_lmn2_size*ndij
2707 : end if
2708 8 : if (paw_ij1%has_dijxc_hat==2) then
2709 0 : buf_dp_size=buf_dp_size +cplxdij_lmn2_size*ndij
2710 : end if
2711 8 : if (paw_ij1%has_dijxc_val==2) then
2712 0 : buf_dp_size=buf_dp_size +cplxdij_lmn2_size*ndij
2713 : end if
2714 8 : if (paw_ij1%has_pawu_occ>=1) then
2715 0 : buf_int_size=buf_int_size+4
2716 : buf_dp_size=buf_dp_size &
2717 : & +size(paw_ij1%nocctot) &
2718 0 : & +size(paw_ij1%noccmmp)
2719 : end if
2720 16 : if (paw_ij1%has_exexch_pot>=1) then
2721 0 : buf_int_size=buf_int_size+3
2722 0 : buf_dp_size=buf_dp_size +size(paw_ij1%vpawx)
2723 : end if
2724 : end do
2725 :
2726 : !Fill input buffers
2727 24 : LIBPAW_ALLOCATE(buf_int,(buf_int_size))
2728 24 : LIBPAW_ALLOCATE(buf_dp,(buf_dp_size))
2729 8 : indx_int=1;indx_dp=1
2730 16 : do ipaw_ij_send=1,npaw_ij_send
2731 8 : iatom_tot=atmtab_send(ipaw_ij_send)
2732 8 : ij = atm_indx_send(iatom_tot)
2733 8 : paw_ij1=>paw_ij(ij)
2734 8 : nspden=paw_ij1%nspden
2735 8 : buf_int(indx_int)=iatom_tot ;indx_int=indx_int+1
2736 8 : buf_int(indx_int)=paw_ij1%cplex_dij ;indx_int=indx_int+1
2737 8 : buf_int(indx_int)=paw_ij1%qphase ;indx_int=indx_int+1
2738 8 : buf_int(indx_int)=paw_ij1%itypat ;indx_int=indx_int+1
2739 8 : buf_int(indx_int)=nspden ;indx_int=indx_int+1
2740 8 : buf_int(indx_int)=paw_ij1%nsppol ;indx_int=indx_int+1
2741 8 : buf_int(indx_int)=paw_ij1%lmn_size ;indx_int=indx_int+1
2742 8 : buf_int(indx_int)=paw_ij1%lmn2_size ;indx_int=indx_int+1
2743 8 : buf_int(indx_int)=paw_ij1%ndij ;indx_int=indx_int+1
2744 8 : buf_int(indx_int)=paw_ij1%has_dij ;indx_int=indx_int+1
2745 8 : buf_int(indx_int)=paw_ij1%has_dij0 ;indx_int=indx_int+1
2746 8 : buf_int(indx_int)=paw_ij1%has_dijexxc ;indx_int=indx_int+1
2747 8 : buf_int(indx_int)=paw_ij1%has_dijfock ;indx_int=indx_int+1
2748 8 : buf_int(indx_int)=paw_ij1%has_dijfr ;indx_int=indx_int+1
2749 8 : buf_int(indx_int)=paw_ij1%has_dijhartree ;indx_int=indx_int+1
2750 8 : buf_int(indx_int)=paw_ij1%has_dijhat ;indx_int=indx_int+1
2751 8 : buf_int(indx_int)=paw_ij1%has_dijnd ;indx_int=indx_int+1
2752 8 : buf_int(indx_int)=paw_ij1%has_dijso ;indx_int=indx_int+1
2753 8 : buf_int(indx_int)=paw_ij1%has_dijU ;indx_int=indx_int+1
2754 8 : buf_int(indx_int)=paw_ij1%has_dijxc ;indx_int=indx_int+1
2755 8 : buf_int(indx_int)=paw_ij1%has_dijxc_hat ;indx_int=indx_int+1
2756 8 : buf_int(indx_int)=paw_ij1%has_dijxc_val ;indx_int=indx_int+1
2757 8 : buf_int(indx_int)=paw_ij1%has_exexch_pot ;indx_int=indx_int+1
2758 8 : buf_int(indx_int)=paw_ij1%has_pawu_occ ;indx_int=indx_int+1
2759 8 : lmn2_size=paw_ij1%lmn2_size
2760 8 : cplxdij_lmn2_size=paw_ij1%cplex_dij*lmn2_size
2761 8 : cplxq_lmn2_size=paw_ij1%qphase*lmn2_size
2762 8 : cplxdijq_lmn2_size=cplxdij_lmn2_size*paw_ij1%qphase
2763 8 : ndij=paw_ij1%ndij
2764 8 : if (paw_ij1%has_dij==2) then
2765 8 : ii=cplxdijq_lmn2_size*ndij
2766 16 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij1%dij,(/ii/))
2767 8 : indx_dp=indx_dp+ii
2768 : end if
2769 8 : if (paw_ij1%has_dij0==2) then
2770 0 : ii=lmn2_size
2771 0 : buf_dp(indx_dp:indx_dp+lmn2_size-1)=paw_ij1%dij0(:)
2772 : indx_dp=indx_dp+lmn2_size
2773 : end if
2774 8 : if (paw_ij1%has_dijexxc==2) then
2775 0 : ii=cplxdij_lmn2_size*ndij
2776 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij1%dijexxc,(/ii/))
2777 0 : indx_dp=indx_dp+ii
2778 : end if
2779 8 : if (paw_ij1%has_dijfock==2) then
2780 0 : ii=cplxdij_lmn2_size*ndij
2781 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij1%dijfock,(/ii/))
2782 0 : indx_dp=indx_dp+ii
2783 : end if
2784 8 : if (paw_ij1%has_dijfr==2) then
2785 0 : ii=cplxdijq_lmn2_size*ndij
2786 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij1%dijfr,(/ii/))
2787 0 : indx_dp=indx_dp+ii
2788 : end if
2789 8 : if (paw_ij1%has_dijhartree==2) then
2790 8 : ii=cplxq_lmn2_size
2791 296 : buf_dp(indx_dp:indx_dp+ii-1)=paw_ij1%dijhartree(:)
2792 : indx_dp=indx_dp+ii
2793 : end if
2794 8 : if (paw_ij1%has_dijhat==2) then
2795 0 : ii=cplxdijq_lmn2_size*ndij
2796 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij1%dijhat,(/ii/))
2797 0 : indx_dp=indx_dp+ii
2798 : end if
2799 8 : if (paw_ij1%has_dijnd==2) then
2800 0 : ii=cplxdij_lmn2_size*ndij
2801 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij1%dijnd,(/ii/))
2802 0 : indx_dp=indx_dp+ii
2803 : end if
2804 8 : if (paw_ij1%has_dijso==2) then
2805 0 : ii=cplxdijq_lmn2_size*ndij
2806 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij1%dijso,(/ii/))
2807 0 : indx_dp=indx_dp+ii
2808 : end if
2809 8 : if (paw_ij1%has_dijU==2) then
2810 0 : ii=cplxdijq_lmn2_size*ndij
2811 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij1%dijU,(/ii/))
2812 0 : indx_dp=indx_dp+ii
2813 : end if
2814 8 : if (paw_ij1%has_dijxc==2) then
2815 0 : ii=cplxdijq_lmn2_size*ndij
2816 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij1%dijxc,(/ii/))
2817 0 : indx_dp=indx_dp+ii
2818 : end if
2819 8 : if (paw_ij1%has_dijxc_hat==2) then
2820 0 : ii=cplxdij_lmn2_size*ndij
2821 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij1%dijxc_hat,(/ii/))
2822 0 : indx_dp=indx_dp+ii
2823 : end if
2824 8 : if (paw_ij1%has_dijxc_val==2) then
2825 0 : ii=cplxdij_lmn2_size*ndij
2826 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij1%dijxc_val,(/ii/))
2827 0 : indx_dp=indx_dp+ii
2828 : end if
2829 8 : if (paw_ij1%has_pawu_occ>=1)then
2830 0 : buf_int(indx_int)=size(paw_ij1%noccmmp,1) ;indx_int=indx_int+1
2831 0 : buf_int(indx_int)=size(paw_ij1%noccmmp,2) ;indx_int=indx_int+1
2832 0 : buf_int(indx_int)=size(paw_ij1%noccmmp,3) ;indx_int=indx_int+1
2833 0 : buf_int(indx_int)=size(paw_ij1%noccmmp,4) ;indx_int=indx_int+1
2834 0 : nocc=paw_ij1%ndij
2835 0 : buf_dp(indx_dp:indx_dp+nocc-1)=paw_ij1%nocctot(1:nocc)
2836 0 : indx_dp=indx_dp+nocc
2837 0 : nocc=size(paw_ij1%noccmmp)
2838 0 : buf_dp(indx_dp:indx_dp+nocc-1)=reshape(paw_ij1%noccmmp,(/nocc/))
2839 0 : indx_dp=indx_dp+nocc
2840 : end if
2841 16 : if (paw_ij1%has_exexch_pot>=1) then
2842 0 : sz1=size(paw_ij1%vpawx,1);sz2=size(paw_ij1%vpawx,2)
2843 0 : sz3=size(paw_ij1%vpawx,3)
2844 0 : buf_int(indx_int)=sz1; indx_int=indx_int+1
2845 0 : buf_int(indx_int)=sz2; indx_int=indx_int+1
2846 0 : buf_int(indx_int)=sz3; indx_int=indx_int+1
2847 0 : ii=sz1*sz2*sz3
2848 0 : buf_dp(indx_dp:indx_dp+ii-1)=reshape(paw_ij1%vpawx,(/(ii)/))
2849 0 : indx_dp=indx_dp+ii
2850 : end if
2851 : end do
2852 8 : indx_int=indx_int-1;indx_dp=indx_dp-1
2853 8 : if ((indx_int/=buf_int_size).or.(indx_dp/=buf_dp_size)) then
2854 0 : write(msg,'(a,i10,a,i10)') 'Wrong buffer sizes: buf_int_size=',buf_int_size,' buf_dp_size=',buf_dp_size
2855 0 : LIBPAW_BUG(msg)
2856 : end if
2857 :
2858 8 : end subroutine paw_ij_isendreceive_fillbuffer
2859 : !!***
2860 :
2861 : !----------------------------------------------------------------------
2862 :
2863 0 : END MODULE m_paw_ij
2864 : !!***
|
