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