Branch data Line data Source code
1 : : !!****m* ABINIT/m_mpinfo
2 : : !! NAME
3 : : !! m_mpinfo
4 : : !!
5 : : !! FUNCTION
6 : : !!
7 : : !! COPYRIGHT
8 : : !! Copyright (C) 2008-2026 ABINIT group (MT, GG, XG, FJ, AR, MB, CMartins)
9 : : !! This file is distributed under the terms of the
10 : : !! GNU General Public License, see ~abinit/COPYING
11 : : !! or http://www.gnu.org/copyleft/gpl.txt .
12 : : !!
13 : : !! TODO
14 : : !! Change the name of the datatype: (MPI_|mpi_) is a reserved keyword
15 : : !! and should not be used in client code!
16 : : !!
17 : : !! SOURCE
18 : :
19 : : #if defined HAVE_CONFIG_H
20 : : #include "config.h"
21 : : #endif
22 : :
23 : : #include "abi_common.h"
24 : :
25 : : MODULE m_mpinfo
26 : :
27 : : use defs_basis
28 : : use m_errors
29 : : use m_abicore
30 : : USE_MPI
31 : : use m_xmpi
32 : : use m_sort
33 : : use m_distribfft
34 : : use m_dtset
35 : :
36 : : use defs_abitypes, only : MPI_type
37 : : use m_fstrings, only : sjoin, ltoa
38 : : use m_io_tools, only : file_exists, open_file
39 : : use m_libpaw_tools, only : libpaw_write_comm_set
40 : : use m_paral_atom, only : get_my_natom, get_my_atmtab
41 : :
42 : : implicit none
43 : :
44 : : private
45 : :
46 : : #if defined HAVE_MPI1
47 : : include 'mpif.h'
48 : : #endif
49 : :
50 : : !type, extends(mpi_type_base_t), public :: mpi_type
51 : : !contains
52 : : !end type mpi_type
53 : : !!***
54 : :
55 : : public :: init_mpi_enreg ! Initialise a mpi_enreg structure with dataset independent values.
56 : : public :: nullify_mpi_enreg ! nullify a mpi_enreg datastructure
57 : : public :: destroy_mpi_enreg ! Free memory
58 : : public :: copy_mpi_enreg ! Copy a mpi_enreg datastructure into another.
59 : : public :: set_mpi_enreg_fft ! Set the content of a MPI datastructure in order to call fourwf/fourdp
60 : : public :: unset_mpi_enreg_fft ! Unset the content of a MPI datastructure used to call fourwf/fourdp
61 : : public :: ptabs_fourdp ! Return *pointers* to the internal MPI-FFT tables used in fourdp
62 : : public :: ptabs_fourwf ! Return *pointers* to the internal MPI-FFT tables used in fourwf
63 : : public :: mpi_distrib_is_ok ! Check if a MPI datastructure contains number of processors
64 : : ! compatible (in terms of efficiency) with the number of spins/kpts/bands
65 : : public :: proc_distrb_cycle ! Test a condition to cycle
66 : : public :: proc_distrb_nband ! Return number of bands present on this cpu
67 : : public :: proc_distrb_cycle_bands ! Return array of logicals for bands to cycle at this k and spin
68 : : public :: proc_distrb_band ! Return array of me indices for bands at this k and spin
69 : :
70 : : public :: initmpi_seq ! Initializes the MPI information for sequential use.
71 : : public :: initmpi_world ! %comm_world is redefined for the number of processors on which ABINIT is launched
72 : :
73 : : public :: initmpi_atom ! Initializes the mpi information for parallelism over atoms (PAW).
74 : : public :: clnmpi_atom ! Cleans-up the mpi information for the parallelism over atoms (PAW).
75 : :
76 : : public :: initmpi_grid ! Initializes the MPI information for the grid
77 : : public :: clnmpi_grid ! Cleans-up the mpi information for parallelism over grid (kpt/band/fft).
78 : :
79 : : public :: initmpi_img ! Initializes the mpi information for parallelism over images of the cell (npimage>1).
80 : : public :: clnmpi_img ! Cleans-up the mpi information for parallelism over images of the cell (npimage>1).
81 : :
82 : : public :: initmpi_pert ! Creates group for Parallelization over Perturbations.
83 : : public :: clnmpi_pert ! Cleans-up the mpi information for parallelization over perturbations.
84 : :
85 : : public :: initmpi_band ! Initializes the mpi information for band parallelism (paralbd=1).
86 : :
87 : : ! Helper functions.
88 : : public :: pre_gather
89 : : public :: pre_scatter
90 : : public :: iwrite_fftdatar ! Select the subset of processors that will write density/potential files.
91 : :
92 : : public :: distrb2 ! Creates the tabs of repartition of processors for sharing the jobs on k-points, spins and bands.
93 : : public :: distrb2_hf ! Creates the tabs of repartition for Hartree-Fock calculations.
94 : : !!***
95 : :
96 : : CONTAINS !========================================================================================
97 : : !!***
98 : :
99 : : !!****f* m_mpinfo/init_mpi_enreg
100 : : !! NAME
101 : : !! init_mpi_enreg
102 : : !!
103 : : !! FUNCTION
104 : : !! Initialise a mpi_enreg structure with dataset independent values.
105 : : !! Other values of mpi_enreg are dataset dependent, and should NOT be initialized
106 : : !! inside abinit.F90.
107 : : !! XG 071118: At present several other values are
108 : : !! initialized temporarily inside invars1.F90, FROM THE DTSET
109 : : !! VALUES. In order to relieve the present constraint of having mpi_enreg
110 : : !! equal for all datasets, they should be reinitialized from the dtset values
111 : : !! inside invars2m.F90 (where there is a loop over datasets, and finally,
112 : : !! reinitialized from the dataset values inside each big routine called by driver,
113 : : !! according to the kind of parallelisation that is needed there.
114 : : !! One should have one init_mpi_dtset routine (or another name) per big routine (well, there is also
115 : : !! the problem of TDDFT ...). Also, one should have a clean_mpi_dtset called at the end
116 : : !! of each big routine, as well as invars1.F90 or invars2m.F90 .
117 : : !!
118 : : !! SIDE EFFECTS
119 : : !! MPI_enreg<MPI_type>=All pointer set to null().
120 : : !!
121 : : !! SOURCE
122 : :
123 : 8404 : subroutine init_mpi_enreg(mpi_enreg)
124 : :
125 : : !Arguments ------------------------------------
126 : : class(MPI_type),intent(inout) :: MPI_enreg
127 : : ! *********************************************************************
128 : :
129 : : !Default for sequential use
130 : 8404 : call initmpi_seq(mpi_enreg)
131 : :
132 : : !Initialize MPI
133 : : #if defined HAVE_MPI
134 : 8404 : mpi_enreg%comm_world=xmpi_world
135 : 8404 : mpi_enreg%me = xmpi_comm_rank(xmpi_world)
136 : 8404 : mpi_enreg%nproc = xmpi_comm_size(xmpi_world)
137 : : #endif
138 : :
139 : 8404 : end subroutine init_mpi_enreg
140 : : !!***
141 : :
142 : : !----------------------------------------------------------------------
143 : :
144 : : !!****f* m_mpinfo/nullify_mpi_enreg
145 : : !! NAME
146 : : !! nullify_mpi_enreg
147 : : !!
148 : : !! FUNCTION
149 : : !! nullify a mpi_enreg datastructure
150 : : !!
151 : : !! SOURCE
152 : :
153 : 525291 : subroutine nullify_mpi_enreg(MPI_enreg)
154 : :
155 : : !Arguments ------------------------------------
156 : : class(MPI_type),intent(inout) :: MPI_enreg
157 : : ! *********************************************************************
158 : :
159 : 525291 : nullify(mpi_enreg%nscatterarr)
160 : 525291 : nullify(mpi_enreg%ngatherarr)
161 : 525291 : nullify(mpi_enreg%my_atmtab)
162 : 525291 : nullify(mpi_enreg%distribfft)
163 : :
164 : 98 : end subroutine nullify_mpi_enreg
165 : : !!***
166 : :
167 : : !----------------------------------------------------------------------
168 : :
169 : : !!****f* m_mpinfo/destroy_mpi_enreg
170 : : !! NAME
171 : : !! destroy_mpi_enreg
172 : : !!
173 : : !! FUNCTION
174 : : !! Destroy a mpi_enreg datastructure
175 : : !!
176 : : !! SOURCE
177 : :
178 : 522812 : subroutine destroy_mpi_enreg(MPI_enreg)
179 : :
180 : : !Arguments ------------------------------------
181 : : class(MPI_type),intent(inout) :: MPI_enreg
182 : : ! *********************************************************************
183 : :
184 [ + + ]: 522812 : if (associated(mpi_enreg%distribfft)) then
185 : 519366 : call mpi_enreg%distribfft%free()
186 [ - + - + : 519366 : ABI_FREE(mpi_enreg%distribfft)
- + - + -
+ - + - +
- + - + -
+ - + - +
- + ]
187 : : nullify(mpi_enreg%distribfft)
188 : : end if
189 : :
190 [ + + ]: 522812 : ABI_SFREE(mpi_enreg%proc_distrb)
191 [ - + ]: 522812 : ABI_SFREE(mpi_enreg%kptdstrb)
192 [ - + ]: 522812 : ABI_SFREE(mpi_enreg%kpt_loc2fbz_sp)
193 [ - + ]: 522812 : ABI_SFREE(mpi_enreg%kpt_loc2ibz_sp)
194 [ - + ]: 522812 : ABI_SFREE(mpi_enreg%mkmem)
195 [ + + ]: 522812 : ABI_SFREE(mpi_enreg%my_kpttab)
196 [ - + ]: 522812 : if (associated(mpi_enreg%my_atmtab)) then
197 : 0 : ABI_FREE(mpi_enreg%my_atmtab)
198 : : nullify(mpi_enreg%my_atmtab)
199 : : end if
200 [ - + ]: 522812 : ABI_SFREE(mpi_enreg%distrb_pert)
201 [ + + ]: 522812 : ABI_SFREE(mpi_enreg%distrb_img)
202 [ + + ]: 522812 : ABI_SFREE(mpi_enreg%my_imgtab)
203 [ + + ]: 522812 : ABI_SFREE(mpi_enreg%my_kgtab)
204 [ + + ]: 522812 : ABI_SFREE(mpi_enreg%distrb_hf)
205 : :
206 : : !Do not deallocate wavelet denspot distribution arrays, they are handled by BigDFT.
207 : :
208 : 522812 : end subroutine destroy_mpi_enreg
209 : : !!***
210 : :
211 : : !----------------------------------------------------------------------
212 : :
213 : : !!****f* m_mpinfo/copy_mpi_enreg
214 : : !! NAME
215 : : !! copy_mpi_enreg
216 : : !!
217 : : !! FUNCTION
218 : : !! Copy a mpi_enreg datastructure into another
219 : : !!
220 : : !! SOURCE
221 : :
222 [ + - ]: 2270 : subroutine copy_mpi_enreg(MPI_enreg1, MPI_enreg2)
223 : :
224 : : !Arguments ------------------------------------
225 : : class(MPI_type),intent(in) :: mpi_enreg1
226 : : class(MPI_type),intent(out) :: MPI_enreg2
227 : :
228 : : !Local variables-------------------------------
229 : : integer :: sz1,sz2,sz3
230 : : ! *********************************************************************
231 : :
232 : : !scalars
233 : 2270 : mpi_enreg2%comm_world=mpi_enreg1%comm_world
234 : 2270 : mpi_enreg2%me=mpi_enreg1%me
235 : 2270 : mpi_enreg2%nproc=mpi_enreg1%nproc
236 : 2270 : mpi_enreg2%paral_spinor=mpi_enreg1%paral_spinor
237 : 2270 : mpi_enreg2%paralbd=mpi_enreg1%paralbd
238 : 2270 : mpi_enreg2%me_fft=mpi_enreg1%me_fft
239 : 2270 : mpi_enreg2%me_band=mpi_enreg1%me_band
240 : 2270 : mpi_enreg2%nproc_fft=mpi_enreg1%nproc_fft
241 : 2270 : mpi_enreg2%paral_kgb=mpi_enreg1%paral_kgb
242 : 2270 : mpi_enreg2%me_g0=mpi_enreg1%me_g0
243 : 2270 : mpi_enreg2%me_g0_fft=mpi_enreg1%me_g0_fft
244 : 2270 : mpi_enreg2%paral_pert=mpi_enreg1%paral_pert
245 : 2270 : mpi_enreg2%me_pert=mpi_enreg1%me_pert
246 : 2270 : mpi_enreg2%nproc_pert=mpi_enreg1%nproc_pert
247 : 2270 : mpi_enreg2%comm_pert=mpi_enreg1%comm_pert
248 : 2270 : mpi_enreg2%comm_bandfft=mpi_enreg1%comm_bandfft
249 : 2270 : mpi_enreg2%comm_band=mpi_enreg1%comm_band
250 : 2270 : mpi_enreg2%comm_fft=mpi_enreg1%comm_fft
251 : 2270 : mpi_enreg2%nproc_band=mpi_enreg1%nproc_band
252 : 2270 : mpi_enreg2%comm_bandspinorfft=mpi_enreg1%comm_bandspinorfft
253 : 2270 : mpi_enreg2%comm_kpt=mpi_enreg1%comm_kpt
254 : 2270 : mpi_enreg2%me_kpt=mpi_enreg1%me_kpt
255 : 2270 : mpi_enreg2%nproc_spkpt=mpi_enreg1%nproc_spkpt
256 [ + + ]: 6810 : mpi_enreg2%my_isppoltab=mpi_enreg1%my_isppoltab
257 : 2270 : mpi_enreg2%my_natom=mpi_enreg1%my_natom
258 : 2270 : mpi_enreg2%comm_atom=mpi_enreg1%comm_atom
259 : 2270 : mpi_enreg2%nproc_atom=mpi_enreg1%nproc_atom
260 : 2270 : mpi_enreg2%comm_kptband=mpi_enreg1%comm_kptband
261 : 2270 : mpi_enreg2%bandpp=mpi_enreg1%bandpp
262 : 2270 : mpi_enreg2%paral_img=mpi_enreg1%paral_img
263 : 2270 : mpi_enreg2%comm_img=mpi_enreg1%comm_img
264 : 2270 : mpi_enreg2%me_img=mpi_enreg1%me_img
265 : 2270 : mpi_enreg2%nproc_img=mpi_enreg1%nproc_img
266 : 2270 : mpi_enreg2%comm_cell=mpi_enreg1%comm_cell
267 : 2270 : mpi_enreg2%comm_cell_pert=mpi_enreg1%comm_cell_pert
268 : 2270 : mpi_enreg2%me_cell=mpi_enreg1%me_cell
269 : 2270 : mpi_enreg2%nproc_cell=mpi_enreg1%nproc_cell
270 : 2270 : mpi_enreg2%nproc_spinor=mpi_enreg1%nproc_spinor
271 : 2270 : mpi_enreg2%me_spinor=mpi_enreg1%me_spinor
272 : 2270 : mpi_enreg2%comm_spinorfft=mpi_enreg1%comm_spinorfft
273 : 2270 : mpi_enreg2%me_wvl =mpi_enreg1%me_wvl
274 : 2270 : mpi_enreg2%nproc_wvl =mpi_enreg1%nproc_wvl
275 : 2270 : mpi_enreg2%comm_wvl =mpi_enreg1%comm_wvl
276 : 2270 : mpi_enreg2%me_hf =mpi_enreg1%me_hf
277 : 2270 : mpi_enreg2%nproc_hf =mpi_enreg1%nproc_hf
278 : 2270 : mpi_enreg2%comm_hf =mpi_enreg1%comm_hf
279 : 2270 : mpi_enreg2%paral_hf=mpi_enreg1%paral_hf
280 : 2270 : mpi_enreg2%pw_unbal_thresh=mpi_enreg1%pw_unbal_thresh
281 : :
282 : : !pointers
283 [ + - ]: 2270 : if (associated(mpi_enreg1%distribfft)) then
284 [ + - ]: 2270 : if (.not.associated(mpi_enreg2%distribfft)) then
285 [ - + ]: 2270 : ABI_MALLOC(mpi_enreg2%distribfft,)
286 : : end if
287 : 2270 : call mpi_enreg1%distribfft%copy(mpi_enreg2%distribfft)
288 : : end if
289 : :
290 [ + + ]: 2270 : if (allocated(mpi_enreg1%proc_distrb)) then
291 : 132 : sz1=size(mpi_enreg1%proc_distrb,1)
292 : 132 : sz2=size(mpi_enreg1%proc_distrb,2)
293 : 132 : sz3=size(mpi_enreg1%proc_distrb,3)
294 [ - + + - : 660 : ABI_MALLOC(mpi_enreg2%proc_distrb,(sz1,sz2,sz3))
- + + - -
+ + - + -
+ - - + -
+ - + ]
295 [ + - + - : 5375 : mpi_enreg2%proc_distrb=mpi_enreg1%proc_distrb
+ - - + -
- - - - -
- - - - -
- - - + +
+ + + + ]
296 : : end if
297 [ - + ]: 2270 : if (allocated(mpi_enreg1%kptdstrb)) then
298 : 0 : sz1=size(mpi_enreg1%kptdstrb,1)
299 : 0 : sz2=size(mpi_enreg1%kptdstrb,2)
300 : 0 : sz3=size(mpi_enreg1%kptdstrb,3)
301 [ # # # # : 0 : ABI_MALLOC(mpi_enreg2%kptdstrb,(sz1,sz2,sz3))
# # # # #
# # # # #
# # # # #
# # # ]
302 [ # # # # : 0 : mpi_enreg2%kptdstrb=mpi_enreg1%kptdstrb
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
303 : : end if
304 [ - + ]: 2270 : if (allocated(mpi_enreg1%kpt_loc2fbz_sp)) then
305 : 0 : sz1=size(mpi_enreg1%kpt_loc2fbz_sp,1)-1
306 : 0 : sz2=size(mpi_enreg1%kpt_loc2fbz_sp,2)
307 : 0 : sz3=size(mpi_enreg1%kpt_loc2fbz_sp,3)
308 [ # # # # : 0 : ABI_MALLOC(mpi_enreg2%kpt_loc2fbz_sp,(0:sz1,1:sz2,1:sz3))
# # # # #
# # # # #
# # # # #
# # # ]
309 [ # # # # : 0 : mpi_enreg2%kpt_loc2fbz_sp=mpi_enreg1%kpt_loc2fbz_sp
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
310 : : end if
311 [ - + ]: 2270 : if (allocated(mpi_enreg1%kpt_loc2ibz_sp)) then
312 : 0 : sz1=size(mpi_enreg1%kpt_loc2ibz_sp,1)-1
313 : 0 : sz2=size(mpi_enreg1%kpt_loc2ibz_sp,2)
314 : 0 : sz3=size(mpi_enreg1%kpt_loc2ibz_sp,3)
315 [ # # # # : 0 : ABI_MALLOC(mpi_enreg2%kpt_loc2ibz_sp,(0:sz1,1:sz2,1:sz3))
# # # # #
# # # # #
# # # # #
# # # ]
316 [ # # # # : 0 : mpi_enreg2%kpt_loc2ibz_sp=mpi_enreg1%kpt_loc2ibz_sp
# # # # #
# # # # #
# # # # #
# # # # #
# # # # ]
317 : : end if
318 [ - + ]: 2270 : if (allocated(mpi_enreg1%mkmem)) then
319 [ # # # # : 0 : ABI_MALLOC(mpi_enreg2%mkmem,(0:size(mpi_enreg1%mkmem,1)-1))
# # # # #
# # # #
# ]
320 [ # # # # : 0 : mpi_enreg2%mkmem=mpi_enreg1%mkmem
# # # # #
# # # ]
321 : : end if
322 [ - + ]: 2270 : if (associated(mpi_enreg1%my_atmtab)) then
323 [ # # # # : 0 : ABI_MALLOC(mpi_enreg2%my_atmtab,(size(mpi_enreg1%my_atmtab)))
# # # # #
# # # ]
324 [ # # ]: 0 : mpi_enreg2%my_atmtab=mpi_enreg1%my_atmtab
325 : : else
326 : 2270 : nullify(mpi_enreg2%my_atmtab)
327 : : end if
328 [ + + ]: 2270 : if (allocated(mpi_enreg1%my_kgtab)) then
329 : 4 : sz1=size(mpi_enreg1%my_kgtab,1)
330 : 4 : sz2=size(mpi_enreg1%my_kgtab,2)
331 [ - + + - : 16 : ABI_MALLOC(mpi_enreg2%my_kgtab,(sz1,sz2))
- + + - +
- + - - +
- + - + ]
332 [ + - + - : 269 : mpi_enreg2%my_kgtab=mpi_enreg1%my_kgtab
- + - - -
- - - - -
- - + + +
+ ]
333 : : end if
334 [ - + ]: 2270 : if (allocated(mpi_enreg1%distrb_pert)) then
335 [ # # # # : 0 : ABI_MALLOC(mpi_enreg2%distrb_pert,(size(mpi_enreg1%distrb_pert)))
# # # # #
# # # #
# ]
336 [ # # # # : 0 : mpi_enreg2%distrb_pert=mpi_enreg1%distrb_pert
# # # # #
# # # ]
337 : : end if
338 [ + + ]: 2270 : if (allocated(mpi_enreg1%distrb_img)) then
339 [ - + + - : 396 : ABI_MALLOC(mpi_enreg2%distrb_img,(size(mpi_enreg1%distrb_img)))
+ - + - -
+ - + -
+ ]
340 [ + - - + : 396 : mpi_enreg2%distrb_img=mpi_enreg1%distrb_img
- - - - -
- + + ]
341 : : end if
342 [ + + ]: 2270 : if (allocated(mpi_enreg1%my_imgtab)) then
343 [ - + + - : 396 : ABI_MALLOC(mpi_enreg2%my_imgtab,(size(mpi_enreg1%my_imgtab)))
+ - + - -
+ - + -
+ ]
344 [ + - - + : 396 : mpi_enreg2%my_imgtab=mpi_enreg1%my_imgtab
- - - - -
- + + ]
345 : : end if
346 [ + + ]: 2270 : if (allocated(mpi_enreg1%distrb_hf)) then
347 : 123 : sz1=size(mpi_enreg1%distrb_hf,1)
348 : 123 : sz2=size(mpi_enreg1%distrb_hf,2)
349 : 123 : sz3=size(mpi_enreg1%distrb_hf,3)
350 [ - + + - : 615 : ABI_MALLOC(mpi_enreg2%distrb_hf,(sz1,sz2,sz3))
- + + - -
+ + - + -
+ - - + -
+ - + ]
351 [ + - + - : 4039 : mpi_enreg2%distrb_hf=mpi_enreg1%distrb_hf
+ - - + -
- - - - -
- - - - -
- - - + +
+ + + + ]
352 : : end if
353 : :
354 : : !Optional pointers
355 [ + + ]: 2270 : if (allocated(mpi_enreg1%my_kpttab)) then
356 [ - + + - : 396 : ABI_MALLOC(mpi_enreg2%my_kpttab,(size(mpi_enreg1%my_kpttab)))
+ - + - -
+ - + -
+ ]
357 [ + - - + : 954 : mpi_enreg2%my_kpttab=mpi_enreg1%my_kpttab
- - - - -
- + + ]
358 : : end if
359 : :
360 : : !Do not copy wavelet pointers, just associate.
361 : 2270 : mpi_enreg2%nscatterarr => mpi_enreg1%nscatterarr
362 : 2270 : mpi_enreg2%ngatherarr => mpi_enreg1%ngatherarr
363 : :
364 : 2270 : end subroutine copy_mpi_enreg
365 : : !!***
366 : :
367 : : !----------------------------------------------------------------------
368 : :
369 : : !!****f* m_mpinfo/set_mpi_enreg_fft
370 : : !! NAME
371 : : !! set_mpi_enreg_fft
372 : : !!
373 : : !! FUNCTION
374 : : !! Set the content of a MPI datastructure in order to call fourwf/fourdp
375 : : !! (in view of a wrapper for these routines)
376 : : !!
377 : : !! INPUTS
378 : : !! me_g0=1 if the current process treat the g=0 plane-wave
379 : : !! comm_fft= MPI communicator over FFT components
380 : : !! paral_kgb= flag used to activate "band-FFT" parallelism
381 : : !!
382 : : !! SIDE EFFECTS
383 : : !! MPI_enreg<MPI_type>=FFT pointer/flags initialized
384 : : !!
385 : : !! SOURCE
386 : :
387 : 3702 : subroutine set_mpi_enreg_fft(MPI_enreg,comm_fft,distribfft,me_g0,paral_kgb)
388 : :
389 : : !Arguments ------------------------------------
390 : : class(MPI_type),intent(inout) :: MPI_enreg
391 : : integer,intent(in) :: me_g0,comm_fft,paral_kgb
392 : : type(distribfft_type),intent(in),target :: distribfft
393 : : ! *********************************************************************
394 : :
395 : 3702 : mpi_enreg%comm_fft=comm_fft
396 : 3702 : mpi_enreg%paral_kgb=paral_kgb
397 : 3702 : mpi_enreg%me_g0=me_g0
398 : 3702 : mpi_enreg%nproc_fft=xmpi_comm_size(comm_fft)
399 : 3702 : mpi_enreg%me_fft=xmpi_comm_rank(comm_fft)
400 : 3702 : mpi_enreg%me_g0_fft=0
401 [ + + ]: 3702 : if (mpi_enreg%me_fft==0) then
402 : 3482 : mpi_enreg%me_g0_fft=1
403 : : end if
404 [ + + ]: 3702 : if (associated(mpi_enreg%distribfft)) then
405 : 3 : call mpi_enreg%distribfft%free()
406 [ - + - + : 3 : ABI_FREE(mpi_enreg%distribfft)
- + - + -
+ - + - +
- + - + -
+ - + - +
- + ]
407 : : end if
408 : 3702 : mpi_enreg%distribfft => distribfft
409 : :
410 : 3702 : end subroutine set_mpi_enreg_fft
411 : : !!***
412 : :
413 : : !----------------------------------------------------------------------
414 : :
415 : : !!****f* m_mpinfo/unset_mpi_enreg_fft
416 : : !! NAME
417 : : !! unset_mpi_enreg_fft
418 : : !!
419 : : !! FUNCTION
420 : : !! Unset the content of a MPI datastructure used to call fourwf/fourdp
421 : : !! (in view of a wrapper for these routines)
422 : : !!
423 : : !! SIDE EFFECTS
424 : : !! MPI_enreg<MPI_type>=FFT pointer/flags initialized
425 : : !!
426 : : !! SOURCE
427 : :
428 : 8090 : subroutine unset_mpi_enreg_fft(MPI_enreg)
429 : :
430 : : !Arguments ------------------------------------
431 : : class(MPI_type),intent(inout) :: MPI_enreg
432 : : ! *********************************************************************
433 : :
434 : 8090 : mpi_enreg%me_g0=1
435 : 8090 : mpi_enreg%comm_fft=xmpi_comm_self
436 : 8090 : mpi_enreg%nproc_fft=1
437 : 8090 : mpi_enreg%me_fft=0
438 : 8090 : mpi_enreg%me_g0_fft=1
439 : 8090 : mpi_enreg%paral_kgb=0
440 : 8090 : nullify(mpi_enreg%distribfft)
441 : :
442 : 8090 : end subroutine unset_mpi_enreg_fft
443 : : !!***
444 : :
445 : : !----------------------------------------------------------------------
446 : :
447 : : !!****f* m_mpinfo/ptabs_fourdp
448 : : !! NAME
449 : : !! ptabs_fourdp
450 : : !!
451 : : !! FUNCTION
452 : : !! Returns pointers to the tables used for the MPI FFT of densities and potentials (fourdp routine).
453 : : !!
454 : : !! NOTES
455 : : !! 1) These pointers are references to the internal tables stored in MPI_enreg hence
456 : : !! *** DO NOT DEALLOCATE THE POINTERS YOU HAVE RECEIVED! ***
457 : : !!
458 : : !! INPUTS
459 : : !! MPI_enreg<MPI_type>=Datatype gathering information on the parallelism.
460 : : !! n2,n3=Number of FFT divisions along y and z
461 : : !!
462 : : !! OUTPUT
463 : : !! fftn2_distrib(:)= rank of the processor which own fft planes in 2nd dimension for fourdp
464 : : !! ffti2_local(:) = local i2 indices in fourdp
465 : : !! fftn3_distrib(:) = rank of the processor which own fft planes in 3rd dimension for fourdp
466 : : !! ffti3_local(:) = local i3 indices in fourdp
467 : : !!
468 : : !! SOURCE
469 : :
470 : 2804610 : subroutine ptabs_fourdp(MPI_enreg,n2,n3,fftn2_distrib,ffti2_local,fftn3_distrib,ffti3_local)
471 : :
472 : : !Arguments ------------------------------------
473 : : class(MPI_type),intent(in) :: MPI_enreg
474 : : integer,intent(in) :: n2,n3
475 : : integer, contiguous, pointer :: fftn2_distrib(:),ffti2_local(:)
476 : : integer, contiguous, pointer :: fftn3_distrib(:),ffti3_local(:)
477 : :
478 : : !Local variables-------------------------------
479 : : !scalars
480 : : logical :: grid_found
481 : : ! *********************************************************************
482 : :
483 : : grid_found=.false.
484 : :
485 : : ! Get the distrib associated with this fft_grid => for i2 and i3 planes
486 : 2804610 : grid_found=.false.
487 [ + + ]: 2804610 : if (n2== mpi_enreg%distribfft%n2_coarse) then
488 [ + + ]: 2437019 : if( n3 == size(mpi_enreg%distribfft%tab_fftdp3_distrib) )then
489 : 2435563 : fftn2_distrib => mpi_enreg%distribfft%tab_fftdp2_distrib
490 : 2435563 : ffti2_local => mpi_enreg%distribfft%tab_fftdp2_local
491 : 2435563 : fftn3_distrib => mpi_enreg%distribfft%tab_fftdp3_distrib
492 : 2435563 : ffti3_local => mpi_enreg%distribfft%tab_fftdp3_local
493 : 2435563 : grid_found=.true.
494 : : end if
495 : : end if
496 : :
497 [ + + + + ]: 2804610 : if((n2 == mpi_enreg%distribfft%n2_fine).and.(.not.(grid_found))) then
498 [ + - ]: 369047 : if( n3 == size(mpi_enreg%distribfft%tab_fftdp3dg_distrib) )then
499 : 369047 : fftn2_distrib => mpi_enreg%distribfft%tab_fftdp2dg_distrib
500 : 369047 : ffti2_local => mpi_enreg%distribfft%tab_fftdp2dg_local
501 : 369047 : fftn3_distrib => mpi_enreg%distribfft%tab_fftdp3dg_distrib
502 : 369047 : ffti3_local => mpi_enreg%distribfft%tab_fftdp3dg_local
503 : : grid_found=.true.
504 : : end if
505 : : end if
506 : :
507 [ - + ]: 1957903 : if (.not. grid_found) then
508 [ # # ]: 0 : ABI_BUG(sjoin("Unable to find an allocated distrib for this fft grid with n2, n3 = ", ltoa([n2, n3])))
509 : : end if
510 : :
511 : 2804610 : end subroutine ptabs_fourdp
512 : : !!***
513 : :
514 : : !----------------------------------------------------------------------
515 : :
516 : : !!****f* m_mpinfo/ptabs_fourwf
517 : : !! NAME
518 : : !! ptabs_fourwf
519 : : !!
520 : : !! FUNCTION
521 : : !! Returns pointers to the tables used for the MPI FFT of the wavefunctions (fourwf routine).
522 : : !!
523 : : !! NOTES
524 : : !! 1) These pointers are references to the internal tables stored in MPI_enreg hence
525 : : !! *** DO NOT DEALLOCATE THE POINTERS YOU HAVE RECEIVED! ***
526 : : !!
527 : : !! INPUTS
528 : : !! MPI_enreg<MPI_type>=Datatype gathering information on the parallelism.
529 : : !! n2,n3=Number of FFT divisions along y and z
530 : : !!
531 : : !! OUTPUT
532 : : !! fftn2_distrib(:)= rank of the processors which own fft planes in 2nd dimension for fourwf
533 : : !! ffti2_local(:) = local i2 indices in fourwf
534 : : !! fftn3_distrib(:) = rank of the processors which own fft planes in 3rd dimension for fourwf
535 : : !! ffti3_local(:) = local i3 indices in fourwf
536 : : !!
537 : : !! SOURCE
538 : :
539 : 61028027 : subroutine ptabs_fourwf(MPI_enreg,n2,n3,fftn2_distrib,ffti2_local,fftn3_distrib,ffti3_local)
540 : :
541 : : !Arguments ------------------------------------
542 : : !scalars
543 : : class(MPI_type),intent(in) :: MPI_enreg
544 : : integer,intent(in) :: n2,n3
545 : : integer, contiguous, pointer :: fftn2_distrib(:),ffti2_local(:)
546 : : integer, contiguous, pointer :: fftn3_distrib(:),ffti3_local(:)
547 : :
548 : : !Local variables-------------------------------
549 : : !scalars
550 : : logical :: grid_found
551 : : ! *********************************************************************
552 : :
553 : 61028027 : grid_found=.false.
554 : :
555 : : ! Get the distrib associated with this fft_grid => for i2 and i3 planes
556 [ + + ]: 61028027 : if (n2 == mpi_enreg%distribfft%n2_coarse) then
557 [ + - ]: 61013348 : if (n3 == size(mpi_enreg%distribfft%tab_fftdp3_distrib))then
558 : 61013348 : fftn2_distrib => mpi_enreg%distribfft%tab_fftwf2_distrib
559 : 61013348 : ffti2_local => mpi_enreg%distribfft%tab_fftwf2_local
560 : 61013348 : fftn3_distrib => mpi_enreg%distribfft%tab_fftdp3_distrib
561 : 61013348 : ffti3_local => mpi_enreg%distribfft%tab_fftdp3_local
562 : 61013348 : grid_found=.true.
563 : : end if
564 : : end if
565 : :
566 [ + + + + ]: 61028027 : if((n2 == mpi_enreg%distribfft%n2_fine).and.(.not.(grid_found))) then
567 [ + - ]: 14679 : if (n3 == size(mpi_enreg%distribfft%tab_fftdp3dg_distrib) )then
568 : 14679 : fftn2_distrib => mpi_enreg%distribfft%tab_fftwf2dg_distrib
569 : 14679 : ffti2_local => mpi_enreg%distribfft%tab_fftwf2dg_local
570 : 14679 : fftn3_distrib => mpi_enreg%distribfft%tab_fftdp3dg_distrib
571 : 14679 : ffti3_local => mpi_enreg%distribfft%tab_fftdp3dg_local
572 : : grid_found=.true.
573 : : end if
574 : : end if
575 : :
576 [ - + ]: 57825352 : if(.not. grid_found) then
577 [ # # ]: 0 : ABI_BUG(sjoin("Unable to find an allocated distrib for this fft grid", ltoa([n2, n3])))
578 : : end if
579 : :
580 : 61028027 : end subroutine ptabs_fourwf
581 : : !!***
582 : :
583 : : !----------------------------------------------------------------------
584 : :
585 : : !!****f* m_mpinfo/mpi_distrib_is_ok
586 : : !! NAME
587 : : !! mpi_distrib_is_ok
588 : : !!
589 : : !! FUNCTION
590 : : !! Check if a MPI datastructure contains number of processors
591 : : !! compatible (in terms of efficiency) with the number of spins/k-points/bands
592 : : !!
593 : : !! INPUTS
594 : : !! MPI_enreg<MPI_type>=Datatype gathering information on the parallelism
595 : : !! nband=number of bands
596 : : !! nkpt=number of k-points
597 : : !! nptk_current_proc=number of k-points handled by current MPI process
598 : : !! nsppol= number of spins (1 or 2)
599 : : !!
600 : : !! OUTPUT
601 : : !! mpi_distrib_is_ok (current function)=TRUE if the current MPI distribution is optimal
602 : : !! FALSE otherwise
603 : : !! [msg]= -optional- warning message to be printed out
604 : : !!
605 : : !! SOURCE
606 : :
607 : 10450 : logical function mpi_distrib_is_ok(MPI_enreg,nband,nkpt,nkpt_current_proc,nsppol,msg)
608 : :
609 : : !Arguments ------------------------------------
610 : : !scalars
611 : : class(MPI_type),intent(in) :: MPI_enreg
612 : : integer,intent(in) :: nband,nkpt,nkpt_current_proc,nsppol
613 : : character(len=*),optional,intent(out) :: msg
614 : : ! *********************************************************************
615 : :
616 : 10450 : mpi_distrib_is_ok=.true.
617 : :
618 [ + + ]: 10450 : if (MPI_enreg%paralbd==0) then
619 [ - + + + ]: 9745 : if (MPI_enreg%nproc_spkpt-floor(nsppol*nkpt*one/nkpt_current_proc)>=nkpt_current_proc) then
620 : 148 : mpi_distrib_is_ok=.false.
621 [ + + ]: 148 : if (present(msg)) then
622 : : write(msg,'(a,i0,4a,i0,3a)') &
623 : 74 : 'Your number of spins*k-points (=',nsppol*nkpt,') ',&
624 : 74 : 'will not distribute correctly',ch10, &
625 : 74 : 'with the current number of processors (=',MPI_enreg%nproc_spkpt,').',ch10,&
626 : 148 : 'You will leave some empty.'
627 : : end if
628 : : end if
629 : : else
630 [ - + ]: 705 : if (mod(nband,max(1,MPI_enreg%nproc_spkpt/(nsppol*nkpt)))/=0) then
631 : 0 : mpi_distrib_is_ok=.false.
632 [ # # ]: 0 : if (present(msg)) then
633 : : write(msg,'(a,i0,2a,i0,4a,i0,7a)')&
634 : 0 : 'Your number of spins*k-points (=',nsppol*nkpt,') ',&
635 : 0 : 'and bands (=',nband,') ',&
636 : 0 : 'will not distribute correctly',ch10,&
637 : 0 : 'with the current number of processors (=',MPI_enreg%nproc_spkpt,').',ch10,&
638 : 0 : 'You will leave some empty.'
639 : : end if
640 : : end if
641 : : end if
642 : :
643 : 10450 : end function mpi_distrib_is_ok
644 : : !!***
645 : :
646 : : !!****f* ABINIT/proc_distrb_cycle
647 : : !! NAME
648 : : !! proc_distrb_cycle
649 : : !!
650 : : !! FUNCTION
651 : : !! test a condition to cycle over bands and k-points which do not belong to the present processor
652 : : !! if return value is true, you can cycle over the given range of bands for this k and sppol
653 : : !!
654 : : !! INPUTS
655 : : !!
656 : : !! SOURCE
657 : :
658 : 6257533 : logical function proc_distrb_cycle(distrb,ikpt,iband1,iband2,isppol,me)
659 : :
660 : : !Arguments ------------------------------------
661 : : !scalars
662 : : integer,intent(in) :: ikpt,iband1,iband2,isppol,me
663 : : integer,allocatable,intent(in) :: distrb(:,:,:)
664 : : ! *************************************************************************
665 : :
666 : 6257533 : proc_distrb_cycle=.false.
667 [ + + ]: 6257533 : if (allocated(distrb)) then
668 [ + + ]: 6253843 : if (isppol==-1) then
669 : : ! in this condition, if one of the distrb is for me, then the minval will be == 0, so it returns false
670 [ + + + + ]: 5245918 : proc_distrb_cycle=(minval(abs(distrb(ikpt,iband1:iband2,:)-me))/=0)
671 : : else
672 [ + + ]: 31613661 : proc_distrb_cycle=(minval(abs(distrb(ikpt,iband1:iband2,isppol)-me))/=0)
673 : : end if
674 : : end if
675 : :
676 : 6257533 : end function proc_distrb_cycle
677 : : !!***
678 : :
679 : : !!****f* ABINIT/proc_distrb_nband
680 : : !! NAME
681 : : !! proc_distrb_nband
682 : : !!
683 : : !! FUNCTION
684 : : !! return number of bands at this k and spin which are on current proc "me"
685 : : !! NB: could replace proc_distrb_cycle with "proc_distrb_nband > 0"
686 : : !! isppol -1 means for all spin channels, I think...
687 : : !!
688 : : !! INPUTS
689 : : !!
690 : : !! SOURCE
691 : :
692 : 5859612 : integer function proc_distrb_nband(distrb,ikpt,nband_k,isppol,me)
693 : :
694 : : !Arguments ------------------------------------
695 : : !scalars
696 : : integer,intent(in) :: ikpt,isppol,me,nband_k
697 : : integer,allocatable,intent(in) :: distrb(:,:,:)
698 : : ! *************************************************************************
699 : :
700 : 5859612 : proc_distrb_nband=0
701 [ + - ]: 5859612 : if (allocated(distrb)) then
702 [ - + ]: 5859612 : if (isppol==-1) then
703 : : !TODO: check this is used correctly : in nsppol 2 case you could end up with 2*nband
704 [ # # # # : 0 : proc_distrb_nband=(count(distrb(ikpt,1:nband_k,:)==me))
# # ]
705 : : else
706 [ + + + + ]: 48367086 : proc_distrb_nband=(count(distrb(ikpt,1:nband_k,isppol)==me))
707 : : end if
708 : : end if
709 : :
710 : 5859612 : end function proc_distrb_nband
711 : : !!***
712 : :
713 : : !!****f* ABINIT/proc_distrb_cycle_bands
714 : : !! NAME
715 : : !! proc_distrb_cycle_bands
716 : : !!
717 : : !! FUNCTION
718 : : !! return vector of logicals for each band being on present proc
719 : : !!
720 : : !! INPUTS
721 : : !!
722 : : !! SOURCE
723 : :
724 : 4466629 : subroutine proc_distrb_cycle_bands(cycle_bands,distrb,ikpt,isppol,me)
725 : :
726 : : !Arguments ------------------------------------
727 : : !scalars
728 : : integer,intent(in) :: ikpt,isppol,me
729 : : integer,allocatable,intent(in) :: distrb(:,:,:)
730 : : logical,allocatable,intent(out) :: cycle_bands(:)
731 : : character(len=500) :: msg
732 : : ! *************************************************************************
733 : :
734 [ - + - + : 13399887 : ABI_REMALLOC (cycle_bands, (size(distrb, 2)))
+ - + - +
- - + - +
- + ]
735 [ + + ]: 39539147 : cycle_bands=.false.
736 [ + - ]: 4466629 : if (allocated(distrb)) then
737 [ - + ]: 4466629 : if (isppol==-1) then
738 : : ! TODO : should raise error here - the output rank will be all wrong
739 : : ! could return an OR of the two spin channels, if appropriate
740 [ # # # # : 0 : cycle_bands=(distrb(ikpt,:,1)/=me)
# # # # ]
741 : 0 : write (msg, "(a)") " for the moment proc_distrb_cycle_bands does not handle the 'any spin' option nsppol -1"
742 : 0 : ABI_ERROR(msg)
743 : : else
744 [ + - - + : 44005776 : cycle_bands=(distrb(ikpt,:,isppol)/=me)
- - + + ]
745 : : end if
746 : : end if
747 : :
748 : 4466629 : end subroutine proc_distrb_cycle_bands
749 : : !!***
750 : :
751 : : !!****f* ABINIT/proc_distrb_kptband
752 : : !! NAME
753 : : !! proc_distrb_kptband
754 : : !!
755 : : !! FUNCTION
756 : : !! return vector of processor indices for each band, within the full kpt communicator
757 : : !!
758 : : !! INPUTS
759 : : !!
760 : : !! SOURCE
761 : :
762 : : subroutine proc_distrb_kptband(kpt_band_procs,distrb,ikpt,isppol)
763 : :
764 : : !Arguments ------------------------------------
765 : : !scalars
766 : : integer,intent(in) :: ikpt,isppol
767 : : integer,allocatable,intent(in) :: distrb(:,:,:)
768 : : integer,allocatable,intent(out) :: kpt_band_procs(:)
769 : : character(len=500) :: msg
770 : : ! *************************************************************************
771 : :
772 : : ABI_REMALLOC(kpt_band_procs, (size(distrb, 2)))
773 : : kpt_band_procs=-1
774 : : if (allocated(distrb)) then
775 : : if (isppol==-1) then
776 : : ! TODO : should raise error here - the output rank will be all wrong for isppol 2!
777 : : kpt_band_procs=distrb(ikpt,:,1)
778 : : write (msg, "(a)") " for the moment proc_distrb_kptband does not handle the 'any spin' option nsppol -1"
779 : : ABI_ERROR(msg)
780 : : else
781 : : kpt_band_procs=distrb(ikpt,:,isppol)
782 : : end if
783 : : end if
784 : :
785 : : end subroutine proc_distrb_kptband
786 : : !!***
787 : :
788 : : !!****f* ABINIT/proc_distrb_band
789 : : !! NAME
790 : : !! proc_distrb_band
791 : : !!
792 : : !! FUNCTION
793 : : !! return `rank_band` array with the rank of the processor in comm_band treating `band`
794 : : !!
795 : : !! INPUTS
796 : : !!
797 : : !! SOURCE
798 : :
799 : 1011608 : subroutine proc_distrb_band(rank_band,distrib,ikpt,isppol,nband,me_band,me_kpt,comm_band)
800 : :
801 : : !Arguments ------------------------------------
802 : : !scalars
803 : : integer,intent(in) :: nband, ikpt, isppol
804 : : integer,intent(in) :: me_band,me_kpt,comm_band
805 : : integer,allocatable,intent(in) :: distrib(:,:,:)
806 : : integer,intent(out) :: rank_band(nband)
807 : :
808 : : integer :: ierr, iband
809 : : ! *************************************************************************
810 : :
811 [ + + ]: 6410966 : rank_band = 0
812 : :
813 [ + - ]: 1011608 : if (allocated(distrib)) then
814 [ + + ]: 6410966 : do iband=1, nband
815 : : ! is this (k, band, spin) on current proc?
816 [ + + ]: 5399358 : if (distrib(ikpt,iband,isppol)/=me_kpt) cycle
817 : : ! if so save rank in band subcommunicator
818 : 6410966 : rank_band(iband) = me_band+1
819 : : end do
820 : 1011608 : call xmpi_sum(rank_band,comm_band,ierr)
821 : : end if
822 : :
823 [ + + ]: 6410966 : rank_band = rank_band-1
824 : :
825 : 1011608 : end subroutine proc_distrb_band
826 : : !!***
827 : :
828 : : !!****f* ABINIT/initmpi_world
829 : : !! NAME
830 : : !! initmpi_world
831 : : !!
832 : : !! FUNCTION
833 : : !! %comm_world is redefined for the number of processors on which ABINIT is launched
834 : : !!
835 : : !! SOURCE
836 : :
837 : 98 : subroutine initmpi_world(mpi_enreg,nproc)
838 : :
839 : : !Arguments ------------------------------------
840 : : class(MPI_type),intent(inout) :: mpi_enreg
841 : : integer, intent(in)::nproc
842 : :
843 : : !Local variables-------------------------------
844 : : !scalars
845 : : integer :: ii
846 : : !arrays
847 : 98 : integer,allocatable :: ranks(:)
848 : : ! ***********************************************************************
849 : :
850 : : DBG_ENTER("COLL")
851 : :
852 [ + - ]: 98 : if(nproc==mpi_enreg%nproc) return
853 : :
854 [ # # # # : 0 : ABI_MALLOC(ranks,(0:nproc-1))
# # # # #
# # # ]
855 [ # # # # : 0 : ranks(0:nproc-1)=(/((ii),ii=0,nproc-1)/)
# # ]
856 : 0 : mpi_enreg%comm_world=xmpi_subcomm(xmpi_world,nproc,ranks)
857 [ # # ]: 0 : ABI_FREE(ranks)
858 : :
859 [ # # ]: 0 : if(mpi_enreg%me<nproc) then
860 : 0 : mpi_enreg%me=xmpi_comm_rank(mpi_enreg%comm_world)
861 : 0 : mpi_enreg%nproc=xmpi_comm_size(mpi_enreg%comm_world)
862 : 0 : call abi_io_redirect(new_io_comm=mpi_enreg%comm_world)
863 : 0 : call libpaw_write_comm_set(mpi_enreg%comm_world)
864 : : else
865 : 0 : mpi_enreg%me=-1
866 : : end if
867 : :
868 : : DBG_EXIT("COLL")
869 : :
870 : : end subroutine initmpi_world
871 : : !!***
872 : :
873 : : !!****f* ABINIT/initmpi_seq
874 : : !! NAME
875 : : !! initmpi_seq
876 : : !!
877 : : !! FUNCTION
878 : : !! Initializes the MPI information for sequential use.
879 : : !!
880 : : !! INPUTS
881 : : !!
882 : : !! OUTPUT
883 : : !! mpi_enreg=information about MPI parallelization
884 : : !!
885 : : !! SOURCE
886 : :
887 [ + - ]: 525193 : subroutine initmpi_seq(mpi_enreg)
888 : :
889 : : !Arguments ------------------------------------
890 : : class(MPI_type),intent(out) :: mpi_enreg
891 : : ! ***********************************************************************
892 : :
893 : : DBG_ENTER("COLL")
894 : :
895 : : !Set default seq values for scalars
896 : 525193 : mpi_enreg%bandpp=1
897 : 525193 : mpi_enreg%me=0
898 : 525193 : mpi_enreg%me_band=0
899 : 525193 : mpi_enreg%me_cell=0
900 : 525193 : mpi_enreg%me_fft=0
901 : 525193 : mpi_enreg%me_g0=1
902 : 525193 : mpi_enreg%me_g0_fft=1
903 : 525193 : mpi_enreg%me_img=0
904 : 525193 : mpi_enreg%me_hf=0
905 : 525193 : mpi_enreg%me_kpt=0
906 : 525193 : mpi_enreg%me_pert=0
907 : 525193 : mpi_enreg%me_spinor=0
908 : 525193 : mpi_enreg%me_wvl=0
909 : 525193 : mpi_enreg%my_natom=0 ! Should be natom
910 [ + + ]: 1575579 : mpi_enreg%my_isppoltab=0 ! Should be (1,0) if nsppol=1 or (1,1) if nsppol=2
911 : 525193 : mpi_enreg%ngfft3_ionic=1
912 : 525193 : mpi_enreg%my_nimage=1
913 : 525193 : mpi_enreg%nproc=1
914 : 525193 : mpi_enreg%nproc_atom=1
915 : 525193 : mpi_enreg%nproc_band=1
916 : 525193 : mpi_enreg%nproc_cell=1
917 : 525193 : mpi_enreg%nproc_fft=1
918 : 525193 : mpi_enreg%nproc_img=1
919 : 525193 : mpi_enreg%nproc_hf=1
920 : 525193 : mpi_enreg%nproc_spkpt=1
921 : 525193 : mpi_enreg%nproc_pert=1
922 : 525193 : mpi_enreg%nproc_spinor=1
923 : 525193 : mpi_enreg%nproc_wvl=1
924 : 525193 : mpi_enreg%paralbd=0
925 : 525193 : mpi_enreg%paral_img=0
926 : 525193 : mpi_enreg%paral_hf=0
927 : 525193 : mpi_enreg%paral_kgb=0
928 : 525193 : mpi_enreg%paral_pert=0
929 : 525193 : mpi_enreg%paral_spinor=0
930 : 525193 : mpi_enreg%pw_unbal_thresh=-1._dp
931 : :
932 : : !Set default seq values for communicators
933 : 525193 : mpi_enreg%comm_world = xmpi_world
934 : 525193 : mpi_enreg%comm_atom = xmpi_comm_self
935 : 525193 : mpi_enreg%comm_band = xmpi_comm_self
936 : 525193 : mpi_enreg%comm_bandspinor = xmpi_comm_self
937 : 525193 : mpi_enreg%comm_bandfft = xmpi_comm_self
938 : 525193 : mpi_enreg%comm_bandspinorfft = xmpi_comm_self
939 : 525193 : mpi_enreg%comm_cell = xmpi_comm_self
940 : 525193 : mpi_enreg%comm_cell_pert = xmpi_comm_self
941 : 525193 : mpi_enreg%comm_fft = xmpi_comm_self
942 : 525193 : mpi_enreg%comm_hf = xmpi_comm_self
943 : 525193 : mpi_enreg%comm_img = xmpi_comm_self
944 : 525193 : mpi_enreg%comm_kpt = xmpi_comm_self
945 : 525193 : mpi_enreg%comm_kptband = xmpi_comm_self
946 : 525193 : mpi_enreg%comm_pert = xmpi_comm_self
947 : 525193 : mpi_enreg%comm_spinor = xmpi_comm_self
948 : 525193 : mpi_enreg%comm_spinorfft = xmpi_comm_self
949 : 525193 : mpi_enreg%comm_wvl = xmpi_comm_self
950 : :
951 : : !Nullify all pointers
952 : 525193 : call nullify_mpi_enreg(mpi_enreg)
953 : :
954 : : !Allocate and nullify distribfft datastructure
955 : : ! This is not good since distribfft is not initialized here (even with 0s).
956 : : ! It can be dangerous if use with no care (Valgrind might complain)
957 [ - + ]: 525193 : ABI_MALLOC(mpi_enreg%distribfft,)
958 : :
959 : : DBG_EXIT("COLL")
960 : :
961 : 525193 : end subroutine initmpi_seq
962 : : !!***
963 : :
964 : : !!****f* ABINIT/initmpi_atom
965 : : !! NAME
966 : : !! initmpi_atom
967 : : !!
968 : : !! FUNCTION
969 : : !! Initializes the mpi information for parallelism over atoms (PAW).
970 : : !!
971 : : !! INPUTS
972 : : !! dtset <type(dataset_type)>=all input variables for this dataset
973 : : !! mpi_enreg= information about MPI parallelization
974 : : !!
975 : : !! OUTPUT
976 : : !! mpi_enreg= information about MPI parallelization
977 : : !! comm_atom =communicator over atoms
978 : : !! nproc_atom =size of the communicator over atoms
979 : : !! my_natom =number of atoms treated by current proc
980 : : !! my_atmtab(mpi_enreg%natom)=indexes of the atoms treated by current processor
981 : : !!
982 : : !! SOURCE
983 : :
984 : 7006 : subroutine initmpi_atom(dtset,mpi_enreg)
985 : :
986 : : !Arguments ------------------------------------
987 : : !scalars
988 : : type(dataset_type),intent(in) :: dtset
989 : : class(MPI_type),intent(inout) :: mpi_enreg
990 : :
991 : : !Local variables-------------------------------
992 : : !scalars
993 : : logical :: my_atmtab_allocated,paral_atom
994 : : character(len=500) :: msg
995 : : integer :: iatom
996 : : ! ***********************************************************************
997 : :
998 : : DBG_ENTER("COLL")
999 : :
1000 : 7006 : mpi_enreg%nproc_atom=1
1001 : 7006 : mpi_enreg%comm_atom=xmpi_comm_self
1002 : 7006 : mpi_enreg%my_natom=dtset%natom
1003 [ + + ]: 7006 : if (associated(mpi_enreg%my_atmtab))then
1004 : 40 : ABI_FREE(mpi_enreg%my_atmtab)
1005 : : end if
1006 : 7006 : nullify(mpi_enreg%my_atmtab)
1007 : :
1008 : : if (xmpi_paral==0) then
1009 : : mpi_enreg%nproc_atom=0
1010 : : ABI_MALLOC(mpi_enreg%my_atmtab,(0))
1011 : : return
1012 : : end if
1013 : :
1014 : : !Check compatibility
1015 [ + + ]: 7006 : if (dtset%paral_atom>0) then
1016 : 514 : msg=''
1017 [ - + ]: 514 : if (dtset%usepaw==0) msg= 'Parallelisation over atoms not compatible with usepaw=0 !'
1018 [ - + ]: 514 : if (dtset%usedmft==1) msg=' Parallelisation over atoms not compatible with usedmft=1 !'
1019 [ - + ]: 514 : if (dtset%usedmft==10) msg=' Parallelisation over atoms not compatible with usedmft=10 !'
1020 [ - + ]: 514 : if (dtset%usewvl==1) msg= 'Parallelisation over atoms not compatible with usewvl=1 !'
1021 [ - + - - ]: 514 : if (dtset%prtden>1.and.dtset%paral_kgb<=0) &
1022 : 0 : & msg= 'Parallelisation over atoms not compatible with prtden>1 (PAW AE densities) !'
1023 [ - + ]: 514 : if (dtset%optdriver/=RUNL_GSTATE.and.dtset%optdriver/=RUNL_RESPFN) &
1024 : 0 : & msg=' Parallelisation over atoms only compatible with GS or RF !'
1025 [ - + ]: 514 : if (dtset%macro_uj/=0)msg=' Parallelisation over atoms not compatible with macro_uj!=0 !'
1026 [ - + ]: 514 : if (msg/='') then
1027 : 0 : ABI_ERROR(msg)
1028 : : end if
1029 : : end if
1030 : :
1031 [ - + ]: 7006 : if (mpi_enreg%comm_atom==xmpi_comm_null) then
1032 : 0 : mpi_enreg%nproc_atom=0;mpi_enreg%my_natom=0
1033 [ # # ]: 0 : ABI_MALLOC(mpi_enreg%my_atmtab,(0))
1034 : 0 : return
1035 : : end if
1036 : :
1037 [ + + ]: 7006 : if (dtset%paral_atom>0) then
1038 : :
1039 : : ! Build correct atom communicator
1040 [ + + + + ]: 514 : if (dtset%optdriver==RUNL_GSTATE.and.dtset%paral_kgb==1) then
1041 : 396 : mpi_enreg%comm_atom=mpi_enreg%comm_kptband
1042 : : else
1043 : 118 : mpi_enreg%comm_atom=mpi_enreg%comm_cell
1044 : : end if
1045 : :
1046 : : ! Get number of processors sharing the atomic data distribution
1047 : 514 : mpi_enreg%nproc_atom=xmpi_comm_size(mpi_enreg%comm_atom)
1048 : :
1049 : : ! Get local number of atoms
1050 : 514 : call get_my_natom(mpi_enreg%comm_atom,mpi_enreg%my_natom,dtset%natom)
1051 : 514 : paral_atom=(mpi_enreg%my_natom/=dtset%natom)
1052 : :
1053 : : ! Build atom table
1054 [ + + + + ]: 514 : if (mpi_enreg%my_natom>0.and.paral_atom) then
1055 : 348 : my_atmtab_allocated=.false.
1056 : : call get_my_atmtab(mpi_enreg%comm_atom,mpi_enreg%my_atmtab,my_atmtab_allocated, &
1057 : 348 : & paral_atom,dtset%natom)
1058 [ + + ]: 166 : else if (.not.paral_atom) then
1059 [ - + + - : 36 : ABI_MALLOC(mpi_enreg%my_atmtab,(dtset%natom))
+ - + - -
+ - + ]
1060 [ + - + + : 60 : mpi_enreg%my_atmtab(1:dtset%natom)=(/(iatom, iatom=1,dtset%natom)/)
+ + ]
1061 [ + - ]: 154 : else if (mpi_enreg%my_natom==0) then
1062 [ - + ]: 154 : ABI_MALLOC(mpi_enreg%my_atmtab,(0))
1063 : : end if
1064 : :
1065 : : end if
1066 : :
1067 : : DBG_EXIT("COLL")
1068 : :
1069 : : end subroutine initmpi_atom
1070 : : !!***
1071 : :
1072 : : !----------------------------------------------------------------------
1073 : :
1074 : : !!****f* m_mpinfo/clnmpi_atom
1075 : : !! NAME
1076 : : !! clnmpi_atom
1077 : : !!
1078 : : !! FUNCTION
1079 : : !! Cleans-up the mpi information for the parallelism over atoms (PAW).
1080 : : !!
1081 : : !! SIDE EFFECTS
1082 : : !! mpi_enreg=information about MPI parallelization
1083 : : !!
1084 : : !! SOURCE
1085 : :
1086 : 6962 : subroutine clnmpi_atom(mpi_enreg)
1087 : :
1088 : : !Arguments ------------------------------------
1089 : : class(MPI_type), intent(inout) :: mpi_enreg
1090 : : ! ***********************************************************************
1091 : :
1092 : : DBG_ENTER("COLL")
1093 : :
1094 : : if (xmpi_paral==0) return
1095 : :
1096 [ + + ]: 6962 : if (mpi_enreg%comm_atom/=mpi_enreg%comm_world) then
1097 : 6884 : call xmpi_comm_free(mpi_enreg%comm_atom)
1098 : 6884 : mpi_enreg%comm_atom=xmpi_comm_null
1099 : : end if
1100 : :
1101 [ + + ]: 6962 : if(associated(mpi_enreg%my_atmtab)) then
1102 : 474 : ABI_FREE(mpi_enreg%my_atmtab)
1103 : : end if
1104 : :
1105 : 6962 : mpi_enreg%nproc_atom=1
1106 : 6962 : mpi_enreg%my_natom=0 ! should be natom
1107 : :
1108 : : DBG_EXIT("COLL")
1109 : :
1110 : 6962 : end subroutine clnmpi_atom
1111 : : !!***
1112 : :
1113 : : !!****f* ABINIT/initmpi_grid
1114 : : !! NAME
1115 : : !! initmpi_grid
1116 : : !!
1117 : : !! FUNCTION
1118 : : !! Initializes the MPI information for the grid:
1119 : : !! * 2D if parallelization KPT/FFT (paral_kgb == 0 & MPI)
1120 : : !! * 3D if parallelization KPT/FFT/BAND (paral_kgb == 1 & MPI)
1121 : : !! * 2D in case of an Hartree-Fock calculation
1122 : : !!
1123 : : !! INPUTS
1124 : : !!
1125 : : !! OUTPUT
1126 : : !!
1127 : : !! SOURCE
1128 : :
1129 : 6966 : subroutine initmpi_grid(mpi_enreg)
1130 : :
1131 : : !Arguments ------------------------------------
1132 : : class(MPI_type),intent(inout) :: mpi_enreg
1133 : :
1134 : : !Local variables-------------------------------
1135 : : !scalars
1136 : : integer :: nproc,nproc_eff,spacecomm
1137 : : character(len=500) :: msg
1138 : : #if defined HAVE_MPI
1139 : : integer :: commcart_4d,dimcart,ierr,me_cart_4d
1140 : : integer :: commcart_2d,me_cart_2d
1141 : : logical :: reorder
1142 : : !arrays
1143 : 6966 : integer,allocatable :: coords(:),sizecart(:)
1144 : 6966 : logical,allocatable :: period(:), keepdim(:)
1145 : : #endif
1146 : : ! *********************************************************************
1147 : :
1148 : : DBG_ENTER("COLL")
1149 : :
1150 : : !Select the correct "world" communicator"
1151 : 6966 : nproc=mpi_enreg%nproc_cell
1152 : : if(mpi_enreg%paral_pert==1) nproc=mpi_enreg%nproc_cell
1153 : 6966 : spacecomm=mpi_enreg%comm_cell
1154 : :
1155 : : !Fake values for null communicator
1156 [ - + ]: 6966 : if (nproc==0) then
1157 : 0 : mpi_enreg%nproc_fft = 0
1158 : 0 : mpi_enreg%nproc_band = 0
1159 : 0 : mpi_enreg%nproc_hf = 0
1160 : 0 : mpi_enreg%nproc_spkpt = 0
1161 : 0 : mpi_enreg%nproc_spinor = 0
1162 : 0 : mpi_enreg%comm_fft = xmpi_comm_null
1163 : 0 : mpi_enreg%comm_band = xmpi_comm_null
1164 : 0 : mpi_enreg%comm_hf = xmpi_comm_null
1165 : 0 : mpi_enreg%comm_kpt = xmpi_comm_null
1166 : 0 : mpi_enreg%comm_kptband = xmpi_comm_null
1167 : 0 : mpi_enreg%comm_spinor = xmpi_comm_null
1168 : 0 : mpi_enreg%comm_bandspinor = xmpi_comm_null
1169 : 0 : mpi_enreg%comm_spinorfft = xmpi_comm_null
1170 : 0 : mpi_enreg%comm_bandfft = xmpi_comm_null
1171 : 0 : mpi_enreg%comm_bandspinorfft = xmpi_comm_null
1172 : 0 : mpi_enreg%bandpp = 1
1173 : 0 : return
1174 : : end if
1175 : :
1176 : : #if defined HAVE_MPI
1177 [ + - ]: 6966 : if (mpi_enreg%paral_hf==0) then
1178 : : ! either the option Fock exchange is not active or there is no parallelization on Fock exchange calculation.
1179 : :
1180 [ + + ]: 6966 : if (mpi_enreg%nproc_spinor>1) mpi_enreg%paral_spinor=1
1181 : :
1182 : : !Effective number of processors used for the grid
1183 : 6966 : nproc_eff=mpi_enreg%nproc_fft*mpi_enreg%nproc_band *mpi_enreg%nproc_spkpt*mpi_enreg%nproc_spinor
1184 [ - + ]: 6966 : if(nproc_eff/=nproc) then
1185 : : write(msg,'(4a,5(a,i0,a))') &
1186 : 0 : ' The number of band*FFT*spin*kpt*spinor processors, npband*npfft*np_spkpt*npspinor should be',ch10,&
1187 : 0 : ' equal to the total number of processors, nproc.',ch10,&
1188 : 0 : ' However, npband =',mpi_enreg%nproc_band, ch10, &
1189 : 0 : ' npfft =',mpi_enreg%nproc_fft, ch10, &
1190 : 0 : ' np_spkpt =',mpi_enreg%nproc_spkpt, ch10, &
1191 : 0 : ' npspinor =',mpi_enreg%nproc_spinor, ch10, &
1192 : 0 : ' nproc =',nproc,ch10
1193 : 0 : ABI_WARNING(msg)
1194 : : end if
1195 : :
1196 : : ! Nothing to do if only 1 proc
1197 [ + + ]: 6966 : if (nproc_eff==1) return
1198 : :
1199 : : ! Initialize the communicator for Hartree-Fock to xmpi_comm_self
1200 : 1234 : mpi_enreg%me_hf =0
1201 : 1234 : mpi_enreg%comm_hf=xmpi_comm_self
1202 : :
1203 [ + + ]: 1234 : if(mpi_enreg%paral_kgb==0) then
1204 : 612 : mpi_enreg%me_fft =0
1205 : 612 : mpi_enreg%me_band=0
1206 : 612 : mpi_enreg%me_kpt =mpi_enreg%me_cell
1207 : 612 : mpi_enreg%me_spinor=0
1208 : 612 : mpi_enreg%comm_fft=xmpi_comm_self
1209 : 612 : mpi_enreg%comm_band=xmpi_comm_self
1210 : 612 : mpi_enreg%comm_kpt=mpi_enreg%comm_cell
1211 : 612 : mpi_enreg%comm_spinor=xmpi_comm_self
1212 : 612 : mpi_enreg%comm_bandspinor=xmpi_comm_self
1213 : 612 : mpi_enreg%comm_kptband=mpi_enreg%comm_cell
1214 : 612 : mpi_enreg%comm_spinorfft=xmpi_comm_self
1215 : 612 : mpi_enreg%comm_bandfft=xmpi_comm_self
1216 : 612 : mpi_enreg%comm_bandspinorfft=xmpi_comm_self
1217 : : else
1218 : : ! CREATE THE 4D GRID
1219 : : ! ==================================================
1220 : :
1221 : : ! Create the global cartesian 4D- communicator
1222 : : ! valgrind claims this is not deallocated in test v5/72
1223 : : ! Can someone knowledgeble check?
1224 : 622 : dimcart=4
1225 [ - + ]: 622 : ABI_MALLOC(sizecart,(dimcart))
1226 [ - + ]: 622 : ABI_MALLOC(period,(dimcart))
1227 : : ! MT 2012-june: change the order of the indexes; not sure this is efficient
1228 : : ! (not efficient on TGCC-Curie).
1229 : 622 : sizecart(1)=mpi_enreg%nproc_spkpt ! mpi_enreg%nproc_spkpt
1230 : 622 : sizecart(2)=mpi_enreg%nproc_band ! mpi_enreg%nproc_band
1231 : 622 : sizecart(3)=mpi_enreg%nproc_spinor ! mpi_enreg%nproc_spinor
1232 : 622 : sizecart(4)=mpi_enreg%nproc_fft ! mpi_enreg%nproc_fft
1233 [ + + ]: 3110 : period(:)=.false.;reorder=.false.
1234 : 622 : call MPI_CART_CREATE(spacecomm,dimcart,sizecart,period,reorder,commcart_4d,ierr)
1235 [ - + ]: 622 : ABI_FREE(period)
1236 : 622 : ABI_FREE(sizecart)
1237 : :
1238 : : ! Find the index and coordinates of the current processor
1239 : 622 : call MPI_COMM_RANK(commcart_4d, me_cart_4d, ierr)
1240 [ - + + - : 1866 : ABI_MALLOC(coords,(dimcart))
+ - + - -
+ - + ]
1241 : 622 : call MPI_CART_COORDS(commcart_4d, me_cart_4d,dimcart,coords,ierr)
1242 : 622 : mpi_enreg%me_kpt =coords(1)
1243 : 622 : mpi_enreg%me_band=coords(2)
1244 : 622 : mpi_enreg%me_spinor=coords(3)
1245 : 622 : mpi_enreg%me_fft =coords(4)
1246 : 622 : ABI_FREE(coords)
1247 : :
1248 [ - + + - : 1866 : ABI_MALLOC(keepdim,(dimcart))
+ - + - -
+ - + ]
1249 : :
1250 : : ! Create the communicator for fft distribution
1251 : 622 : keepdim(1)=.false.
1252 : 622 : keepdim(2)=.false.
1253 : 622 : keepdim(3)=.false.
1254 : 622 : keepdim(4)=.true.
1255 : 622 : call MPI_CART_SUB(commcart_4d, keepdim, mpi_enreg%comm_fft,ierr)
1256 : :
1257 : : ! Create the communicator for band distribution
1258 : 622 : keepdim(1)=.false.
1259 : 622 : keepdim(2)=.true.
1260 : 622 : keepdim(3)=.false.
1261 : 622 : keepdim(4)=.false.
1262 : 622 : call MPI_CART_SUB(commcart_4d, keepdim, mpi_enreg%comm_band,ierr)
1263 : :
1264 : : ! Create the communicator for kpt distribution
1265 : 622 : keepdim(1)=.true.
1266 : 622 : keepdim(2)=.false.
1267 : 622 : keepdim(3)=.false.
1268 : 622 : keepdim(4)=.false.
1269 : 622 : call MPI_CART_SUB(commcart_4d, keepdim, mpi_enreg%comm_kpt,ierr)
1270 : :
1271 : : ! Create the communicator for spinor distribution
1272 : 622 : keepdim(1)=.false.
1273 : 622 : keepdim(2)=.false.
1274 : 622 : keepdim(3)=.true.
1275 : 622 : keepdim(4)=.false.
1276 : 622 : call MPI_CART_SUB(commcart_4d, keepdim, mpi_enreg%comm_spinor,ierr)
1277 : :
1278 : : ! Create the communicator for band-spinor distribution
1279 : 622 : keepdim(1)=.false.
1280 : 622 : keepdim(2)=.true.
1281 : 622 : keepdim(3)=.true.
1282 : 622 : keepdim(4)=.false.
1283 : 622 : call MPI_CART_SUB(commcart_4d, keepdim, mpi_enreg%comm_bandspinor,ierr)
1284 [ - + ]: 622 : if (ierr /= MPI_SUCCESS ) then
1285 : 0 : call xmpi_abort(mpi_enreg%comm_world,ierr)
1286 : : end if
1287 : :
1288 : : ! Create the communicator for kpt-band distribution
1289 : 622 : keepdim(1)=.true.
1290 : 622 : keepdim(2)=.true.
1291 : 622 : keepdim(3)=.false.
1292 : 622 : keepdim(4)=.false.
1293 : 622 : call MPI_CART_SUB(commcart_4d, keepdim, mpi_enreg%comm_kptband,ierr)
1294 : :
1295 : : ! Create the communicator for fft-spinor distribution
1296 : 622 : keepdim(1)=.false.
1297 : 622 : keepdim(2)=.false.
1298 : 622 : keepdim(3)=.true.
1299 : 622 : keepdim(4)=.true.
1300 : 622 : call MPI_CART_SUB(commcart_4d, keepdim, mpi_enreg%comm_spinorfft,ierr)
1301 : :
1302 : : ! Create the communicator for fft-band distribution
1303 : 622 : keepdim(1)=.false.
1304 : 622 : keepdim(2)=.true.
1305 : 622 : keepdim(3)=.false.
1306 : 622 : keepdim(4)=.true.
1307 : 622 : call MPI_CART_SUB(commcart_4d, keepdim, mpi_enreg%comm_bandfft,ierr)
1308 : :
1309 : : ! Create the communicator for fft-band-spinor distribution
1310 : 622 : keepdim(1)=.false.
1311 : 622 : keepdim(2)=.true.
1312 : 622 : keepdim(3)=.true.
1313 : 622 : keepdim(4)=.true.
1314 : 622 : call MPI_CART_SUB(commcart_4d, keepdim, mpi_enreg%comm_bandspinorfft,ierr)
1315 : :
1316 : 622 : ABI_FREE(keepdim)
1317 : 622 : call xmpi_comm_free(commcart_4d)
1318 : : end if
1319 : :
1320 : : !Write some data
1321 : : !write(msg,'(a,4i5)') 'npfft, npband, npspinor and np_spkpt: ',&
1322 : : !mpi_enreg%nproc_fft,mpi_enreg%nproc_band, mpi_enreg%nproc_spinor,mpi_enreg%nproc_spkpt
1323 : : !call wrtout(std_out,msg,'COLL')
1324 : : !write(msg,'(a,4i5)') 'me_fft, me_band, me_spinor , me_kpt: ',&
1325 : : !mpi_enreg%me_fft,mpi_enreg%me_band,mpi_enreg%me_spinor, mpi_enreg%me_kpt
1326 : : !call wrtout(std_out,msg,'COLL')
1327 : :
1328 : : else ! paral_hf==1
1329 : : !* Option Hartree-Fock is active and more than 1 processor is dedicated to the parallelization over occupied states.
1330 : :
1331 : : !* Initialize the values of fft, band and spinor communicators, as in the case paral_kgb==0.
1332 : 0 : mpi_enreg%me_fft =0
1333 : 0 : mpi_enreg%me_band=0
1334 : 0 : mpi_enreg%me_spinor=0
1335 : 0 : mpi_enreg%comm_fft=xmpi_comm_self
1336 : 0 : mpi_enreg%comm_band=xmpi_comm_self
1337 : 0 : mpi_enreg%comm_spinor=xmpi_comm_self
1338 : 0 : mpi_enreg%comm_bandspinor=xmpi_comm_self
1339 : 0 : mpi_enreg%comm_kptband=mpi_enreg%comm_cell
1340 : 0 : mpi_enreg%comm_spinorfft=xmpi_comm_self
1341 : 0 : mpi_enreg%comm_bandfft=xmpi_comm_self
1342 : 0 : mpi_enreg%comm_bandspinorfft=xmpi_comm_self
1343 : :
1344 : : !* Create the global cartesian 2D- communicator
1345 : 0 : dimcart=2
1346 [ # # ]: 0 : ABI_MALLOC(sizecart,(dimcart))
1347 [ # # ]: 0 : ABI_MALLOC(period,(dimcart))
1348 : 0 : sizecart(1)=mpi_enreg%nproc_spkpt ! mpi_enreg%nproc_spkpt
1349 : 0 : sizecart(2)=mpi_enreg%nproc_hf ! mpi_enreg%nproc_hf
1350 [ # # ]: 0 : period(:)=.false.;reorder=.false.
1351 : 0 : call MPI_CART_CREATE(spacecomm,dimcart,sizecart,period,reorder,commcart_2d,ierr)
1352 [ # # ]: 0 : ABI_FREE(period)
1353 : 0 : ABI_FREE(sizecart)
1354 : :
1355 : : !* Find the index and coordinates of the current processor
1356 : 0 : call MPI_COMM_RANK(commcart_2d, me_cart_2d, ierr)
1357 [ # # # # : 0 : ABI_MALLOC(coords,(dimcart))
# # # # #
# # # ]
1358 : 0 : call MPI_CART_COORDS(commcart_2d, me_cart_2d,dimcart,coords,ierr)
1359 : 0 : mpi_enreg%me_kpt =coords(1)
1360 : 0 : mpi_enreg%me_hf=coords(2)
1361 : 0 : ABI_FREE(coords)
1362 : :
1363 [ # # # # : 0 : ABI_MALLOC(keepdim,(dimcart))
# # # # #
# # # ]
1364 : :
1365 : : !* Create the communicator for kpt distribution
1366 : 0 : keepdim(1)=.true.
1367 : 0 : keepdim(2)=.false.
1368 : 0 : call MPI_CART_SUB(commcart_2d, keepdim, mpi_enreg%comm_kpt,ierr)
1369 : :
1370 : : !* Create the communicator for hf distribution
1371 : 0 : keepdim(1)=.false.
1372 : 0 : keepdim(2)=.true.
1373 : 0 : call MPI_CART_SUB(commcart_2d, keepdim, mpi_enreg%comm_hf,ierr)
1374 : :
1375 : 0 : ABI_FREE(keepdim)
1376 : 0 : call xmpi_comm_free(commcart_2d)
1377 : :
1378 : : !* Write some data
1379 : 0 : write(msg,'(a,2(1x,i0))') 'nphf and np_spkpt: ',mpi_enreg%nproc_hf, mpi_enreg%nproc_spkpt
1380 : 0 : call wrtout(std_out,msg)
1381 : 0 : write(msg,'(a,2(1x,i0))') 'me_hf, me_kpt: ',mpi_enreg%me_hf, mpi_enreg%me_kpt
1382 : 0 : call wrtout(std_out,msg)
1383 : : end if
1384 : : #endif
1385 : :
1386 : : DBG_EXIT("COLL")
1387 : :
1388 : : end subroutine initmpi_grid
1389 : : !!***
1390 : :
1391 : : !----------------------------------------------------------------------
1392 : :
1393 : : !!****f* m_mpinfo/clnmpi_grid
1394 : : !! NAME
1395 : : !! clnmpi_grid
1396 : : !!
1397 : : !! FUNCTION
1398 : : !! Cleans-up the mpi information for parallelism over grid (kpt/band/fft).
1399 : : !!
1400 : : !! SIDE EFFECTS
1401 : : !! mpi_enreg=information about MPI parallelization
1402 : : !!
1403 : : !! SOURCE
1404 : :
1405 : 6962 : subroutine clnmpi_grid(mpi_enreg)
1406 : :
1407 : : !Arguments ------------------------------------
1408 : : class(MPI_type), intent(inout) :: mpi_enreg
1409 : : ! ***********************************************************************
1410 : :
1411 : : DBG_ENTER("COLL")
1412 : :
1413 : : if (xmpi_paral==0) return
1414 : :
1415 [ + - ]: 6962 : if (mpi_enreg%comm_bandspinorfft/=mpi_enreg%comm_world) then
1416 : 6962 : call xmpi_comm_free(mpi_enreg%comm_bandspinorfft)
1417 : 6962 : mpi_enreg%comm_bandspinorfft=xmpi_comm_null
1418 : : end if
1419 : :
1420 [ + - ]: 6962 : if (mpi_enreg%comm_bandfft/=mpi_enreg%comm_world) then
1421 : 6962 : call xmpi_comm_free(mpi_enreg%comm_bandfft)
1422 : 6962 : mpi_enreg%comm_bandfft=xmpi_comm_null
1423 : : end if
1424 : :
1425 [ + - ]: 6962 : if (mpi_enreg%comm_spinorfft/=mpi_enreg%comm_world) then
1426 : 6962 : call xmpi_comm_free(mpi_enreg%comm_spinorfft)
1427 : 6962 : mpi_enreg%comm_spinorfft=xmpi_comm_null
1428 : : end if
1429 : :
1430 [ + - ]: 6962 : if (mpi_enreg%comm_bandspinor/=mpi_enreg%comm_world) then
1431 : 6962 : call xmpi_comm_free(mpi_enreg%comm_bandspinor)
1432 : 6962 : mpi_enreg%comm_bandspinor=xmpi_comm_null
1433 : : end if
1434 : :
1435 [ + + ]: 6962 : if (mpi_enreg%comm_kptband/=mpi_enreg%comm_world) then
1436 : 6350 : call xmpi_comm_free(mpi_enreg%comm_kptband)
1437 : 6350 : mpi_enreg%comm_kptband=xmpi_comm_null
1438 : : end if
1439 : :
1440 [ + - ]: 6962 : if (mpi_enreg%comm_fft/=mpi_enreg%comm_world) then
1441 : 6962 : call xmpi_comm_free(mpi_enreg%comm_fft)
1442 : 6962 : mpi_enreg%comm_fft=xmpi_comm_null
1443 : : end if
1444 : :
1445 [ + - ]: 6962 : if (mpi_enreg%comm_band/=mpi_enreg%comm_world) then
1446 : 6962 : call xmpi_comm_free(mpi_enreg%comm_band)
1447 : 6962 : mpi_enreg%comm_band=xmpi_comm_null
1448 : : end if
1449 : :
1450 [ + - ]: 6962 : if (mpi_enreg%comm_spinor/=mpi_enreg%comm_world) then
1451 : 6962 : call xmpi_comm_free(mpi_enreg%comm_spinor)
1452 : 6962 : mpi_enreg%comm_spinor=xmpi_comm_null
1453 : : end if
1454 : :
1455 [ + + ]: 6962 : if (mpi_enreg%comm_kpt/=mpi_enreg%comm_world) then
1456 : 6350 : call xmpi_comm_free(mpi_enreg%comm_kpt)
1457 : 6350 : mpi_enreg%comm_kpt=xmpi_comm_null
1458 : : end if
1459 : :
1460 : : DBG_EXIT("COLL")
1461 : :
1462 : 6962 : end subroutine clnmpi_grid
1463 : : !!***
1464 : :
1465 : : !!****f* ABINIT/initmpi_img
1466 : : !! NAME
1467 : : !! initmpi_img
1468 : : !!
1469 : : !! FUNCTION
1470 : : !! Initializes the mpi information for parallelism over images of the cell (npimage>1).
1471 : : !!
1472 : : !! INPUTS
1473 : : !! dtset <type(dataset_type)>=all input variables in this dataset
1474 : : !! mpi_enreg= information about MPI parallelization
1475 : : !! option= see below
1476 : : !!
1477 : : !! OUTPUT
1478 : : !! mpi_enreg%my_nimage= number of images of the cell treated by current proc
1479 : : !! ===== if option==1 or option==-1
1480 : : !! mpi_enreg%my_imgtab= indexes of images of the cell treated by current proc
1481 : : !! ===== if option==2 or option==3 or option==-1
1482 : : !! mpi_enreg%comm_cell=Communicator over all processors treating the same image
1483 : : !! mpi_enreg%nproc_cell=size of comm_cell
1484 : : !! mpi_enreg%me_cell=my rank in comm_cell
1485 : : !! ===== if option==3 or option==-1
1486 : : !! mpi_enreg%comm_img=Communicator over all images
1487 : : !! mpi_enreg%nproc_img=size of comm_img
1488 : : !! mpi_enreg%me_img=my rank in comm_img
1489 : : !! mpi_enreg%distrb_img(:)=index of processor treating each image (in comm_img communicator)
1490 : : !!
1491 : : !! SOURCE
1492 : :
1493 : 8399 : subroutine initmpi_img(dtset,mpi_enreg,option)
1494 : :
1495 : : !Arguments ------------------------------------
1496 : : integer,intent(in) :: option
1497 : : type(dataset_type),intent(in) :: dtset
1498 : : class(MPI_type),intent(inout) :: mpi_enreg
1499 : :
1500 : : !Local variables-------------------------------
1501 : : integer :: imod,irank,iprocmax,iprocmin,jrank
1502 : : integer :: ndynimage_eff,nimage_eff,nproc_per_image,nrank
1503 : : logical,parameter :: debug=.false.
1504 : 8399 : integer,allocatable :: ranks(:)
1505 : : character(len=500) :: msg
1506 : :
1507 : : !integer :: group_cell,ierr
1508 : : ! ***********************************************************************
1509 : :
1510 : : DBG_ENTER("COLL")
1511 [ + - ]: 8399 : if (option/=0) then
1512 : 8399 : mpi_enreg%comm_img=xmpi_comm_self
1513 : 8399 : mpi_enreg%comm_cell=mpi_enreg%comm_world
1514 : : end if
1515 : :
1516 [ - + - - : 8399 : if (xmpi_paral==1.and.dtset%npimage>1.and.dtset%npimage<=mpi_enreg%nproc.and. dtset%optdriver==RUNL_GSTATE) then
- - ]
1517 : :
1518 : : ! Activate flag for parallelization over images
1519 : 0 : mpi_enreg%paral_img=1
1520 : :
1521 [ # # ]: 0 : ndynimage_eff=dtset%ndynimage;if (dtset%ntimimage<=1) ndynimage_eff=0
1522 : :
1523 : : ! Print several warnings
1524 [ # # ]: 0 : if (option==0) then
1525 : 0 : nimage_eff=max(ndynimage_eff,dtset%nimage-ndynimage_eff)
1526 [ # # ]: 0 : if (dtset%npimage>nimage_eff) then
1527 : : write(unit=msg,fmt='(3a,i4,a,i4,4a)') &
1528 : 0 : 'The number of processors used for the parallelization',ch10,&
1529 : 0 : ' over images (npimage=',dtset%npimage,&
1530 : 0 : ') is greater than the number of dynamic (or static) images (',nimage_eff,') !',ch10,&
1531 : 0 : ' This is inefficient.',ch10
1532 : 0 : ABI_WARNING(msg)
1533 : : end if
1534 [ # # ]: 0 : if (dtset%npimage>mpi_enreg%nproc) then
1535 : : write(unit=msg,fmt='(3a,i6,a,i4,4a)') &
1536 : 0 : 'The number of processors used for the parallelization',ch10,&
1537 : 0 : ' over images (nproc=',mpi_enreg%nproc,&
1538 : 0 : ') is smaller than npimage in input file (',dtset%npimage,&
1539 : 0 : ')!',ch10,' This is inconsistent.',ch10
1540 : 0 : ABI_ERROR(msg)
1541 : : end if
1542 [ # # ]: 0 : if (mod(nimage_eff,dtset%npimage)/=0) then
1543 : : write(unit=msg,fmt='(3a,i4,a,i4,4a)') &
1544 : 0 : 'The number of processors used for the parallelization',ch10,&
1545 : 0 : ' over images (npimage=',dtset%npimage,&
1546 : 0 : ') does not divide the number of dynamic images (',nimage_eff,&
1547 : 0 : ') !',ch10,' This is inefficient (charge unbalancing).',ch10
1548 : 0 : ABI_WARNING(msg)
1549 : : end if
1550 : : end if
1551 : :
1552 : : ! # of images treated by current proc
1553 : 0 : nproc_per_image=mpi_enreg%nproc/dtset%npimage
1554 : 0 : iprocmax=nproc_per_image*dtset%npimage-1
1555 [ # # ]: 0 : if (mpi_enreg%me<=iprocmax) then
1556 : 0 : mpi_enreg%my_nimage=(ndynimage_eff/dtset%npimage)+((dtset%nimage-ndynimage_eff)/dtset%npimage)
1557 : 0 : imod=mod(ndynimage_eff,dtset%npimage)-1
1558 [ # # ]: 0 : if (mpi_enreg%me/nproc_per_image<=imod) mpi_enreg%my_nimage=mpi_enreg%my_nimage+1
1559 : 0 : imod=mod((dtset%nimage-ndynimage_eff),dtset%npimage)-1
1560 [ # # ]: 0 : if (mpi_enreg%me/nproc_per_image<=imod) mpi_enreg%my_nimage=mpi_enreg%my_nimage+1
1561 : : else
1562 : 0 : mpi_enreg%my_nimage=0
1563 : : end if
1564 [ # # ]: 0 : if (option==1.or.option==-1) then
1565 : : ! Indexes of images treated by current proc
1566 [ # # ]: 0 : if (mpi_enreg%me<=iprocmax) then
1567 [ # # # # : 0 : ABI_MALLOC(mpi_enreg%my_imgtab,(mpi_enreg%my_nimage))
# # # # #
# # # #
# ]
1568 : 0 : nrank=0
1569 : 0 : imod=mpi_enreg%me/nproc_per_image+1;imod=mod(imod,dtset%npimage)
1570 : : ! Dynamic images
1571 : 0 : irank=0
1572 [ # # ]: 0 : do jrank=1,dtset%nimage
1573 [ # # # # ]: 0 : if (dtset%dynimage(jrank)/=0.and.dtset%ntimimage>1) then
1574 : 0 : irank=irank+1
1575 [ # # ]: 0 : if (mod(irank,dtset%npimage)==imod) then
1576 : 0 : nrank=nrank+1
1577 : 0 : mpi_enreg%my_imgtab(nrank)=jrank
1578 : : end if
1579 : : end if
1580 : : end do
1581 : : ! Static images
1582 : : irank=0
1583 [ # # ]: 0 : do jrank=1,dtset%nimage
1584 [ # # # # ]: 0 : if (dtset%dynimage(jrank)==0.or.dtset%ntimimage<=1) then
1585 : 0 : irank=irank+1
1586 [ # # ]: 0 : if (mod(irank,dtset%npimage)==imod) then
1587 : 0 : nrank=nrank+1
1588 : 0 : mpi_enreg%my_imgtab(nrank)=jrank
1589 : : end if
1590 : : end if
1591 : : end do
1592 [ # # ]: 0 : if (nrank/=mpi_enreg%my_nimage) then
1593 : 0 : ABI_BUG('Error on nrank !')
1594 : : end if
1595 : : ! Sort images by increasing index (this step is MANDATORY !!)
1596 [ # # ]: 0 : if (nrank>0) then
1597 [ # # # # : 0 : ABI_MALLOC(ranks,(nrank))
# # # # #
# ]
1598 : 0 : call sort_int(nrank,mpi_enreg%my_imgtab,ranks)
1599 [ # # ]: 0 : ABI_FREE(ranks)
1600 : : end if
1601 : : else
1602 [ # # # # ]: 0 : ABI_MALLOC(mpi_enreg%my_imgtab,(0))
1603 : : end if
1604 : : end if
1605 [ # # ]: 0 : if (option==2.or.option==3.or.option==-1) then
1606 : : ! Communicator over one image
1607 [ # # ]: 0 : if (mpi_enreg%me<=iprocmax) then
1608 [ # # # # : 0 : ABI_MALLOC(ranks,(nproc_per_image))
# # # # #
# # # ]
1609 : 0 : iprocmin=(mpi_enreg%me/nproc_per_image)*nproc_per_image
1610 [ # # # # : 0 : ranks=(/((iprocmin+irank-1),irank=1,nproc_per_image)/)
# # # # #
# # # # #
# # ]
1611 : 0 : mpi_enreg%comm_cell=xmpi_subcomm(mpi_enreg%comm_world,nproc_per_image,ranks)
1612 [ # # ]: 0 : ABI_FREE(ranks)
1613 : 0 : mpi_enreg%me_cell=xmpi_comm_rank(mpi_enreg%comm_cell)
1614 : 0 : mpi_enreg%nproc_cell=nproc_per_image
1615 [ # # # # ]: 0 : if (mpi_enreg%me_cell==0.and.mod(mpi_enreg%me,nproc_per_image)/=0) then
1616 : 0 : ABI_BUG('Error on me_cell !')
1617 : : end if
1618 : : else
1619 : 0 : mpi_enreg%comm_img=xmpi_comm_null
1620 : 0 : mpi_enreg%nproc_cell=0
1621 : 0 : mpi_enreg%me_cell=-1
1622 : : end if
1623 : : end if
1624 [ # # ]: 0 : if (option==3.or.option==-1) then
1625 : : ! Communicator over all images
1626 [ # # ]: 0 : if (mpi_enreg%me<=iprocmax) then
1627 [ # # # # : 0 : ABI_MALLOC(ranks,(dtset%npimage))
# # # # #
# ]
1628 : 0 : iprocmin=mod(mpi_enreg%me,nproc_per_image)
1629 [ # # # # : 0 : ranks=(/((iprocmin+(irank-1)*nproc_per_image),irank=1,dtset%npimage)/)
# # # # #
# # # # #
# # ]
1630 : 0 : mpi_enreg%comm_img=xmpi_subcomm(mpi_enreg%comm_world,dtset%npimage,ranks)
1631 [ # # ]: 0 : ABI_FREE(ranks)
1632 : 0 : mpi_enreg%me_img=xmpi_comm_rank(mpi_enreg%comm_img)
1633 : 0 : mpi_enreg%nproc_img=dtset%npimage
1634 [ # # # # : 0 : if (iprocmin==0.and.mpi_enreg%me_img==0.and.mpi_enreg%me/=0) then
# # ]
1635 : 0 : ABI_BUG('Error on me_img!')
1636 : : end if
1637 [ # # # # : 0 : ABI_MALLOC(mpi_enreg%distrb_img,(dtset%nimage))
# # # # #
# # # #
# ]
1638 : : ! Dynamic images
1639 : 0 : nrank=0
1640 [ # # ]: 0 : do irank=1,dtset%nimage
1641 [ # # # # ]: 0 : if (dtset%dynimage(irank)/=0.and.dtset%ntimimage>1) then
1642 : 0 : nrank=nrank+1
1643 : 0 : mpi_enreg%distrb_img(irank)=mod(nrank,dtset%npimage)-1
1644 [ # # ]: 0 : if (mpi_enreg%distrb_img(irank)==-1) mpi_enreg%distrb_img(irank)=dtset%npimage-1
1645 : : end if
1646 : : end do
1647 : : ! Static images
1648 : 0 : nrank=0
1649 [ # # ]: 0 : do irank=1,dtset%nimage
1650 [ # # # # ]: 0 : if (dtset%dynimage(irank)==0.or.dtset%ntimimage<=1) then
1651 : 0 : nrank=nrank+1
1652 : 0 : mpi_enreg%distrb_img(irank)=mod(nrank,dtset%npimage)-1
1653 [ # # ]: 0 : if (mpi_enreg%distrb_img(irank)==-1) mpi_enreg%distrb_img(irank)=dtset%npimage-1
1654 : : end if
1655 : : end do
1656 : : else
1657 : 0 : mpi_enreg%comm_img=xmpi_comm_null
1658 : 0 : mpi_enreg%nproc_img=0
1659 : 0 : mpi_enreg%me_img=-1
1660 [ # # # # ]: 0 : ABI_MALLOC(mpi_enreg%distrb_img,(0))
1661 : : end if
1662 : : end if
1663 : :
1664 : : ! if (debug) then
1665 : : ! write(200+mpi_enreg%me,*) "=================================="
1666 : : ! write(200+mpi_enreg%me,*) "DEBUGGING STATEMENTS IN INITMPI_IMG"
1667 : : ! write(200+mpi_enreg%me,*) "=================================="
1668 : : ! write(200+mpi_enreg%me,*) "option =",option
1669 : : ! write(200+mpi_enreg%me,*) "MPI_UNDEFINED =",MPI_UNDEFINED
1670 : : ! write(200+mpi_enreg%me,*) "MPI_IDENT =",MPI_IDENT
1671 : : ! write(200+mpi_enreg%me,*) "MPI_CONGRUENT =",MPI_CONGRUENT
1672 : : ! write(200+mpi_enreg%me,*) "MPI_SIMILAR =",MPI_SIMILAR
1673 : : ! write(200+mpi_enreg%me,*) "MPI_UNEQUAL =",MPI_UNEQUAL
1674 : : ! write(200+mpi_enreg%me,*) "null_comm =",MPI_COMM_NULL
1675 : : ! write(200+mpi_enreg%me,*) "self_comm =",xmpi_comm_self
1676 : : ! write(200+mpi_enreg%me,*) "world_comm =",mpi_enreg%comm_world
1677 : : ! write(200+mpi_enreg%me,*) "empty_group =",MPI_GROUP_EMPTY
1678 : : ! write(200+mpi_enreg%me,*) "nimage =",mpi_enreg%my_nimage
1679 : : ! write(200+mpi_enreg%me,*) "nproc_per_image=",nproc_per_image
1680 : : ! call MPI_COMM_SIZE(mpi_enreg%comm_world,irank,ierr)
1681 : : ! write(200+mpi_enreg%me,*) "Size of world_comm =",irank
1682 : : ! call MPI_COMM_RANK(mpi_enreg%comm_world,irank,ierr)
1683 : : ! write(200+mpi_enreg%me,*) "My rank in world_comm =",irank
1684 : : ! if (option==1.or.option==-1) then
1685 : : ! write(200+mpi_enreg%me,*) "index_img=",mpi_enreg%my_imgtab(:)
1686 : : ! end if
1687 : : ! if (option==2.or.option==3.or.option==-1) then
1688 : : ! write(200+mpi_enreg%me,*) "nproc_cell =",mpi_enreg%nproc_cell
1689 : : ! write(200+mpi_enreg%me,*) "me_cell =",mpi_enreg%me_cell
1690 : : ! call xmpi_comm_group(mpi_enreg%comm_cell,group_cell,ierr)
1691 : : ! write(200+mpi_enreg%me,*) "group_cell =",group_cell
1692 : : ! write(200+mpi_enreg%me,*) "comm_cell =",mpi_enreg%comm_cell
1693 : : ! if (group_cell/=MPI_GROUP_EMPTY) then
1694 : : ! call MPI_GROUP_SIZE(group_cell,irank,ierr)
1695 : : ! write(200+mpi_enreg%me,*) "Size of group_cell =",irank
1696 : : ! call MPI_GROUP_RANK(group_cell,irank,ierr)
1697 : : ! write(200+mpi_enreg%me,*) "My rank in group_cell=",irank
1698 : : ! else
1699 : : ! write(200+mpi_enreg%me,*) "Size of group_cell =",0
1700 : : ! write(200+mpi_enreg%me,*) "My rank in group_cell=",-1
1701 : : ! end if
1702 : : ! if (mpi_enreg%comm_cell/=MPI_COMM_NULL) then
1703 : : ! call MPI_COMM_SIZE(mpi_enreg%comm_cell,irank,ierr)
1704 : : ! write(200+mpi_enreg%me,*) "Size of comm_cell =",irank
1705 : : ! call MPI_COMM_RANK(mpi_enreg%comm_cell,irank,ierr)
1706 : : ! write(200+mpi_enreg%me,*) "My rank in comm_cell=",irank
1707 : : ! call MPI_COMM_COMPARE(mpi_enreg%comm_world,mpi_enreg%comm_cell,irank,ierr)
1708 : : ! write(200+mpi_enreg%me,*) "Comparison world_comm/comm_cell=",irank
1709 : : ! call MPI_COMM_COMPARE(xmpi_comm_self,mpi_enreg%comm_cell,irank,ierr)
1710 : : ! write(200+mpi_enreg%me,*) "Comparison self_comm/comm_cell =",irank
1711 : : ! else
1712 : : ! write(200+mpi_enreg%me,*) "Size of comm_cell =",0
1713 : : ! write(200+mpi_enreg%me,*) "My rank in comm_cell=",-1
1714 : : ! write(200+mpi_enreg%me,*) "Comparison world_comm/comm_cell=",MPI_UNEQUAL
1715 : : ! write(200+mpi_enreg%me,*) "Comparison self_comm/comm_cell =",MPI_UNEQUAL
1716 : : ! end if
1717 : : ! end if
1718 : : ! if (option==3.or.option==-1) then
1719 : : ! write(200+mpi_enreg%me,*) "nproc_img =",mpi_enreg%nproc_img
1720 : : ! write(200+mpi_enreg%me,*) "me_img =",mpi_enreg%me_img
1721 : : ! write(200+mpi_enreg%me,*) "img_comm =",mpi_enreg%comm_img
1722 : : ! if (mpi_enreg%comm_img/=MPI_COMM_NULL) then
1723 : : ! call MPI_COMM_SIZE(mpi_enreg%comm_img,irank,ierr)
1724 : : ! write(200+mpi_enreg%me,*) "Size of img_comm =",irank
1725 : : ! call MPI_COMM_RANK(mpi_enreg%comm_img,irank,ierr)
1726 : : ! write(200+mpi_enreg%me,*) "My rank in img_comm=",irank
1727 : : ! call MPI_COMM_COMPARE(mpi_enreg%comm_world,mpi_enreg%comm_img,irank,ierr)
1728 : : ! write(200+mpi_enreg%me,*) "Comparison world_comm/img_comm=",irank
1729 : : ! call MPI_COMM_COMPARE(xmpi_comm_self,mpi_enreg%comm_img,irank,ierr)
1730 : : ! write(200+mpi_enreg%me,*) "Comparison self_comm/img_comm =",irank
1731 : : ! else
1732 : : ! write(200+mpi_enreg%me,*) "Size of img_comm =",0
1733 : : ! write(200+mpi_enreg%me,*) "My rank in img_comm=",-1
1734 : : ! write(200+mpi_enreg%me,*) "Comparison world_comm/img_comm=",MPI_UNEQUAL
1735 : : ! write(200+mpi_enreg%me,*) "Comparison self_comm/img_comm =",MPI_UNEQUAL
1736 : : ! end if
1737 : : ! write(200+mpi_enreg%me,*) "distrb_img=",mpi_enreg%distrb_img(:)
1738 : : ! end if
1739 : : ! write(200+mpi_enreg%me,*)
1740 : : ! call flush_unit(200+mpi_enreg%me)
1741 : : ! if (option==-1) stop
1742 : : ! end if
1743 : :
1744 : : else
1745 : :
1746 : : ! Do not activate flag for parallelization over images
1747 : 8399 : mpi_enreg%paral_img=0
1748 : : ! # of images treated by current proc
1749 [ + + ]: 8399 : if (dtset%optdriver==RUNL_GSTATE) then
1750 : 7077 : mpi_enreg%my_nimage=dtset%nimage
1751 : : else
1752 : 1322 : mpi_enreg%my_nimage=1
1753 : : end if
1754 : : ! Indexes of images treated by current proc
1755 [ + - ]: 8399 : if (option==1.or.option==-1) then
1756 [ - + + - : 25197 : ABI_MALLOC(mpi_enreg%my_imgtab,(mpi_enreg%my_nimage))
+ - + - -
+ - + -
+ ]
1757 [ + - + + : 51174 : mpi_enreg%my_imgtab=(/(irank,irank=1,mpi_enreg%my_nimage)/)
+ - + + +
- - + - -
+ + ]
1758 : : end if
1759 : : ! Communicator over all images
1760 [ + - ]: 8399 : if (option==2.or.option==3.or.option==-1) then
1761 : : ! Communicator for one image
1762 : 8399 : mpi_enreg%nproc_cell=mpi_enreg%nproc
1763 : 8399 : mpi_enreg%me_cell=mpi_enreg%me
1764 : : end if
1765 [ + - ]: 8399 : if (option==3.or.option==-1) then
1766 : : ! Communicator over all images
1767 : 8399 : mpi_enreg%nproc_img=1
1768 : 8399 : mpi_enreg%comm_img=xmpi_comm_self
1769 : 8399 : mpi_enreg%me_img=0
1770 [ - + + - : 25197 : ABI_MALLOC(mpi_enreg%distrb_img,(dtset%nimage))
+ - + - -
+ - + -
+ ]
1771 [ + + ]: 17058 : mpi_enreg%distrb_img(:)=0
1772 : : end if
1773 : : end if
1774 : :
1775 : : DBG_EXIT("COLL")
1776 : :
1777 : 8399 : end subroutine initmpi_img
1778 : : !!***
1779 : :
1780 : : !----------------------------------------------------------------------
1781 : :
1782 : : !!****f* m_mpinfo/clnmpi_img
1783 : : !! NAME
1784 : : !! clnmpi_img
1785 : : !!
1786 : : !! FUNCTION
1787 : : !! Cleans-up the mpi information for parallelism over images of the cell (npimage>1).
1788 : : !!
1789 : : !! SOURCE
1790 : :
1791 : 8392 : subroutine clnmpi_img(mpi_enreg)
1792 : :
1793 : : !Arguments ------------------------------------
1794 : : class(MPI_type), intent(inout) :: mpi_enreg
1795 : : ! ***********************************************************************
1796 : :
1797 : : DBG_ENTER("COLL")
1798 : :
1799 : : if (xmpi_paral==0) return
1800 : :
1801 [ - + ]: 8392 : if (mpi_enreg%comm_cell/=mpi_enreg%comm_world) then
1802 : 0 : call xmpi_comm_free(mpi_enreg%comm_cell)
1803 : 0 : mpi_enreg%comm_cell=xmpi_comm_null
1804 : : end if
1805 : :
1806 [ + - ]: 8392 : if (mpi_enreg%comm_img/=mpi_enreg%comm_world) then
1807 : 8392 : call xmpi_comm_free(mpi_enreg%comm_img)
1808 : 8392 : mpi_enreg%comm_img=xmpi_comm_null
1809 : : end if
1810 : :
1811 [ + - ]: 8392 : ABI_SFREE(mpi_enreg%my_imgtab)
1812 [ + - ]: 8392 : ABI_SFREE(mpi_enreg%distrb_img)
1813 : :
1814 : 8392 : mpi_enreg%paral_img=0
1815 : 8392 : mpi_enreg%my_nimage=1
1816 : 8392 : mpi_enreg%me_img=0
1817 : 8392 : mpi_enreg%me_cell=0
1818 : 8392 : mpi_enreg%nproc_img=1
1819 : 8392 : mpi_enreg%nproc_cell=1
1820 : :
1821 : : DBG_EXIT("COLL")
1822 : :
1823 : 8392 : end subroutine clnmpi_img
1824 : : !!***
1825 : :
1826 : : !!****f* ABINIT/initmpi_pert
1827 : : !! NAME
1828 : : !! initmpi_pert
1829 : : !!
1830 : : !! FUNCTION
1831 : : !! Creates group for Parallelization over Perturbations.
1832 : : !!
1833 : : !! INPUTS
1834 : : !! dtset <type(dataset_type)>=all input variables in this dataset
1835 : : !!
1836 : : !! OUTPUT
1837 : : !!
1838 : : !! SIDE EFFECTS
1839 : : !! mpi_enreg=information about MPI parallelization
1840 : : !!
1841 : : !! SOURCE
1842 : :
1843 : 26 : subroutine initmpi_pert(dtset,mpi_enreg)
1844 : :
1845 : : !Arguments ------------------------------------
1846 : : !scalars
1847 : : class(MPI_type),intent(inout) :: mpi_enreg
1848 : : type(dataset_type),intent(in) :: dtset
1849 : :
1850 : : !Local variables-------------------------------
1851 : : !scalars
1852 : : integer:: iprocmin,irank,npert,nproc_per_cell,nrank,numproc
1853 : 26 : integer,allocatable :: ranks(:)
1854 : : !character(len=500) :: msg
1855 : : !arrays
1856 : 26 : integer,pointer :: nkpt_rbz(:)
1857 : 26 : real(dp),pointer :: nband_rbz(:,:)
1858 : : ! ***********************************************************************
1859 : :
1860 : 26 : if (mpi_enreg%me_pert<0) then
1861 : 0 : ABI_ERROR('Error in MPI distribution! Change your proc(s) distribution or use autoparal>0.')
1862 : : end if
1863 : :
1864 : 26 : call dtset%get_npert_rbz(nband_rbz, nkpt_rbz, npert)
1865 : :
1866 [ + - ]: 26 : if (dtset%nppert>=1) then
1867 [ - + ]: 26 : if (mpi_enreg%comm_cell/=mpi_enreg%comm_world) then
1868 : 0 : call xmpi_comm_free(mpi_enreg%comm_cell)
1869 : : end if
1870 : 26 : mpi_enreg%comm_cell=mpi_enreg%comm_world
1871 : :
1872 : : ! These values will be properly set in set_pert_comm
1873 : 26 : mpi_enreg%me_cell=mpi_enreg%me
1874 : 26 : mpi_enreg%nproc_cell=mpi_enreg%nproc
1875 : :
1876 [ + - ]: 26 : if (mpi_enreg%me>=0) then
1877 : 26 : nproc_per_cell=mpi_enreg%nproc/dtset%nppert
1878 [ - + + - : 78 : ABI_MALLOC(ranks,(dtset%nppert))
+ - - + -
+ ]
1879 : 26 : iprocmin=mod(mpi_enreg%me,nproc_per_cell)
1880 [ + - + + : 222 : ranks=(/((iprocmin+(irank-1)*nproc_per_cell),irank=1,dtset%nppert)/)
+ - + + +
- - + - -
+ + ]
1881 : 26 : mpi_enreg%comm_pert=xmpi_subcomm(mpi_enreg%comm_world,dtset%nppert,ranks)
1882 [ - + ]: 26 : ABI_FREE(ranks)
1883 : 26 : mpi_enreg%me_pert=xmpi_comm_rank(mpi_enreg%comm_pert)
1884 : 26 : mpi_enreg%nproc_pert=dtset%nppert
1885 [ + + + + : 26 : if (iprocmin==0.and.mpi_enreg%me_pert==0.and.mpi_enreg%me/=0) then
- + ]
1886 : 0 : ABI_BUG('Error on me_pert!')
1887 : : end if
1888 : : ! Define mpi_enreg%distrb_pert
1889 [ - + + - : 78 : ABI_MALLOC(mpi_enreg%distrb_pert,(npert))
+ - + - -
+ - + -
+ ]
1890 : 26 : nrank=0
1891 [ + + ]: 100 : do irank=1,npert
1892 : 74 : nrank=nrank+1
1893 : 74 : mpi_enreg%distrb_pert(irank)=mod(nrank,dtset%nppert)-1
1894 [ + + ]: 100 : if (mpi_enreg%distrb_pert(irank)==-1) mpi_enreg%distrb_pert(irank)=dtset%nppert-1
1895 : : end do
1896 : : ! Make sure that subrank 0 is working on the last perturbation
1897 : : ! Swap the ranks if necessary
1898 : 26 : numproc=mpi_enreg%distrb_pert(npert)
1899 [ + + ]: 26 : if(numproc/=0) then
1900 [ + + ]: 52 : do irank=1,npert
1901 [ + + ]: 40 : if (mpi_enreg%distrb_pert(irank)==numproc) mpi_enreg%distrb_pert(irank)=-2
1902 [ + + ]: 52 : if (mpi_enreg%distrb_pert(irank)==0) mpi_enreg%distrb_pert(irank)=-3
1903 : : end do
1904 [ + + ]: 52 : do irank=1,npert
1905 [ + + ]: 40 : if (mpi_enreg%distrb_pert(irank)==-2) mpi_enreg%distrb_pert(irank)=0
1906 [ + + ]: 52 : if (mpi_enreg%distrb_pert(irank)==-3) mpi_enreg%distrb_pert(irank)=numproc
1907 : : end do
1908 : : end if
1909 : : ! Communicator over one cell
1910 [ - + + - : 78 : ABI_MALLOC(ranks,(nproc_per_cell))
+ - + - -
+ - + ]
1911 : 26 : iprocmin=(mpi_enreg%me/nproc_per_cell)*nproc_per_cell
1912 [ + - + + : 252 : ranks=(/((iprocmin+irank-1),irank=1,nproc_per_cell)/)
+ - + + +
- - + - -
+ + ]
1913 : 26 : mpi_enreg%comm_cell_pert=xmpi_subcomm(mpi_enreg%comm_world,nproc_per_cell,ranks)
1914 [ - + ]: 26 : ABI_FREE(ranks)
1915 : : end if
1916 : :
1917 : : else !nppert<=1
1918 : 0 : mpi_enreg%nproc_pert=1
1919 : 0 : mpi_enreg%comm_pert=xmpi_comm_self
1920 : 0 : mpi_enreg%me_pert=0
1921 [ # # # # : 0 : ABI_MALLOC(mpi_enreg%distrb_pert,(npert))
# # # # #
# # # #
# ]
1922 [ # # ]: 0 : mpi_enreg%distrb_pert(:)=0
1923 : : end if
1924 : :
1925 [ - + ]: 26 : ABI_FREE(nband_rbz)
1926 [ - + ]: 26 : ABI_FREE(nkpt_rbz)
1927 : :
1928 [ - + ]: 26 : end subroutine initmpi_pert
1929 : : !!***
1930 : :
1931 : : !----------------------------------------------------------------------
1932 : :
1933 : : !!****f* m_mpinfo/clnmpi_pert
1934 : : !! NAME
1935 : : !! clnmpi_pert
1936 : : !!
1937 : : !! FUNCTION
1938 : : !! Cleans-up the mpi information for parallelization over perturbations.
1939 : : !!
1940 : : !! SOURCE
1941 : :
1942 : 6962 : subroutine clnmpi_pert(mpi_enreg)
1943 : :
1944 : : !Arguments ------------------------------------
1945 : : class(MPI_type),intent(inout) :: mpi_enreg
1946 : : ! ***********************************************************************
1947 : :
1948 : : DBG_ENTER("COLL")
1949 : :
1950 : : if (xmpi_paral==0) return
1951 : :
1952 [ + + ]: 6962 : if(mpi_enreg%paral_pert == 1) then
1953 : :
1954 : : ! Reset communicators
1955 [ + - ]: 26 : if (mpi_enreg%comm_pert/=mpi_enreg%comm_world) then
1956 : 26 : call xmpi_comm_free(mpi_enreg%comm_pert)
1957 : 26 : mpi_enreg%comm_pert=xmpi_comm_null
1958 : : end if
1959 : :
1960 [ + - ]: 26 : ABI_SFREE(mpi_enreg%distrb_pert)
1961 : :
1962 : 26 : mpi_enreg%me_pert=0
1963 : 26 : mpi_enreg%me_cell=0
1964 : 26 : mpi_enreg%nproc_pert=1
1965 : 26 : mpi_enreg%nproc_cell=1
1966 : : end if
1967 : :
1968 : : DBG_EXIT("COLL")
1969 : :
1970 : 6962 : end subroutine clnmpi_pert
1971 : : !!***
1972 : :
1973 : : !!****f* ABINIT/initmpi_band
1974 : : !! NAME
1975 : : !! initmpi_band
1976 : : !!
1977 : : !! FUNCTION
1978 : : !! Initializes the mpi information for band parallelism (paralbd=1).
1979 : : !!
1980 : : !! INPUTS
1981 : : !! mpi_enreg= information about MPI parallelization
1982 : : !! nband(nkpt*nsppol)= number of bands per k point, for each spin
1983 : : !! nkpt= number of k-points
1984 : : !! nsppol= 1 for unpolarized, 2 for polarized
1985 : : !!
1986 : : !! OUTPUT
1987 : : !! mpi_enreg=information about MPI parallelization
1988 : : !! mpi_enreg%comm_band=communicator of BAND set
1989 : : !!
1990 : : !! SOURCE
1991 : :
1992 : 2359 : subroutine initmpi_band(mkmem,mpi_enreg,nband,nkpt,nsppol)
1993 : :
1994 : : !Arguments ------------------------------------
1995 : : !scalars
1996 : : integer,intent(in) :: mkmem
1997 : : integer,intent(in) :: nkpt,nsppol
1998 : : integer,intent(in) :: nband(nkpt*nsppol)
1999 : : class(MPI_type),intent(inout) :: mpi_enreg
2000 : :
2001 : : !Local variables-------------------------------
2002 : : !scalars
2003 : : integer :: ii,ikpt,iproc_min,iproc_max,irank,isppol
2004 : : integer :: me,nband_k,nproc,nb_per_proc,nrank,nstates,spacecomm
2005 : : integer :: maxproc_bandpool, mband
2006 : : character(len=500) :: msg
2007 : : !arrays
2008 : 2359 : integer,allocatable :: ranks(:)
2009 : : ! ***********************************************************************
2010 : :
2011 : : ! reinstate default just to be sure - can be switched inside a previous part of the same dtset!
2012 : 2359 : mpi_enreg%comm_band=xmpi_comm_self
2013 : 2359 : mpi_enreg%nproc_band=1
2014 : :
2015 [ + + ]: 151826 : mband = maxval(nband)
2016 : :
2017 : : ABI_UNUSED(mkmem)
2018 : :
2019 : : ! Comm_kpt is supposed to treat spins, k-points and bands
2020 : : !MJV: I think we need to make a proper subcomm here, not treat bands inside the same comm...
2021 : 2359 : spacecomm=mpi_enreg%comm_kpt
2022 : 2359 : nproc=mpi_enreg%nproc_spkpt
2023 : :
2024 : : ! make sure we have saturated kpt parallelization
2025 [ + + + + ]: 2359 : if (mpi_enreg%paralbd==1 .and. xmpi_paral==1 .and. nproc >= 2*nkpt*nsppol) then
2026 : :
2027 : : ! number of procs per kpt/spin, on which we can distribute bands
2028 [ - + ]: 36 : maxproc_bandpool=floor(nproc*one/(nkpt*nsppol))
2029 : 36 : me=mpi_enreg%me_kpt
2030 : :
2031 : : !! total number of states/bands, over all k and spin
2032 : : nstates=sum(nband(1:nkpt*nsppol))
2033 : : ! number of bands per proc in the band pool
2034 : : ! nb_per_proc=nstates/maxproc_bandpool
2035 : :
2036 [ + - ]: 36 : do nb_per_proc = mband / maxproc_bandpool, mband
2037 [ - + ]: 36 : if (mod(mband,nb_per_proc)==0) exit
2038 : : end do
2039 : :
2040 : 36 : nrank=0
2041 : :
2042 : : ! NB: do this for all procs even if mkmem == 0, otherwise the subcomm call below fails
2043 [ + - ]: 36 : if (nb_per_proc<mband) then
2044 [ + + ]: 72 : do isppol=1,nsppol
2045 [ + + ]: 108 : do ikpt=1,nkpt
2046 : 36 : ii=ikpt+(isppol-1)*nkpt
2047 : 36 : nband_k=nband(ii)
2048 [ - + ]: 72 : if (nb_per_proc<nband_k) then
2049 [ + + ]: 660 : iproc_min=minval(mpi_enreg%proc_distrb(ikpt,:,isppol))
2050 [ + + ]: 660 : iproc_max=maxval(mpi_enreg%proc_distrb(ikpt,:,isppol))
2051 [ - + ]: 36 : if ((me>=iproc_min).and.(me<=iproc_max)) then
2052 : 36 : nrank=iproc_max-iproc_min+1
2053 [ + - ]: 36 : if (.not.allocated(ranks)) then
2054 [ - + + - : 108 : ABI_MALLOC(ranks,(nrank))
+ - - + -
+ - + ]
2055 [ + - + + : 540 : if (nrank>0) ranks=(/((iproc_min+irank-1),irank=1,nrank)/)
+ - + + +
- - + - -
+ + ]
2056 [ # # ]: 0 : else if (nrank/=size(ranks)) then
2057 : : ! TODO MJV: still can not lift this restriction...
2058 : 0 : ABI_BUG('Number of bands per proc should be the same for all k-points!')
2059 : : end if
2060 : : end if
2061 : : end if
2062 : : end do
2063 : : end do
2064 : :
2065 [ - + ]: 36 : if (.not.allocated(ranks)) then
2066 : 0 : nrank = 0
2067 [ # # # # ]: 0 : ABI_MALLOC(ranks,(0))
2068 : : end if
2069 : :
2070 : : ! ABI_CHECK(nrank*nkpt==nproc, ' band and k-point distribution should be rectangular: make sure nproc=nkpt*integer')
2071 : :
2072 [ - + ]: 36 : if (nrank*nkpt*nsppol < nproc) then
2073 : : write(unit=msg,fmt='(a,i6,2a,i6,a,i6,4a)') &
2074 : 0 : 'The number of processors nproc = ', nproc, ch10,&
2075 : 0 : ' is not equal to nrank (=',nrank,&
2076 : 0 : ') times nkpt*nsppol (',nkpt*nsppol,&
2077 : 0 : ' , which may change with perturbation) !',ch10,&
2078 : 0 : ' This is inefficient (load unbalancing). Adjust nband to have a divisor <= nproc/nkpt/nsppol',ch10
2079 : 0 : ABI_WARNING(msg)
2080 : : end if
2081 : : ! NB: everyone in spacecomm has to call subcomm, even if it is a trivial call with self_comm for the subcomm
2082 : 36 : mpi_enreg%comm_band=xmpi_subcomm(spacecomm,nrank,ranks, my_rank_in_group=mpi_enreg%me_band)
2083 : 36 : mpi_enreg%nproc_band=nrank
2084 : : ! mpi_enreg%me_band=mod(me, nrank)
2085 : :
2086 : 36 : write(msg,'(4(a,i0))') 'P Present parallel dimensions: nkpt= ',nkpt,' nsppol ',nsppol,&
2087 : 72 : ' nband per processor= ', nb_per_proc, ' npband= ',nrank
2088 : 36 : call wrtout(std_out,msg)
2089 : :
2090 [ - + ]: 36 : ABI_FREE(ranks)
2091 : : end if
2092 : :
2093 : : end if
2094 : :
2095 : 2359 : end subroutine initmpi_band
2096 : : !!***
2097 : :
2098 : : !----------------------------------------------------------------------
2099 : :
2100 : : !!****f* m_mpinfo/pre_gather
2101 : : !!
2102 : : !! NAME
2103 : : !! pre_gather
2104 : : !!
2105 : : !! FUNCTION
2106 : : !! Gathers data from FFT processors.
2107 : : !!
2108 : : !! INPUTS
2109 : : !! n1,n2,n3= FFT grid dimensions
2110 : : !! n4= n3/mpi_enreg%nproc_fft
2111 : : !! array= data to gather among procs
2112 : : !!
2113 : : !! OUTPUT
2114 : : !! None
2115 : : !!
2116 : : !! SIDE EFFECTS
2117 : : !! array_allgather= gathered data
2118 : : !!
2119 : : !! SOURCE
2120 : :
2121 : 0 : subroutine pre_gather(array,array_allgather,n1,n2,n3,n4,mpi_enreg)
2122 : :
2123 : : !Arguments ------------------------------------
2124 : : integer,intent(in) :: n1,n2,n3,n4
2125 : : real(dp),intent(in) :: array(n1,n2,n4,1)
2126 : : real(dp),intent(inout) :: array_allgather(n1,n2,n3,1)
2127 : : class(mpi_type),intent(in) :: mpi_enreg
2128 : :
2129 : : !Local variables-------------------------------
2130 : : integer :: ier
2131 : : ! *********************************************************************
2132 : :
2133 : : !Gather the array on all procs
2134 : 0 : call xmpi_allgather(array,n1*n2*n3/mpi_enreg%nproc_fft,array_allgather,mpi_enreg%comm_fft,ier)
2135 : :
2136 : 0 : end subroutine pre_gather
2137 : : !!***
2138 : :
2139 : : !----------------------------------------------------------------------
2140 : :
2141 : : !!****f* m_mpinfo/pre_scatter
2142 : : !!
2143 : : !! NAME
2144 : : !! pre_scatter
2145 : : !!
2146 : : !! FUNCTION
2147 : : !! Scatters data among FFT processors.
2148 : : !!
2149 : : !! INPUTS
2150 : : !! n1,n2,n3= FFT grid dimensions
2151 : : !! n4= n3/mpi_enreg%nproc_fft
2152 : : !! array_allgather= data to scatter among FFT procs
2153 : : !!
2154 : : !! OUTPUT
2155 : : !! array= scattered data
2156 : : !!
2157 : : !! SOURCE
2158 : :
2159 : 0 : subroutine pre_scatter(array,array_allgather,n1,n2,n3,n4,mpi_enreg)
2160 : :
2161 : : !Arguments ------------------------------------
2162 : : integer,intent(in) :: n1,n2,n3,n4
2163 : : real(dp),intent(out) :: array(n1,n2,n4,1)
2164 : : real(dp),intent(in) :: array_allgather(n1,n2,n3,1)
2165 : : class(mpi_type),intent(in) :: mpi_enreg
2166 : : ! *********************************************************************
2167 : :
2168 : : !Perform the reverse operation
2169 : : array(:,:,:,:) = &
2170 [ # # # # : 0 : & array_allgather(:,:,n3/mpi_enreg%nproc_fft*mpi_enreg%me_fft+1:n3/mpi_enreg%nproc_fft*(mpi_enreg%me_fft+1),:)
# # # # ]
2171 : :
2172 : 0 : end subroutine pre_scatter
2173 : : !!***
2174 : :
2175 : : !!****f* m_mpinfo/iwrite_fftdatar
2176 : : !! NAME
2177 : : !! iwrite_fftdatar
2178 : : !!
2179 : : !! FUNCTION
2180 : : !! This function selects the subset of processors that should write density/potential
2181 : : !! Return True if the processors should do IO.
2182 : : !!
2183 : : !! INPUTS
2184 : : !! mpi_enreg<MPI_type>=Datatype gathering information on the parallelism
2185 : : !!
2186 : : !! SOURCE
2187 : :
2188 : 57529 : logical function iwrite_fftdatar(mpi_enreg) result(ans)
2189 : :
2190 : : !Arguments ------------------------------------
2191 : : !scalars
2192 : : class(MPI_type),intent(in) :: mpi_enreg
2193 : : ! *********************************************************************
2194 : :
2195 : : ans = (xmpi_paral==0 .or. & ! No MPI
2196 : : (mpi_enreg%paral_kgb==0 .and. mpi_enreg%me==0) .or. & ! paral_kgb=0 does not use MPI-FFT and cartesian communicators.
2197 : : (mpi_enreg%paral_kgb==1 .and. mpi_enreg%me_band==0 .and. & ! select procs in one FFT communicator.
2198 : : mpi_enreg%me_kpt==0 .and. mpi_enreg%me_spinor==0) .or. &
2199 : : (mpi_enreg%paral_pert==1 .and. mpi_enreg%me_cell==0) & ! Group master in perturbation communicator.
2200 [ + + + + : 57529 : )
+ + + + +
+ + + + +
+ + ]
2201 : :
2202 : 57529 : end function iwrite_fftdatar
2203 : : !!***
2204 : :
2205 : : !----------------------------------------------------------------------
2206 : :
2207 : : !!****f* ABINIT/distrb2
2208 : : !! NAME
2209 : : !! distrb2
2210 : : !!
2211 : : !! FUNCTION
2212 : : !! Creates the tabs of repartition of processors for sharing the jobs on k-points, spins and bands.
2213 : : !!
2214 : : !! INPUTS
2215 : : !! mband = maximum number of bands
2216 : : !! nband(nkpt*nsppol) = number of bands per k point, for each spin
2217 : : !! nkpt = number of k-points
2218 : : !! nproc= number of processors available for this distribution
2219 : : !! nsppol = 1 for unpolarized, 2 for polarized
2220 : : !!
2221 : : !! SIDE EFFECTS
2222 : : !! mpi_enreg%proc_distrb(nkpt,mband,nsppol)=number of the processor
2223 : : !! that will treat each band in each k point.
2224 : : !! mpi_enreg%nproc_spkpt is set
2225 : : !!
2226 : : !! NOTES
2227 : : !! For the time being, the band parallelisation works only
2228 : : !! when the number of bands is identical for spin up and spin down
2229 : : !! at the same k point. The problem is the most clearly seen
2230 : : !! in the kpgio routine, where a different parallel repartition
2231 : : !! of k points for spin up and spin down would conflict with the
2232 : : !! present computation of k+G sphere, independent of the spin.
2233 : : !!
2234 : : !! SOURCE
2235 : :
2236 : 9463 : subroutine distrb2(mband,mband_mem_out,nband,nkpt,nproc,nsppol,mpi_enreg)
2237 : :
2238 : : !Arguments ------------------------------------
2239 : : integer,intent(in) :: mband,nkpt,nproc,nsppol
2240 : : integer,intent(in) :: nband(nkpt*nsppol)
2241 : : integer,intent(out) :: mband_mem_out
2242 : : class(MPI_type),intent(inout) :: mpi_enreg
2243 : :
2244 : : !Local variables-------------------------------
2245 : : integer :: maxproc_bandpool
2246 : : integer :: nproc_band
2247 : : integer :: inb1,ind,ind0,nband_k,proc_max,proc_min
2248 : : integer :: nband_k_sp2,minb_per_proc
2249 : : integer :: iiband,iikpt,iisppol,ikpt_this_proc,nb_per_proc,nproc_spkpt,temp_unit
2250 : 9463 : integer :: kpt_distrb(nkpt)
2251 : : logical,save :: first=.true.,has_file
2252 : : character(len=500) :: msg
2253 : : !******************************************************************
2254 : :
2255 : 9463 : nproc_spkpt=mpi_enreg%nproc_spkpt
2256 [ + + ]: 9463 : if (mpi_enreg%paral_pert==1) nproc_spkpt=nproc
2257 : : ! if (mpi_enreg%paral_pert==1) nproc_spkpt=nproc/mpi_enreg%nproc_pert
2258 : :
2259 : 9463 : mband_mem_out = 0
2260 : :
2261 : : !Initialization of proc_distrb
2262 [ + + + + : 1946287 : mpi_enreg%proc_distrb = nproc+1
+ + ]
2263 [ + + ]: 20847 : do iisppol=1,nsppol
2264 [ + + ]: 290248 : do iikpt=1,nkpt
2265 [ + + ]: 2074502 : do iiband=1,nband(iikpt+(iisppol-1)*nkpt)
2266 : 2063118 : mpi_enreg%proc_distrb(iikpt,iiband,iisppol)=nproc_spkpt-1
2267 : : end do
2268 : : end do
2269 : : end do
2270 : : !That s all for an empty communication space
2271 [ - + ]: 9463 : if (nproc==0) return
2272 : :
2273 : : !Some checks
2274 : : !if (mpi_enreg%paralbd==0 .and. any(dtset%optdriver == [RUNL_GSTATE, RUNL_RESPFN])) then
2275 [ + + ]: 9463 : if (mpi_enreg%paralbd==0) then
2276 : : ! Check if nkpt and nproc_spkpt match
2277 [ + + ]: 6312 : if(nproc_spkpt>nkpt*nsppol) then
2278 : : ! Too many proc. with respect to nkpt
2279 : : write(msg,'(a,i0,a,i0,a,i0,4a)')&
2280 : 96 : 'nproc_spkpt= ',nproc_spkpt,' >= nkpt= ',nkpt,'* nsppol= ',nsppol,ch10,&
2281 : 96 : 'The number of processors is larger than nkpt*nsppol. This is a WASTE.',ch10,&
2282 : 192 : ' Ignore this warning if this is not a GS run'
2283 : 96 : ABI_WARNING(msg)
2284 [ + + ]: 6216 : else if (mod(nkpt*nsppol,nproc_spkpt) /= 0) then
2285 : : ! nkpt not a multiple of nproc_spkpt
2286 : : write(msg,'(a,i0,a,i0,5a)')&
2287 : 114 : 'nkpt*nsppol (', nkpt*nsppol, ') is not a multiple of nproc_spkpt (',nproc_spkpt, ')', ch10,&
2288 : 114 : 'The k-point parallelisation is INEFFICIENT. ',ch10,&
2289 : 228 : 'Ignore this warning if this is not a GS run.'
2290 : 114 : ABI_WARNING(msg)
2291 : : end if
2292 : : end if
2293 : :
2294 : : !Inquire whether there exist a file containing the processor distribution
2295 [ + + ]: 9463 : if (first) then
2296 : : ! Case first time: test file to do
2297 : : ! Open the file containing the k-point distribution
2298 : 1435 : first=.false.; has_file = file_exists("kpt_distrb")
2299 : : end if
2300 : :
2301 : : !---------------------------------------------------------------------------
2302 : : !Initialize the processor distribution, either from a file, or from an algorithm
2303 [ - + ]: 9463 : if (has_file) then
2304 [ # # ]: 0 : if (open_file('kpt_distrb',msg,newunit=temp_unit,form='formatted',status='old') /= 0) then
2305 : 0 : ABI_ERROR(msg)
2306 : : end if
2307 : 0 : rewind(unit=temp_unit)
2308 [ # # ]: 0 : if (mpi_enreg%paralbd == 1) then
2309 : : ! -> read bands distribution
2310 : 0 : read(temp_unit,*) mpi_enreg%proc_distrb
2311 : : else
2312 : 0 : read(temp_unit,*) kpt_distrb
2313 : : end if
2314 : 0 : close(temp_unit)
2315 : 0 : proc_max=0
2316 : 0 : proc_min=nproc_spkpt
2317 : : ! -> determine the range of proc. requested
2318 [ # # ]: 0 : if (mpi_enreg%paralbd == 1) then
2319 [ # # ]: 0 : do iisppol=1,nsppol
2320 [ # # ]: 0 : do iikpt=1,nkpt
2321 : 0 : nband_k = nband(iikpt+(iisppol-1)*nkpt)
2322 [ # # ]: 0 : proc_max=maxval(mpi_enreg%proc_distrb(iikpt,1:nband_k,iisppol))
2323 [ # # ]: 0 : proc_min=minval(mpi_enreg%proc_distrb(iikpt,1:nband_k,iisppol))
2324 : : end do
2325 : : end do
2326 : : else
2327 [ # # ]: 0 : proc_max=maxval(kpt_distrb(1:nkpt))
2328 [ # # ]: 0 : proc_min=minval(kpt_distrb(1:nkpt))
2329 : : ! -> fill the tab proc_distrb with kpt_distrb
2330 [ # # ]: 0 : do iisppol=1,nsppol
2331 [ # # ]: 0 : do iikpt=1,nkpt
2332 : 0 : nband_k = nband(iikpt+(iisppol-1)*nkpt)
2333 [ # # ]: 0 : do iiband=1,nband_k
2334 : 0 : mpi_enreg%proc_distrb(iikpt,iiband,iisppol)=kpt_distrb(iikpt)
2335 : : end do
2336 : : end do
2337 : : end do
2338 : : end if ! mpi_enreg%paralbd
2339 : :
2340 [ # # ]: 0 : if(proc_max>(nproc_spkpt-1)) then
2341 : : ! Too much proc. requested
2342 : : write(msg, '(a,a,a,i0,a,a,a)' )&
2343 : 0 : 'The number of processors mentioned in the kpt_distrb file',ch10,&
2344 : 0 : 'must be lower or equal to the actual number of processors =',nproc_spkpt-1,ch10,&
2345 : 0 : 'Action: change the kpt_distrb file, or increase the',' number of processors.'
2346 : 0 : ABI_ERROR(msg)
2347 : : end if
2348 : :
2349 [ # # ]: 0 : if(proc_max/=(nproc_spkpt-1)) then
2350 : : ! Too few proc. used
2351 : : write(msg, '(a,i0,a,a,a,i0,a,a,a)' )&
2352 : 0 : 'Only ',proc_max+1,' processors are used (from kpt_distrb file),',ch10,&
2353 : 0 : 'when',nproc_spkpt,' processors are available.',ch10,&
2354 : 0 : 'Action: adjust number of processors and kpt_distrb file.'
2355 : 0 : ABI_ERROR(msg)
2356 : : end if
2357 : :
2358 [ # # ]: 0 : if(proc_min<0) then
2359 : : write(msg, '(a,a,a)' )&
2360 : 0 : 'The number of processors must be bigger than 0 in kpt_distrb file.',ch10,&
2361 : 0 : 'Action: modify kpt_distrb file.'
2362 : 0 : ABI_ERROR(msg)
2363 : : end if
2364 : :
2365 : : !---------------------------------------------------------------------------
2366 : : else
2367 : : ! 'kpt_distrb' file does not exist
2368 : :
2369 [ + + ]: 9463 : if (mpi_enreg%paralbd==1) then
2370 : :
2371 : : ! No possible band parallelization
2372 [ + + ]: 3151 : if (nproc<(nkpt*nsppol)) then
2373 : :
2374 : : ! Does not allow a processor to treat different spins
2375 : : ! NB: for odd nproc this will happen anyway for the middle proc - will this not unbalance things?
2376 : 2971 : ind0=0
2377 : 2971 : inb1=(nkpt*nsppol)/nproc
2378 : : if (mod((nkpt*nsppol),nproc)/=0) inb1=inb1+1
2379 [ + + ]: 208453 : do iikpt=1,nkpt
2380 : 205482 : nband_k=nband(iikpt)
2381 : 205482 : nband_k_sp2=nband(iikpt+nkpt*(nsppol-1))
2382 : : !ind=ind0/inb1
2383 : 205482 : ind=mod(ind0,nproc)
2384 [ + + ]: 1374451 : do iiband=1,nband_k
2385 : 1168969 : mpi_enreg%proc_distrb(iikpt,iiband,1)=ind
2386 [ + + + + ]: 1374451 : if (nsppol==2 .and. iiband <= nband_k_sp2) then
2387 : 30837 : mpi_enreg%proc_distrb(iikpt,iiband,2)=ind
2388 : : end if
2389 : : !if (nsppol==2) mpi_enreg%proc_distrb(iikpt,iiband,2)=nproc-ind-1
2390 : : end do
2391 : 208453 : ind0=ind0+1
2392 : : end do
2393 : :
2394 : : ! MT130831 : OLD CODING
2395 : : ! do iisppol=1,nsppol;do iikpt=1,nkpt
2396 : : ! ind=(iikpt+(iisppol-1)*nkpt-1)/inb1
2397 : : ! nband_k=nband(iikpt+(iisppol-1)*nkpt)
2398 : : ! do iiband=1,nband_k
2399 : : ! mpi_enreg%proc_distrb(iikpt,iiband,iisppol)=ind
2400 : : ! end do;end do;end do
2401 : : ! MT130831 : END OF OLD CODING
2402 : :
2403 : : ! Possible band parallelization
2404 : : else
2405 : : ! Does not allow a processor to treat different spins
2406 : 180 : ind0=0
2407 [ - + ]: 180 : maxproc_bandpool=floor(nproc*one/(nkpt*nsppol))
2408 [ + + ]: 396 : do iikpt=1,nkpt
2409 : 216 : nband_k=nband(iikpt)
2410 : 216 : nband_k_sp2=nband(iikpt+nkpt*(nsppol-1))
2411 [ - + ]: 216 : minb_per_proc=floor(nband_k*one/maxproc_bandpool)
2412 [ - + ]: 216 : if (mod(nband_k,maxproc_bandpool)/=0) minb_per_proc=minb_per_proc+1
2413 [ + - ]: 216 : do nb_per_proc = minb_per_proc, nband_k
2414 [ - + ]: 216 : if (mod(nband_k,nb_per_proc)==0) exit
2415 : : end do
2416 : 216 : nproc_band = nband_k / nb_per_proc
2417 : :
2418 : 216 : mband_mem_out = max(mband_mem_out,nb_per_proc)
2419 [ + + ]: 3187 : do iiband=1,nband_k
2420 : 2971 : ind=mod((iiband-1)/nb_per_proc+ind0, nproc)
2421 : : !ind = mod( mod((iiband-1),nproc_band) + ind0, nproc )
2422 : 2971 : mpi_enreg%proc_distrb(iikpt,iiband,1)=ind
2423 : : !TODO : could end up with 0 bands on certain procs with this configuration and nband(k) /= constant
2424 [ - + - - ]: 3187 : if (nsppol==2 .and. iiband <= nband_k_sp2) then
2425 : 0 : mpi_enreg%proc_distrb(iikpt,iiband,2)=ind+nkpt*nproc_band
2426 : : end if
2427 : : !if (nsppol==2) mpi_enreg%proc_distrb(iikpt,iiband,2)=nproc-ind-1
2428 : : end do
2429 : 396 : ind0=ind+1 ! take last proc associated to the bands at iikpt, and increment
2430 : : !ind0 = ind0 + nproc_band
2431 : : end do
2432 : :
2433 : : ! MT130831 : OLD CODING
2434 : : ! ind0=0;maxproc_bandpool=nproc/(nkpt*nsppol)
2435 : : ! do iisppol=1,nsppol;do iikpt=1,nkpt
2436 : : ! nband_k=nband(iikpt+(iisppol-1)*nkpt)
2437 : : ! nb_per_proc=nband_k/maxproc_bandpool;if (mod(nband_k,maxproc_bandpool)/=0) nb_per_proc=nb_per_proc+1
2438 : : ! do iiband=1,nband_k
2439 : : ! ind=(iiband-1)/nb_per_proc+ind0
2440 : : ! mpi_enreg%proc_distrb(iikpt,iiband,iisppol)=ind
2441 : : ! end do
2442 : : ! ind0=ind+1
2443 : : ! end do;end do
2444 : : ! MT130831 : END OF OLD CODING
2445 : :
2446 : : end if
2447 : :
2448 : : ! XG060807 : OLD CODING
2449 : : ! ind=0
2450 : : ! do iisppol=1,nsppol;do iikpt=1,nkpt
2451 : : ! nband_k=nband(iikpt+(iisppol-1)*nkpt)
2452 : : ! do iiband=1,nband_k
2453 : : ! mpi_enreg%proc_distrb(iikpt,iiband,iisppol)=ind/nb_per_proc
2454 : : ! ind=ind+1
2455 : : ! end do;end do;end do
2456 : : ! XG060807 : END OF OLD CODING
2457 : :
2458 [ + - ]: 6312 : elseif (mpi_enreg%paralbd==0) then
2459 : :
2460 : : ! Does not allow a processor to treat different spins
2461 : 6312 : ind0=0
2462 : 6312 : nb_per_proc=(nsppol*nkpt)/nproc_spkpt
2463 [ + + ]: 6312 : if (mod((nsppol*nkpt),nproc_spkpt)/=0) nb_per_proc=nb_per_proc+1
2464 [ + + ]: 64155 : do iikpt=1,nkpt
2465 : 57843 : nband_k=nband(iikpt)
2466 : 57843 : ind=ind0/nb_per_proc
2467 [ + + ]: 600393 : do iiband=1,nband_k
2468 : 542550 : mpi_enreg%proc_distrb(iikpt,iiband,1)=ind
2469 [ + + ]: 600393 : if (nsppol==2) then
2470 : : !TODO: why are these bands ordered in the opposite direction wrt spin 1??
2471 : 48467 : mpi_enreg%proc_distrb(iikpt,iiband,2)=nproc_spkpt-ind-1
2472 : : end if
2473 : : end do
2474 : 64155 : ind0=ind0+1
2475 : : end do
2476 : :
2477 : : ! XG060807 : OLD CODING
2478 : : ! ind=0
2479 : : ! do iisppol=1,nsppol;do iikpt=1,nkpt
2480 : : ! nband_k = nband(iikpt+(iisppol-1)*nkpt)
2481 : : ! do iiband=1,nband_k
2482 : : ! Distribute k-points homogeneously
2483 : : ! proc_distrb(iikpt,iiband,iisppol)=mod(iikpt-1,nproc_spkpt)
2484 : : ! mpi_enreg%proc_distrb(iikpt,iiband,iisppol)=ind/nb_per_proc
2485 : : ! end do
2486 : : ! ind=ind + 1
2487 : : ! end do;end do
2488 : : ! XG060807 : END OF OLD CODING
2489 : :
2490 : : end if ! mpi_enreg%paralbd
2491 : :
2492 : : end if ! has_file
2493 : :
2494 : : ! local indices on cpus, for each sppol kpt band
2495 [ + + ]: 273004 : mpi_enreg%my_kpttab(:)=0
2496 [ + + ]: 28389 : mpi_enreg%my_isppoltab(:)=0
2497 [ + + ]: 20847 : do iisppol=1,nsppol
2498 : 11384 : ikpt_this_proc=0
2499 [ + + ]: 290248 : do iikpt=1,nkpt
2500 : 269401 : nband_k=nband(iikpt+(iisppol-1)*nkpt)
2501 [ + + ]: 269401 : if(proc_distrb_cycle(mpi_enreg%proc_distrb,iikpt,1,nband_k,iisppol,mpi_enreg%me_kpt)) cycle
2502 : 224853 : ikpt_this_proc=ikpt_this_proc+1
2503 : 224853 : mpi_enreg%my_kpttab(iikpt)=ikpt_this_proc
2504 : 280785 : mpi_enreg%my_isppoltab(iisppol)=1
2505 : : end do
2506 : : end do
2507 : :
2508 [ + + ]: 9463 : if (mband_mem_out == 0) mband_mem_out = mband
2509 : :
2510 : : end subroutine distrb2
2511 : : !!***
2512 : :
2513 : : !!****f* ABINIT/distrb2_hf
2514 : : !! NAME
2515 : : !! distrb2_hf
2516 : : !!
2517 : : !! FUNCTION
2518 : : !! Create the tabs of repartition of processors for sharing the jobs
2519 : : !! on occupied states (labeled by k-points, bands and spin indices) for Hartree-Fock calculation.
2520 : : !!
2521 : : !! INPUTS
2522 : : !! nbandhf = maximum number of occupied bands
2523 : : !! nkpthf = number of k-points in full BZ
2524 : : !! nproc= number of processors available for this distribution
2525 : : !! nsppol = 1 for unpolarized, 2 for polarized
2526 : : !!
2527 : : !! SIDE EFFECTS
2528 : : !! mpi_enreg%proc_distrb(nkpthf,nbandhf,nsppol)=number of the processor
2529 : : !! that will treat each band in each k point.
2530 : : !! mpi_enreg%nproc_spkpt is set
2531 : : !!
2532 : : !! NOTES
2533 : : !! For the time being, the band parallelisation works only
2534 : : !! when the number of bands is identical for spin up and spin down
2535 : : !! at the same k point. The problem is the most clearly seen
2536 : : !! in the kpgio routine, where a different parallel repartition
2537 : : !! of k points for spin up and spin down would conflict with the
2538 : : !! present computation of k+G sphere, independent of the spin.
2539 : : !!
2540 : : !! SOURCE
2541 : :
2542 : 146 : subroutine distrb2_hf(nbandhf,nkpthf, nproc, nsppol, mpi_enreg)
2543 : :
2544 : : !Arguments ------------------------------------
2545 : : integer,intent(in) :: nbandhf,nkpthf,nproc,nsppol
2546 : : class(MPI_type),intent(inout) :: mpi_enreg
2547 : :
2548 : : !Local variables-------------------------------
2549 : : integer :: ind,iiband,iikpt,iistep,nproc_hf
2550 : : character(len=500) :: msg
2551 : : !******************************************************************
2552 : :
2553 : 146 : nproc_hf=mpi_enreg%nproc_hf
2554 : :
2555 : : !* Initialize distrb_hf (the array exists necessarily)
2556 [ + + ]: 807 : do iiband=1,nbandhf
2557 [ + + ]: 12530 : do iikpt=1,nkpthf
2558 : 12384 : mpi_enreg%distrb_hf(iikpt,iiband,1)=nproc_hf-1
2559 : : end do
2560 : : end do
2561 : :
2562 : : !* End of the routine for an empty communication space
2563 [ - + ]: 146 : if (nproc==0) return
2564 : :
2565 : : !*** Testing section ***
2566 : :
2567 [ + + ]: 146 : if (nsppol==2) then
2568 : : !* Check that the distribution over (spin,k point) allow to consider spin up and spin dn independently.
2569 [ - + - - ]: 7 : if (mpi_enreg%nproc_spkpt/=1.and.mod(mpi_enreg%nproc_spkpt,2)/=0) then
2570 : 0 : ABI_ERROR( 'The variable nproc_spkpt is not even but nsppol= 2')
2571 : : !* In this case, one processor will carry both spin. (this will create pbms for the calculation)
2572 : : end if
2573 : : !* Check that the number of band is the same for each spin, at each k-point. (It should be)
2574 : : !* do iikpt=1,nkpthf
2575 : : !* if (nband(iikpt)/=nband(iikpt+nkpthf)) then
2576 : : !* msg = ' WARNING - the number of bands is different for spin up or spin down. '
2577 : : !* ABI_ERROR(msg)
2578 : : !* end if
2579 : : !* end do
2580 : : !* If one of this test is not good for one proc then other procs fall in deadlock, according to distrb2.
2581 : : !* What does it mean ???
2582 : : end if
2583 : :
2584 : :
2585 : : !* Check if nkpthf and nproc_hf match
2586 [ - + ]: 146 : if (nproc_hf>nkpthf*nbandhf) then
2587 : : !* There are too many processors with respect to nkpthf*nbandhf
2588 : 0 : write(msg, '(a,a,i4,a,i4,a,i4,a,a)' ) ch10,&
2589 : 0 : & 'nproc_hf=',nproc_hf,' >= nkpthf=',nkpthf,'* nbandhf=',nbandhf,ch10,&
2590 : 0 : & 'The number of processors is larger than nkpthf*nbandhf. This is a waste.'
2591 : 0 : ABI_WARNING(msg)
2592 : :
2593 [ - + ]: 146 : else if(mod(nkpthf*nbandhf,nproc_hf)/=0) then
2594 : : !* nkpthf*nbandhf is not a multiple of nproc_hf
2595 : 0 : write(msg, '(2a,i5,a,i5,3a)' ) ch10,&
2596 : 0 : & 'nkpthf*nbandhf (', nkpthf*nbandhf, ') is not a multiple of nproc_hf (',nproc_hf, ')', ch10,&
2597 : 0 : & 'The parallelisation may not be efficient.'
2598 : 0 : ABI_WARNING(msg)
2599 : : end if
2600 : :
2601 : : !*** End of testing section ***
2602 : :
2603 : : !*** Initialize the processor distribution from a simple algorithm ***
2604 : :
2605 [ + + ]: 146 : if (nproc_hf<nkpthf) then
2606 : : !* In this case, a parallelization over kpts only.
2607 : 123 : iistep=nkpthf/nproc_hf
2608 [ - + ]: 123 : if (mod(nkpthf,nproc_hf) /=0) iistep=iistep+1
2609 : 123 : ind=0
2610 [ + + ]: 2858 : do iikpt=1,nkpthf
2611 : : !*** Only the first "nbandhf" bands are considered (they are assumed to be the only occupied ones)
2612 [ + + ]: 14337 : do iiband=1,nbandhf
2613 : 14337 : mpi_enreg%distrb_hf(iikpt,iiband,1)=ind/iistep
2614 : : end do
2615 : 2858 : ind=ind+1
2616 : : end do
2617 : :
2618 : : else
2619 : : !* In this case, a parallelization over all the occupied states is possible.
2620 [ + + ]: 23 : if (nproc_hf < nbandhf*nkpthf) then
2621 : 20 : iistep=(nbandhf*nkpthf)/nproc_hf;
2622 [ - + ]: 20 : if (mod((nbandhf*nkpthf),nproc_hf) /=0) iistep=iistep+1
2623 : : else
2624 : : iistep=1
2625 : : end if
2626 : 23 : ind=0
2627 [ + + ]: 46 : do iikpt=1,nkpthf
2628 : : !*** Only the first "nbandhf" bands are considered (they are assumed to be the only occupied ones)
2629 [ + + ]: 167 : do iiband=1,nbandhf
2630 : 121 : mpi_enreg%distrb_hf(iikpt,iiband,1)=ind/iistep
2631 : 144 : ind=ind+1
2632 : : end do
2633 : : end do
2634 : : end if
2635 : :
2636 : : !*** Initialization of processor distribution from a file (simple copy from distrb2, not yet implemented) ***
2637 : :
2638 : : ! !* Inquire whether there exist a file containing the processor distribution
2639 : : ! if (first) then
2640 : : ! ! Case first time : test file to do
2641 : : ! ! Open the file containing the (k-points,bands) distribution
2642 : : ! open(unit=temp_unit,file='kpt_distrb_hf',form='formatted',status='old',iostat=ios)
2643 : : ! if(ios==0) then
2644 : : ! ! 'kpt_distrb_hf' file exists
2645 : : ! file_exist=1
2646 : : ! close(temp_unit)
2647 : : ! else
2648 : : ! file_exist=0
2649 : : ! end if
2650 : : ! first=.false.
2651 : : ! end if
2652 : : !
2653 : : ! !* Initialize the processor distribution, either from a file, or from an algorithm
2654 : : ! if (file_exist == 1) then
2655 : : ! !* Read (k-points,bands) distribution out of the file
2656 : : ! open(unit=temp_unit,file='kpt_distrb_hf',form='formatted',status='old',iostat=ios)
2657 : : ! rewind(unit=temp_unit)
2658 : : ! read(temp_unit,*) mpi_enreg%distrb_hf
2659 : : ! close(temp_unit)
2660 : : ! !* Determine the range of processors requested
2661 : : ! proc_max=0
2662 : : ! proc_min=nproc_hf
2663 : : ! do iikpt=1,nkpthf
2664 : : ! mband_occ_k = mband_occ(iikpt+(iisppol-1)*nkpthf)
2665 : : ! proc_max=maxval(mpi_enreg%distrb_hf(iikpt,1:mband_occ_k,1))
2666 : : ! proc_min=minval(mpi_enreg%distrb_hf(iikpt,1:mband_occ_k,1))
2667 : : ! end do
2668 : : !
2669 : : ! if(proc_max>(nproc_hf-1)) then
2670 : : ! !* Too much proc. requested
2671 : : ! write(msg, '(a,a,a,i4,a,a,a)' )&
2672 : : ! & ' The number of processors mentioned in the kpt_distrb file',ch10,&
2673 : : ! & ' must be lower or equal to the actual number of processors =',&
2674 : : ! & nproc_hf-1,ch10,&
2675 : : ! & ' Action: change the kpt_distrb file, or increase the',&
2676 : : ! & ' number of processors.'
2677 : : ! ABI_ERROR(msg)
2678 : : ! end if
2679 : : !
2680 : : ! if(proc_max/=(nproc_hf-1)) then
2681 : : ! !* Too few proc. used
2682 : : ! write(msg, '(a,i4,a,a,a,i4,a,a,a)' )&
2683 : : ! & ' Only ',proc_max+1,' processors are used (from kpt_distrb file),',ch10,&
2684 : : ! & ' when',nproc_hf,' processors are available.',ch10,&
2685 : : ! & ' Action: adjust number of processors and kpt_distrb file.'
2686 : : ! ABI_ERROR(msg)
2687 : : ! end if
2688 : : !
2689 : : ! if(proc_min<0) then
2690 : : ! write(msg, '(a,a,a)' )&
2691 : : ! & ' The number of processors must be bigger than 0 in kpt_distrb file.',ch10,&
2692 : : ! & ' Action: modify kpt_distrb file.'
2693 : : ! ABI_ERROR(msg)
2694 : : ! end if
2695 : : ! else
2696 : : ! !* The file does not exist...
2697 : : ! end if ! file_exist
2698 : :
2699 : : !DEBUG
2700 : : !write(std_out,*)' distrb2_hf: exit '
2701 : : !ENDDEBUG
2702 : :
2703 : : end subroutine distrb2_hf
2704 : : !!***
2705 : :
2706 : : end module m_mpinfo
2707 : : !!***
|
