Branch data Line data Source code
1 : : !!****m* ABINIT/m_bandfft_kpt
2 : : !! NAME
3 : : !! m_bandfft_kpt
4 : : !!
5 : : !! FUNCTION
6 : : !! This module provides the definition of the bandfft_kpt_type
7 : : !! used for kgb parallelization.
8 : : !!
9 : : !! COPYRIGHT
10 : : !! Copyright (C) 2011-2026 ABINIT group (FJ, FB, MT)
11 : : !! This file is distributed under the terms of the
12 : : !! GNU General Public License, see ~abinit/COPYING
13 : : !! or http://www.gnu.org/copyleft/gpl.txt .
14 : : !!
15 : : !! SOURCE
16 : :
17 : : #if defined HAVE_CONFIG_H
18 : : #include "config.h"
19 : : #endif
20 : :
21 : : #include "abi_common.h"
22 : :
23 : : MODULE m_bandfft_kpt
24 : :
25 : : use, intrinsic :: iso_c_binding, only : c_int32_t, c_double
26 : :
27 : : use defs_basis
28 : : use m_abicore
29 : : use m_errors
30 : : use m_xmpi
31 : :
32 : : use defs_abitypes, only : MPI_type
33 : : use m_time, only : timab
34 : : use m_kg, only : mkkpg
35 : : use m_fftcore, only : sphereboundary
36 : : use m_mpinfo, only : proc_distrb_cycle
37 : : use m_hamiltonian, only : gs_hamiltonian_type
38 : :
39 : : #if defined HAVE_YAKL
40 : : use gator_mod
41 : : #endif
42 : :
43 : : implicit none
44 : :
45 : : private
46 : : public :: bandfft_kpt_init1
47 : : public :: bandfft_kpt_init2
48 : : public :: bandfft_kpt_reset
49 : : public :: bandfft_kpt_destroy
50 : : public :: bandfft_kpt_destroy_array
51 : : public :: bandfft_kpt_copy
52 : : public :: bandfft_kpt_mpi_send
53 : : public :: bandfft_kpt_mpi_recv
54 : : public :: bandfft_kpt_savetabs
55 : : public :: bandfft_kpt_restoretabs
56 : : public :: bandfft_kpt_set_ikpt
57 : : public :: bandfft_kpt_get_ikpt
58 : : public :: prep_bandfft_tabs
59 : : !!***
60 : :
61 : : !!****t* m_bandfft_kpt/bandfft_kpt_type
62 : : !! NAME
63 : : !! bandfft_kpt_type
64 : : !!
65 : : !! FUNCTION
66 : : !! The bandfft_kpt_type structured datatype gather different information
67 : : !! about the triple band-fft-kpt parallelisation:
68 : : !! tabs which are distributed over all the three dimensions and stored during
69 : : !! the calculation, dimensions of messages exchange during the calculations...
70 : : !! i.e.: all the information which were spread over the entire code before and
71 : : !! recomputed at each iline, istep or itime STEP with a large probability to
72 : : !! make a mistake.
73 : : !!
74 : : !! SOURCE
75 : :
76 : : type, public :: bandfft_kpt_type
77 : :
78 : : ! WARNING : if you modify this datatype, please check whether there might be creation/destruction/copy routines,
79 : : ! declared in another part of ABINIT, that might need to take into account your modification.
80 : :
81 : : integer :: flag1_is_allocated ! determine if the following data are allocated or not
82 : : integer :: npw_tot ! array holding the total number of plane waves for each k point
83 : : integer :: ndatarecv ! total number of values received by the processor and sent
84 : : ! by the other processors band
85 : :
86 : : #if defined HAVE_GPU && defined HAVE_YAKL
87 : : integer(c_int32_t), contiguous, pointer :: kg_k_gather(:,:) => null()
88 : : #else
89 : : integer, allocatable :: kg_k_gather(:,:) ! planewave coordinates
90 : : ! (of the processor + sent by other processors band)
91 : : #endif
92 : :
93 : : integer, allocatable :: recvcounts(:) ! number of values received by the processor from each processor band
94 : : integer, allocatable :: sendcounts(:) ! number of values sent by the processor to each processor band
95 : : integer, allocatable :: rdispls (:) ! positions of values received by the processor from each processor band
96 : : integer, allocatable :: sdispls (:) ! postions of values sent by the processor to each processor band
97 : : integer, allocatable :: gbound(:,:) ! sphere boundary info: gbound(2*mgfft+8,2)
98 : :
99 : : integer :: flag2_is_allocated ! determine if the following data are allocated or not
100 : : real(dp), allocatable :: ffnl_gather(:,:,:,:) ! ffnl tab (of the processor + sent by other processors band)
101 : :
102 : : #if defined HAVE_GPU && defined HAVE_YAKL
103 : : real(c_double), contiguous, pointer :: kinpw_gather(:) => null() ! kinpw tab (of the processor + sent by other processors band)
104 : : #else
105 : : real(dp), allocatable :: kinpw_gather(:) ! kinpw tab (of the processor + sent by other processors band)
106 : : #endif
107 : :
108 : : real(dp), allocatable :: ph3d_gather(:,:,:) ! ph3d tab (of the processor + sent by other processors band)
109 : : real(dp), allocatable :: kpg_k_gather(:,:) ! kpg_k tab (of the processor + sent by other processors band)
110 : :
111 : : ! GBT second-spinor tables at k'=k+q/2. These must be kept per local
112 : : ! k point, just like the ordinary-k tables, because prep_bandfft_tabs is
113 : : ! only valid while the original distributed G layout is available.
114 : : real(dp), allocatable :: ffnl_kp_gather(:,:,:,:)
115 : : real(dp), allocatable :: kinpw_kp_gather(:)
116 : : real(dp), allocatable :: ph3d_kp_gather(:,:,:)
117 : : real(dp), allocatable :: kpg_kp_gather(:,:)
118 : :
119 : :
120 : : integer :: flag3_is_allocated ! determine if the following data are allocated or not
121 : : integer :: istwf_k ! input option parameter that describes the storage of wfs
122 : : integer :: idatarecv0 ! position of the planewave coordinates (0,0,0)
123 : : integer :: ndatarecv_tot ! total number of received values by the processor
124 : : ! (ndatarecv + number of received opposited planewave coordinates)
125 : : integer :: ndatasend_sym ! number of sent values to the processors fft to create opposited
126 : : ! planewave coordinates
127 : : integer, allocatable :: kg_k_gather_sym(:,:) ! planewave coordinates
128 : : ! (kg_k_gather + opposited planewave coordinates sent by the processors fft)
129 : : integer, allocatable :: rdispls_sym(:) ! positions of values received by the processor from each processor fft
130 : : integer, allocatable :: recvcounts_sym(:) ! number of values received by the processor from each processor fft
131 : : integer, allocatable :: recvcounts_sym_tot(:) ! number of values received by each processor from the other processors fft
132 : : integer, allocatable :: sdispls_sym(:) ! postions of values sent by the processor to each processor fft
133 : : integer, allocatable :: sendcounts_sym(:) ! number of values sent by the processor to each processor fft
134 : : integer, allocatable :: sendcounts_sym_all(:) ! number of values sent by each processor to the other processors fft
135 : : integer, allocatable :: tab_proc(:) ! positions of opposited planewave coordinates in the list of the processors fft
136 : :
137 : : logical :: have_to_reequilibrate ! indicates weather we will have to reequilibrate and allocate all these stuff
138 : : integer :: npw_fft ! Number of plane waves during fft step
139 : : integer, allocatable :: indices_pw_fft(:) ! Indices for sorting pw like pw
140 : : integer, allocatable :: sendcount_fft (:) ! Number of pw to send to others proc fft
141 : : integer, allocatable :: senddisp_fft(:) ! Positions for sending
142 : : integer, allocatable :: recvcount_fft(:) ! Number of pw to receive from others proc fft
143 : : integer, allocatable :: recvdisp_fft(:) ! Positions for receiving
144 : : integer, allocatable :: kg_k_fft(:,:) ! planewaves coordinates
145 : : integer :: gpu_option ! if this structure will be used with GPU
146 : :
147 : : end type bandfft_kpt_type
148 : : !!***
149 : :
150 : : type(bandfft_kpt_type),save,public,pointer :: bandfft_kpt(:) => null()
151 : : ! Contains all the information related to the band/FFT parallelism
152 : : ! which depends on kpt exists only if mpi_enreg%paral_kgb==1
153 : :
154 : : integer,save,private :: bandfft_kpt_current_ikpt=-1
155 : : ! Index of current k point processed by current proc,
156 : : ! i.e. current index of bandfft_kpt loaded in memory
157 : : ! => bandfft_kpt_current_ikpt=my_kpttab(ikpt)
158 : : ! Please, use bandfft_kpt_set_ikpt method to change the value
159 : : ! and bandfft_kpt_get_ikpt to get it.
160 : :
161 : : CONTAINS
162 : :
163 : : !===========================================================
164 : : !!***
165 : :
166 : : !!****f* m_bandfft_kpt/bandfft_kpt_init1
167 : : !! NAME
168 : : !! bandfft_kpt_init1
169 : : !!
170 : : !! FUNCTION
171 : : !! Init all (or part of) scalars and pointers in a bandfft_kpt datastructure
172 : : !!
173 : : !! INPUTS
174 : : !! istwfk(nkpt) = input option parameter that describes the storage of wfs
175 : : !! kg(3,mpw*mkmem) = dimensionless coords of G vecs in basis sphere at k point
176 : : !! mgfft = maximum single fft dimension (IN)
177 : : !! mkmem = number of k points which can fit in memory; set to 0 if use disk
178 : : !! mpi_enreg = information about MPI parallelization
179 : : !! mpw = maximum number of planewaves as dimensioned in calling routine
180 : : !! nband(nkpt*nsppol) = number of bands at each k point
181 : : !! nkpt = number of k points
182 : : !! npwarr(nkpt) = array holding npw for each k point, taking into account
183 : : !! the effect of istwfk, and the spreading over processors
184 : : !! nsppol = 1 for unpolarized, 2 for polarized
185 : : !!
186 : : !! OUTPUT
187 : : !!
188 : : !!---------------------------------------------------------------------
189 : : !! within the bandfft_kpt data_type : Initialize and compute
190 : : !!---------------------------------------------------------------------
191 : : !! gbound = sphere boundary info
192 : : !! idatarecv0 = position of the planewave coordinates (0,0,0)
193 : : !! istwf_k = input option parameter that describes the storage of wfs
194 : : !! kg_k_gather = planewave coordinates
195 : : !! (of the processor + sended by other processors band)
196 : : !! kg_k_gather_sym = planewave coordinates
197 : : !! (kg_k_gather + opposited planewave coordinates sended by the processors fft)
198 : : !! ndatarecv = total number of values received by the processor and sended
199 : : !! by the other processors band
200 : : !! ndatasend_sym = number of sended values to the processors fft to create opposited
201 : : !! planewave coordinates
202 : : !! ndatarecv_tot = total number of received values by the processor
203 : : !! (ndatarecv + number of received opposited planewave coordinates)
204 : : !! recvcounts = number of values received by the processor from each processor band
205 : : !! recvcounts_sym = number of values received by the processor from each processor fft
206 : : !! recvcounts_sym_tot = number of values received by each processor from the other processors fft
207 : : !! rdispls = positions of values received by the processor from each processor band
208 : : !! rdispls_sym = positions of values received by the processor from each processor fft
209 : : !! sendcounts = number of values sended by the processor to each processor band
210 : : !! sendcounts_sym = number of values sended by the processor to each processor fft
211 : : !! sendcounts_sym_all = number of values sended by each processor to the other processors fft
212 : : !! sdispls = postions of values sended by the processor to each processor band
213 : : !! sdispls_sym = postions of values sended by the processor to each processor fft
214 : : !! tab_proc = positions of opposited planewave coordinates in the list of the
215 : : !! processors fft
216 : : !! SIDE EFFECTS
217 : : !! bandfft_kpt_in=<type(bandfft_kpt)>=bandfft_kpt datastructure
218 : : !!
219 : : !! SOURCE
220 : :
221 : 5710 : subroutine bandfft_kpt_init1(bandfft_kpt_in,istwfk,kg,mgfft,mkmem,mpi_enreg,mpw,nband,nkpt,npwarr,nsppol,gpu_option)
222 : :
223 : : !Arguments ------------------------------------
224 : : !scalars
225 : : integer,intent(in) :: mgfft,mkmem,mpw,nkpt,nsppol
226 : : type(bandfft_kpt_type),pointer :: bandfft_kpt_in(:)
227 : : type(MPI_type),intent(inout) :: mpi_enreg
228 : : integer,intent(in),optional :: gpu_option
229 : : !arrays
230 : : integer,intent(in) :: istwfk(nkpt),nband(nkpt*nsppol)
231 : : integer,intent(in) :: kg(3,mpw*mkmem),npwarr(nkpt)
232 : :
233 : : !Local variables-------------------------------
234 : : !scalars
235 : : integer :: comm_band,comm_fft,idatarecv,idatarecv0,ierr,ikg,ikpt,ikpt_this_proc,iproc,isppol,istwf_k,itest,jsendloc
236 : : integer :: me_fft,me_kpt,n2,nband_k,ndatarecv,ndatarecv_tot,ndatasend_sym,nproc_band,nproc_fft,npw_fft,npw_k,npw_tot
237 : : logical :: reequilibrate_allocated
238 : : character(len=500) :: message
239 : : !arrays
240 : 5710 : integer,allocatable :: buff_kg(:,:),gbound(:,:),indices_pw_fft(:),kg_k(:,:),kg_k_fft(:,:),kg_k_gather(:,:)
241 : 5710 : integer,allocatable :: kg_k_gather_all(:,:),kg_k_gather_send(:,:),kg_k_gather_sym(:,:)
242 : 5710 : integer,allocatable :: npw_per_proc(:)
243 : 5710 : integer,allocatable :: rdispls(:),rdispls_all(:),rdispls_sym(:),rdispls_sym_loc(:)
244 : 5710 : integer,allocatable :: recvcounts(:),recvcounts_sym(:),recvcounts_fft(:),recvcounts_sym_loc(:),recvcounts_sym_tot(:)
245 : 5710 : integer,allocatable :: recvdisp_fft(:),sdispls(:),sdispls_sym_loc(:),sdispls_sym(:)
246 : 5710 : integer,allocatable :: sendcounts(:),sendcounts_fft(:),sendcounts_sym(:),sendcounts_sym_all(:),sendcounts_sym_loc(:)
247 : 5710 : integer,allocatable :: senddisp_fft(:),sum_kg(:),tab_proc(:)
248 : :
249 : : ! *********************************************************************
250 : :
251 [ + + ]: 5710 : If(mpi_enreg%paral_kgb/=1) then
252 : 5075 : nullify(bandfft_kpt_in)
253 : 5075 : return
254 : : end if
255 : :
256 : : !---------------------------------------------
257 : : !Initialisation
258 : : !---------------------------------------------
259 : 635 : nproc_fft = mpi_enreg%nproc_fft
260 : 635 : nproc_band = mpi_enreg%nproc_band
261 : :
262 : 635 : me_fft = mpi_enreg%me_fft
263 : 635 : me_kpt = mpi_enreg%me_kpt
264 : :
265 : 635 : comm_band = mpi_enreg%comm_band
266 : 635 : comm_fft = mpi_enreg%comm_fft
267 : :
268 : : !=============================================================================
269 : : !Compute and store various tabs in bandfft_kpt(ikpt) data_struc
270 : : !These ones will be used in following subroutines:
271 : : !vtorho, mkrho, prep_nonlop, prep_fourwf, prep_getghc...
272 : : !=============================================================================
273 : :
274 [ - + + - : 4912 : ABI_MALLOC(bandfft_kpt_in,(mkmem))
+ - + - -
+ - + +
+ ]
275 : :
276 [ - + + - : 1905 : ABI_MALLOC(sdispls ,(nproc_band))
+ - + - -
+ - + ]
277 [ - + + - : 1270 : ABI_MALLOC(sendcounts ,(nproc_band))
- + - + ]
278 [ - + + - : 1270 : ABI_MALLOC(rdispls ,(nproc_band))
- + - + ]
279 [ - + + - : 1270 : ABI_MALLOC(recvcounts ,(nproc_band))
- + - + ]
280 [ - + + - : 1905 : ABI_MALLOC(sendcounts_fft,(nproc_fft))
+ - + - -
+ - + ]
281 [ - + + - : 1270 : ABI_MALLOC(senddisp_fft ,(nproc_fft))
- + - + ]
282 [ - + + - : 1270 : ABI_MALLOC(recvcounts_fft,(nproc_fft))
- + - + ]
283 [ - + + - : 1270 : ABI_MALLOC(recvdisp_fft ,(nproc_fft))
- + - + ]
284 : :
285 [ + + ]: 3642 : bandfft_kpt_in(:)%flag1_is_allocated=0
286 [ + + ]: 3642 : bandfft_kpt_in(:)%flag2_is_allocated=0
287 [ + + ]: 3642 : bandfft_kpt_in(:)%flag3_is_allocated=0
288 [ + + ]: 3642 : bandfft_kpt_in(:)%gpu_option=ABI_GPU_DISABLED
289 [ + + + + ]: 3498 : if(present(gpu_option)) bandfft_kpt_in(:)%gpu_option=gpu_option
290 : :
291 [ + + ]: 1298 : do isppol=1,nsppol
292 : 663 : ikg=0
293 [ + + ]: 5325 : do ikpt=1,nkpt
294 : 4027 : npw_k=npwarr(ikpt)
295 : 4027 : istwf_k=istwfk(ikpt)
296 : 4027 : nband_k=nband(ikpt+(isppol-1)*nkpt)
297 [ + + ]: 4027 : if(proc_distrb_cycle(mpi_enreg%proc_distrb,ikpt,1,nband_k,isppol,me_kpt))cycle
298 : 3023 : ikpt_this_proc=mpi_enreg%my_kpttab(ikpt)
299 [ + - - + ]: 3023 : if ((ikpt_this_proc > mkmem).or.(ikpt_this_proc==0)) then
300 : 0 : message = ' this bandfft tab is not allocated !'
301 : 0 : ABI_ERROR(message)
302 : : end if
303 [ + + ]: 3023 : if (bandfft_kpt_in(ikpt_this_proc)%flag1_is_allocated==0) then
304 [ + - - + : 12028 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%gbound ,(2*mgfft+8,2))
+ - + - +
- + - - +
- + - + ]
305 [ - + + - : 6014 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%recvcounts,(nproc_band))
- + - + -
+ ]
306 [ - + + - : 6014 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%sendcounts,(nproc_band))
- + - + -
+ ]
307 [ - + + - : 6014 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%rdispls ,(nproc_band))
- + - + -
+ ]
308 [ - + + - : 6014 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%sdispls ,(nproc_band))
- + - + -
+ ]
309 : 3007 : bandfft_kpt_in(ikpt_this_proc)%flag1_is_allocated=1
310 : : end if
311 : :
312 : : ! Initialize various quantities for the reequilibration step
313 [ + + + + ]: 3023 : reequilibrate_allocated=(isppol==2.and.bandfft_kpt_in(ikpt_this_proc)%have_to_reequilibrate)
314 : 3023 : bandfft_kpt_in(ikpt_this_proc)%have_to_reequilibrate = .false.
315 : 3023 : bandfft_kpt_in(ikpt_this_proc)%npw_fft = 0
316 : :
317 : 3023 : call xmpi_allgather(npw_k,recvcounts,comm_band,ierr)
318 : 3023 : rdispls(1)=0
319 [ + + ]: 8893 : do iproc=2,nproc_band
320 : 8893 : rdispls(iproc)=rdispls(iproc-1)+recvcounts(iproc-1)
321 : : end do
322 : 3023 : ndatarecv=rdispls(nproc_band)+recvcounts(nproc_band)
323 : :
324 [ - + + - : 9069 : ABI_MALLOC(kg_k_gather,(3,ndatarecv))
+ - + - -
+ - + -
+ ]
325 [ - + + - : 9069 : ABI_MALLOC(kg_k,(3,npw_k))
+ - + - -
+ - + -
+ ]
326 [ + + + + ]: 1344883 : kg_k(:,1:npw_k)=kg(:,1+ikg:npw_k+ikg)
327 [ + - + + : 20809 : call xmpi_allgatherv(kg_k,3*npw_k,kg_k_gather,3*recvcounts(:),3*rdispls(:),comm_band,ierr)
+ - + + ]
328 : :
329 [ + + ]: 11916 : sendcounts(:)=npw_k*mpi_enreg%bandpp
330 [ + + ]: 11916 : do iproc=1,nproc_band
331 : 11916 : sdispls(iproc)=(iproc-1)*npw_k*mpi_enreg%bandpp
332 : : end do
333 : :
334 : : ! ============================================================================
335 : : ! Here we compute gbound, as well for istwf_k=1 as for istwf_k=2 and store it
336 : : ! ============================================================================
337 : : !MG: Why don't we compute gbound locally by just computing the full G-sphere from ecut
338 [ - + + - : 9069 : ABI_MALLOC(npw_per_proc,(nproc_fft))
+ - + - -
+ - + -
+ ]
339 [ - + + - : 6046 : ABI_MALLOC(rdispls_all,(nproc_fft))
- + - + ]
340 [ + - - + : 12092 : ABI_MALLOC(gbound,(2*mgfft+8,2))
+ - + - +
- + - - +
- + ]
341 [ + - + + : 291201 : if (mgfft>0) gbound(:,:)=0
+ + ]
342 [ + + ]: 3023 : if (istwf_k==1) then
343 : 2235 : call xmpi_allgather(ndatarecv,npw_per_proc,mpi_enreg%comm_fft,ierr)
344 : 2235 : rdispls_all(1)=0
345 [ + + ]: 3489 : do iproc=2,nproc_fft
346 : 3489 : rdispls_all(iproc)=rdispls_all(iproc-1)+npw_per_proc(iproc-1)
347 : : end do
348 : 2235 : npw_tot=rdispls_all(nproc_fft)+npw_per_proc(nproc_fft)
349 [ - + + - : 6705 : ABI_MALLOC(kg_k_gather_all,(3,npw_tot))
+ - + - -
+ - + -
+ ]
350 : : call xmpi_allgatherv(kg_k_gather,&
351 [ + - + + : 9213 : & 3*ndatarecv,kg_k_gather_all,3*npw_per_proc(:),3*rdispls_all,mpi_enreg%comm_fft,ierr)
+ - + + ]
352 [ + - ]: 4470 : if (mgfft>0) then
353 : 2235 : call sphereboundary(gbound,istwf_k,kg_k_gather_all,mgfft,npw_tot)
354 : : end if
355 : :
356 : : else !if (istwf_k==2) then
357 : :
358 : : ! ============================================================================
359 : : ! In this case, we have to add the opposite values in the kg_k_gather tab
360 : : ! before computing gbound
361 : : ! ============================================================================
362 : :
363 : : ! Allocation
364 [ - + + - : 2364 : ABI_MALLOC(tab_proc ,(ndatarecv))
+ - + - -
+ - + ]
365 [ - + + - : 1576 : ABI_MALLOC(sendcounts_sym ,(nproc_fft))
- + - + -
+ ]
366 [ - + + - : 2364 : ABI_MALLOC(sendcounts_sym_all,(nproc_fft*nproc_fft))
+ - + - -
+ - + ]
367 [ - + + - : 1576 : ABI_MALLOC(sdispls_sym ,(nproc_fft))
- + - + ]
368 [ - + + - : 1576 : ABI_MALLOC(recvcounts_sym ,(nproc_fft))
- + - + -
+ ]
369 [ - + + - : 1576 : ABI_MALLOC(recvcounts_sym_tot,(nproc_fft))
- + - + -
+ ]
370 [ - + + - : 1576 : ABI_MALLOC(rdispls_sym ,(nproc_fft))
- + - + -
+ ]
371 [ - + + - : 1576 : ABI_MALLOC(sendcounts_sym_loc,(nproc_fft))
- + - + -
+ ]
372 [ - + + - : 1576 : ABI_MALLOC(sdispls_sym_loc ,(nproc_fft))
- + - + -
+ ]
373 [ - + + - : 1576 : ABI_MALLOC(recvcounts_sym_loc,(nproc_fft))
- + - + -
+ ]
374 [ - + + - : 1576 : ABI_MALLOC(rdispls_sym_loc ,(nproc_fft))
- + - + -
+ ]
375 : :
376 : : ! Initialisation
377 [ + + ]: 140996 : tab_proc(:) = 0
378 [ + + ]: 1594 : sendcounts_sym(:) = 0
379 [ + + ]: 1630 : sendcounts_sym_all(:) = 0
380 [ + + ]: 1594 : sdispls_sym(:) = 0
381 [ + + ]: 1594 : recvcounts_sym(:) = 0
382 [ + + ]: 1594 : recvcounts_sym_tot(:) = 0
383 : :
384 : : ! Localisation of kg_k==[0 0 0]
385 [ - + + - : 1576 : ABI_MALLOC(sum_kg,(ndatarecv))
- + - + ]
386 : 788 : idatarecv0 = -1
387 : 788 : ndatasend_sym = ndatarecv
388 [ + - - + : 562408 : sum_kg=sum(abs(kg_k_gather),1)
- - + + +
+ ]
389 [ + + + + : 140996 : if (count(sum_kg==0)/=0) then
+ + ]
390 [ + + ]: 137621 : do idatarecv=1,ndatarecv
391 [ + + ]: 137621 : if (sum_kg(idatarecv)==0) idatarecv0=idatarecv
392 : : end do
393 : 779 : ndatasend_sym = ndatarecv-1
394 : : end if
395 : :
396 : : ! Localisation of the processor where the vector -k2 is
397 : 788 : n2 = mpi_enreg%distribfft%n2_coarse
398 [ + + ]: 140996 : do idatarecv=1,ndatarecv
399 [ + + ]: 140996 : if (idatarecv/=idatarecv0) then
400 : 139429 : tab_proc(idatarecv) = mpi_enreg%distribfft%tab_fftwf2_distrib(modulo(-kg_k_gather(2,idatarecv),n2) + 1)
401 : : else
402 : 779 : tab_proc(idatarecv) = -1
403 : : end if
404 : : end do
405 : :
406 : : ! Number of values send by the processor to the others
407 [ + + ]: 1594 : do iproc=1,nproc_fft
408 [ + + + + ]: 148626 : sendcounts_sym(iproc) = count(tab_proc(:)==(iproc-1))
409 : : end do
410 : :
411 : : ! Save sendcounts_sym for each processor in sendcounts_sym_all
412 : : ! knowed by all processors of comm_fft
413 : 788 : rdispls_sym(1)=0
414 [ + + ]: 806 : do iproc=2,nproc_fft
415 : 806 : rdispls_sym(iproc)= nproc_fft*(iproc-1)
416 : : end do
417 [ + + ]: 1594 : recvcounts_sym(:)=nproc_fft
418 : : call xmpi_allgatherv(sendcounts_sym(:),nproc_fft,&
419 : 788 : & sendcounts_sym_all(:),recvcounts_sym,rdispls_sym,comm_fft,ierr)
420 : :
421 : : ! Calculation of the dimension of kg_k_gather_sym for each processor
422 : : ! recvcounts_sym_tot is knowed by all processors of comm_fft
423 : 788 : call xmpi_sum(sendcounts_sym,recvcounts_sym_tot,nproc_fft,comm_fft,ierr)
424 : :
425 : : ! Dimension of kg_k_gather_sym
426 : 788 : ndatarecv_tot = ndatarecv+recvcounts_sym_tot(me_fft+1)
427 : :
428 : : ! Intialize kg_k_gather_sym
429 [ - + + - : 2364 : ABI_MALLOC(kg_k_gather_sym,(3,ndatarecv_tot))
+ - + - -
+ - + ]
430 [ + + + + ]: 1119336 : kg_k_gather_sym(:,:)=0
431 [ + + + + ]: 561620 : kg_k_gather_sym(:,1:ndatarecv) = kg_k_gather(:,:)
432 : :
433 : : ! Allocation and initialisation
434 [ - + + - : 2364 : ABI_MALLOC(kg_k_gather_send,(3,ndatasend_sym))
+ - + - -
+ - + ]
435 [ + + + + ]: 558504 : kg_k_gather_send(:,:)=0
436 : :
437 : : ! The values are sorted in blocks
438 : : jsendloc=0
439 [ + + ]: 1594 : do iproc=1,nproc_fft
440 : :
441 : : ! Position of the beginning of the block
442 : 806 : sdispls_sym(iproc)=jsendloc
443 : :
444 : : ! Creation of the blocks
445 [ + + ]: 148626 : do idatarecv=1,ndatarecv
446 [ + + ]: 147838 : if (tab_proc(idatarecv)==(iproc-1)) then
447 : 139429 : jsendloc=jsendloc+1
448 [ + + ]: 557716 : kg_k_gather_send(:,jsendloc) = -kg_k_gather(:,idatarecv)
449 : : end if
450 : : end do
451 : : end do
452 : :
453 : : ! Position of received data
454 : 788 : rdispls_sym(1)= ndatarecv
455 : 788 : recvcounts_sym(1)= sendcounts_sym_all((me_fft+1))
456 [ + + ]: 806 : do iproc=2,nproc_fft
457 : : rdispls_sym(iproc) = rdispls_sym(iproc-1) + &
458 : 18 : sendcounts_sym_all((me_fft+1)+(iproc-2)*nproc_fft)
459 : 806 : recvcounts_sym(iproc) = sendcounts_sym_all((me_fft+1)+(iproc-1)*nproc_fft)
460 : : end do
461 : :
462 : : ! Exchange of kg_k
463 [ + - - + : 2382 : sendcounts_sym_loc = sendcounts_sym*3
- - + + ]
464 [ - + + + ]: 2382 : sdispls_sym_loc = sdispls_sym *3
465 [ - + + + ]: 2382 : recvcounts_sym_loc = recvcounts_sym*3
466 [ - + + + ]: 2382 : rdispls_sym_loc = rdispls_sym *3
467 : : call xmpi_alltoallv(kg_k_gather_send(:,:),sendcounts_sym_loc,sdispls_sym_loc,&
468 : 788 : & kg_k_gather_sym(:,:) ,recvcounts_sym_loc,rdispls_sym_loc,comm_fft,ierr)
469 : :
470 : : ! Store the following data in the bandfft_kpt_in data_struc
471 : 788 : ikpt_this_proc=mpi_enreg%my_kpttab(ikpt)
472 [ + - ]: 788 : if (bandfft_kpt_in(ikpt_this_proc)%flag3_is_allocated==0) then
473 [ - + + - : 1576 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%kg_k_gather_sym,(3,ndatarecv_tot))
- + - + -
+ ]
474 [ - + + - : 1576 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%rdispls_sym,(nproc_fft))
- + - + -
+ ]
475 [ - + + - : 1576 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%recvcounts_sym,(nproc_fft))
- + - + -
+ ]
476 [ - + + - : 1576 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%recvcounts_sym_tot,(nproc_fft))
- + - + -
+ ]
477 [ - + + - : 1576 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%sdispls_sym,(nproc_fft))
- + - + -
+ ]
478 [ - + + - : 1576 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%sendcounts_sym,(nproc_fft))
- + - + -
+ ]
479 [ - + + - : 1576 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%sendcounts_sym_all,(nproc_fft*nproc_fft))
- + - + -
+ ]
480 [ - + + - : 1576 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%tab_proc,(ndatarecv))
- + - + -
+ ]
481 : 788 : bandfft_kpt_in(ikpt_this_proc)%flag3_is_allocated=1
482 : : end if
483 : :
484 : 788 : bandfft_kpt_in(ikpt_this_proc)%idatarecv0 =idatarecv0
485 : 788 : bandfft_kpt_in(ikpt_this_proc)%ndatarecv_tot =ndatarecv_tot
486 : 788 : bandfft_kpt_in(ikpt_this_proc)%ndatasend_sym =ndatasend_sym
487 [ + + + + ]: 1119336 : bandfft_kpt_in(ikpt_this_proc)%kg_k_gather_sym(:,:) =kg_k_gather_sym(:,:)
488 [ + + ]: 1594 : bandfft_kpt_in(ikpt_this_proc)%rdispls_sym(:) =rdispls_sym(:)
489 [ + + ]: 1594 : bandfft_kpt_in(ikpt_this_proc)%recvcounts_sym(:) =recvcounts_sym(:)
490 [ + + ]: 1594 : bandfft_kpt_in(ikpt_this_proc)%recvcounts_sym_tot(:)=recvcounts_sym_tot(:)
491 [ + + ]: 1594 : bandfft_kpt_in(ikpt_this_proc)%sdispls_sym(:) =sdispls_sym(:)
492 [ + + ]: 1594 : bandfft_kpt_in(ikpt_this_proc)%sendcounts_sym(:) =sendcounts_sym(:)
493 [ + + ]: 1630 : bandfft_kpt_in(ikpt_this_proc)%sendcounts_sym_all(:)=sendcounts_sym_all(:)
494 [ + + ]: 140996 : bandfft_kpt_in(ikpt_this_proc)%tab_proc(:) =tab_proc(:)
495 : :
496 [ - + ]: 788 : ABI_FREE(tab_proc)
497 [ - + ]: 788 : ABI_FREE(sendcounts_sym)
498 : 788 : ABI_FREE(sendcounts_sym_all)
499 [ - + ]: 788 : ABI_FREE(sdispls_sym)
500 : 788 : ABI_FREE(recvcounts_sym)
501 : 788 : ABI_FREE(recvcounts_sym_tot)
502 : 788 : ABI_FREE(rdispls_sym)
503 [ - + ]: 788 : ABI_FREE(kg_k_gather_sym)
504 [ - + ]: 788 : ABI_FREE(sendcounts_sym_loc)
505 [ - + ]: 788 : ABI_FREE(recvcounts_sym_loc)
506 [ - + ]: 788 : ABI_FREE(sdispls_sym_loc)
507 [ - + ]: 788 : ABI_FREE(rdispls_sym_loc)
508 [ - + ]: 788 : ABI_FREE(kg_k_gather_send)
509 [ - + ]: 788 : ABI_FREE(sum_kg)
510 : :
511 : : ! Then compute gbound
512 : 788 : call xmpi_allgather(ndatarecv_tot,npw_per_proc,mpi_enreg%comm_fft,ierr)
513 : 788 : rdispls_all(1)=0
514 [ + + ]: 806 : do iproc=2,nproc_fft
515 : 806 : rdispls_all(iproc)=rdispls_all(iproc-1)+npw_per_proc(iproc-1)
516 : : end do
517 : 788 : npw_tot=rdispls_all(nproc_fft)+npw_per_proc(nproc_fft)
518 [ - + + - : 2364 : ABI_MALLOC(kg_k_gather_all,(3,npw_tot))
+ - + - -
+ - + -
+ ]
519 : : call xmpi_allgatherv(bandfft_kpt_in(ikpt_this_proc)%kg_k_gather_sym,&
520 [ + - + + : 2400 : & 3*ndatarecv_tot,kg_k_gather_all,3*npw_per_proc(:),3*rdispls_all,mpi_enreg%comm_fft,ierr)
+ - + + ]
521 [ - + ]: 2364 : if (mgfft>0) then
522 : 788 : call sphereboundary(gbound,istwf_k,kg_k_gather_all,mgfft,npw_tot)
523 : : end if
524 : :
525 : : ! Only calculations with istwfk=1 or 2
526 : : end if
527 [ - + ]: 3023 : ABI_FREE(kg_k_gather_all)
528 [ - + ]: 3023 : ABI_FREE(npw_per_proc)
529 [ - + ]: 3023 : ABI_FREE(rdispls_all)
530 : : ! ============================================================================
531 : : ! End of gbound
532 : : ! ============================================================================
533 : :
534 : : ! Check if there is k_G vectors have been redistributed (after unbalancing dectecion)
535 : : ! Note that FFT load balancing is directly related to unbalancing detection
536 : : ! made in kpgsph routine.
537 : 3023 : itest=0 ; n2 = mpi_enreg%distribfft%n2_coarse
538 [ + + ]: 744418 : do idatarecv=1,ndatarecv
539 : 741395 : iproc=mpi_enreg%distribfft%tab_fftwf2_distrib(modulo(kg_k_gather(2,idatarecv),n2)+1)
540 [ - + ]: 744418 : if (iproc/=me_fft) itest=itest+1
541 : : end do
542 : 3023 : call xmpi_sum(itest,mpi_enreg%comm_fft,ierr)
543 [ - + ]: 3023 : if (itest>0) then
544 : : write(message, '(a,i4,3a)' ) &
545 : 0 : & 'There is a load unbalancing for the FFT parallelization (kpt',ikpt,').',ch10,&
546 : 0 : & 'Plane-wave components will be redistributed before each FFT!'
547 : 0 : ABI_COMMENT(message)
548 : : end if
549 : 3023 : bandfft_kpt_in(ikpt_this_proc)%have_to_reequilibrate=(itest>0)
550 : :
551 : : ! If yes, store relevant data
552 [ - + ]: 3023 : if(bandfft_kpt_in(ikpt_this_proc)%have_to_reequilibrate) then
553 : 0 : n2 = mpi_enreg%distribfft%n2_coarse
554 [ # # ]: 0 : sendcounts_fft(:) = 0
555 [ # # ]: 0 : recvcounts_fft(:) = 0
556 [ # # ]: 0 : senddisp_fft(:) = 0
557 [ # # ]: 0 : recvdisp_fft(:) = 0
558 [ # # ]: 0 : do idatarecv = 1 ,ndatarecv
559 : 0 : iproc = mpi_enreg%distribfft%tab_fftwf2_distrib(modulo(kg_k_gather(2,idatarecv),n2) + 1)
560 : 0 : sendcounts_fft(iproc + 1) = sendcounts_fft(iproc + 1) + 1
561 : : end do
562 : 0 : call xmpi_alltoall(sendcounts_fft,1,recvcounts_fft,1,mpi_enreg%comm_fft,ierr)
563 [ # # ]: 0 : do iproc =2, nproc_fft
564 : 0 : senddisp_fft(iproc) = senddisp_fft(iproc - 1) + sendcounts_fft(iproc-1)
565 : 0 : recvdisp_fft(iproc) = recvdisp_fft(iproc - 1) + recvcounts_fft(iproc-1)
566 : : end do
567 : 0 : npw_fft = recvdisp_fft(nproc_fft) + recvcounts_fft(nproc_fft) ! nb plane wave for fourwf call
568 [ # # # # : 0 : ABI_MALLOC(buff_kg,(3,ndatarecv)) ! for sorting kg_k
# # # # #
# # # #
# ]
569 [ # # # # : 0 : ABI_MALLOC(kg_k_fft,(3,npw_fft))
# # # # #
# # # #
# ]
570 [ # # # # : 0 : ABI_MALLOC(indices_pw_fft,(ndatarecv))
# # # # #
# # # ]
571 : : !filling of sorted send buffers
572 [ # # ]: 0 : sendcounts_fft(:) = 0
573 [ # # ]: 0 : do idatarecv = 1 ,ndatarecv
574 : 0 : iproc = mpi_enreg%distribfft%tab_fftwf2_distrib(modulo(kg_k_gather(2,idatarecv),n2) + 1)
575 : 0 : sendcounts_fft(iproc + 1) = sendcounts_fft(iproc + 1) + 1
576 : 0 : indices_pw_fft(idatarecv) = senddisp_fft(iproc+1) + sendcounts_fft(iproc+1)
577 [ # # ]: 0 : buff_kg(1:3,indices_pw_fft(idatarecv)) = kg_k_gather(1:3,idatarecv)
578 : : end do
579 : :
580 : : call xmpi_alltoallv(buff_kg, 3*sendcounts_fft, 3*senddisp_fft, &
581 [ # # # # : 0 : & kg_k_fft,3*recvcounts_fft, 3*recvdisp_fft, mpi_enreg%comm_fft,ierr)
# # # # #
# # # ]
582 : :
583 [ # # ]: 0 : if (.not.reequilibrate_allocated) then
584 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%kg_k_fft, (3,npw_fft) )
# # # # #
# ]
585 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%indices_pw_fft, (ndatarecv))
# # # # #
# ]
586 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%sendcount_fft, (nproc_fft))
# # # # #
# # # #
# ]
587 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%senddisp_fft, (nproc_fft))
# # # # #
# ]
588 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%recvcount_fft, (nproc_fft))
# # # # #
# ]
589 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%recvdisp_fft, (nproc_fft))
# # # # #
# ]
590 : : end if
591 : 0 : bandfft_kpt_in(ikpt_this_proc)%npw_fft = npw_fft
592 [ # # ]: 0 : bandfft_kpt_in(ikpt_this_proc)%indices_pw_fft(:) = indices_pw_fft(:)
593 [ # # ]: 0 : bandfft_kpt_in(ikpt_this_proc)%sendcount_fft (:) = sendcounts_fft (:)
594 [ # # ]: 0 : bandfft_kpt_in(ikpt_this_proc)%senddisp_fft(:) = senddisp_fft(:)
595 [ # # ]: 0 : bandfft_kpt_in(ikpt_this_proc)%recvcount_fft(:) = recvcounts_fft(:)
596 [ # # ]: 0 : bandfft_kpt_in(ikpt_this_proc)%recvdisp_fft(:) = recvdisp_fft(:)
597 [ # # # # ]: 0 : bandfft_kpt_in(ikpt_this_proc)%kg_k_fft(:,:) = kg_k_fft(:,:)
598 [ # # ]: 0 : ABI_FREE(buff_kg )
599 [ # # ]: 0 : ABI_FREE(kg_k_fft)
600 [ # # ]: 0 : ABI_FREE(indices_pw_fft)
601 : : end if
602 : :
603 : : ! Tabs which are common to istwf_k=1 and 2
604 : : #if defined HAVE_GPU && defined HAVE_YAKL
605 : : if (.not. associated(bandfft_kpt_in(ikpt_this_proc)%kg_k_gather)) then
606 : : if(bandfft_kpt_in(ikpt_this_proc)%gpu_option==ABI_GPU_KOKKOS) then
607 : : ABI_MALLOC_MANAGED(bandfft_kpt_in(ikpt_this_proc)%kg_k_gather,(/3,ndatarecv/))
608 : : else
609 : : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%kg_k_gather,(3,ndatarecv))
610 : : end if
611 : : end if
612 : : #else
613 [ + + ]: 3023 : if (.not. allocated(bandfft_kpt_in(ikpt_this_proc)%kg_k_gather)) then
614 [ - + + - : 9021 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%kg_k_gather,(3,ndatarecv))
+ - + - -
+ - + -
+ ]
615 : : end if
616 : : #endif
617 : :
618 [ + + ]: 11916 : bandfft_kpt_in(ikpt_this_proc)%recvcounts(:) =recvcounts(:)
619 [ + + ]: 11916 : bandfft_kpt_in(ikpt_this_proc)%sendcounts(:) =sendcounts(:)
620 [ + + ]: 11916 : bandfft_kpt_in(ikpt_this_proc)%rdispls(:) =rdispls(:)
621 [ + + ]: 11916 : bandfft_kpt_in(ikpt_this_proc)%sdispls(:) =sdispls(:)
622 [ + + + + ]: 291201 : bandfft_kpt_in(ikpt_this_proc)%gbound(:,:) =gbound(:,:)
623 [ + + + + ]: 2968603 : bandfft_kpt_in(ikpt_this_proc)%kg_k_gather(:,:)=kg_k_gather(:,:)
624 : 3023 : bandfft_kpt_in(ikpt_this_proc)%ndatarecv =ndatarecv
625 : 3023 : bandfft_kpt_in(ikpt_this_proc)%istwf_k =istwf_k
626 : 3023 : bandfft_kpt_in(ikpt_this_proc)%npw_tot =npw_tot
627 [ - + ]: 3023 : ABI_FREE(kg_k_gather)
628 [ - + ]: 3023 : ABI_FREE(kg_k)
629 [ - + ]: 3023 : ABI_FREE(gbound)
630 : :
631 : 10736 : ikg=ikg+npw_k
632 : : end do
633 : : end do
634 [ - + ]: 635 : ABI_FREE(recvcounts)
635 [ - + ]: 635 : ABI_FREE(sendcounts)
636 [ - + ]: 635 : ABI_FREE(rdispls)
637 [ - + ]: 635 : ABI_FREE(sdispls)
638 [ - + ]: 635 : ABI_FREE(sendcounts_fft)
639 [ - + ]: 635 : ABI_FREE(senddisp_fft)
640 [ - + ]: 635 : ABI_FREE(recvcounts_fft)
641 [ - + ]: 635 : ABI_FREE(recvdisp_fft)
642 : :
643 : : !=============================================================================
644 : : !End of computation and storage of the bandfft_kpt(ikpt) data_struc
645 : : !=============================================================================
646 : :
647 [ - + - + : 5710 : end subroutine bandfft_kpt_init1
- + - + -
+ - + - +
- + - + -
+ - + - +
- + - + -
+ - + -
+ ]
648 : : !!***
649 : :
650 : : !----------------------------------------------------------------------
651 : :
652 : : !!****f* m_bandfft_kpt/bandfft_kpt_init2
653 : : !! NAME
654 : : !! bandfft_kpt_init2
655 : : !!
656 : : !! FUNCTION
657 : : !! Init part of scalars and pointers in a bandfft_kpt datastructure
658 : : !!
659 : : !! INPUTS
660 : : !! dimffnl=second dimension of ffnl (1+number of derivatives)
661 : : !! ffnl_gather(ndatarecv,dimffnl,lmnmax,ntypat)=nonlocal form factors on basis sphere.
662 : : !! kinpw_gather(:)=(modified) kinetic energy for each plane wave (Hartree)
663 : : !! kpg_k_gather(ndatarecv,nkpg)=k+G vector for a given k point
664 : : !! lmnmax=if useylm=1, max number of (l,m,n) comp. over all type of psps
665 : : !! =if useylm=0, max number of (l,n) comp. over all type of psps
666 : : !! matblk=dimension of the array ph3d
667 : : !! mkmem =number of k points which can fit in memory; set to 0 if use disk
668 : : !! ndatarecv= dimension of the arrays
669 : : !! nkpg=second dimension of kpg_k (0 if useylm=0)
670 : : !! ntypat=number of types of atoms in unit cell.
671 : : !! ph3d_gather(2,ndatarecv,matblk)=3-dim structure factors, for each atom and plane wave.
672 : :
673 : : !! OUTPUT
674 : : !!
675 : : !! SIDE EFFECTS
676 : : !!
677 : : !! SOURCE
678 : :
679 [ - + ]: 13146 : subroutine bandfft_kpt_init2(bandfft_kpt_in,dimffnl,ffnl_gather,ikpt_this_proc,kinpw_gather,&
680 [ - + - + : 13146 : & kpg_k_gather,lmnmax,matblk,mkmem,ndatarecv,nkpg,ntypat,ph3d_gather)
- + ]
681 : :
682 : : !Arguments -------------------------------
683 : : integer, intent(in) :: dimffnl,ikpt_this_proc,lmnmax,matblk,mkmem,ndatarecv,nkpg,ntypat
684 : : !Local variables-------------------------------
685 : : real(dp),intent(in) :: ffnl_gather(:,:,:,:),kinpw_gather(:)
686 : : real(dp),intent(in) :: kpg_k_gather(:,:),ph3d_gather(:,:,:)
687 : : type(bandfft_kpt_type), intent(inout) :: bandfft_kpt_in (mkmem)
688 : :
689 : : ! *********************************************************************
690 : :
691 [ + + ]: 13146 : ABI_SFREE(bandfft_kpt_in(ikpt_this_proc)%ffnl_gather)
692 [ + + + - ]: 65730 : if (size(ffnl_gather)>0) then
693 [ - + + - : 78876 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%ffnl_gather,(ndatarecv,dimffnl,lmnmax,ntypat))
- + + - -
+ + - - +
+ - + - +
- - + - +
- + ]
694 [ + + + + : 74379670 : bandfft_kpt_in(ikpt_this_proc)%ffnl_gather(:,:,:,:)=ffnl_gather(:,:,:,:)
+ + + + ]
695 : : else
696 [ # # # # ]: 0 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%ffnl_gather,(0,0,0,0))
697 : : end if
698 : :
699 [ + + ]: 13146 : ABI_SFREE(bandfft_kpt_in(ikpt_this_proc)%ph3d_gather)
700 [ + - ]: 13146 : if (size(ph3d_gather,dim=1)>0) then
701 [ - + + - : 52584 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%ph3d_gather,(2,ndatarecv,matblk))
- + + - +
- + - - +
- + - + ]
702 [ + + + + : 34010266 : bandfft_kpt_in(ikpt_this_proc)%ph3d_gather(:,:,:) =ph3d_gather(:,:,:)
+ + ]
703 : : else
704 [ # # # # ]: 0 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%ph3d_gather,(0,0,0))
705 : : end if
706 : :
707 [ + + ]: 13146 : ABI_SFREE(bandfft_kpt_in(ikpt_this_proc)%kpg_k_gather)
708 [ + + + + ]: 39438 : if (size(kpg_k_gather)>0) then
709 [ - + + - : 13868 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%kpg_k_gather,(ndatarecv,nkpg))
- + + - +
- + - - +
- + - + ]
710 [ + + + + ]: 2393828 : bandfft_kpt_in(ikpt_this_proc)%kpg_k_gather(:,:) =kpg_k_gather(:,:)
711 : : else
712 [ - + - + ]: 9679 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%kpg_k_gather,(0,0))
713 : : end if
714 : :
715 : : #if defined HAVE_GPU && defined HAVE_YAKL
716 : : if (associated(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather)) then
717 : : if(bandfft_kpt_in(ikpt_this_proc)%gpu_option==ABI_GPU_KOKKOS) then
718 : : ABI_FREE_MANAGED(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather)
719 : : else
720 : : ABI_FREE(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather)
721 : : end if
722 : : end if
723 : : if(bandfft_kpt_in(ikpt_this_proc)%gpu_option==ABI_GPU_KOKKOS) then
724 : : if (size(kinpw_gather)>0) then
725 : : ABI_MALLOC_MANAGED(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather,(/ndatarecv/))
726 : : bandfft_kpt_in(ikpt_this_proc)%kinpw_gather(:) =kinpw_gather(:)
727 : : else
728 : : ABI_MALLOC_MANAGED(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather,(/0/))
729 : : end if
730 : : else
731 : : if (size(kinpw_gather)>0) then
732 : : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather,(ndatarecv))
733 : : bandfft_kpt_in(ikpt_this_proc)%kinpw_gather(:) =kinpw_gather(:)
734 : : else
735 : : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather,(0))
736 : : end if
737 : : end if
738 : : #else
739 [ + + ]: 13146 : ABI_SFREE(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather)
740 [ + + ]: 13146 : if (size(kinpw_gather)>0) then
741 [ - + + - : 30588 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather,(ndatarecv))
+ - + - -
+ - + -
+ ]
742 [ + + ]: 1924895 : bandfft_kpt_in(ikpt_this_proc)%kinpw_gather(:) =kinpw_gather(:)
743 : : else
744 [ - + - + ]: 2950 : ABI_MALLOC(bandfft_kpt_in(ikpt_this_proc)%kinpw_gather,(0))
745 : : end if
746 : : #endif
747 : :
748 : 13146 : bandfft_kpt_in(ikpt_this_proc)%flag2_is_allocated=1
749 : :
750 : 13146 : end subroutine bandfft_kpt_init2
751 : : !!***
752 : :
753 : : !----------------------------------------------------------------------
754 : :
755 : : !!****f* m_bandfft_kpt/bandfft_kpt_reset
756 : : !! NAME
757 : : !! bandfft_kpt_reset
758 : : !!
759 : : !! FUNCTION
760 : : !! Reset flags a bandfft_kpt datastructure
761 : : !!
762 : : !! INPUTS
763 : : !!
764 : : !! OUTPUT
765 : : !!
766 : : !! SIDE EFFECTS
767 : : !! bandfft_kpt_in=the datastructure to nullify
768 : : !!
769 : : !! SOURCE
770 : :
771 : 0 : subroutine bandfft_kpt_reset(bandfft_kpt_in)
772 : :
773 : : !Arguments ------------------------------------
774 : : type(bandfft_kpt_type) :: bandfft_kpt_in
775 : : !Local variables-------------------------------
776 : :
777 : : ! ***********************************************************************
778 : :
779 : 0 : bandfft_kpt_in%flag1_is_allocated=0
780 : 0 : bandfft_kpt_in%flag2_is_allocated=0
781 : 0 : bandfft_kpt_in%flag3_is_allocated=0
782 : 0 : bandfft_kpt_in%have_to_reequilibrate=.false.
783 : :
784 : 0 : end subroutine bandfft_kpt_reset
785 : : !!***
786 : :
787 : : !----------------------------------------------------------------------
788 : :
789 : : !!****f* m_bandfft_kpt/bandfft_kpt_destroy
790 : : !! NAME
791 : : !! bandfft_kpt_destroy
792 : : !!
793 : : !! FUNCTION
794 : : !! Destroy a bandfft_kpt datastructure
795 : : !!
796 : : !! INPUTS
797 : : !!
798 : : !! OUTPUT
799 : : !!
800 : : !! SIDE EFFECTS
801 : : !! bandfft_kpt_in=the datastructure to destroy
802 : : !!
803 : : !! SOURCE
804 : :
805 : 3023 : subroutine bandfft_kpt_destroy(bandfft_kpt_in)
806 : :
807 : : !Arguments ------------------------------------
808 : : type(bandfft_kpt_type) :: bandfft_kpt_in
809 : : !Local variables-------------------------------
810 : :
811 : : ! ***********************************************************************
812 : :
813 : 3023 : bandfft_kpt_in%flag1_is_allocated=0
814 : 3023 : bandfft_kpt_in%flag2_is_allocated=0
815 : 3023 : bandfft_kpt_in%flag3_is_allocated=0
816 : 3023 : bandfft_kpt_in%have_to_reequilibrate=.false.
817 : :
818 : : #if defined HAVE_GPU && defined HAVE_YAKL
819 : : if (associated(bandfft_kpt_in%kg_k_gather)) then
820 : : if(bandfft_kpt_in%gpu_option==ABI_GPU_KOKKOS) then
821 : : ABI_FREE_MANAGED(bandfft_kpt_in%kg_k_gather)
822 : : else
823 : : ABI_FREE(bandfft_kpt_in%kg_k_gather)
824 : : end if
825 : : end if
826 : : #else
827 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%kg_k_gather)
828 : : #endif
829 : :
830 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%gbound)
831 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%recvcounts)
832 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%sendcounts)
833 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%rdispls)
834 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%sdispls)
835 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%ffnl_gather)
836 : :
837 : : #if defined HAVE_GPU && defined HAVE_YAKL
838 : : if (associated(bandfft_kpt_in%kinpw_gather)) then
839 : : if(bandfft_kpt_in%gpu_option==ABI_GPU_KOKKOS) then
840 : : ABI_FREE_MANAGED(bandfft_kpt_in%kinpw_gather)
841 : : else
842 : : ABI_FREE(bandfft_kpt_in%kinpw_gather)
843 : : end if
844 : : end if
845 : : #else
846 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%kinpw_gather)
847 : : #endif
848 : :
849 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%kpg_k_gather)
850 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%ph3d_gather)
851 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%ffnl_kp_gather)
852 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%kinpw_kp_gather)
853 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%kpg_kp_gather)
854 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%ph3d_kp_gather)
855 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%kg_k_gather_sym)
856 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%rdispls_sym)
857 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%recvcounts_sym)
858 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%recvcounts_sym_tot)
859 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%sdispls_sym)
860 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%sendcounts_sym)
861 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%sendcounts_sym_all)
862 [ + + ]: 3023 : ABI_SFREE(bandfft_kpt_in%tab_proc)
863 [ - + ]: 3023 : ABI_SFREE(bandfft_kpt_in%indices_pw_fft)
864 [ - + ]: 3023 : ABI_SFREE(bandfft_kpt_in%sendcount_fft)
865 [ - + ]: 3023 : ABI_SFREE(bandfft_kpt_in%senddisp_fft)
866 [ - + ]: 3023 : ABI_SFREE(bandfft_kpt_in%recvcount_fft)
867 [ - + ]: 3023 : ABI_SFREE(bandfft_kpt_in%recvdisp_fft)
868 [ - + ]: 3023 : ABI_SFREE(bandfft_kpt_in%kg_k_fft)
869 : :
870 : 3023 : end subroutine bandfft_kpt_destroy
871 : : !!***
872 : :
873 : : !----------------------------------------------------------------------
874 : :
875 : : !!****f* m_bandfft_kpt/bandfft_kpt_destroy_array
876 : : !! NAME
877 : : !! bandfft_kpt_destroy_array
878 : : !!
879 : : !! FUNCTION
880 : : !! Clean and destroy an array of bandfft_kpt datastructures
881 : : !!
882 : : !! INPUTS
883 : : !!
884 : : !! OUTPUT
885 : : !!
886 : : !! SIDE EFFECTS
887 : : !! bandfft_kpt_in(:)=the array of datastructure to destroy
888 : : !!
889 : : !!
890 : : !! SOURCE
891 : :
892 : 5709 : subroutine bandfft_kpt_destroy_array(bandfft_kpt_in,mpi_enreg)
893 : :
894 : : !Arguments ------------------------------------
895 : : type(bandfft_kpt_type),pointer :: bandfft_kpt_in(:)
896 : : type(MPI_type), intent(inout) :: mpi_enreg
897 : :
898 : : !Local variables-------------------------------
899 : : integer :: ikpt_this_proc,isppol,ikpt,mkmem,nband,nkpt,nsppol
900 : : character(len=500) :: msg
901 : :
902 : : ! ***********************************************************************
903 : :
904 : : if (xmpi_paral==0) return
905 : :
906 [ + + ]: 5709 : if (associated(bandfft_kpt_in)) then
907 : 635 : mkmem =size(bandfft_kpt_in)
908 : 635 : nkpt=size(mpi_enreg%proc_distrb,1)
909 : 635 : nband=size(mpi_enreg%proc_distrb,2)
910 : 635 : nsppol=size(mpi_enreg%proc_distrb,3)
911 [ - + ]: 635 : if (nsppol==0.or.nkpt==0) then
912 : 0 : msg=' mpi_enreg%proc_distrb should be allocated !'
913 : 0 : ABI_BUG(msg)
914 : : end if
915 : 635 : nkpt=size(mpi_enreg%my_kpttab)
916 [ - + ]: 635 : if (nkpt==0) then
917 : 0 : msg=' mpi_enreg%my_kpttab should be allocated !'
918 : 0 : ABI_BUG(msg)
919 : : end if
920 [ + + ]: 1298 : do isppol=1,nsppol
921 [ + + ]: 5325 : do ikpt=1,nkpt
922 [ + + ]: 4027 : if(proc_distrb_cycle(mpi_enreg%proc_distrb,ikpt,1,nband,isppol,mpi_enreg%me_kpt)) cycle
923 : 3023 : ikpt_this_proc=mpi_enreg%my_kpttab(ikpt)
924 [ - + ]: 3023 : if ((ikpt_this_proc>mkmem) .or.(ikpt_this_proc<=0)) then
925 : 0 : msg=' The bandfft tab cannot be deallocated !'
926 : 0 : ABI_BUG(msg)
927 : : end if
928 : 4690 : call bandfft_kpt_destroy(bandfft_kpt_in(ikpt_this_proc))
929 : : end do
930 : : end do
931 [ - + ]: 635 : ABI_FREE(bandfft_kpt_in)
932 : : nullify(bandfft_kpt_in)
933 : : end if
934 : :
935 : 5709 : end subroutine bandfft_kpt_destroy_array
936 : : !!***
937 : :
938 : : !----------------------------------------------------------------------
939 : :
940 : : !!****f* m_bandfft_kpt/bandfft_kpt_copy
941 : : !! NAME
942 : : !! bandfft_kpt_copy
943 : : !!
944 : : !! FUNCTION
945 : : !! Copy a bandfft_kpt datastructure into another
946 : : !!
947 : : !! INPUTS
948 : : !! bandfft_kpt_in=<type(bandfft_kpt_type)>=input bandfft_kpt datastructure
949 : : !!
950 : : !! OUTPUT
951 : : !! bandfft_kpt_out=<type(bandfft_kpt_type)>=output bandfft_kpt datastructure
952 : : !!
953 : : !! SOURCE
954 : :
955 : 0 : subroutine bandfft_kpt_copy(bandfft_kpt_in,bandfft_kpt_out,mpi_enreg1,opt_bandfft)
956 : :
957 : : !Arguments ------------------------------------
958 : : !scalars
959 : : integer,intent(in) :: opt_bandfft
960 : : type(bandfft_kpt_type),pointer :: bandfft_kpt_in(:)
961 : : type(bandfft_kpt_type),pointer :: bandfft_kpt_out(:)
962 : : type(MPI_type),intent(inout) :: mpi_enreg1
963 : :
964 : : !Local variables-------------------------------
965 : : !scalars
966 : : integer :: ikpt,isppol,jkpt,sz1,sz2,sz3,sz4
967 : :
968 : : ! *********************************************************************
969 : :
970 : : !Optional pointers
971 [ # # ]: 0 : if (opt_bandfft==0) then
972 : 0 : nullify(bandfft_kpt_out)
973 [ # # ]: 0 : else if (opt_bandfft==1) then
974 [ # # ]: 0 : if (associated(bandfft_kpt_in)) then
975 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out,(size(bandfft_kpt_in)))
# # # # #
# # # #
# ]
976 [ # # ]: 0 : do isppol=1,size(mpi_enreg1%proc_distrb,3)
977 [ # # ]: 0 : do ikpt=1,size(mpi_enreg1%proc_distrb,1)
978 : 0 : sz1=size(mpi_enreg1%proc_distrb,2)
979 [ # # ]: 0 : if(proc_distrb_cycle(mpi_enreg1%proc_distrb,ikpt,1,sz1,isppol,mpi_enreg1%me_kpt)) then
980 : : cycle
981 : : end if
982 : 0 : jkpt=mpi_enreg1%my_kpttab(ikpt)
983 : : ! if (allocated(bandfft_kpt_in(jkpt)%ind_kg_mpi_to_seq)) then
984 : : ! sz1=size(bandfft_kpt_in(jkpt)%ind_kg_mpi_to_seq)
985 : : ! ABI_MALLOC(bandfft_kpt_out(jkpt)%ind_kg_mpi_to_seq,(sz1))
986 : : ! bandfft_kpt_out(jkpt)%ind_kg_mpi_to_seq= &
987 : : ! & bandfft_kpt_in(jkpt)%ind_kg_mpi_to_seq
988 : : ! end if
989 : :
990 : 0 : bandfft_kpt_out(jkpt)%gpu_option=bandfft_kpt_in(jkpt)%gpu_option
991 : : #if defined HAVE_GPU && defined HAVE_YAKL
992 : : if (associated(bandfft_kpt_in(jkpt)%kg_k_gather)) then
993 : : sz1=size(bandfft_kpt_in(jkpt)%kg_k_gather,1)
994 : : sz2=size(bandfft_kpt_in(jkpt)%kg_k_gather,2)
995 : : if(bandfft_kpt_in(jkpt)%gpu_option==ABI_GPU_KOKKOS) then
996 : : ABI_MALLOC_MANAGED(bandfft_kpt_out(jkpt)%kg_k_gather,(/sz1,sz2/))
997 : : bandfft_kpt_out(jkpt)%kg_k_gather= &
998 : : & bandfft_kpt_in(jkpt)%kg_k_gather
999 : : else
1000 : : ABI_MALLOC(bandfft_kpt_out(jkpt)%kg_k_gather,(sz1,sz2))
1001 : : bandfft_kpt_out(jkpt)%kg_k_gather= &
1002 : : & bandfft_kpt_in(jkpt)%kg_k_gather
1003 : : end if
1004 : : end if
1005 : : #else
1006 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%kg_k_gather)) then
1007 : 0 : sz1=size(bandfft_kpt_in(jkpt)%kg_k_gather,1)
1008 : 0 : sz2=size(bandfft_kpt_in(jkpt)%kg_k_gather,2)
1009 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%kg_k_gather,(sz1,sz2))
# # # # #
# # # # #
# # # # ]
1010 : : bandfft_kpt_out(jkpt)%kg_k_gather= &
1011 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%kg_k_gather
# # # # #
# # # # #
# # # # #
# # # # #
# # ]
1012 : : end if
1013 : : #endif
1014 : :
1015 : 0 : bandfft_kpt_out(jkpt)%flag1_is_allocated=bandfft_kpt_in(jkpt)%flag1_is_allocated
1016 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%gbound)) then
1017 : 0 : sz1=size(bandfft_kpt_in(jkpt)%gbound,1)
1018 : 0 : sz2=size(bandfft_kpt_in(jkpt)%gbound,2)
1019 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%gbound,(sz1,sz2))
# # # # #
# # # # #
# # # # ]
1020 : : bandfft_kpt_out(jkpt)%gbound= &
1021 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%gbound
# # # # #
# # # # #
# # # # #
# # # # #
# # ]
1022 : : end if
1023 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%recvcounts)) then
1024 : 0 : sz1=size(bandfft_kpt_in(jkpt)%recvcounts)
1025 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%recvcounts,(sz1))
# # # # #
# # # #
# ]
1026 : : bandfft_kpt_out(jkpt)%recvcounts= &
1027 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%recvcounts
# # # # #
# # # # #
# # ]
1028 : : end if
1029 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%sendcounts)) then
1030 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%sendcounts,(size(bandfft_kpt_in(jkpt)%sendcounts)))
# # # # #
# # # #
# ]
1031 : : bandfft_kpt_out(jkpt)%sendcounts= &
1032 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%sendcounts
# # # # #
# # # # #
# # ]
1033 : : end if
1034 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%rdispls)) then
1035 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%rdispls,(size(bandfft_kpt_in(jkpt)%rdispls)))
# # # # #
# # # #
# ]
1036 : : bandfft_kpt_out(jkpt)%rdispls= &
1037 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%rdispls
# # # # #
# # # # #
# # ]
1038 : : end if
1039 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%sdispls)) then
1040 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%sdispls,(size(bandfft_kpt_in(jkpt)%sdispls)))
# # # # #
# # # #
# ]
1041 : : bandfft_kpt_out(jkpt)%sdispls= &
1042 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%sdispls
# # # # #
# # # # #
# # ]
1043 : : end if
1044 : 0 : bandfft_kpt_out(jkpt)%flag2_is_allocated=bandfft_kpt_in(jkpt)%flag2_is_allocated
1045 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%ffnl_gather)) then
1046 : 0 : sz1=size(bandfft_kpt_in(jkpt)%ffnl_gather,1)
1047 : 0 : sz2=size(bandfft_kpt_in(jkpt)%ffnl_gather,2)
1048 : 0 : sz3=size(bandfft_kpt_in(jkpt)%ffnl_gather,3)
1049 : 0 : sz4=size(bandfft_kpt_in(jkpt)%ffnl_gather,4)
1050 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%ffnl_gather,(sz1,sz2,sz3,sz4))
# # # # #
# # # # #
# # # # #
# # # # #
# # ]
1051 : : bandfft_kpt_out(jkpt)%ffnl_gather= &
1052 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%ffnl_gather
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # ]
1053 : : end if
1054 : :
1055 : : #if defined HAVE_GPU && defined HAVE_YAKL
1056 : : if (associated(bandfft_kpt_in(jkpt)%kinpw_gather)) then
1057 : : sz1=size(bandfft_kpt_in(jkpt)%kinpw_gather)
1058 : : if(bandfft_kpt_in(jkpt)%gpu_option==ABI_GPU_KOKKOS) then
1059 : : ABI_MALLOC_MANAGED(bandfft_kpt_out(jkpt)%kinpw_gather,(/sz1/))
1060 : : bandfft_kpt_out(jkpt)%kinpw_gather= &
1061 : : & bandfft_kpt_in(jkpt)%kinpw_gather
1062 : : else
1063 : : ABI_MALLOC(bandfft_kpt_out(jkpt)%kinpw_gather,(sz1))
1064 : : bandfft_kpt_out(jkpt)%kinpw_gather= &
1065 : : & bandfft_kpt_in(jkpt)%kinpw_gather
1066 : : end if
1067 : : end if
1068 : : #else
1069 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%kinpw_gather)) then
1070 : 0 : sz1=size(bandfft_kpt_in(jkpt)%kinpw_gather)
1071 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%kinpw_gather,(sz1))
# # # # #
# # # #
# ]
1072 : : bandfft_kpt_out(jkpt)%kinpw_gather= &
1073 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%kinpw_gather
# # # # #
# # # # #
# # ]
1074 : : end if
1075 : : #endif
1076 : :
1077 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%ph3d_gather)) then
1078 : 0 : sz1=size(bandfft_kpt_in(jkpt)%ph3d_gather,1)
1079 : 0 : sz2=size(bandfft_kpt_in(jkpt)%ph3d_gather,2)
1080 : 0 : sz3=size(bandfft_kpt_in(jkpt)%ph3d_gather,3)
1081 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%ph3d_gather,(sz1,sz2,sz3))
# # # # #
# # # # #
# # # # #
# # # ]
1082 : : bandfft_kpt_out(jkpt)%ph3d_gather= &
1083 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%ph3d_gather
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # ]
1084 : : end if
1085 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%kpg_k_gather)) then
1086 : 0 : sz1=size(bandfft_kpt_in(jkpt)%kpg_k_gather,1)
1087 : 0 : sz2=size(bandfft_kpt_in(jkpt)%kpg_k_gather,2)
1088 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%kpg_k_gather,(sz1,sz2))
# # # # #
# # # # #
# # # # ]
1089 : : bandfft_kpt_out(jkpt)%kpg_k_gather= &
1090 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%kpg_k_gather
# # # # #
# # # # #
# # # # #
# # # # #
# # ]
1091 : : end if
1092 : 0 : bandfft_kpt_out(jkpt)%flag3_is_allocated=bandfft_kpt_in(jkpt)%flag3_is_allocated
1093 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%kg_k_gather_sym)) then
1094 : 0 : sz1=size(bandfft_kpt_in(jkpt)%kg_k_gather_sym,1)
1095 : 0 : sz2=size(bandfft_kpt_in(jkpt)%kg_k_gather_sym,2)
1096 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%kg_k_gather_sym,(sz1,sz2))
# # # # #
# # # # #
# # # # ]
1097 : : bandfft_kpt_out(jkpt)%kg_k_gather_sym= &
1098 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%kg_k_gather_sym
# # # # #
# # # # #
# # # # #
# # # # #
# # ]
1099 : : end if
1100 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%rdispls_sym)) then
1101 : 0 : sz1=size(bandfft_kpt_in(jkpt)%rdispls_sym)
1102 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%rdispls_sym,(sz1))
# # # # #
# # # #
# ]
1103 : : bandfft_kpt_out(jkpt)%rdispls_sym= &
1104 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%rdispls_sym
# # # # #
# # # # #
# # ]
1105 : : end if
1106 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%recvcounts_sym)) then
1107 : 0 : sz1=size(bandfft_kpt_in(jkpt)%recvcounts_sym)
1108 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%recvcounts_sym,(sz1))
# # # # #
# # # #
# ]
1109 : : bandfft_kpt_out(jkpt)%recvcounts_sym= &
1110 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%recvcounts_sym
# # # # #
# # # # #
# # ]
1111 : : end if
1112 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%recvcounts_sym_tot)) then
1113 : 0 : sz1=size(bandfft_kpt_in(jkpt)%recvcounts_sym_tot)
1114 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%recvcounts_sym_tot,(sz1))
# # # # #
# # # #
# ]
1115 : : bandfft_kpt_out(jkpt)%recvcounts_sym_tot= &
1116 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%recvcounts_sym_tot
# # # # #
# # # # #
# # ]
1117 : : end if
1118 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%sdispls_sym)) then
1119 : 0 : sz1=size(bandfft_kpt_in(jkpt)%sdispls_sym)
1120 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%sdispls_sym,(sz1))
# # # # #
# # # #
# ]
1121 : : bandfft_kpt_out(jkpt)%sdispls_sym= &
1122 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%sdispls_sym
# # # # #
# # # # #
# # ]
1123 : : end if
1124 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%sendcounts_sym)) then
1125 : 0 : sz1=size(bandfft_kpt_in(jkpt)%sendcounts_sym)
1126 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%sendcounts_sym,(sz1))
# # # # #
# # # #
# ]
1127 : : bandfft_kpt_out(jkpt)%sendcounts_sym= &
1128 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%sendcounts_sym
# # # # #
# # # # #
# # ]
1129 : : end if
1130 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%sendcounts_sym_all)) then
1131 : 0 : sz1=size(bandfft_kpt_in(jkpt)%sendcounts_sym_all)
1132 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%sendcounts_sym_all,(sz1))
# # # # #
# # # #
# ]
1133 : : bandfft_kpt_out(jkpt)%sendcounts_sym_all= &
1134 [ # # # # : 0 : & bandfft_kpt_in(jkpt)%sendcounts_sym_all
# # # # #
# # # # #
# # ]
1135 : : end if
1136 [ # # ]: 0 : if (allocated(bandfft_kpt_in(jkpt)%tab_proc)) then
1137 : 0 : sz1=size(bandfft_kpt_in(jkpt)%tab_proc)
1138 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%tab_proc,(sz1))
# # # # #
# # # #
# ]
1139 : : bandfft_kpt_out(jkpt)%tab_proc= &
1140 [ # # # # : 0 : bandfft_kpt_in(jkpt)%tab_proc
# # # # #
# # # # #
# # ]
1141 : : end if
1142 [ # # ]: 0 : if (bandfft_kpt_in(jkpt)%have_to_reequilibrate) then
1143 : 0 : bandfft_kpt_out(jkpt)%have_to_reequilibrate = .true.
1144 : 0 : bandfft_kpt_out(jkpt)%npw_fft = bandfft_kpt_in(jkpt)%npw_fft
1145 : 0 : sz1=size(bandfft_kpt_in(jkpt)%indices_pw_fft)
1146 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%indices_pw_fft,(sz1))
# # # # #
# # # #
# ]
1147 [ # # # # : 0 : bandfft_kpt_out(jkpt)%indices_pw_fft=bandfft_kpt_in(jkpt)%indices_pw_fft
# # # # #
# # # # #
# # ]
1148 : 0 : sz1=size(bandfft_kpt_in(jkpt)%sendcount_fft)
1149 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%sendcount_fft,(sz1))
# # # # #
# # # #
# ]
1150 [ # # # # : 0 : bandfft_kpt_out(jkpt)%sendcount_fft=bandfft_kpt_in(jkpt)%sendcount_fft
# # # # #
# # # # #
# # ]
1151 : 0 : sz1=size(bandfft_kpt_in(jkpt)%senddisp_fft)
1152 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%senddisp_fft,(sz1))
# # # # #
# # # #
# ]
1153 [ # # # # : 0 : bandfft_kpt_out(jkpt)%senddisp_fft=bandfft_kpt_in(jkpt)%senddisp_fft
# # # # #
# # # # #
# # ]
1154 : 0 : sz1=size(bandfft_kpt_in(jkpt)%recvcount_fft)
1155 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%recvcount_fft,(sz1))
# # # # #
# # # #
# ]
1156 [ # # # # : 0 : bandfft_kpt_out(jkpt)%recvcount_fft=bandfft_kpt_in(jkpt)%recvcount_fft
# # # # #
# # # # #
# # ]
1157 : 0 : sz1=size(bandfft_kpt_in(jkpt)%recvdisp_fft)
1158 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%recvdisp_fft,(sz1))
# # # # #
# # # #
# ]
1159 [ # # # # : 0 : bandfft_kpt_out(jkpt)%recvdisp_fft=bandfft_kpt_in(jkpt)%recvdisp_fft
# # # # #
# # # # #
# # ]
1160 : 0 : sz1=size(bandfft_kpt_in(jkpt)%kg_k_fft,1)
1161 : 0 : sz2=size(bandfft_kpt_in(jkpt)%kg_k_fft,2)
1162 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out(jkpt)%kg_k_fft,(sz1,sz2))
# # # # #
# # # # #
# # # # ]
1163 [ # # # # : 0 : bandfft_kpt_out(jkpt)%kg_k_fft=bandfft_kpt_in(jkpt)%kg_k_fft
# # # # #
# # # # #
# # # # #
# # # # #
# # ]
1164 : : end if
1165 : : end do
1166 : : end do
1167 : : end if
1168 : : end if
1169 : :
1170 : 0 : end subroutine bandfft_kpt_copy
1171 : : !!***
1172 : :
1173 : : !----------------------------------------------------------------------
1174 : :
1175 : : !!****f* ABINIT/bandfft_kpt_mpi_send
1176 : : !! NAME
1177 : : !! bandfft_kpt_mpi_send
1178 : : !!
1179 : : !! FUNCTION
1180 : : !! Send a bandfft_kpt_type inside a MPI communicator
1181 : : !!
1182 : : !! INPUTS
1183 : : !! input=The datatype to be transmitted
1184 : : !! receiver=ID of the receiver in spaceComm
1185 : : !! tag=message tag
1186 : : !! spaceComm=MPI Communicator
1187 : : !! [profile]=(character, optional, default=full)
1188 : : !! Define the part of the datastructure to be sent; possible values:
1189 : : !! 'full'= the entire datastructure
1190 : : !! 'fourwf'= only arrays needed by the fourwf routine
1191 : : !!
1192 : : !! OUTPUT
1193 : : !! ierr=Error status
1194 : : !!
1195 : : !! SOURCE
1196 : :
1197 : 0 : subroutine bandfft_kpt_mpi_send(input,receiver,tag,spaceComm,ierr,profile)
1198 : :
1199 : : !Arguments ------------------------------------
1200 : : !scalars
1201 : : integer,intent(in) :: receiver,spaceComm,tag
1202 : : integer,intent(out) :: ierr
1203 : : character(len=*),optional,intent(in) :: profile
1204 : : !arrays
1205 : : type(bandfft_kpt_type),intent(in) :: input
1206 : :
1207 : : !Local variables-------------------------------
1208 : : !scalars
1209 : : integer :: ipck,nsize,size_dp,size_int
1210 : : integer :: size1_kg_k_gather=0,size2_kg_k_gather=0,size_recvcounts=0
1211 : : integer :: size_sendcounts=0,size_rdispls=0,size_sdispls=0,size1_gbound=0,size2_gbound
1212 : : integer :: size1_kg_k_gather_sym=0,size2_kg_k_gather_sym=0,size_rdispls_sym=0
1213 : : integer :: size_sdispls_sym=0,size_recvcounts_sym=0,size_recvcounts_sym_tot=0
1214 : : integer :: size_sendcounts_sym=0,size_sendcounts_sym_all=0,size_tab_proc=0
1215 : : integer :: size_indices_pw_fft=0,size_sendcount_fft=0,size_senddisp_fft=0
1216 : : integer :: size_recvcount_fft=0,size_recvdisp_fft=0,size1_kg_k_fft=0,size2_kg_k_fft=0
1217 : : integer :: size1_ffnl_gather=0,size2_ffnl_gather=0,size3_ffnl_gather=0,size4_ffnl_gather=0
1218 : : integer :: size_kinpw_gather=0,size1_ph3d_gather=0,size2_ph3d_gather=0,size3_ph3d_gather=0
1219 : : integer :: size1_kpg_k_gather=0,size2_kpg_k_gather=0
1220 : : logical :: fourwf,full
1221 : : !arrays
1222 : 0 : integer,allocatable :: buffer_int(:)
1223 : 0 : real(dp),allocatable :: buffer_dp(:)
1224 : :
1225 : : ! *************************************************************************
1226 : :
1227 [ # # ]: 0 : if (xmpi_comm_size(spaceComm)<=1) return
1228 : :
1229 [ # # ]: 0 : fourwf=.false.;if (present(profile)) fourwf=(trim(profile)=='fourwf')
1230 : 0 : full=(.not.fourwf)
1231 : :
1232 : : !=== Store sizes ====
1233 : : if (fourwf.or.full) then
1234 : :
1235 : : #if defined HAVE_GPU && defined HAVE_YAKL
1236 : : if (associated(input%kg_k_gather)) size1_kg_k_gather=size(input%kg_k_gather,1)
1237 : : if (associated(input%kg_k_gather)) size2_kg_k_gather=size(input%kg_k_gather,2)
1238 : : #else
1239 [ # # ]: 0 : if (allocated(input%kg_k_gather)) size1_kg_k_gather=size(input%kg_k_gather,1)
1240 [ # # ]: 0 : if (allocated(input%kg_k_gather)) size2_kg_k_gather=size(input%kg_k_gather,2)
1241 : : #endif
1242 [ # # ]: 0 : if (input%flag1_is_allocated==1) then
1243 [ # # ]: 0 : if (allocated(input%recvcounts)) size_recvcounts=size(input%recvcounts)
1244 [ # # ]: 0 : if (allocated(input%sendcounts)) size_sendcounts=size(input%sendcounts)
1245 [ # # ]: 0 : if (allocated(input%rdispls)) size_rdispls=size(input%rdispls)
1246 [ # # ]: 0 : if (allocated(input%sdispls)) size_sdispls=size(input%sdispls)
1247 [ # # ]: 0 : if (allocated(input%gbound)) size1_gbound=size(input%gbound,1)
1248 [ # # ]: 0 : if (allocated(input%gbound)) size2_gbound=size(input%gbound,2)
1249 : : end if
1250 [ # # # # ]: 0 : if (input%flag3_is_allocated==1.and.input%istwf_k>1) then
1251 [ # # ]: 0 : if (allocated(input%kg_k_gather_sym)) size1_kg_k_gather_sym=size(input%kg_k_gather_sym,1)
1252 [ # # ]: 0 : if (allocated(input%kg_k_gather_sym)) size2_kg_k_gather_sym=size(input%kg_k_gather_sym,2)
1253 [ # # ]: 0 : if (allocated(input%rdispls_sym)) size_rdispls_sym=size(input%rdispls_sym)
1254 [ # # ]: 0 : if (allocated(input%sdispls_sym)) size_sdispls_sym=size(input%sdispls_sym)
1255 [ # # ]: 0 : if (allocated(input%recvcounts_sym)) size_recvcounts_sym=size(input%recvcounts_sym)
1256 [ # # ]: 0 : if (allocated(input%recvcounts_sym_tot)) size_recvcounts_sym_tot=size(input%recvcounts_sym_tot)
1257 [ # # ]: 0 : if (allocated(input%sendcounts_sym)) size_sendcounts_sym=size(input%sendcounts_sym)
1258 [ # # ]: 0 : if (allocated(input%sendcounts_sym_all)) size_sendcounts_sym_all=size(input%sendcounts_sym_all)
1259 [ # # ]: 0 : if (allocated(input%tab_proc)) size_tab_proc=size(input%tab_proc)
1260 : : end if
1261 [ # # ]: 0 : if (input%have_to_reequilibrate) then
1262 [ # # ]: 0 : if (allocated(input%indices_pw_fft)) size_indices_pw_fft=size(input%indices_pw_fft)
1263 [ # # ]: 0 : if (allocated(input%sendcount_fft)) size_sendcount_fft=size(input%sendcount_fft)
1264 [ # # ]: 0 : if (allocated(input%senddisp_fft)) size_senddisp_fft=size(input%senddisp_fft)
1265 [ # # ]: 0 : if (allocated(input%recvcount_fft)) size_recvcount_fft=size(input%recvcount_fft)
1266 [ # # ]: 0 : if (allocated(input%recvdisp_fft)) size_recvdisp_fft=size(input%recvdisp_fft)
1267 [ # # ]: 0 : if (allocated(input%kg_k_fft)) size1_kg_k_fft=size(input%kg_k_fft,1)
1268 [ # # ]: 0 : if (allocated(input%kg_k_fft)) size2_kg_k_fft=size(input%kg_k_fft,2)
1269 : : end if
1270 : : end if
1271 [ # # # # ]: 0 : if (input%flag2_is_allocated==1.and.full) then
1272 [ # # ]: 0 : if (allocated(input%ffnl_gather)) size1_ffnl_gather=size(input%ffnl_gather,1)
1273 [ # # ]: 0 : if (allocated(input%ffnl_gather)) size2_ffnl_gather=size(input%ffnl_gather,2)
1274 [ # # ]: 0 : if (allocated(input%ffnl_gather)) size3_ffnl_gather=size(input%ffnl_gather,3)
1275 [ # # ]: 0 : if (allocated(input%ffnl_gather)) size4_ffnl_gather=size(input%ffnl_gather,4)
1276 : :
1277 : : #if defined HAVE_GPU && defined HAVE_YAKL
1278 : : if (associated(input%kinpw_gather)) size_kinpw_gather=size(input%kinpw_gather)
1279 : : #else
1280 [ # # ]: 0 : if (allocated(input%kinpw_gather)) size_kinpw_gather=size(input%kinpw_gather)
1281 : : #endif
1282 : :
1283 [ # # ]: 0 : if (allocated(input%ph3d_gather)) size1_ph3d_gather=size(input%ph3d_gather,1)
1284 [ # # ]: 0 : if (allocated(input%ph3d_gather)) size2_ph3d_gather=size(input%ph3d_gather,2)
1285 [ # # ]: 0 : if (allocated(input%ph3d_gather)) size3_ph3d_gather=size(input%ph3d_gather,3)
1286 [ # # ]: 0 : if (allocated(input%kpg_k_gather)) size1_kpg_k_gather=size(input%kpg_k_gather,1)
1287 [ # # ]: 0 : if (allocated(input%kpg_k_gather)) size2_kpg_k_gather=size(input%kpg_k_gather,2)
1288 : : end if
1289 : :
1290 : : !=== Compute amount of data to transmit ====
1291 : : size_int=size1_kg_k_gather*size2_kg_k_gather &
1292 : : & +size_recvcounts+size_sendcounts+size_rdispls+size_sdispls &
1293 : : & +size1_gbound*size2_gbound &
1294 : : & +size1_kg_k_gather_sym*size2_kg_k_gather_sym &
1295 : : & +size_rdispls_sym+size_sdispls_sym &
1296 : : & +size_recvcounts_sym+size_recvcounts_sym_tot &
1297 : : & +size_sendcounts_sym+size_sendcounts_sym_all+size_tab_proc &
1298 : : & +size_indices_pw_fft+size_sendcount_fft+size_senddisp_fft &
1299 : : & +size_recvcount_fft+size_recvdisp_fft &
1300 : 0 : & +size1_kg_k_fft*size2_kg_k_fft
1301 : : size_dp=size1_ffnl_gather*size2_ffnl_gather*size3_ffnl_gather*size4_ffnl_gather &
1302 : : & +size_kinpw_gather &
1303 : : & +size1_ph3d_gather*size2_ph3d_gather*size3_ph3d_gather &
1304 : 0 : & +size1_kpg_k_gather*size2_kpg_k_gather
1305 : :
1306 : : !=== Send flags and array sizes ====
1307 : 0 : nsize=45
1308 [ # # ]: 0 : ABI_MALLOC(buffer_int,(nsize))
1309 : 0 : buffer_int(1)=input%flag1_is_allocated
1310 : 0 : buffer_int(2)=input%flag2_is_allocated
1311 : 0 : buffer_int(3)=input%flag3_is_allocated
1312 [ # # ]: 0 : buffer_int(4)=0;if (input%have_to_reequilibrate) buffer_int(4)=1
1313 : 0 : buffer_int(5)=input%istwf_k
1314 : 0 : buffer_int(6)=input%npw_tot
1315 : 0 : buffer_int(7)=input%npw_fft
1316 : 0 : buffer_int(8)=input%ndatarecv
1317 : 0 : buffer_int(9)=input%idatarecv0
1318 : 0 : buffer_int(10)=input%ndatarecv_tot
1319 : 0 : buffer_int(11)=input%ndatasend_sym
1320 : 0 : buffer_int(12)=size_recvcounts
1321 : 0 : buffer_int(13)=size_sendcounts
1322 : 0 : buffer_int(14)=size_rdispls
1323 : 0 : buffer_int(15)=size_sdispls
1324 : 0 : buffer_int(16)=size1_gbound
1325 : 0 : buffer_int(17)=size2_gbound
1326 : 0 : buffer_int(18)=size1_ffnl_gather
1327 : 0 : buffer_int(19)=size2_ffnl_gather
1328 : 0 : buffer_int(20)=size3_ffnl_gather
1329 : 0 : buffer_int(21)=size4_ffnl_gather
1330 : 0 : buffer_int(22)=size_kinpw_gather
1331 : 0 : buffer_int(23)=size1_ph3d_gather
1332 : 0 : buffer_int(24)=size2_ph3d_gather
1333 : 0 : buffer_int(25)=size3_ph3d_gather
1334 : 0 : buffer_int(26)=size1_kpg_k_gather
1335 : 0 : buffer_int(27)=size2_kpg_k_gather
1336 : 0 : buffer_int(28)=size_indices_pw_fft
1337 : 0 : buffer_int(29)=size_sendcount_fft
1338 : 0 : buffer_int(30)=size_senddisp_fft
1339 : 0 : buffer_int(31)=size_recvcount_fft
1340 : 0 : buffer_int(32)=size_recvdisp_fft
1341 : 0 : buffer_int(33)=size1_kg_k_fft
1342 : 0 : buffer_int(34)=size2_kg_k_fft
1343 : 0 : buffer_int(35)=size1_kg_k_gather
1344 : 0 : buffer_int(36)=size2_kg_k_gather
1345 : 0 : buffer_int(37)=size1_kg_k_gather_sym
1346 : 0 : buffer_int(38)=size2_kg_k_gather_sym
1347 : 0 : buffer_int(39)=size_rdispls_sym
1348 : 0 : buffer_int(40)=size_sdispls_sym
1349 : 0 : buffer_int(41)=size_recvcounts_sym
1350 : 0 : buffer_int(42)=size_recvcounts_sym_tot
1351 : 0 : buffer_int(43)=size_sendcounts_sym
1352 : 0 : buffer_int(44)=size_sendcounts_sym_all
1353 : 0 : buffer_int(45)=size_tab_proc
1354 : 0 : call xmpi_send(buffer_int,receiver,3*tag-2,spaceComm,ierr)
1355 [ # # ]: 0 : ABI_FREE(buffer_int)
1356 : :
1357 : : !=== Pack and send integer data ====
1358 [ # # ]: 0 : if (size_int>0) then
1359 : 0 : ipck=0
1360 [ # # # # : 0 : ABI_MALLOC(buffer_int,(size_int))
# # # # #
# ]
1361 [ # # ]: 0 : if (size1_kg_k_gather*size2_kg_k_gather>0) then
1362 : 0 : nsize=size1_kg_k_gather*size2_kg_k_gather
1363 [ # # ]: 0 : buffer_int(ipck+1:ipck+nsize)=reshape(input%kg_k_gather(:,:),(/nsize/))
1364 : 0 : ipck=ipck+nsize
1365 : : end if
1366 [ # # ]: 0 : if (size_recvcounts>0) then
1367 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_recvcounts)=input%recvcounts(:)
1368 : : ipck=ipck+size_recvcounts
1369 : : end if
1370 [ # # ]: 0 : if (size_sendcounts>0) then
1371 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_sendcounts)=input%sendcounts(:)
1372 : : ipck=ipck+size_sendcounts
1373 : : end if
1374 [ # # ]: 0 : if (size_rdispls>0) then
1375 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_rdispls)=input%rdispls(:)
1376 : : ipck=ipck+size_rdispls
1377 : : end if
1378 [ # # ]: 0 : if (size_sdispls>0) then
1379 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_sdispls)=input%sdispls(:)
1380 : : ipck=ipck+size_sdispls
1381 : : end if
1382 [ # # ]: 0 : if (size1_gbound*size2_gbound>0) then
1383 : 0 : nsize=size1_gbound*size2_gbound
1384 [ # # ]: 0 : buffer_int(ipck+1:ipck+nsize)=reshape(input%gbound(:,:),(/nsize/))
1385 : 0 : ipck=ipck+nsize
1386 : : end if
1387 [ # # ]: 0 : if (size1_kg_k_gather_sym*size2_kg_k_gather_sym>0) then
1388 : 0 : nsize=size1_kg_k_gather_sym*size2_kg_k_gather_sym
1389 [ # # ]: 0 : buffer_int(ipck+1:ipck+nsize)=reshape(input%kg_k_gather_sym(:,:),(/nsize/))
1390 : 0 : ipck=ipck+nsize
1391 : : end if
1392 [ # # ]: 0 : if (size_rdispls_sym>0) then
1393 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_rdispls_sym)=input%rdispls_sym(:)
1394 : : ipck=ipck+size_rdispls_sym
1395 : : end if
1396 [ # # ]: 0 : if (size_sdispls_sym>0) then
1397 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_sdispls_sym)=input%sdispls_sym(:)
1398 : : ipck=ipck+size_sdispls_sym
1399 : : end if
1400 [ # # ]: 0 : if (size_recvcounts_sym>0) then
1401 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_recvcounts_sym)=input%recvcounts_sym(:)
1402 : : ipck=ipck+size_recvcounts_sym
1403 : : end if
1404 [ # # ]: 0 : if (size_recvcounts_sym_tot>0) then
1405 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_recvcounts_sym_tot)=input%recvcounts_sym_tot(:)
1406 : : ipck=ipck+size_recvcounts_sym_tot
1407 : : end if
1408 [ # # ]: 0 : if (size_sendcounts_sym>0) then
1409 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_sendcounts_sym)=input%sendcounts_sym(:)
1410 : : ipck=ipck+size_sendcounts_sym
1411 : : end if
1412 [ # # ]: 0 : if (size_sendcounts_sym_all>0) then
1413 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_sendcounts_sym_all)=input%sendcounts_sym_all(:)
1414 : : ipck=ipck+size_sendcounts_sym_all
1415 : : end if
1416 [ # # ]: 0 : if (size_tab_proc>0) then
1417 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_tab_proc)=input%tab_proc(:)
1418 : : ipck=ipck+size_tab_proc
1419 : : end if
1420 [ # # ]: 0 : if (size_indices_pw_fft>0) then
1421 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_indices_pw_fft)=input%indices_pw_fft(:)
1422 : : ipck=ipck+size_indices_pw_fft
1423 : : end if
1424 [ # # ]: 0 : if (size_sendcount_fft>0) then
1425 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_sendcount_fft)=input%sendcount_fft(:)
1426 : : ipck=ipck+size_sendcount_fft
1427 : : end if
1428 [ # # ]: 0 : if (size_senddisp_fft>0) then
1429 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_senddisp_fft)=input%senddisp_fft(:)
1430 : : ipck=ipck+size_senddisp_fft
1431 : : end if
1432 [ # # ]: 0 : if (size_recvcount_fft>0) then
1433 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_recvcount_fft)=input%recvcount_fft(:)
1434 : : ipck=ipck+size_recvcount_fft
1435 : : end if
1436 [ # # ]: 0 : if (size_recvdisp_fft>0) then
1437 [ # # ]: 0 : buffer_int(ipck+1:ipck+size_recvdisp_fft)=input%recvdisp_fft(:)
1438 : : ipck=ipck+size_recvdisp_fft
1439 : : end if
1440 [ # # ]: 0 : if (size1_kg_k_fft*size2_kg_k_fft>0) then
1441 : 0 : nsize=size1_kg_k_fft*size2_kg_k_fft
1442 [ # # ]: 0 : buffer_int(ipck+1:ipck+nsize)=reshape(input%kg_k_fft(:,:),(/nsize/))
1443 : 0 : ipck=ipck+nsize
1444 : : end if
1445 : 0 : call xmpi_send(buffer_int,receiver,3*tag-1,spaceComm,ierr)
1446 [ # # ]: 0 : ABI_FREE(buffer_int)
1447 : : end if
1448 : :
1449 : : !=== Pack and send real data ====
1450 [ # # ]: 0 : if (size_dp>0) then
1451 : 0 : ipck=0
1452 [ # # # # : 0 : ABI_MALLOC(buffer_dp,(size_dp))
# # # # #
# ]
1453 [ # # ]: 0 : if (size1_ffnl_gather*size2_ffnl_gather*size3_ffnl_gather*size4_ffnl_gather>0) then
1454 : 0 : nsize=size1_ffnl_gather*size2_ffnl_gather*size3_ffnl_gather*size4_ffnl_gather
1455 [ # # ]: 0 : buffer_dp(ipck+1:ipck+nsize)=reshape(input%ffnl_gather(:,:,:,:),(/nsize/))
1456 : 0 : ipck=ipck+nsize
1457 : : end if
1458 [ # # ]: 0 : if (size_kinpw_gather>0) then
1459 [ # # ]: 0 : buffer_dp(ipck+1:ipck+size_kinpw_gather)=input%kinpw_gather(:)
1460 : : ipck=ipck+size_kinpw_gather
1461 : : end if
1462 [ # # ]: 0 : if (size1_ph3d_gather*size2_ph3d_gather*size3_ph3d_gather>0) then
1463 : 0 : nsize=size1_ph3d_gather*size2_ph3d_gather*size3_ph3d_gather
1464 [ # # ]: 0 : buffer_dp(ipck+1:ipck+nsize)=reshape(input%ph3d_gather(:,:,:),(/nsize/))
1465 : 0 : ipck=ipck+nsize
1466 : : end if
1467 [ # # ]: 0 : if (size1_kpg_k_gather*size2_kpg_k_gather>0) then
1468 : 0 : nsize=size1_kpg_k_gather*size2_kpg_k_gather
1469 [ # # ]: 0 : buffer_dp(ipck+1:ipck+nsize)=reshape(input%kpg_k_gather(:,:),(/nsize/))
1470 : 0 : ipck=ipck+nsize
1471 : : end if
1472 : 0 : call xmpi_send(buffer_dp,receiver,3*tag,spaceComm,ierr)
1473 [ # # ]: 0 : ABI_FREE(buffer_dp)
1474 : : end if
1475 : :
1476 [ # # # # ]: 0 : end subroutine bandfft_kpt_mpi_send
1477 : : !!***
1478 : :
1479 : : !----------------------------------------------------------------------
1480 : :
1481 : : !!****f* ABINIT/bandfft_kpt_mpi_recv
1482 : : !! NAME
1483 : : !! bandfft_kpt_mpi_recv
1484 : : !!
1485 : : !! FUNCTION
1486 : : !! Receive a bandfft_kpt_type inside a MPI communicator.
1487 : : !!
1488 : : !! INPUTS
1489 : : !! sender=ID of the sender in spaceComm
1490 : : !! tag=message tag
1491 : : !! spaceComm=MPI Communicator
1492 : : !!
1493 : : !! OUTPUT
1494 : : !! ierr=Error status
1495 : : !! output=# of on proc. sender
1496 : : !!
1497 : : !! SOURCE
1498 : :
1499 [ # # # # : 0 : subroutine bandfft_kpt_mpi_recv(output,sender,tag,spaceComm,ierr)
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # #
# ]
1500 : :
1501 : : !Arguments ------------------------------------
1502 : : !scalars
1503 : : integer,intent(in) :: sender,spaceComm,tag
1504 : : integer,intent(out) :: ierr
1505 : : !arrays
1506 : : type(bandfft_kpt_type),intent(out) :: output
1507 : :
1508 : : !Local variables-------------------------------
1509 : : !scalars
1510 : : integer :: ipck,nsize,size_dp,size_int
1511 : : integer :: size1_kg_k_gather=0,size2_kg_k_gather=0,size_recvcounts=0
1512 : : integer :: size_sendcounts=0,size_rdispls=0,size_sdispls=0,size1_gbound=0,size2_gbound
1513 : : integer :: size1_kg_k_gather_sym=0,size2_kg_k_gather_sym=0,size_rdispls_sym=0
1514 : : integer :: size_sdispls_sym=0,size_recvcounts_sym=0,size_recvcounts_sym_tot=0
1515 : : integer :: size_sendcounts_sym=0,size_sendcounts_sym_all=0,size_tab_proc=0
1516 : : integer :: size_indices_pw_fft=0,size_sendcount_fft=0,size_senddisp_fft=0
1517 : : integer :: size_recvcount_fft=0,size_recvdisp_fft=0,size1_kg_k_fft=0,size2_kg_k_fft=0
1518 : : integer :: size1_ffnl_gather=0,size2_ffnl_gather=0,size3_ffnl_gather=0,size4_ffnl_gather=0
1519 : : integer :: size_kinpw_gather=0,size1_ph3d_gather=0,size2_ph3d_gather=0,size3_ph3d_gather=0
1520 : : integer :: size1_kpg_k_gather=0,size2_kpg_k_gather=0,sz1,sz2,sz3,sz4
1521 : : !arrays
1522 : 0 : integer,allocatable :: buffer_int(:)
1523 [ # # ]: 0 : real(dp),allocatable :: buffer_dp(:)
1524 : :
1525 : : ! *************************************************************************
1526 : :
1527 [ # # ]: 0 : if (xmpi_comm_size(spaceComm)<=1) return
1528 : :
1529 : : !=== Receive flags and array sizes ====
1530 : 0 : nsize=45
1531 [ # # ]: 0 : ABI_MALLOC(buffer_int,(nsize))
1532 : 0 : call xmpi_recv(buffer_int,sender,3*tag-2,spaceComm,ierr)
1533 : 0 : output%flag1_is_allocated=buffer_int(1)
1534 : 0 : output%flag2_is_allocated=buffer_int(2)
1535 : 0 : output%flag3_is_allocated=buffer_int(3)
1536 : 0 : output%have_to_reequilibrate=(buffer_int(4)/=0)
1537 : 0 : output%istwf_k=buffer_int(5)
1538 : 0 : output%npw_tot=buffer_int(6)
1539 : 0 : output%npw_fft=buffer_int(7)
1540 : 0 : output%ndatarecv=buffer_int(8)
1541 : 0 : output%idatarecv0=buffer_int(9)
1542 : 0 : output%ndatarecv_tot=buffer_int(10)
1543 : 0 : output%ndatasend_sym=buffer_int(11)
1544 : 0 : size_recvcounts=buffer_int(12)
1545 : 0 : size_sendcounts=buffer_int(13)
1546 : 0 : size_rdispls=buffer_int(14)
1547 : 0 : size_sdispls=buffer_int(15)
1548 : 0 : size1_gbound=buffer_int(16)
1549 : 0 : size2_gbound=buffer_int(17)
1550 : 0 : size1_ffnl_gather=buffer_int(18)
1551 : 0 : size2_ffnl_gather=buffer_int(19)
1552 : 0 : size3_ffnl_gather=buffer_int(20)
1553 : 0 : size4_ffnl_gather=buffer_int(21)
1554 : 0 : size_kinpw_gather=buffer_int(22)
1555 : 0 : size1_ph3d_gather=buffer_int(23)
1556 : 0 : size2_ph3d_gather=buffer_int(24)
1557 : 0 : size3_ph3d_gather=buffer_int(25)
1558 : 0 : size1_kpg_k_gather=buffer_int(26)
1559 : 0 : size2_kpg_k_gather=buffer_int(27)
1560 : 0 : size_indices_pw_fft=buffer_int(28)
1561 : 0 : size_sendcount_fft=buffer_int(29)
1562 : 0 : size_senddisp_fft=buffer_int(30)
1563 : 0 : size_recvcount_fft=buffer_int(31)
1564 : 0 : size_recvdisp_fft=buffer_int(32)
1565 : 0 : size1_kg_k_fft=buffer_int(33)
1566 : 0 : size2_kg_k_fft=buffer_int(34)
1567 : 0 : size1_kg_k_gather=buffer_int(35)
1568 : 0 : size2_kg_k_gather=buffer_int(36)
1569 : 0 : size1_kg_k_gather_sym=buffer_int(37)
1570 : 0 : size2_kg_k_gather_sym=buffer_int(38)
1571 : 0 : size_rdispls_sym=buffer_int(39)
1572 : 0 : size_sdispls_sym=buffer_int(40)
1573 : 0 : size_recvcounts_sym=buffer_int(41)
1574 : 0 : size_recvcounts_sym_tot=buffer_int(42)
1575 : 0 : size_sendcounts_sym=buffer_int(43)
1576 : 0 : size_sendcounts_sym_all=buffer_int(44)
1577 : 0 : size_tab_proc=buffer_int(45)
1578 : 0 : ABI_FREE(buffer_int)
1579 : :
1580 : : !=== Compute amount of transmitted data ====
1581 : : size_int=size1_kg_k_gather*size2_kg_k_gather &
1582 : : & +size_recvcounts+size_sendcounts+size_rdispls+size_sdispls &
1583 : : & +size1_gbound*size2_gbound &
1584 : : & +size1_kg_k_gather_sym*size2_kg_k_gather_sym &
1585 : : & +size_rdispls_sym+size_sdispls_sym &
1586 : : & +size_recvcounts_sym+size_recvcounts_sym_tot &
1587 : : & +size_sendcounts_sym+size_sendcounts_sym_all+size_tab_proc &
1588 : : & +size_indices_pw_fft+size_sendcount_fft+size_senddisp_fft &
1589 : : & +size_recvcount_fft+size_recvdisp_fft &
1590 : 0 : & +size1_kg_k_fft*size2_kg_k_fft
1591 : : size_dp=size1_ffnl_gather*size2_ffnl_gather*size3_ffnl_gather*size4_ffnl_gather &
1592 : : & +size_kinpw_gather &
1593 : : & +size1_ph3d_gather*size2_ph3d_gather*size3_ph3d_gather &
1594 : 0 : & +size1_kpg_k_gather*size2_kpg_k_gather
1595 : :
1596 : : !=== Receive and unpack integer data ====
1597 [ # # ]: 0 : if (size_int>0) then
1598 : 0 : ipck=0
1599 [ # # # # : 0 : ABI_MALLOC(buffer_int,(size_int))
# # # # #
# ]
1600 : 0 : call xmpi_recv(buffer_int,sender,3*tag-1,spaceComm,ierr)
1601 : :
1602 : : #if defined HAVE_GPU && defined HAVE_YAKL
1603 : : if (associated(output%kg_k_gather)) then
1604 : : if(output%gpu_option==ABI_GPU_KOKKOS) then
1605 : : ABI_FREE_MANAGED(output%kg_k_gather)
1606 : : else
1607 : : ABI_FREE(output%kg_k_gather)
1608 : : end if
1609 : : end if
1610 : : if (size1_kg_k_gather*size2_kg_k_gather>0) then
1611 : : nsize=size1_kg_k_gather*size2_kg_k_gather
1612 : : sz1=size1_kg_k_gather;sz2=size2_kg_k_gather
1613 : : if(output%gpu_option==ABI_GPU_KOKKOS) then
1614 : : ABI_MALLOC_MANAGED(output%kg_k_gather,(/sz1,sz2/))
1615 : : else
1616 : : ABI_MALLOC(output%kg_k_gather,(sz1,sz2))
1617 : : end if
1618 : : output%kg_k_gather(:,:)=reshape(buffer_int(ipck+1:ipck+nsize),(/sz1,sz2/))
1619 : : ipck=ipck+nsize
1620 : : end if
1621 : : #else
1622 [ # # ]: 0 : if (allocated(output%kg_k_gather)) then
1623 : 0 : ABI_FREE(output%kg_k_gather)
1624 : : end if
1625 [ # # ]: 0 : if (size1_kg_k_gather*size2_kg_k_gather>0) then
1626 : 0 : nsize=size1_kg_k_gather*size2_kg_k_gather
1627 : 0 : sz1=size1_kg_k_gather;sz2=size2_kg_k_gather
1628 [ # # # # : 0 : ABI_MALLOC(output%kg_k_gather,(sz1,sz2))
# # # # #
# # # # #
# # # # ]
1629 [ # # # # : 0 : output%kg_k_gather(:,:)=reshape(buffer_int(ipck+1:ipck+nsize),(/sz1,sz2/))
# # ]
1630 : 0 : ipck=ipck+nsize
1631 : : end if
1632 : : #endif
1633 : :
1634 [ # # ]: 0 : ABI_SFREE(output%recvcounts)
1635 [ # # ]: 0 : if (size_recvcounts>0) then
1636 [ # # # # : 0 : ABI_MALLOC(output%recvcounts,(size_recvcounts))
# # # # #
# # # ]
1637 [ # # ]: 0 : output%recvcounts(:)=buffer_int(ipck+1:ipck+size_recvcounts)
1638 : : ipck=ipck+size_recvcounts
1639 : : end if
1640 [ # # ]: 0 : ABI_SFREE(output%sendcounts)
1641 [ # # ]: 0 : if (size_sendcounts>0) then
1642 [ # # # # : 0 : ABI_MALLOC(output%sendcounts,(size_sendcounts))
# # # # #
# # # ]
1643 [ # # ]: 0 : output%sendcounts(:)=buffer_int(ipck+1:ipck+size_sendcounts)
1644 : : ipck=ipck+size_sendcounts
1645 : : end if
1646 [ # # ]: 0 : ABI_SFREE(output%rdispls)
1647 [ # # ]: 0 : if (size_rdispls>0) then
1648 [ # # # # : 0 : ABI_MALLOC(output%rdispls,(size_rdispls))
# # # # #
# # # ]
1649 [ # # ]: 0 : output%rdispls(:)=buffer_int(ipck+1:ipck+size_rdispls)
1650 : : ipck=ipck+size_rdispls
1651 : : end if
1652 [ # # ]: 0 : ABI_SFREE(output%sdispls)
1653 [ # # ]: 0 : if (size_sdispls>0) then
1654 [ # # # # : 0 : ABI_MALLOC(output%sdispls,(size_sdispls))
# # # # #
# # # ]
1655 [ # # ]: 0 : output%sdispls(:)=buffer_int(ipck+1:ipck+size_sdispls)
1656 : : ipck=ipck+size_sdispls
1657 : : end if
1658 [ # # ]: 0 : ABI_SFREE(output%gbound)
1659 [ # # ]: 0 : if (size1_gbound*size2_gbound>0) then
1660 : 0 : nsize=size1_gbound*size2_gbound
1661 : 0 : sz1=size1_gbound;sz2=size2_gbound
1662 [ # # # # : 0 : ABI_MALLOC(output%gbound,(sz1,sz2))
# # # # #
# # # # #
# # # # ]
1663 [ # # # # : 0 : output%gbound(:,:)=reshape(buffer_int(ipck+1:ipck+nsize),(/sz1,sz2/))
# # ]
1664 : 0 : ipck=ipck+nsize
1665 : : end if
1666 [ # # ]: 0 : ABI_SFREE(output%kg_k_gather_sym)
1667 [ # # ]: 0 : if (size1_kg_k_gather_sym*size2_kg_k_gather_sym>0) then
1668 : 0 : nsize=size1_kg_k_gather_sym*size2_kg_k_gather_sym
1669 : 0 : sz1=size1_kg_k_gather_sym;sz2=size2_kg_k_gather_sym
1670 [ # # # # : 0 : ABI_MALLOC(output%kg_k_gather_sym,(sz1,sz2))
# # # # #
# # # # #
# # # # ]
1671 [ # # # # : 0 : output%kg_k_gather_sym(:,:)=reshape(buffer_int(ipck+1:ipck+nsize),(/sz1,sz2/))
# # ]
1672 : 0 : ipck=ipck+nsize
1673 : : end if
1674 [ # # ]: 0 : ABI_SFREE(output%rdispls_sym)
1675 [ # # ]: 0 : if (size_rdispls_sym>0) then
1676 [ # # # # : 0 : ABI_MALLOC(output%rdispls_sym,(size_rdispls_sym))
# # # # #
# # # ]
1677 [ # # ]: 0 : output%rdispls_sym(:)=buffer_int(ipck+1:ipck+size_rdispls_sym)
1678 : : ipck=ipck+size_rdispls_sym
1679 : : end if
1680 [ # # ]: 0 : ABI_SFREE(output%sdispls_sym)
1681 [ # # ]: 0 : if (size_sdispls_sym>0) then
1682 [ # # # # : 0 : ABI_MALLOC(output%sdispls_sym,(size_sdispls_sym))
# # # # #
# # # ]
1683 [ # # ]: 0 : output%sdispls_sym(:)=buffer_int(ipck+1:ipck+size_sdispls_sym)
1684 : : ipck=ipck+size_sdispls_sym
1685 : : end if
1686 [ # # ]: 0 : ABI_SFREE(output%recvcounts_sym)
1687 [ # # ]: 0 : if (size_recvcounts_sym>0) then
1688 [ # # # # : 0 : ABI_MALLOC(output%recvcounts_sym,(size_recvcounts_sym))
# # # # #
# # # ]
1689 [ # # ]: 0 : output%recvcounts_sym(:)=buffer_int(ipck+1:ipck+size_recvcounts_sym)
1690 : : ipck=ipck+size_recvcounts_sym
1691 : : end if
1692 [ # # ]: 0 : ABI_SFREE(output%recvcounts_sym_tot)
1693 [ # # ]: 0 : if (size_recvcounts_sym_tot>0) then
1694 [ # # # # : 0 : ABI_MALLOC(output%recvcounts_sym_tot,(size_recvcounts_sym_tot))
# # # # #
# # # ]
1695 [ # # ]: 0 : output%recvcounts_sym_tot(:)=buffer_int(ipck+1:ipck+size_recvcounts_sym_tot)
1696 : : ipck=ipck+size_recvcounts_sym_tot
1697 : : end if
1698 [ # # ]: 0 : ABI_SFREE(output%sendcounts_sym)
1699 [ # # ]: 0 : if (size_sendcounts_sym>0) then
1700 [ # # # # : 0 : ABI_MALLOC(output%sendcounts_sym,(size_sendcounts_sym))
# # # # #
# # # ]
1701 [ # # ]: 0 : output%sendcounts_sym(:)=buffer_int(ipck+1:ipck+size_sendcounts_sym)
1702 : : ipck=ipck+size_sendcounts_sym
1703 : : end if
1704 [ # # ]: 0 : ABI_SFREE(output%sendcounts_sym_all)
1705 [ # # ]: 0 : if (size_sendcounts_sym_all>0) then
1706 [ # # # # : 0 : ABI_MALLOC(output%sendcounts_sym_all,(size_sendcounts_sym_all))
# # # # #
# # # ]
1707 [ # # ]: 0 : output%sendcounts_sym_all(:)=buffer_int(ipck+1:ipck+size_sendcounts_sym_all)
1708 : : ipck=ipck+size_sendcounts_sym_all
1709 : : end if
1710 [ # # ]: 0 : ABI_SFREE(output%tab_proc)
1711 [ # # ]: 0 : if (size_tab_proc>0) then
1712 [ # # # # : 0 : ABI_MALLOC(output%tab_proc,(size_tab_proc))
# # # # #
# # # ]
1713 [ # # ]: 0 : output%tab_proc(:)=buffer_int(ipck+1:ipck+size_tab_proc)
1714 : : ipck=ipck+size_tab_proc
1715 : : end if
1716 [ # # ]: 0 : ABI_SFREE(output%indices_pw_fft)
1717 [ # # ]: 0 : if (size_indices_pw_fft>0) then
1718 [ # # # # : 0 : ABI_MALLOC(output%indices_pw_fft,(size_indices_pw_fft))
# # # # #
# # # ]
1719 [ # # ]: 0 : output%indices_pw_fft(:)=buffer_int(ipck+1:ipck+size_indices_pw_fft)
1720 : : ipck=ipck+size_indices_pw_fft
1721 : : end if
1722 [ # # ]: 0 : ABI_SFREE(output%sendcount_fft)
1723 [ # # ]: 0 : if (size_sendcount_fft>0) then
1724 [ # # # # : 0 : ABI_MALLOC(output%sendcount_fft,(size_sendcount_fft))
# # # # #
# # # ]
1725 [ # # ]: 0 : output%sendcount_fft(:)=buffer_int(ipck+1:ipck+size_sendcount_fft)
1726 : : ipck=ipck+size_sendcount_fft
1727 : : end if
1728 [ # # ]: 0 : ABI_SFREE(output%senddisp_fft)
1729 [ # # ]: 0 : if (size_senddisp_fft>0) then
1730 [ # # # # : 0 : ABI_MALLOC(output%senddisp_fft,(size_senddisp_fft))
# # # # #
# # # ]
1731 [ # # ]: 0 : output%senddisp_fft(:)=buffer_int(ipck+1:ipck+size_senddisp_fft)
1732 : : ipck=ipck+size_senddisp_fft
1733 : : end if
1734 [ # # ]: 0 : ABI_SFREE(output%recvcount_fft)
1735 [ # # ]: 0 : if (size_recvcount_fft>0) then
1736 [ # # # # : 0 : ABI_MALLOC(output%recvcount_fft,(size_recvcount_fft))
# # # # #
# # # ]
1737 [ # # ]: 0 : output%recvcount_fft(:)=buffer_int(ipck+1:ipck+size_recvcount_fft)
1738 : : ipck=ipck+size_recvcount_fft
1739 : : end if
1740 [ # # ]: 0 : ABI_SFREE(output%recvdisp_fft)
1741 [ # # ]: 0 : if (size_recvdisp_fft>0) then
1742 [ # # # # : 0 : ABI_MALLOC(output%recvdisp_fft,(size_recvdisp_fft))
# # # # #
# # # ]
1743 [ # # ]: 0 : output%recvdisp_fft(:)=buffer_int(ipck+1:ipck+size_recvdisp_fft)
1744 : : ipck=ipck+size_recvdisp_fft
1745 : : end if
1746 [ # # ]: 0 : ABI_SFREE(output%kg_k_fft)
1747 [ # # ]: 0 : if (size1_kg_k_fft*size2_kg_k_fft>0) then
1748 : 0 : nsize=size1_kg_k_fft*size2_kg_k_fft
1749 : 0 : sz1=size1_kg_k_fft;sz2=size2_kg_k_fft
1750 [ # # # # : 0 : ABI_MALLOC(output%kg_k_fft,(sz1,sz2))
# # # # #
# # # # #
# # # # ]
1751 [ # # # # : 0 : output%kg_k_fft(:,:)=reshape(buffer_int(ipck+1:ipck+nsize),(/sz1,sz2/))
# # ]
1752 : 0 : ipck=ipck+nsize
1753 : : end if
1754 [ # # ]: 0 : ABI_FREE(buffer_int)
1755 : : end if
1756 : :
1757 : : !=== Receive and unpack real data ====
1758 [ # # ]: 0 : if (size_dp>0) then
1759 : 0 : ipck=0
1760 [ # # # # : 0 : ABI_MALLOC(buffer_dp,(size_dp))
# # # # #
# ]
1761 : 0 : call xmpi_recv(buffer_dp,sender,3*tag,spaceComm,ierr)
1762 [ # # ]: 0 : ABI_SFREE(output%ffnl_gather)
1763 [ # # ]: 0 : if (size1_ffnl_gather*size2_ffnl_gather*size3_ffnl_gather*size4_ffnl_gather>0) then
1764 : 0 : nsize=size1_ffnl_gather*size2_ffnl_gather*size3_ffnl_gather*size4_ffnl_gather
1765 : 0 : sz1=size1_ffnl_gather;sz2=size2_ffnl_gather;sz3=size3_ffnl_gather;sz4=size4_ffnl_gather
1766 [ # # # # : 0 : ABI_MALLOC(output%ffnl_gather,(sz1,sz2,sz3,sz4))
# # # # #
# # # # #
# # # # #
# # # # #
# # ]
1767 [ # # # # : 0 : output%ffnl_gather(:,:,:,:)=reshape(buffer_dp(ipck+1:ipck+nsize),(/sz1,sz2,sz3,sz4/))
# # # # #
# ]
1768 : 0 : ipck=ipck+nsize
1769 : : end if
1770 : :
1771 : : #if defined HAVE_GPU && defined HAVE_YAKL
1772 : : if (associated(output%kinpw_gather)) then
1773 : : if(output%gpu_option==ABI_GPU_KOKKOS) then
1774 : : ABI_FREE_MANAGED(output%kinpw_gather)
1775 : : else
1776 : : ABI_FREE(output%kinpw_gather)
1777 : : endif
1778 : : end if
1779 : : if (size_kinpw_gather>0) then
1780 : : if(output%gpu_option==ABI_GPU_KOKKOS) then
1781 : : ABI_MALLOC_MANAGED(output%kinpw_gather,(/size_kinpw_gather/))
1782 : : else
1783 : : ABI_MALLOC(output%kinpw_gather,(size_kinpw_gather))
1784 : : endif
1785 : : output%kinpw_gather(:)=buffer_dp(ipck+1:ipck+size_kinpw_gather)
1786 : : ipck=ipck+size_kinpw_gather
1787 : : end if
1788 : : #else
1789 [ # # ]: 0 : ABI_SFREE(output%kinpw_gather)
1790 [ # # ]: 0 : if (size_kinpw_gather>0) then
1791 [ # # # # : 0 : ABI_MALLOC(output%kinpw_gather,(size_kinpw_gather))
# # # # #
# # # ]
1792 [ # # ]: 0 : output%kinpw_gather(:)=buffer_dp(ipck+1:ipck+size_kinpw_gather)
1793 : : ipck=ipck+size_kinpw_gather
1794 : : end if
1795 : : #endif
1796 : :
1797 [ # # ]: 0 : ABI_SFREE(output%ph3d_gather)
1798 [ # # ]: 0 : if (size1_ph3d_gather*size2_ph3d_gather*size3_ph3d_gather>0) then
1799 : 0 : nsize=size1_ph3d_gather*size2_ph3d_gather*size3_ph3d_gather
1800 : 0 : sz1=size1_ph3d_gather;sz2=size2_ph3d_gather;sz3=size3_ph3d_gather
1801 [ # # # # : 0 : ABI_MALLOC(output%ph3d_gather,(sz1,sz2,sz3))
# # # # #
# # # # #
# # # # #
# # # ]
1802 [ # # # # : 0 : output%ph3d_gather(:,:,:)=reshape(buffer_dp(ipck+1:ipck+nsize),(/sz1,sz2,sz3/))
# # # # ]
1803 : 0 : ipck=ipck+nsize
1804 : : end if
1805 [ # # ]: 0 : ABI_SFREE(output%kpg_k_gather)
1806 [ # # ]: 0 : if (size1_kpg_k_gather*size2_kpg_k_gather>0) then
1807 : 0 : nsize=size1_kpg_k_gather*size2_kpg_k_gather
1808 : 0 : sz1=size1_kpg_k_gather;sz2=size2_kpg_k_gather
1809 [ # # # # : 0 : ABI_MALLOC(output%kpg_k_gather,(sz1,sz2))
# # # # #
# # # # #
# # # # ]
1810 [ # # # # : 0 : output%kpg_k_gather(:,:)=reshape(buffer_dp(ipck+1:ipck+nsize),(/sz1,sz2/))
# # ]
1811 : 0 : ipck=ipck+nsize
1812 : : end if
1813 [ # # ]: 0 : ABI_FREE(buffer_dp)
1814 : : end if
1815 : :
1816 [ # # # # ]: 0 : end subroutine bandfft_kpt_mpi_recv
1817 : : !!***
1818 : :
1819 : : !----------------------------------------------------------------------
1820 : :
1821 : : !!****f* m_bandfft_kpt/bandfft_kpt_savetabs
1822 : : !! NAME
1823 : : !! bandfft_kpt_savetabs
1824 : : !!
1825 : : !! FUNCTION
1826 : : !! Save some (kpt-dependent) tabs from a bandfft_kpt datastructure
1827 : : !!
1828 : : !! INPUTS
1829 : : !! bandfft_kpt_in=<type(bandfft_kpt)>=bandfft_kpt datastructure
1830 : : !!
1831 : : !! OUTPUT
1832 : : !! ffnl(:,:,:,:)=nonlocal form factors on basis sphere
1833 : : !! ph3d(:,:,:)=3-dim structure factors, for each atom and plane wave
1834 : : !! kpg(:,:)=k+G vector for a given k point
1835 : : !! kinpw(:)=kinetic energy for each plane wave (Hartree)
1836 : : !!
1837 : : !! SOURCE
1838 : :
1839 : 2950 : subroutine bandfft_kpt_savetabs(bandfft_kpt_in,ffnl,ph3d,kpg,kinpw)
1840 : :
1841 : : !Arguments -------------------------------
1842 : : type(bandfft_kpt_type),intent(inout) :: bandfft_kpt_in
1843 : : real(dp),intent(inout),allocatable,optional :: ffnl(:,:,:,:),ph3d(:,:,:),kpg(:,:),kinpw(:)
1844 : : !Local variables-------------------------------
1845 : : integer :: is1,is2,is3,is4
1846 : :
1847 : : ! *********************************************************************
1848 : :
1849 [ + - ]: 2950 : if (present(ffnl)) then
1850 [ - + ]: 2950 : ABI_SFREE(ffnl)
1851 [ + - ]: 2950 : if (allocated(bandfft_kpt_in%ffnl_gather)) then
1852 : 2950 : is1=size(bandfft_kpt_in%ffnl_gather,1)
1853 : 2950 : is2=size(bandfft_kpt_in%ffnl_gather,2)
1854 : 2950 : is3=size(bandfft_kpt_in%ffnl_gather,3)
1855 : 2950 : is4=size(bandfft_kpt_in%ffnl_gather,4)
1856 [ - + + - : 17700 : ABI_MALLOC(ffnl,(is1,is2,is3,is4))
- + + - -
+ + - - +
+ - + - +
- - + - +
- + ]
1857 [ + + + + : 13553290 : ffnl(:,:,:,:)=bandfft_kpt_in%ffnl_gather(:,:,:,:)
+ + + + ]
1858 : : end if
1859 : : end if
1860 [ + - ]: 2950 : if (present(ph3d)) then
1861 [ - + ]: 2950 : ABI_SFREE(ph3d)
1862 [ + - ]: 2950 : if (allocated(bandfft_kpt_in%ph3d_gather)) then
1863 : 2950 : is1=size(bandfft_kpt_in%ph3d_gather,1)
1864 : 2950 : is2=size(bandfft_kpt_in%ph3d_gather,2)
1865 : 2950 : is3=size(bandfft_kpt_in%ph3d_gather,3)
1866 [ - + + - : 14750 : ABI_MALLOC(ph3d,(is1,is2,is3))
- + + - -
+ + - + -
+ - - + -
+ - + ]
1867 [ + + + + : 12270736 : ph3d(:,:,:)=bandfft_kpt_in%ph3d_gather(:,:,:)
+ + ]
1868 : : end if
1869 : : end if
1870 [ + - ]: 2950 : if (present(kpg)) then
1871 [ - + ]: 2950 : ABI_SFREE(kpg)
1872 [ + - ]: 2950 : if (allocated(bandfft_kpt_in%kpg_k_gather)) then
1873 : 2950 : is1=size(bandfft_kpt_in%kpg_k_gather,1)
1874 : 2950 : is2=size(bandfft_kpt_in%kpg_k_gather,2)
1875 [ + + + - : 11800 : ABI_MALLOC(kpg,(is1,is2))
+ + + - +
- + + - +
- + - + ]
1876 [ + + + + ]: 918799 : kpg(:,:)=bandfft_kpt_in%kpg_k_gather(:,:)
1877 : : end if
1878 : : end if
1879 [ - + ]: 2950 : if (present(kinpw)) then
1880 [ # # ]: 0 : ABI_SFREE(kinpw)
1881 : :
1882 : : #if defined HAVE_GPU && defined HAVE_YAKL
1883 : : if (associated(bandfft_kpt_in%kinpw_gather)) then
1884 : : is1=size(bandfft_kpt_in%kinpw_gather,1)
1885 : : ABI_MALLOC(kinpw,(is1))
1886 : : kinpw(:)=bandfft_kpt_in%kinpw_gather(:)
1887 : : end if
1888 : : #else
1889 [ # # ]: 0 : if (allocated(bandfft_kpt_in%kinpw_gather)) then
1890 : 0 : is1=size(bandfft_kpt_in%kinpw_gather,1)
1891 [ # # # # : 0 : ABI_MALLOC(kinpw,(is1))
# # # # #
# # # #
# ]
1892 [ # # ]: 0 : kinpw(:)=bandfft_kpt_in%kinpw_gather(:)
1893 : : end if
1894 : : #endif
1895 : :
1896 : : end if
1897 : :
1898 : 2950 : end subroutine bandfft_kpt_savetabs
1899 : : !!***
1900 : :
1901 : : !----------------------------------------------------------------------
1902 : :
1903 : : !!****f* m_bandfft_kpt/bandfft_kpt_restoretabs
1904 : : !! NAME
1905 : : !! bandfft_kpt_restoretabs
1906 : : !!
1907 : : !! FUNCTION
1908 : : !! Restore some (kpt-dependent) tabs into a bandfft_kpt datastructure
1909 : : !!
1910 : : !! INPUT
1911 : : !!
1912 : : !! OUTPUT
1913 : : !! === Arrays to be eventually restored =====
1914 : : !! ffnl(:,:,:,:)=nonlocal form factors on basis sphere
1915 : : !! ph3d(:,:,:)=3-dim structure factors, for each atom and plane wave
1916 : : !! kpg(:,:)=k+G vector for a given k point
1917 : : !! kinpw(:)=kinetic energy for each plane wave (Hartree)
1918 : : !!
1919 : : !! SIDE EFFECTS
1920 : : !! bandfft_kpt_out=<type(bandfft_kpt)>=bandfft_kpt datastructure
1921 : : !!
1922 : : !! SOURCE
1923 : :
1924 : 3764 : subroutine bandfft_kpt_restoretabs(bandfft_kpt_out,ffnl,ph3d,kpg,kinpw)
1925 : :
1926 : : !Arguments -------------------------------
1927 : : type(bandfft_kpt_type),intent(inout) :: bandfft_kpt_out
1928 : : real(dp),intent(inout),allocatable,optional :: ffnl(:,:,:,:),ph3d(:,:,:),kpg(:,:),kinpw(:)
1929 : : !Local variables-------------------------------
1930 : : integer :: is1,is2,is3,is4
1931 : :
1932 : : ! *********************************************************************
1933 : :
1934 [ + - ]: 3764 : if (present(ffnl)) then
1935 [ + - ]: 3764 : ABI_SFREE(bandfft_kpt_out%ffnl_gather)
1936 [ + + ]: 3764 : if (allocated(ffnl)) then
1937 : 2950 : is1=size(ffnl,1)
1938 : 2950 : is2=size(ffnl,2)
1939 : 2950 : is3=size(ffnl,3)
1940 : 2950 : is4=size(ffnl,4)
1941 [ - + + - : 17700 : ABI_MALLOC(bandfft_kpt_out%ffnl_gather,(is1,is2,is3,is4))
- + + - -
+ + - - +
+ - + - +
- - + - +
- + ]
1942 [ + + + + : 13553290 : bandfft_kpt_out%ffnl_gather(:,:,:,:)=ffnl(:,:,:,:)
+ + + + ]
1943 : 2950 : ABI_FREE(ffnl)
1944 : 2950 : bandfft_kpt_out%flag2_is_allocated=1
1945 : : end if
1946 : : end if
1947 [ + - ]: 3764 : if (present(ph3d)) then
1948 [ + - ]: 3764 : ABI_SFREE(bandfft_kpt_out%ph3d_gather)
1949 [ + + ]: 3764 : if (allocated(ph3d)) then
1950 : 2950 : is1=size(ph3d,1)
1951 : 2950 : is2=size(ph3d,2)
1952 : 2950 : is3=size(ph3d,3)
1953 [ - + + - : 14750 : ABI_MALLOC(bandfft_kpt_out%ph3d_gather,(is1,is2,is3))
- + + - -
+ + - + -
+ - - + -
+ - + ]
1954 [ + + + + : 12270736 : bandfft_kpt_out%ph3d_gather(:,:,:)=ph3d(:,:,:)
+ + ]
1955 : 2950 : ABI_FREE(ph3d)
1956 : 2950 : bandfft_kpt_out%flag2_is_allocated=1
1957 : : end if
1958 : : end if
1959 [ + - ]: 3764 : if (present(kpg)) then
1960 [ + - ]: 3764 : ABI_SFREE(bandfft_kpt_out%kpg_k_gather)
1961 [ + + ]: 3764 : if (allocated(kpg)) then
1962 : 2950 : is1=size(kpg,1)
1963 : 2950 : is2=size(kpg,2)
1964 [ + + + - : 11800 : ABI_MALLOC(bandfft_kpt_out%kpg_k_gather,(is1,is2))
+ + + - +
- + + - +
- + - + ]
1965 [ + + + + ]: 918799 : bandfft_kpt_out%kpg_k_gather(:,:)=kpg(:,:)
1966 : 2950 : ABI_FREE(kpg)
1967 : 2950 : bandfft_kpt_out%flag2_is_allocated=1
1968 : : end if
1969 : : end if
1970 [ - + ]: 3764 : if (present(kinpw)) then
1971 : :
1972 : : #if defined HAVE_GPU && defined HAVE_YAKL
1973 : : if (associated(bandfft_kpt_out%kinpw_gather)) then
1974 : : if(bandfft_kpt_out%gpu_option==ABI_GPU_KOKKOS) then
1975 : : ABI_FREE_MANAGED(bandfft_kpt_out%kinpw_gather)
1976 : : else
1977 : : ABI_FREE(bandfft_kpt_out%kinpw_gather)
1978 : : end if
1979 : : end if
1980 : : if (allocated(kinpw)) then
1981 : : is1=size(kinpw,1)
1982 : : if(bandfft_kpt_out%gpu_option==ABI_GPU_KOKKOS) then
1983 : : ABI_MALLOC_MANAGED(bandfft_kpt_out%kinpw_gather,(/is1/))
1984 : : else
1985 : : ABI_MALLOC(bandfft_kpt_out%kinpw_gather,(is1))
1986 : : end if
1987 : : bandfft_kpt_out%kinpw_gather(:)=kinpw(:)
1988 : : ABI_FREE(kinpw)
1989 : : end if
1990 : : #else
1991 [ # # ]: 0 : ABI_SFREE(bandfft_kpt_out%kinpw_gather)
1992 [ # # ]: 0 : if (allocated(kinpw)) then
1993 : 0 : is1=size(kinpw,1)
1994 [ # # # # : 0 : ABI_MALLOC(bandfft_kpt_out%kinpw_gather,(is1))
# # # # #
# # # #
# ]
1995 [ # # ]: 0 : bandfft_kpt_out%kinpw_gather(:)=kinpw(:)
1996 : 0 : ABI_FREE(kinpw)
1997 : : end if
1998 : : #endif
1999 : :
2000 : : end if
2001 : :
2002 : 3764 : end subroutine bandfft_kpt_restoretabs
2003 : : !!***
2004 : :
2005 : : !----------------------------------------------------------------------
2006 : :
2007 : : !!****f* m_bandfft_kpt/bandfft_kpt_set_ikpt
2008 : : !! NAME
2009 : : !! bandfft_kpt_set_ikpt
2010 : : !!
2011 : : !! FUNCTION
2012 : : !! Set the value of bandfft_kpt_current_ikpt variable,
2013 : : !! i.e. current index of bandfft_kpt loaded in memory
2014 : : !!
2015 : : !! INPUT
2016 : : !! ikpt=index of k-point (in the global array dtset%kpt)
2017 : : !! mpi_enreg= information about MPI parallelization
2018 : : !!
2019 : : !! OUTPUT
2020 : : !! bandfft_kpt_current_ikpt value changed
2021 : : !!
2022 : : !! SOURCE
2023 : :
2024 : 407111 : subroutine bandfft_kpt_set_ikpt(ikpt,mpi_enreg)
2025 : :
2026 : : !Arguments -------------------------------
2027 : : integer,intent(in) :: ikpt
2028 : : type(MPI_type),intent(in) :: mpi_enreg
2029 : : !Local variables-------------------------------
2030 : :
2031 : : ! *********************************************************************
2032 : :
2033 [ + + ]: 393965 : if (ikpt>0) then
2034 : 402623 : bandfft_kpt_current_ikpt=mpi_enreg%my_kpttab(ikpt)
2035 : : else
2036 : 4488 : bandfft_kpt_current_ikpt=-1
2037 : : end if
2038 : :
2039 : 393965 : end subroutine bandfft_kpt_set_ikpt
2040 : : !!***
2041 : :
2042 : : !----------------------------------------------------------------------
2043 : :
2044 : : !!****f* m_bandfft_kpt/bandfft_kpt_get_ikpt
2045 : : !! NAME
2046 : : !! bandfft_kpt_get_ikpt
2047 : : !!
2048 : : !! FUNCTION
2049 : : !! Get the value of bandfft_kpt_current_ikpt variable,
2050 : : !! i.e. current index of bandfft_kpt loaded in memory
2051 : : !!
2052 : : !! INPUT
2053 : : !!
2054 : : !! OUTPUT
2055 : : !! bandfft_kpt_get_ikpt= current index of bandfft_kpt
2056 : : !!
2057 : : !! SOURCE
2058 : :
2059 : 1651967 : function bandfft_kpt_get_ikpt()
2060 : :
2061 : : !Arguments -------------------------------
2062 : : integer :: bandfft_kpt_get_ikpt
2063 : : !Local variables-------------------------------
2064 : :
2065 : : ! *********************************************************************
2066 : :
2067 : 1651967 : bandfft_kpt_get_ikpt=bandfft_kpt_current_ikpt
2068 : :
2069 : 1651967 : end function bandfft_kpt_get_ikpt
2070 : : !!***
2071 : :
2072 : : !!****f* ABINIT/prep_bandfft_tabs
2073 : : !! NAME
2074 : : !! prep_bandfft_tabs
2075 : : !!
2076 : : !! FUNCTION
2077 : : !! This routine transpose various tabs needed in bandfft parallelization
2078 : : !!
2079 : : !! INPUTS
2080 : : !! ikpt=index of the k-point
2081 : : !! gs_hamk <type(gs_hamiltonian_type)>=all data for the Hamiltonian at k
2082 : : !! mkmem=number of k points which can fit in memory; set to 0 if use disk
2083 : : !!
2084 : : !! SIDE EFFECTS
2085 : : !! bandfft_kpt tabs (defined in m_bandfft_kpt module)
2086 : : !!
2087 : : !! SOURCE
2088 : :
2089 : :
2090 : 13146 : subroutine prep_bandfft_tabs(gs_hamk,ikpt,mkmem,mpi_enreg)
2091 : :
2092 : : !Arguments -------------------------------
2093 : : integer,intent(in) :: ikpt,mkmem
2094 : : type(gs_hamiltonian_type),intent(inout) :: gs_hamk
2095 : : type(MPI_type),intent(inout) :: mpi_enreg
2096 : :
2097 : : !Local variables-------------------------------
2098 : : integer :: dimffnl,ierr,ikpt_this_proc,ipw,lmnmax,matblk,ndatarecv,nkpg,npw_k,ntypat,spaceComm
2099 : : logical :: tabs_allocated
2100 : : real(dp) :: tsec(2)
2101 : : character(len=500) :: message
2102 : 13146 : integer, allocatable :: recvcounts(:),rdispls(:)
2103 : 13146 : integer, allocatable :: recvcountsloc(:),rdisplsloc(:)
2104 : 13146 : real(dp),allocatable :: ffnl_gather(:,:,:,:),ffnl_little(:,:,:,:),ffnl_little_gather(:,:,:,:)
2105 : 13146 : real(dp),allocatable :: kinpw_gather(:),kpg_k_gather(:,:)
2106 : 13146 : real(dp),allocatable :: ph3d_gather(:,:,:),ph3d_little(:,:,:),ph3d_little_gather(:,:,:)
2107 : :
2108 : : ! *********************************************************************
2109 : :
2110 : 13146 : call timab(575,1,tsec)
2111 : :
2112 : 13146 : ikpt_this_proc=mpi_enreg%my_kpttab(ikpt)
2113 : : tabs_allocated=((bandfft_kpt(ikpt_this_proc)%flag1_is_allocated==1).and.&
2114 [ + - + - : 13146 : & (ikpt_this_proc <= mkmem).and.(ikpt_this_proc/=0))
- + ]
2115 : :
2116 : : if (.not.tabs_allocated) then
2117 : 0 : message = ' the bandfft tabs are not allocated !'
2118 : 0 : ABI_BUG(message)
2119 : : end if
2120 : :
2121 : 13146 : ntypat=gs_hamk%ntypat
2122 : 13146 : lmnmax=gs_hamk%lmnmax
2123 : 13146 : matblk=gs_hamk%matblk
2124 : 13146 : npw_k=gs_hamk%npw_k
2125 : 13146 : dimffnl=size(gs_hamk%ffnl_k,2)
2126 : 13146 : nkpg=size(gs_hamk%kpg_k,2)
2127 : :
2128 [ - + + - : 39438 : ABI_MALLOC(rdispls,(mpi_enreg%nproc_band))
+ - + - -
+ - + ]
2129 [ - + + - : 26292 : ABI_MALLOC(recvcounts,(mpi_enreg%nproc_band))
- + - + ]
2130 [ - + + - : 26292 : ABI_MALLOC(rdisplsloc,(mpi_enreg%nproc_band))
- + - + -
+ ]
2131 [ - + + - : 26292 : ABI_MALLOC(recvcountsloc,(mpi_enreg%nproc_band))
- + - + -
+ ]
2132 : :
2133 : 13146 : spaceComm =mpi_enreg%comm_band
2134 : 13146 : ndatarecv =bandfft_kpt(ikpt_this_proc)%ndatarecv
2135 [ + + ]: 43096 : rdispls(:) =bandfft_kpt(ikpt_this_proc)%rdispls(:)
2136 [ + + ]: 43096 : recvcounts(:)=bandfft_kpt(ikpt_this_proc)%recvcounts(:)
2137 : :
2138 : : !---- Process FFNL
2139 [ + - ]: 13146 : if (associated(gs_hamk%ffnl_k)) then
2140 [ - + + - : 78876 : ABI_MALLOC(ffnl_gather,(ndatarecv,dimffnl,lmnmax,ntypat))
- + + - -
+ + - - +
+ - + - +
- - + -
+ ]
2141 [ - + + - : 78876 : ABI_MALLOC(ffnl_little,(dimffnl,lmnmax,ntypat,npw_k))
- + + - -
+ + - - +
+ - + - +
- - + -
+ ]
2142 [ - + + - : 78876 : ABI_MALLOC(ffnl_little_gather,(dimffnl,lmnmax,ntypat,ndatarecv))
- + + - -
+ + - - +
+ - + - +
- - + -
+ ]
2143 [ + + ]: 1445184 : do ipw=1,npw_k
2144 [ + + + + : 62448459 : ffnl_little(:,:,:,ipw)=gs_hamk%ffnl_k(ipw,:,:,:)
+ + ]
2145 : : end do
2146 [ + + ]: 43096 : recvcountsloc(:)=recvcounts(:)*dimffnl*lmnmax*ntypat
2147 [ + + ]: 43096 : rdisplsloc(:)=rdispls(:)*dimffnl*lmnmax*ntypat
2148 : : call xmpi_allgatherv(ffnl_little,npw_k*dimffnl*lmnmax*ntypat,ffnl_little_gather,&
2149 : 13146 : & recvcountsloc(:),rdisplsloc,spaceComm,ierr)
2150 [ + + ]: 2718516 : do ipw=1,ndatarecv
2151 [ + + + + : 118154104 : ffnl_gather(ipw,:,:,:)=ffnl_little_gather(:,:,:,ipw)
+ + ]
2152 : : end do
2153 [ - + ]: 13146 : ABI_FREE(ffnl_little)
2154 [ - + ]: 13146 : ABI_FREE(ffnl_little_gather)
2155 : : else
2156 [ # # ]: 0 : ABI_MALLOC(ffnl_gather,(0,0,0,0))
2157 : : end if
2158 : :
2159 : : !---- Process PH3D
2160 [ + - ]: 13146 : if (associated(gs_hamk%ph3d_k)) then
2161 [ - + + - : 52584 : ABI_MALLOC(ph3d_gather,(2,ndatarecv,matblk))
- + + - +
- + - - +
- + ]
2162 [ - + + - : 52584 : ABI_MALLOC(ph3d_little,(2,matblk,npw_k))
- + + - +
- + - - +
- + ]
2163 [ - + + - : 52584 : ABI_MALLOC(ph3d_little_gather,(2,matblk,ndatarecv))
- + + - +
- + - - +
- + ]
2164 [ + + ]: 43096 : recvcountsloc(:)=recvcounts(:)*2*matblk
2165 [ + + ]: 43096 : rdisplsloc(:)=rdispls(:)*2*matblk
2166 [ + + ]: 1445184 : do ipw=1,npw_k
2167 [ + + + + ]: 19674792 : ph3d_little(:,:,ipw)=gs_hamk%ph3d_k(:,ipw,:)
2168 : : end do
2169 : : call xmpi_allgatherv(ph3d_little,npw_k*2*matblk,ph3d_little_gather,&
2170 : 13146 : & recvcountsloc(:),rdisplsloc,spaceComm,ierr)
2171 [ + + ]: 2718516 : do ipw=1,ndatarecv
2172 [ + + + + ]: 36681852 : ph3d_gather(:,ipw,:)=ph3d_little_gather(:,:,ipw)
2173 : : end do
2174 [ - + ]: 13146 : ABI_FREE(ph3d_little_gather)
2175 [ - + ]: 13146 : ABI_FREE(ph3d_little)
2176 : : else
2177 [ # # ]: 0 : ABI_MALLOC(ph3d_gather,(0,0,0))
2178 : : end if
2179 : :
2180 : : !---- Process KPG_K
2181 [ + - ]: 13146 : if (associated(gs_hamk%kpg_k)) then
2182 [ - + + - : 52584 : ABI_MALLOC(kpg_k_gather,(ndatarecv,nkpg))
+ + + - +
- + + - +
- + ]
2183 [ + + ]: 13146 : if (nkpg>0) then
2184 : 3467 : call mkkpg(bandfft_kpt(ikpt_this_proc)%kg_k_gather,kpg_k_gather,gs_hamk%kpt_k,nkpg,ndatarecv)
2185 : : end if
2186 : : else
2187 [ # # ]: 0 : ABI_MALLOC(kpg_k_gather,(0,0))
2188 : : end if
2189 : :
2190 : : !---- Process KINPW
2191 [ + + ]: 13146 : if (associated(gs_hamk%kinpw_k)) then
2192 [ - + + - : 30588 : ABI_MALLOC(kinpw_gather,(ndatarecv))
+ - + - -
+ - + ]
2193 [ + + ]: 33172 : recvcountsloc(:)=recvcounts(:)
2194 [ + + ]: 33172 : rdisplsloc(:)=rdispls(:)
2195 : 10196 : call xmpi_allgatherv(gs_hamk%kinpw_k,npw_k,kinpw_gather,recvcountsloc(:),rdisplsloc,spaceComm,ierr)
2196 : : else
2197 [ - + ]: 2950 : ABI_MALLOC(kinpw_gather,(0))
2198 : : end if
2199 : :
2200 : : call bandfft_kpt_init2(bandfft_kpt,dimffnl,ffnl_gather,ikpt_this_proc,kinpw_gather,kpg_k_gather,&
2201 [ - + ]: 13146 : & lmnmax,matblk,mkmem,ndatarecv,nkpg,ntypat,ph3d_gather)
2202 : :
2203 : : ! GBT needs a second set of k-dependent tables for k'=k+q/2. Store them
2204 : : ! directly in the local band/FFT descriptor. Keeping a second caller-owned
2205 : : ! copy is unnecessary and can be several GB for large plane-wave spheres.
2206 [ - + - - : 13146 : if (associated(gs_hamk%ffnl_kp) .or. associated(gs_hamk%ph3d_kp) .or. &
- - ]
2207 : : & associated(gs_hamk%kinpw_kp)) then
2208 : :
2209 [ + - ]: 13146 : if (associated(gs_hamk%ffnl_kp)) then
2210 [ + + ]: 13146 : ABI_SFREE(bandfft_kpt(ikpt_this_proc)%ffnl_kp_gather)
2211 [ - + + - : 78876 : ABI_MALLOC(bandfft_kpt(ikpt_this_proc)%ffnl_kp_gather,(ndatarecv,dimffnl,lmnmax,ntypat))
- + + - -
+ + - - +
+ - + - +
- - + - +
- + ]
2212 [ - + + - : 78876 : ABI_MALLOC(ffnl_little,(dimffnl,lmnmax,ntypat,npw_k))
- + + - -
+ + - - +
+ - + - +
- - + - +
- + ]
2213 [ - + + - : 78876 : ABI_MALLOC(ffnl_little_gather,(dimffnl,lmnmax,ntypat,ndatarecv))
- + + - -
+ + - - +
+ - + - +
- - + - +
- + ]
2214 [ + + ]: 1445184 : do ipw=1,npw_k
2215 [ + + + + : 62448459 : ffnl_little(:,:,:,ipw)=gs_hamk%ffnl_kp(ipw,:,:,:)
+ + ]
2216 : : end do
2217 [ + + ]: 43096 : recvcountsloc(:)=recvcounts(:)*dimffnl*lmnmax*ntypat
2218 [ + + ]: 43096 : rdisplsloc(:)=rdispls(:)*dimffnl*lmnmax*ntypat
2219 : : call xmpi_allgatherv(ffnl_little,npw_k*dimffnl*lmnmax*ntypat,ffnl_little_gather,&
2220 : 13146 : recvcountsloc,rdisplsloc,spaceComm,ierr)
2221 [ + + ]: 2718516 : do ipw=1,ndatarecv
2222 [ + + + + : 118154104 : bandfft_kpt(ikpt_this_proc)%ffnl_kp_gather(ipw,:,:,:)=ffnl_little_gather(:,:,:,ipw)
+ + ]
2223 : : end do
2224 [ - + ]: 13146 : ABI_FREE(ffnl_little)
2225 [ - + ]: 13146 : ABI_FREE(ffnl_little_gather)
2226 : : else
2227 [ # # ]: 0 : ABI_SFREE(bandfft_kpt(ikpt_this_proc)%ffnl_kp_gather)
2228 [ # # # # ]: 0 : ABI_MALLOC(bandfft_kpt(ikpt_this_proc)%ffnl_kp_gather,(0,0,0,0))
2229 : : end if
2230 : :
2231 [ + - ]: 13146 : if (associated(gs_hamk%ph3d_kp)) then
2232 [ + + ]: 13146 : ABI_SFREE(bandfft_kpt(ikpt_this_proc)%ph3d_kp_gather)
2233 [ - + + - : 52584 : ABI_MALLOC(bandfft_kpt(ikpt_this_proc)%ph3d_kp_gather,(2,ndatarecv,matblk))
- + + - +
- + - - +
- + - + ]
2234 [ - + + - : 52584 : ABI_MALLOC(ph3d_little,(2,matblk,npw_k))
- + + - +
- + - - +
- + - + ]
2235 [ - + + - : 52584 : ABI_MALLOC(ph3d_little_gather,(2,matblk,ndatarecv))
- + + - +
- + - - +
- + - + ]
2236 [ + + ]: 1445184 : do ipw=1,npw_k
2237 [ + + + + ]: 19674792 : ph3d_little(:,:,ipw)=gs_hamk%ph3d_kp(:,ipw,:)
2238 : : end do
2239 [ + + ]: 43096 : recvcountsloc(:)=recvcounts(:)*2*matblk
2240 [ + + ]: 43096 : rdisplsloc(:)=rdispls(:)*2*matblk
2241 : : call xmpi_allgatherv(ph3d_little,npw_k*2*matblk,ph3d_little_gather,&
2242 : 13146 : recvcountsloc,rdisplsloc,spaceComm,ierr)
2243 [ + + ]: 2718516 : do ipw=1,ndatarecv
2244 [ + + + + ]: 36681852 : bandfft_kpt(ikpt_this_proc)%ph3d_kp_gather(:,ipw,:)=ph3d_little_gather(:,:,ipw)
2245 : : end do
2246 [ - + ]: 13146 : ABI_FREE(ph3d_little)
2247 [ - + ]: 13146 : ABI_FREE(ph3d_little_gather)
2248 : : else
2249 [ # # ]: 0 : ABI_SFREE(bandfft_kpt(ikpt_this_proc)%ph3d_kp_gather)
2250 [ # # # # ]: 0 : ABI_MALLOC(bandfft_kpt(ikpt_this_proc)%ph3d_kp_gather,(0,0,0))
2251 : : end if
2252 : :
2253 [ + - ]: 13146 : if (associated(gs_hamk%kpg_kp)) then
2254 [ + + ]: 13146 : ABI_SFREE(bandfft_kpt(ikpt_this_proc)%kpg_kp_gather)
2255 [ - + + - : 52584 : ABI_MALLOC(bandfft_kpt(ikpt_this_proc)%kpg_kp_gather,(ndatarecv,nkpg))
+ + + - +
- + + - +
- + - + ]
2256 [ + + ]: 13146 : if (nkpg>0) call mkkpg(bandfft_kpt(ikpt_this_proc)%kg_k_gather,&
2257 : : bandfft_kpt(ikpt_this_proc)%kpg_kp_gather,&
2258 : 3467 : gs_hamk%kpt_kp,nkpg,ndatarecv)
2259 : : else
2260 [ # # ]: 0 : ABI_SFREE(bandfft_kpt(ikpt_this_proc)%kpg_kp_gather)
2261 [ # # # # ]: 0 : ABI_MALLOC(bandfft_kpt(ikpt_this_proc)%kpg_kp_gather,(0,0))
2262 : : end if
2263 : :
2264 [ + + ]: 13146 : if (associated(gs_hamk%kinpw_kp)) then
2265 [ + + ]: 10196 : ABI_SFREE(bandfft_kpt(ikpt_this_proc)%kinpw_kp_gather)
2266 [ - + + - : 30588 : ABI_MALLOC(bandfft_kpt(ikpt_this_proc)%kinpw_kp_gather,(ndatarecv))
+ - + - -
+ - + -
+ ]
2267 [ + + ]: 33172 : recvcountsloc(:)=recvcounts(:)
2268 [ + + ]: 33172 : rdisplsloc(:)=rdispls(:)
2269 : : call xmpi_allgatherv(gs_hamk%kinpw_kp,npw_k,&
2270 : : bandfft_kpt(ikpt_this_proc)%kinpw_kp_gather,&
2271 : 10196 : recvcountsloc,rdisplsloc,spaceComm,ierr)
2272 : : else
2273 [ + - ]: 2950 : ABI_SFREE(bandfft_kpt(ikpt_this_proc)%kinpw_kp_gather)
2274 [ - + - + ]: 2950 : ABI_MALLOC(bandfft_kpt(ikpt_this_proc)%kinpw_kp_gather,(0))
2275 : : end if
2276 : : end if
2277 : :
2278 [ - + ]: 13146 : ABI_FREE(recvcounts)
2279 [ - + ]: 13146 : ABI_FREE(rdispls)
2280 [ - + ]: 13146 : ABI_FREE(recvcountsloc)
2281 [ - + ]: 13146 : ABI_FREE(rdisplsloc)
2282 : :
2283 [ - + ]: 13146 : ABI_FREE(ffnl_gather)
2284 [ - + ]: 13146 : ABI_FREE(ph3d_gather)
2285 [ - + ]: 13146 : ABI_FREE(kinpw_gather)
2286 [ - + + - ]: 13146 : ABI_FREE(kpg_k_gather)
2287 : :
2288 : : !---- Store current kpt index
2289 : 13146 : call bandfft_kpt_set_ikpt(ikpt,mpi_enreg)
2290 : :
2291 : 13146 : call timab(575,2,tsec)
2292 : :
2293 [ - + - + : 13146 : end subroutine prep_bandfft_tabs
- + - + -
+ - + ]
2294 : : !!***
2295 : :
2296 [ # # # # : 0 : END MODULE m_bandfft_kpt
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
2297 : : !!***
|
