Line data Source code
1 : !!****m* ABINIT/m_paral_atom
2 : !! NAME
3 : !! m_paral_atom
4 : !!
5 : !! FUNCTION
6 : !! This module provides routines and methods used to manage the parallelisation/distribution
7 : !! of PAW data over atomic sites
8 : !!
9 : !! COPYRIGHT
10 : !! Copyright (C) 2012-2026 ABINIT group (MT, MD)
11 : !! This file is distributed under the terms of the
12 : !! GNU General Public License, see ~abinit/COPYING
13 : !! or http://www.gnu.org/copyleft/gpl.txt .
14 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt.
15 : !!
16 : !! NOTES
17 : !! FOR DEVELOPPERS: in order to preserve the portability of libPAW library,
18 : !! please consult ~abinit/src/??_libpaw/libpaw-coding-rules.txt
19 : !!
20 : !! SOURCE
21 :
22 : #include "libpaw.h"
23 :
24 : MODULE m_paral_atom
25 :
26 : USE_DEFS
27 : USE_MSG_HANDLING
28 : USE_MPI_WRAPPERS
29 : USE_MEMORY_PROFILING
30 :
31 : implicit none
32 :
33 : private
34 :
35 : !public procedures.
36 : public :: get_my_natom
37 : public :: get_my_atmtab
38 : public :: free_my_atmtab
39 : public :: get_proc_atmtab
40 : public :: get_atm_proc
41 : !!***
42 :
43 : CONTAINS
44 : !!***
45 :
46 : !----------------------------------------------------------------------
47 :
48 : !!****f* m_paral_atom/get_my_natom
49 : !! NAME
50 : !! get_my_natom
51 : !!
52 : !! FUNCTION
53 : !! Given the total number of atoms, return the number of atoms treated by current process
54 : !!
55 : !! INPUTS
56 : !! comm_atom=communicator over atoms
57 : !! natom=total number of atoms
58 : !!
59 : !! OUTPUT
60 : !! my_natom=number of atoms treated by current process
61 : !!
62 : !! SOURCE
63 :
64 :
65 2284 : subroutine get_my_natom(comm_atom,my_natom,natom)
66 :
67 : !Arguments ---------------------------------------------
68 : !scalars
69 : integer,intent(in) :: comm_atom,natom
70 : integer,intent(out) :: my_natom
71 : !arrays
72 :
73 : !Local variables ---------------------------------------
74 : !scalars
75 : integer :: me,nproc
76 : !arrays
77 :
78 : ! *************************************************************************
79 :
80 2284 : my_natom=natom
81 2284 : if (comm_atom/=xmpi_comm_self.and.comm_atom/=xmpi_comm_null) then
82 2284 : nproc=xmpi_comm_size(comm_atom)
83 2284 : me=xmpi_comm_rank(comm_atom)
84 2284 : my_natom=natom/nproc
85 2284 : if (me<=(mod(natom,nproc)-1)) my_natom=natom/nproc + 1
86 : endif
87 :
88 2284 : end subroutine get_my_natom
89 : !!***
90 :
91 : !----------------------------------------------------------------------
92 :
93 : !!****f* m_paral_atom/get_my_atmtab
94 : !! NAME
95 : !! get_my_atmtab
96 : !!
97 : !! FUNCTION
98 : !! Given the total number of atoms and a MPI communicator return a table
99 : !! containing the indexes of atoms treated by current processor.
100 : !!
101 : !! INPUTS
102 : !! comm_atom=communicator over atoms
103 : !! my_natom_ref= --optional-- a reference value for the local number of atoms
104 : !! (just for checking purposes)
105 : !! natom=total number of atoms
106 : !!
107 : !! OUTPUT
108 : !!
109 : !! SIDE EFFECTS
110 : !! my_atmtab(:)=indexes of atoms treated by current process
111 : !! nothing is done if my_atmtab(:) is already associated to a target
112 : !! my_atmtab_allocated=true if my_atmtab is allocated
113 : !! paral_atom=flag controlling parallelism over atoms
114 : !!
115 : !! SOURCE
116 :
117 :
118 2371000 : subroutine get_my_atmtab(comm_atom,my_atmtab,my_atmtab_allocated,paral_atom,natom,&
119 : & my_natom_ref) ! optional argument
120 :
121 : !Arguments ---------------------------------------------
122 : !scalars
123 : integer,intent(in) :: comm_atom,natom
124 : integer,intent(in),optional :: my_natom_ref
125 : logical,intent(inout) :: my_atmtab_allocated,paral_atom
126 : !arrays
127 : integer,pointer :: my_atmtab(:)
128 : !Local variables ---------------------------------------
129 : !scalars
130 : integer :: iatom,me,my_natom,natom_bef,nmod,nproc
131 : character(len=500) :: msg
132 : !arrays
133 :
134 : ! *************************************************************************
135 :
136 2371000 : my_atmtab_allocated=.false.
137 2371000 : if (.not.paral_atom) return
138 :
139 77832 : if (comm_atom==xmpi_comm_self.or.comm_atom==xmpi_comm_null) paral_atom=.false.
140 77832 : if (paral_atom) then
141 77632 : nproc=xmpi_comm_size(comm_atom)
142 77632 : paral_atom=(nproc>1)
143 77632 : if (paral_atom) then
144 77632 : if (.not.associated(my_atmtab)) then
145 : ! Get local number of atoms
146 3530 : me=xmpi_comm_rank(comm_atom)
147 3530 : my_natom=natom/nproc
148 3530 : if (me<=(mod(natom,nproc)-1)) my_natom=natom/nproc + 1
149 : ! Get table of atoms
150 3530 : if (my_natom>0) then
151 7956 : LIBPAW_POINTER_ALLOCATE(my_atmtab,(my_natom))
152 2652 : my_atmtab_allocated=.true.
153 2652 : if (my_natom==natom) then
154 0 : my_atmtab(1:my_natom)=(/(iatom,iatom=1,natom)/)
155 : else
156 : ! The atoms are distributed contigously by egal part
157 : ! (the rest is distributed on all the procs)
158 2652 : nmod=mod(natom,nproc)
159 2652 : if (me<=(nmod-1)) then
160 1097 : natom_bef=me*(natom/nproc)+me
161 : else
162 1555 : natom_bef=me*(natom/nproc)+nmod
163 : endif
164 6045 : do iatom=1,my_natom
165 6045 : my_atmtab(iatom)=iatom+natom_bef
166 : enddo
167 : end if
168 : end if
169 : else
170 74102 : my_natom=size(my_atmtab)
171 : end if
172 77632 : if (present(my_natom_ref).and.(my_natom>0)) then
173 53696 : if (my_natom_ref/=size(my_atmtab)) then
174 0 : msg='my_atmtab should have a size equal to my_natom !'
175 0 : LIBPAW_BUG(msg)
176 : end if
177 : end if
178 : end if
179 : endif
180 :
181 : end subroutine get_my_atmtab
182 : !!***
183 :
184 : !----------------------------------------------------------------------
185 :
186 : !!****f* m_paral_atom/free_my_atmtab
187 : !! NAME
188 : !! free_my_atmtab
189 : !!
190 : !! FUNCTION
191 : !! Cleanly deallocate a table of atom indexes (my_atmtab)
192 : !!
193 : !! INPUTS
194 : !!
195 : !! OUTPUT
196 : !!
197 : !! SIDE EFFECTS
198 : !! my_atmtab_allocated=true if my_atmtab is allocated
199 : !! my_atmtab(:)=indexes of atoms treated by current process
200 : !! nothing is done if my_atmtab(:) is already associated to a target
201 : !!
202 : !! SOURCE
203 :
204 1749152 : subroutine free_my_atmtab(my_atmtab,my_atmtab_allocated)
205 :
206 : !Arguments ---------------------------------------------
207 : !scalars
208 : logical,intent(inout) :: my_atmtab_allocated
209 : !arrays
210 : integer,pointer :: my_atmtab(:)
211 : !Local variables ---------------------------------------
212 : !scalars
213 : !arrays
214 :
215 : ! *************************************************************************
216 :
217 1749152 : if (my_atmtab_allocated) then
218 8664 : LIBPAW_POINTER_DEALLOCATE(my_atmtab)
219 : nullify(my_atmtab)
220 8664 : my_atmtab_allocated=.false.
221 : end if
222 :
223 1749152 : end subroutine free_my_atmtab
224 : !!***
225 :
226 : !----------------------------------------------------------------------
227 :
228 : !!****f* m_paral_atom/get_proc_atmtab
229 : !! NAME
230 : !! get_proc_atmtab
231 : !!
232 : !! FUNCTION
233 : !! Given the total number of atoms and the size of a communicator,
234 : !! return a table containing the indexes of atoms treated by a processor (with index iproc)
235 : !!
236 : !! INPUTS
237 : !! comm_atom_size= size of communicator (over atoms)
238 : !! iproc= rank of the processor
239 : !! natom= total number of atoms
240 : !!
241 : !! OUTPUT
242 : !! atmtab(natom_out)= indexes of atoms treated by process iproc
243 : !! natom_out= number of atoms treated by process iproc
244 : !!
245 : !! NOTES
246 : !! In case of modification of the distribution of atom over proc,
247 : !! get_atmtab must be modified accordingly
248 : !!
249 : !! SOURCE
250 :
251 0 : subroutine get_proc_atmtab(iproc,atmtab,natom_out,natom,comm_atom_size)
252 :
253 : !Arguments ---------------------------------------------
254 : !scalars
255 : integer, intent(in) :: comm_atom_size,iproc,natom
256 : !arrays
257 : integer,intent(out) :: natom_out
258 : integer,allocatable, intent(out):: atmtab(:)
259 :
260 : !Local variables ---------------------------------------
261 : !scalars
262 : integer :: iatom,natom_bef,nmod,nproc
263 : !arrays
264 :
265 : ! *************************************************************************
266 :
267 0 : nproc=comm_atom_size
268 :
269 0 : natom_out=natom/nproc ; if (iproc<=(mod(natom,nproc)-1)) natom_out=natom/nproc+1
270 :
271 : ! Get table of atoms
272 0 : if (natom_out>0) then
273 0 : LIBPAW_ALLOCATE(atmtab,(natom_out))
274 : ! The atoms are distributed contigously by egal part
275 : ! The rest is distributed on all the procs
276 : ! (see get_my_atmtab)
277 0 : nmod=mod(natom,nproc)
278 0 : if (iproc<=(nmod-1)) then
279 0 : natom_bef=iproc*(natom/nproc)+iproc
280 : else
281 0 : natom_bef=iproc*(natom/nproc)+nmod
282 : end if
283 0 : do iatom=1,natom_out
284 0 : atmtab(iatom)=iatom+natom_bef
285 : end do
286 :
287 : else
288 0 : natom_out=0
289 0 : LIBPAW_ALLOCATE(atmtab,(0))
290 : end if
291 :
292 0 : end subroutine get_proc_atmtab
293 : !!***
294 :
295 : !----------------------------------------------------------------------
296 :
297 : !!****f* m_paral_atom/get_atm_proc
298 : !! NAME
299 : !! get_atm_proc
300 : !!
301 : !! FUNCTION
302 : !! Given a list of atoms and a MPI communicator size, return a table
303 : !! containing the corresponding processor indexes.
304 : !!
305 : !! COPYRIGHT
306 : !! Copyright (C) 2012-2026 ABINIT group (MD)
307 : !! This file is distributed under the terms of the
308 : !! GNU General Public License, see ~abinit/COPYING
309 : !! or http://www.gnu.org/copyleft/gpl.txt .
310 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt.
311 : !!
312 : !! INPUTS
313 : !! atom_list(:)= index of atoms
314 : !! nproc=size of communicator over atoms
315 : !! natom=total number of atoms
316 : !!
317 : !! OUTPUT
318 : !! proc_list(:) = index of procs
319 : !!
320 : !! NOTES
321 : !! The atoms are distributed contigously by egal part; the rest is distributed
322 : !! on all the procs (see get_my_atmtab).
323 : !! In case of modification of the distribution of atom over proc, this routine
324 : !! must be modified accordingly.
325 : !!
326 : !! SOURCE
327 :
328 56 : subroutine get_atm_proc(atom_list,natom,nproc,proc_list)
329 :
330 : !Arguments ---------------------------------------------
331 : !scalars
332 : integer, intent(in) :: natom,nproc
333 : !arrays
334 : integer, intent(in) :: atom_list(:)
335 : integer, intent(out) :: proc_list(:)
336 :
337 : !Local variables ---------------------------------------
338 : !scalars
339 : integer :: nb_atom,dn,dn1,iatom,natomlim,iatm,jproclim,nmod
340 : !arrays
341 :
342 : ! *************************************************************************
343 :
344 56 : nmod=mod(natom,nproc);nb_atom=size(atom_list)
345 :
346 56 : if (nmod==0) then
347 24 : dn=natom/nproc
348 48 : do iatm =1, nb_atom
349 24 : iatom=atom_list(iatm)
350 48 : proc_list(iatm)=(iatom-1)/dn
351 : end do
352 : else
353 32 : dn=natom/nproc
354 32 : dn1=natom/nproc + 1
355 : ! Under (jproclim+1), 1 atome by proc is added
356 : ! The rest nmod is distributed among jproclim+1 first procs
357 32 : jproclim=nmod -1
358 32 : natomlim=dn1*(jproclim+1)
359 64 : do iatm=1,nb_atom
360 32 : iatom=atom_list(iatm)
361 64 : if (iatom<=natomlim) then
362 32 : proc_list(iatm)=(iatom -1 )/dn1
363 : else
364 0 : proc_list(iatm)=jproclim + 1 + (iatom - 1 -(natomlim))/dn
365 : end if
366 : enddo
367 : end if
368 :
369 56 : end subroutine get_atm_proc
370 : !!***
371 :
372 : !----------------------------------------------------------------------
373 :
374 : END MODULE m_paral_atom
375 : !!***
|
