Branch data 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 [ - + ]: 5618 : 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 : 1674 : & has_exexch_pot,has_pawu_occ,nucdipmom,zora,& ! Optional
329 [ + + + + : 5618 : & 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 : 5618 : integer,pointer :: my_atmtab(:)
352 : :
353 : : ! *************************************************************************
354 : :
355 : : !@Paw_ij_type
356 : :
357 [ + + + + : 19362 : with_nucdipmom=.false.;if (present(nucdipmom)) with_nucdipmom=any(abs(nucdipmom)>tol8)
+ + ]
358 [ + + ]: 5618 : zora_=0; if(present(zora)) zora_=zora
359 : :
360 : : !Set up parallelism over atoms
361 [ + + ]: 5618 : my_natom=size(paw_ij);if (my_natom==0) return
362 [ + + + + ]: 5424 : paral_atom=(present(comm_atom).and.(my_natom/=natom))
363 [ + + ]: 5424 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
364 [ + + ]: 5424 : my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom
365 : 5424 : call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,my_natom_ref=my_natom)
366 : :
367 [ + + ]: 17114 : do iat=1,my_natom
368 [ + + ]: 11690 : iat_tot=iat;if (paral_atom) iat_tot=my_atmtab(iat)
369 : 11690 : itypat=typat(iat_tot)
370 : :
371 [ + + + + ]: 11690 : cplex_dij=1;if ((nspinor==2).or.(with_nucdipmom)) cplex_dij=2
372 : 11690 : qphase=cplex
373 : :
374 : 11690 : lmn2_size =Pawtab(itypat)%lmn2_size
375 : 11690 : Paw_ij(iat)%qphase =qphase
376 : 11690 : Paw_ij(iat)%cplex_dij =cplex_dij
377 : 11690 : Paw_ij(iat)%itypat =itypat
378 : 11690 : Paw_ij(iat)%nspden =nspden
379 : 11690 : Paw_ij(iat)%nsppol =nsppol
380 : 11690 : Paw_ij(iat)%zora =zora_
381 : 11690 : Paw_ij(iat)%lmn_size =Pawtab(itypat)%lmn_size
382 : 11690 : Paw_ij(iat)%lmn2_size =lmn2_size
383 : 11690 : Paw_ij(iat)%ndij =MAX(nspinor**2,nspden)
384 : :
385 : 11690 : ndij=Paw_ij(iat)%ndij
386 : :
387 : : ! ==================================
388 : : ! === Allocations (all optional) ===
389 : : ! ==================================
390 : :
391 : : ! === Allocation for total Dij ===
392 : 11690 : Paw_ij(iat)%has_dij=0
393 [ + + ]: 11690 : if (PRESENT(has_dij)) then
394 [ + - ]: 4243 : if (has_dij/=0) then
395 : 4243 : Paw_ij(iat)%has_dij=1
396 [ - + + - : 16972 : LIBPAW_ALLOCATE(Paw_ij(iat)%dij,(cplex_dij*qphase*lmn2_size,ndij))
- + + - +
- + - - +
- + - + ]
397 [ + + + + ]: 504103 : Paw_ij(iat)%dij(:,:)=zero
398 : : end if
399 : : end if
400 : :
401 : : ! === Allocation for atomic Dij ===
402 : 11690 : Paw_ij(iat)%has_dij0=0
403 [ - + ]: 11690 : 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 : 11690 : Paw_ij(iat)%has_dijexxc=0
413 [ - + ]: 11690 : 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 : 11690 : Paw_ij(iat)%has_dijfock=0
423 [ + + ]: 11690 : if (PRESENT(has_dijfock)) then
424 [ + + ]: 3167 : 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 : 11690 : Paw_ij(iat)%has_dijfr=0
433 [ + + ]: 11690 : if (PRESENT(has_dijfr)) then
434 [ + + ]: 8247 : if (has_dijfr/=0) then
435 : 7958 : Paw_ij(iat)%has_dijfr=1
436 [ - + + - : 31832 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijfr,(cplex_dij*qphase*lmn2_size,ndij))
- + + - +
- + - - +
- + - + ]
437 [ + + + + ]: 363522 : Paw_ij(iat)%dijfr(:,:)=zero
438 : : end if
439 : : end if
440 : :
441 : : ! === Allocation for Dij_Hartree ===
442 : 11690 : Paw_ij(iat)%has_dijhartree=0
443 [ + + ]: 11690 : if (PRESENT(has_dijhartree)) then
444 [ + - ]: 4243 : if (has_dijhartree/=0) then
445 : 4243 : Paw_ij(iat)%has_dijhartree=1
446 [ - + + - : 12729 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijhartree,(qphase*lmn2_size))
+ - + - -
+ - + -
+ ]
447 [ + + ]: 250209 : Paw_ij(iat)%dijhartree(:)=zero
448 : : end if
449 : : end if
450 : :
451 : : ! === Allocation for Dij_hat ===
452 : 11690 : Paw_ij(iat)%has_dijhat=0
453 [ + + ]: 11690 : if (PRESENT(has_dijhat)) then
454 [ + + ]: 3206 : if (has_dijhat/=0) then
455 : 39 : Paw_ij(iat)%has_dijhat=1
456 [ - + + - : 156 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijhat,(cplex_dij*qphase*lmn2_size,ndij))
- + + - +
- + - - +
- + - + ]
457 [ + + + + ]: 2300 : Paw_ij(iat)%dijhat(:,:)=zero
458 : : end if
459 : : end if
460 : :
461 : : ! === Allocation for Dij nuclear dipole moment ===
462 : 11690 : Paw_ij(iat)%has_dijnd=0
463 [ + + ]: 11690 : if (PRESENT(has_dijnd)) then
464 [ + + + - ]: 3371 : if (has_dijnd/=0.and.with_nucdipmom) then
465 : 76 : Paw_ij(iat)%has_dijnd=1
466 [ - + + - : 304 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijnd,(cplex_dij*lmn2_size,ndij))
- + + - +
- + - - +
- + - + ]
467 [ + + + + ]: 12048 : Paw_ij(iat)%dijnd(:,:)=zero
468 : : end if
469 : : end if
470 : :
471 : : ! === Allocation for Dij_SO ===
472 : 11690 : Paw_ij(iat)%has_dijso=0
473 [ + + ]: 11690 : if (PRESENT(has_dijso)) then
474 [ + + + + ]: 3410 : if (has_dijso/=0.and.pawspnorb>0) then
475 : 172 : Paw_ij(iat)%has_dijso=1
476 [ - + + - : 688 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijso,(cplex_dij*qphase*lmn2_size,ndij))
- + + - +
- + - - +
- + - + ]
477 [ + + + + ]: 138300 : Paw_ij(iat)%dijso(:,:)=zero
478 : : end if
479 : : end if
480 : :
481 : : ! === Allocation for Dij_U_val ===
482 : 11690 : Paw_ij(iat)%has_dijU=0
483 [ + + ]: 11690 : if (PRESENT(has_dijU)) then
484 [ + + ]: 4210 : if (has_dijU/=0) then
485 : 2851 : Paw_ij(iat)%has_dijU=1
486 [ - + + - : 11404 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijU,(cplex_dij*qphase*lmn2_size,ndij))
- + + - +
- + - - +
- + - + ]
487 [ + + + + ]: 267230 : Paw_ij(iat)%dijU(:,:)=zero
488 : : end if
489 : : end if
490 : :
491 : : ! === Allocation for total Dij_XC ===
492 : 11690 : Paw_ij(iat)%has_dijxc=0
493 [ + + ]: 11690 : if (PRESENT(has_dijxc)) then
494 [ + + ]: 39 : if (has_dijxc/=0) then
495 : 35 : Paw_ij(iat)%has_dijxc=1
496 [ - + + - : 140 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijxc,(cplex_dij*qphase*lmn2_size,ndij))
- + + - +
- + - - +
- + - + ]
497 [ + + + + ]: 2095 : Paw_ij(iat)%dijxc(:,:)=zero
498 : : end if
499 : : end if
500 : :
501 : : ! === Allocation for total Dij_XC_hat ===
502 : 11690 : Paw_ij(iat)%has_dijxc_hat=0
503 [ + + ]: 11690 : if (PRESENT(has_dijxc_hat)) then
504 [ + + ]: 39 : if (has_dijxc_hat/=0) then
505 : 35 : Paw_ij(iat)%has_dijxc_hat=1
506 [ - + + - : 140 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijxc_hat,(cplex_dij*lmn2_size,ndij))
- + + - +
- + - - +
- + - + ]
507 [ + + + + ]: 2095 : Paw_ij(iat)%dijxc_hat(:,:)=zero
508 : : end if
509 : : end if
510 : :
511 : : ! === Allocation for total Dij_XC_val ===
512 : 11690 : Paw_ij(iat)%has_dijxc_val=0
513 [ + + ]: 11690 : if (PRESENT(has_dijxc_val)) then
514 [ + + ]: 39 : if (has_dijxc_val/=0) then
515 : 35 : Paw_ij(iat)%has_dijxc_val=1
516 [ - + + - : 140 : LIBPAW_ALLOCATE(Paw_ij(iat)%dijxc_val,(cplex_dij*lmn2_size,ndij))
- + + - +
- + - - +
- + - + ]
517 [ + + + + ]: 2095 : Paw_ij(iat)%dijxc_val(:,:)=zero
518 : : end if
519 : : end if
520 : :
521 : : ! === Allocation for PAW+U occupations ===
522 : 11690 : Paw_ij(iat)%has_pawu_occ=0
523 [ + + ]: 11690 : if (PRESENT(has_pawu_occ)) then
524 [ + - + + ]: 3443 : if (has_pawu_occ/=0.and.Pawtab(itypat)%usepawu/=0) then
525 : 217 : Paw_ij(iat)%has_pawu_occ=1
526 [ - + + - : 1302 : LIBPAW_ALLOCATE(Paw_ij(iat)%noccmmp,(cplex_dij,2*Pawtab(itypat)%lpawu+1,2*Pawtab(itypat)%lpawu+1,ndij))
+ - - + +
- - + + -
- + + - +
- + - - +
- + - + ]
527 [ - + + - : 651 : LIBPAW_ALLOCATE(Paw_ij(iat)%nocctot,(ndij))
+ - + - -
+ - + -
+ ]
528 [ + + + + : 31387 : Paw_ij(iat)%noccmmp(:,:,:,:)=zero
+ + + + ]
529 [ + + ]: 691 : Paw_ij(iat)%nocctot(:)=zero
530 : : end if
531 : : end if
532 : :
533 : : ! === Allocation for PAW+LEXX potential ===
534 : 11690 : Paw_ij(iat)%has_exexch_pot=0
535 [ + + ]: 17114 : if (PRESENT(has_exexch_pot)) then
536 [ + - + + ]: 3443 : 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 : 5424 : call free_my_atmtab(my_atmtab,my_atmtab_allocated)
548 : :
549 [ + + + + ]: 11236 : 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 [ - + ]: 6278 : 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 [ + + ]: 6278 : natom=SIZE(Paw_ij);if (natom==0) return
580 : :
581 [ + + ]: 18261 : do iat=1,natom
582 [ + + ]: 12504 : if (allocated(Paw_ij(iat)%dij )) then
583 : 4677 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dij)
584 : : end if
585 [ - + ]: 12504 : if (allocated(Paw_ij(iat)%dij0 )) then
586 : 0 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dij0)
587 : : end if
588 [ - + ]: 12504 : if (allocated(Paw_ij(iat)%dijexxc )) then
589 : 0 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijexxc)
590 : : end if
591 [ + + ]: 12504 : if (allocated(Paw_ij(iat)%dijfock )) then
592 : 52 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijfock)
593 : : end if
594 [ + + ]: 12504 : if (allocated(Paw_ij(iat)%dijfr )) then
595 : 7958 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijfr)
596 : : end if
597 [ + + ]: 12504 : if (allocated(Paw_ij(iat)%dijhartree)) then
598 : 4677 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijhartree)
599 : : end if
600 [ + + ]: 12504 : if (allocated(Paw_ij(iat)%dijhat )) then
601 : 39 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijhat)
602 : : end if
603 [ + + ]: 12504 : if (allocated(Paw_ij(iat)%dijnd )) then
604 : 76 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijnd)
605 : : end if
606 [ + + ]: 12504 : if (allocated(Paw_ij(iat)%dijU )) then
607 : 3220 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijU)
608 : : end if
609 [ + + ]: 12504 : if (allocated(Paw_ij(iat)%dijso )) then
610 : 200 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijso)
611 : : end if
612 [ + + ]: 12504 : if (allocated(Paw_ij(iat)%dijxc )) then
613 : 35 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijxc)
614 : : end if
615 [ + + ]: 12504 : if (allocated(Paw_ij(iat)%dijxc_hat )) then
616 : 35 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijxc_hat)
617 : : end if
618 [ + + ]: 12504 : if (allocated(Paw_ij(iat)%dijxc_val )) then
619 : 35 : LIBPAW_DEALLOCATE(Paw_ij(iat)%dijxc_val)
620 : : end if
621 [ + + ]: 12504 : if (allocated(Paw_ij(iat)%noccmmp )) then
622 : 220 : LIBPAW_DEALLOCATE(Paw_ij(iat)%noccmmp)
623 : : end if
624 [ + + ]: 12504 : if (allocated(Paw_ij(iat)%nocctot )) then
625 : 220 : LIBPAW_DEALLOCATE(Paw_ij(iat)%nocctot)
626 : : end if
627 [ + + ]: 12504 : 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 : 12504 : Paw_ij(iat)%has_dij =0
633 : 12504 : Paw_ij(iat)%has_dij0 =0
634 : 12504 : Paw_ij(iat)%has_dijexxc =0
635 : 12504 : Paw_ij(iat)%has_dijfock =0
636 : 12504 : Paw_ij(iat)%has_dijfr =0
637 : 12504 : Paw_ij(iat)%has_dijhartree=0
638 : 12504 : Paw_ij(iat)%has_dijhat =0
639 : 12504 : Paw_ij(iat)%has_dijnd =0
640 : 12504 : Paw_ij(iat)%has_dijso =0
641 : 12504 : Paw_ij(iat)%has_dijU =0
642 : 12504 : Paw_ij(iat)%has_dijxc =0
643 : 12504 : Paw_ij(iat)%has_dijxc_hat =0
644 : 12504 : Paw_ij(iat)%has_dijxc_val =0
645 : 12504 : Paw_ij(iat)%has_exexch_pot=0
646 : 18261 : 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 [ - + ]: 5990 : 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 [ + + ]: 5990 : natom=SIZE(Paw_ij(:));if (natom==0) return
686 : :
687 : : ! Set all has_* flags to zero.
688 [ + + ]: 18394 : do iat=1,natom
689 : : ! === Set all has_* flags to zero ===
690 : 12598 : Paw_ij(iat)%has_dij =0
691 : 12598 : Paw_ij(iat)%has_dij0 =0
692 : 12598 : Paw_ij(iat)%has_dijexxc =0
693 : 12598 : Paw_ij(iat)%has_dijfock =0
694 : 12598 : Paw_ij(iat)%has_dijfr =0
695 : 12598 : Paw_ij(iat)%has_dijhartree=0
696 : 12598 : Paw_ij(iat)%has_dijhat =0
697 : 12598 : Paw_ij(iat)%has_dijnd =0
698 : 12598 : Paw_ij(iat)%has_dijso =0
699 : 12598 : Paw_ij(iat)%has_dijU =0
700 : 12598 : Paw_ij(iat)%has_dijxc =0
701 : 12598 : Paw_ij(iat)%has_dijxc_hat =0
702 : 12598 : Paw_ij(iat)%has_dijxc_val =0
703 : 12598 : Paw_ij(iat)%has_exexch_pot=0
704 : 18394 : 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 [ - + ]: 20175 : subroutine paw_ij_print(Paw_ij,unit,pawprtvol,pawspnorb,mode_paral,enunit,ipert, &
965 [ + + + - : 20175 : & 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 : 20175 : integer,pointer :: my_atmtab(:)
989 : 20175 : real(dp),allocatable,target :: dijh(:,:)
990 : 20175 : real(dp),allocatable :: dij2p(:),dij2p_(:)
991 : :
992 : : ! *************************************************************************
993 : :
994 : : if (.False.) write(std_out,*)"pawspnorb:",pawspnorb
995 : :
996 : : !@Paw_ij_type
997 : 20175 : size_paw_ij=SIZE(Paw_ij);if (size_paw_ij==0) return
998 : :
999 [ + - ]: 18411 : my_unt =std_out ; if (PRESENT(unit )) my_unt =unit
1000 [ + - ]: 18411 : my_prtvol=0 ; if (PRESENT(pawprtvol )) my_prtvol=pawprtvol
1001 [ + - ]: 18411 : my_mode ='COLL' ; if (PRESENT(mode_paral)) my_mode =mode_paral
1002 [ + - ]: 18411 : my_ipert =0 ; if (PRESENT(ipert)) my_ipert =ipert
1003 [ + - ]: 18411 : my_enunit=0 ; if (PRESENT(enunit)) my_enunit=enunit
1004 [ + + ]: 18411 : my_natom=size_paw_ij; if (PRESENT(natom)) my_natom=natom
1005 : :
1006 : : !Set up parallelism over atoms
1007 : 18411 : paral_atom=(present(comm_atom).and.my_natom/=size_paw_ij)
1008 [ + + ]: 18411 : nullify(my_atmtab);if (present(mpi_atmtab)) my_atmtab => mpi_atmtab
1009 [ + + ]: 18411 : my_comm_atom=xmpi_comm_self;if (present(comm_atom)) my_comm_atom=comm_atom
1010 : 18411 : call get_my_atmtab(my_comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,my_natom,my_natom_ref=size_paw_ij)
1011 : :
1012 [ + + ]: 18411 : 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 : 18411 : nsppol = Paw_ij(1)%nsppol
1022 : 18411 : nspden = Paw_ij(1)%nspden
1023 [ + + ]: 18411 : nsploop= nsppol; if (Paw_ij(1)%ndij==4) nsploop=4
1024 : :
1025 [ + + ]: 62874 : do iatom=1,size_paw_ij
1026 : :
1027 [ + + ]: 44463 : iatom_tot=iatom;if (paral_atom) iatom_tot=my_atmtab(iatom)
1028 : :
1029 : 44463 : lmn_size = Paw_ij(iatom)%lmn_size
1030 : 44463 : lmn2_size = Paw_ij(iatom)%lmn2_size
1031 : 44463 : cplex_dij = Paw_ij(iatom)%cplex_dij
1032 : 44463 : qphase = Paw_ij(iatom)%qphase
1033 : 44463 : ndij = Paw_ij(iatom)%ndij
1034 [ + - - + : 133389 : LIBPAW_ALLOCATE(dij2p,(2*lmn2_size))
+ - + - +
- - + - +
- + ]
1035 [ - + + - : 88926 : LIBPAW_ALLOCATE(dij2p_,(2*lmn2_size))
- + - + -
+ ]
1036 : :
1037 : : ! ====================================
1038 : : ! === Loop over density components ===
1039 : : ! ====================================
1040 [ + + ]: 103408 : do idij=1,nsploop
1041 : :
1042 [ + + + + ]: 58945 : idij_sym=idij;if (ndij==4.and.idij>2) idij_sym=7-idij
1043 : :
1044 : : ! =================== Detailed output =====================================
1045 [ + + + + : 58945 : 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 [ + + + + : 103408 : if ((abs(my_prtvol)==0).and.(iatom_tot==1.or.iatom_tot==my_natom)) then
+ + ]
1213 : :
1214 : : !Title
1215 [ + + ]: 37064 : if (idij==1) then
1216 [ + + ]: 27271 : if (my_ipert<=0) then
1217 : 23082 : write(msg, '(2a,i6,a)') ch10,' ****** Psp strength Dij in Ha (atom ',iatom_tot,') *****'
1218 : : else
1219 : 4189 : write(msg, '(2a,i6,a)') ch10,' **** Psp strength Dij(1) in Ha (atom ',iatom_tot,') *****'
1220 : : end if
1221 [ + + + + ]: 27271 : 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 [ + + ]: 37064 : if (paw_ij(iatom)%ndij/=1) then
1226 [ + - ]: 15920 : write(msg,'(4a)') trim(msg),' Component ',trim(dspin(idij+2*(nsploop/4))),':'
1227 : : end if
1228 : :
1229 : : !Dij TOTAL
1230 [ + - ]: 37064 : if (Paw_ij(iatom)%has_dij/=0) then
1231 : 37064 : 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 : 37064 : & title=msg)
1235 : : end if
1236 : :
1237 : : end if
1238 : :
1239 : : ! =================== End main loops =====================================
1240 : :
1241 : : end do !idij
1242 [ - + ]: 44463 : LIBPAW_DEALLOCATE(dij2p)
1243 [ - + ]: 62874 : LIBPAW_DEALLOCATE(dij2p_)
1244 : : end do !iatom
1245 : :
1246 [ + + - + : 38586 : call wrtout(my_unt,' ',my_mode)
- + - + ]
1247 : :
1248 : : !Small helper function
1249 : : contains
1250 : :
1251 : : !Real and imaginary parts of phase.
1252 [ - + - + : 62103 : 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 [ + + ]: 62103 : always_img_=.false.;if(present(always_img)) always_img_=always_img
1264 : 62103 : my_idij=min(size(my_dij,2),idij)
1265 : 62103 : my_idij_sym=min(size(my_dij,2),idij_sym)
1266 [ + + ]: 62103 : if (my_qphase==1) then
1267 [ + + + + : 61527 : 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 : 48306 : tmp_cplex_dij=my_cplex_dij
1275 [ + + ]: 6995717 : do kk=1,my_cplex_dij*lmn2_size
1276 : 6947411 : dij2p(kk) = my_dij(kk,my_idij)
1277 : 6995717 : 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 : 62103 : 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 [ + + ]: 50 : do while (nbmsg_incoming > 0)
2226 [ + + ]: 60 : do i1=1,nbrecvmsg
2227 [ - + ]: 20 : if (.not.msg_pick(i1)) then
2228 : 10 : iproc_send=From(i1)
2229 : : flag=.false.
2230 : 10 : my_tag=200
2231 : 10 : call xmpi_iprobe(iproc_send,my_tag,mpi_comm_exch,flag,ierr)
2232 [ + + ]: 10 : 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 [ - + ]: 21492 : 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 [ + + ]: 21492 : natom=SIZE(Paw_ij);if (natom==0) return
2325 [ + + ]: 19724 : all_=.true.;if (present(all)) all_=all
2326 [ + + ]: 19724 : dijhartree_=.false.;if (present(dijhartree)) dijhartree_=dijhartree
2327 [ + + ]: 19724 : self_consistent_=.false.;if (present(self_consistent)) self_consistent_=self_consistent
2328 : :
2329 [ + + ]: 19724 : if (dijhartree_) then
2330 [ + + ]: 1051 : do iat=1,natom
2331 [ + - ]: 1051 : if (Paw_ij(iat)%has_dijhartree>0) Paw_ij(iat)%has_dijhartree=1
2332 : : end do
2333 : :
2334 [ + + ]: 19365 : else if (self_consistent_) then
2335 [ + + ]: 59496 : do iat=1,natom
2336 [ + - ]: 42111 : if (Paw_ij(iat)%has_dij >0) Paw_ij(iat)%has_dij =1
2337 [ - + ]: 42111 : if (Paw_ij(iat)%has_dijexxc >0) Paw_ij(iat)%has_dijexxc =1
2338 [ + + ]: 42111 : if (Paw_ij(iat)%has_dijfock >0) Paw_ij(iat)%has_dijfock =1
2339 [ + - ]: 42111 : if (Paw_ij(iat)%has_dijhartree>0) Paw_ij(iat)%has_dijhartree=1
2340 [ - + ]: 42111 : if (Paw_ij(iat)%has_dijhat >0) Paw_ij(iat)%has_dijhat =1
2341 [ + + ]: 42111 : if (Paw_ij(iat)%has_dijnd >0) Paw_ij(iat)%has_dijnd =1
2342 [ + + ]: 42111 : if (Paw_ij(iat)%has_dijso >0) Paw_ij(iat)%has_dijso =1
2343 [ + + ]: 42111 : if (Paw_ij(iat)%has_dijU >0) Paw_ij(iat)%has_dijU =1
2344 [ - + ]: 42111 : if (Paw_ij(iat)%has_dijxc >0) Paw_ij(iat)%has_dijxc =1
2345 [ - + ]: 42111 : if (Paw_ij(iat)%has_dijxc_hat >0) Paw_ij(iat)%has_dijxc_hat =1
2346 [ - + ]: 42111 : if (Paw_ij(iat)%has_dijxc_val >0) Paw_ij(iat)%has_dijxc_val =1
2347 [ + + ]: 42111 : if (Paw_ij(iat)%has_exexch_pot>0) Paw_ij(iat)%has_exexch_pot=1
2348 [ + + ]: 59496 : 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 : : !!***
|
