Line data Source code
1 : !!****m* ABINIT/m_effpot_mpi
2 : !!
3 : !! NAME
4 : !! m_effpot_mpi
5 : !!
6 : !! FUNCTION
7 : !! Module for using the paralelisation of effective potential
8 : !! Container type is defined, and destruction, print subroutines
9 : !! This module is still experimental
10 : !!
11 : !! COPYRIGHT
12 : !! Copyright (C) 2010-2026 ABINIT group (AM)
13 : !! This file is distributed under the terms of the
14 : !! GNU General Public Licence, see ~abinit/COPYING
15 : !! or http://www.gnu.org/copyleft/gpl.txt .
16 : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
17 : !!
18 : !! SOURCE
19 :
20 : #if defined HAVE_CONFIG_H
21 : #include "config.h"
22 : #endif
23 :
24 : #include "abi_common.h"
25 :
26 : module m_effpot_mpi
27 :
28 : use defs_basis
29 : use m_xmpi
30 : use m_errors
31 : use m_abicore
32 : use m_supercell,only: getPBCIndexes_supercell
33 :
34 : implicit none
35 :
36 : public :: effpot_mpi_init
37 : public :: effpot_mpi_free
38 : !!***
39 :
40 : !!****t* m_effpot_mpi/effpot_mpi_type
41 : !! NAME
42 : !! effective_potential_type
43 : !!
44 : !! FUNCTION
45 : !! datatype to set the parallelisation
46 : !!
47 : !! SOURCE
48 :
49 : type, public :: effpot_mpi_type
50 :
51 : ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
52 : ! This is for the parallelisation over the supercell
53 : integer :: comm
54 : ! local Communicator over all processors treating the same cell
55 :
56 : integer :: my_rank
57 : ! local Communicator over all processors treating the same cell
58 :
59 : integer my_ncell
60 : ! Number of cell treat by current proc
61 :
62 : integer my_nrpt
63 : ! Number of rpt/coefficient treat by current proc
64 :
65 : integer,allocatable :: my_cells(:)
66 : ! my_cells(my_ncell)
67 : ! Number of each cells in the supercell treat by this CPU
68 :
69 : integer,allocatable :: my_index_cells(:,:)
70 : ! my_cells(4,my_ncell)
71 : ! 1-3 are the indexes of the cells in the supercell treat by this CPU
72 : ! dimension 4 is the index of the first atom in the cell
73 :
74 : integer,allocatable :: my_rpt(:)
75 : ! my_rpt(my_nrpt)
76 : ! List of rpt treat by this CPU
77 :
78 : integer,allocatable :: my_atmrpt_index(:,:)
79 : ! my_cells(my_nrpt,my_ncell)
80 : ! For each cell in the supercell and each rpt, give the index of the first atoms in the rpt cell
81 : ! Take into acount the PBC.
82 :
83 : end type effpot_mpi_type
84 : !!***
85 :
86 : CONTAINS !===========================================================================================
87 :
88 : !****f* m_effective_potential/effpot_mpi_init
89 : !!
90 : !! NAME
91 : !! effpot_mpi_init
92 : !!
93 : !! FUNCTION
94 : !! deallocate all dynamic memory for mpi of supercell
95 : !!
96 : !! INPUTS
97 : !! index_rpt(3,nrpt) = indexes of the rpt for the ifc
98 : !! sc_size(3) = size of the supercell, 3 3 3 for example
99 : !! natom = natom in the unit cell
100 : !! ndiv = number of division to consider. For example if ndiv==2,
101 : !! the mpi will be set over the 2 lvl of parallelisation,
102 : !! cell and nrpt by considering nrpt / 2 for each CPU
103 : !! (still experimental, only ndiv=1 available)
104 : !! nrpt = number of cell to be parallelised for the IFC
105 : !! comm = MPI communicator
106 : !!
107 : !! OUTPUT
108 : !! effpot_mpi<type(effpot_mpi_type)()> = effpot_mpi datatype
109 : !! SOURCE
110 :
111 442 : subroutine effpot_mpi_init(index_rpt,sc_size,effpot_mpi,natom,ndiv,nrpt,comm)
112 :
113 : !Arguments ------------------------------------
114 : !scalars
115 : integer,intent(in) :: comm,natom,ndiv,nrpt
116 : !array
117 : type(effpot_mpi_type), intent(inout) :: effpot_mpi
118 : integer,intent(in) :: sc_size(3),index_rpt(3,nrpt)
119 :
120 : !Local variables-------------------------------
121 : !scalars
122 : integer :: i1,i2,i3,icell,ii,irpt,irpt_tmp
123 : integer :: my_rank,ncell_alone,ncell,nproc
124 : integer :: npcell,nprpt,virt_rank
125 : integer :: master = 0
126 : logical :: iam_master
127 : character(len=500) :: msg
128 : !array
129 : integer :: cell_atom2(3)
130 442 : integer,allocatable :: rpt_list(:)
131 :
132 : ! ***********************************************************************
133 :
134 : !Set the number of cell in the supercell
135 1768 : ncell = product(sc_size(:))
136 :
137 :
138 1768 : if (any(sc_size <= 0).or.ncell<=0) then
139 0 : write(msg,'(a,a)')' No supercell found for setting'
140 0 : ABI_ERROR(msg)
141 : end if
142 :
143 : !MPI variables
144 442 : nproc = xmpi_comm_size(comm); my_rank = xmpi_comm_rank(comm)
145 : iam_master = .false.
146 442 : iam_master = (my_rank == master)
147 :
148 :
149 : !Set the number of cpu for each level
150 442 : npcell = ncell / nproc * ndiv
151 442 : nprpt = nrpt / ndiv
152 :
153 : !Do some checks
154 : if(mod(nrpt,npcell) /= 0.or.mod(ncell,npcell) /=0)then
155 : ! write(msg,'(2a,2I0)')' Chose another number of CPU ',ncell,nrpt
156 : ! ABI_ERROR(msg)
157 : end if
158 :
159 442 : call effpot_mpi_free(effpot_mpi)
160 :
161 442 : effpot_mpi%comm = comm
162 442 : effpot_mpi%my_rank = my_rank
163 :
164 : !Determine the number of cell for each CPU
165 442 : ncell_alone = mod(ncell,nproc)
166 :
167 : !TREAT CELL
168 442 : effpot_mpi%my_ncell = int(aint(real(ncell,sp)/(nproc)))
169 :
170 442 : if(my_rank >= (nproc-ncell_alone)) then
171 40 : effpot_mpi%my_ncell = effpot_mpi%my_ncell + 1
172 : end if
173 :
174 442 : if(ndiv>1) effpot_mpi%my_ncell = npcell
175 :
176 : !Allocation of array
177 1326 : ABI_MALLOC(effpot_mpi%my_cells,(effpot_mpi%my_ncell))
178 1326 : ABI_MALLOC(effpot_mpi%my_index_cells,(4,effpot_mpi%my_ncell))
179 3854 : effpot_mpi%my_cells = 0
180 17502 : effpot_mpi%my_index_cells = 0
181 :
182 442 : virt_rank = int(aint(real(my_rank,sp)/(ndiv)))
183 :
184 3854 : do icell=1,effpot_mpi%my_ncell
185 3854 : if(virt_rank >= (nproc-ncell_alone))then
186 : effpot_mpi%my_cells(icell)=(int(aint(real(ncell,sp)/nproc)))*(virt_rank)+&
187 164 : & (virt_rank - (nproc-ncell_alone)) + icell
188 : else
189 3248 : effpot_mpi%my_cells(icell)=(effpot_mpi%my_ncell)*(virt_rank) + icell
190 : end if
191 : end do
192 :
193 442 : icell = 0
194 442 : ii = 0
195 1346 : do i1 = 1,sc_size(1)
196 3558 : do i2 = 1,sc_size(2)
197 7776 : do i3 = 1,sc_size(3)
198 4660 : ii = ii +1
199 124672 : if(any(effpot_mpi%my_cells==ii))then
200 3412 : icell=icell+1
201 3412 : effpot_mpi%my_index_cells(1,icell) = i1
202 3412 : effpot_mpi%my_index_cells(2,icell) = i2
203 3412 : effpot_mpi%my_index_cells(3,icell) = i3
204 3412 : effpot_mpi%my_index_cells(4,icell) = (effpot_mpi%my_cells(icell)-1)*natom
205 : end if
206 : end do
207 : end do
208 : end do
209 :
210 : !TREAT RPT Not yet parallelised
211 1326 : ABI_MALLOC(rpt_list,(nproc))
212 :
213 1002 : irpt = 1
214 :
215 1002 : do while (irpt < nproc)
216 1120 : do ii=1,ndiv
217 1120 : rpt_list(irpt+ii-1) = ii-1
218 : end do
219 560 : irpt = irpt + ndiv
220 : end do
221 :
222 442 : virt_rank = rpt_list(my_rank+1)
223 :
224 442 : effpot_mpi%my_nrpt = nprpt
225 1326 : ABI_MALLOC(effpot_mpi%my_rpt,(effpot_mpi%my_nrpt))
226 1768 : ABI_MALLOC(effpot_mpi%my_atmrpt_index,(effpot_mpi%my_nrpt,effpot_mpi%my_ncell))
227 39212 : effpot_mpi%my_rpt = 0
228 653582 : effpot_mpi%my_atmrpt_index = 0
229 :
230 :
231 39212 : do irpt=1,effpot_mpi%my_nrpt
232 : !AM_EXPERIMENTAL
233 : ! if(virt_rank >= (nproc-ncell_alone))then
234 : ! effpot_mpi%my_rpt(irpt)=(aint(real(nrpt,sp)/nproc))*(virt_rank)+&
235 : !& (virt_rank - (nproc-ncell_alone)) + irpt
236 : ! else
237 : ! effpot_mpi%my_rpt(irpt)=(effpot_mpi%my_nrpt)*(virt_rank) + irpt
238 : ! end if
239 39212 : effpot_mpi%my_rpt(irpt)= irpt
240 : !AM_EXPERIMENTAL
241 : end do
242 :
243 3854 : do icell = 1,effpot_mpi%my_ncell
244 3412 : i1=effpot_mpi%my_index_cells(1,icell)
245 3412 : i2=effpot_mpi%my_index_cells(2,icell)
246 3412 : i3=effpot_mpi%my_index_cells(3,icell)
247 653582 : do irpt_tmp = 1,effpot_mpi%my_nrpt
248 649728 : irpt = effpot_mpi%my_rpt(irpt_tmp)
249 : ! do irpt = 1,eff_pot%harmonics_terms%ifcs%nrpt
250 : ! get the cell of atom2 (0 0 0, 0 0 1...)
251 649728 : cell_atom2(1) = i1 + index_rpt(1,irpt)
252 649728 : cell_atom2(2) = i2 + index_rpt(2,irpt)
253 649728 : cell_atom2(3) = i3 + index_rpt(3,irpt)
254 649728 : call getPBCIndexes_supercell(cell_atom2(1:3),sc_size(1:3))
255 : ! index of the second atom in the displacement array
256 : effpot_mpi%my_atmrpt_index(irpt_tmp,icell) = &
257 : & ((cell_atom2(1)-1)*sc_size(2)*sc_size(3))*natom+&
258 : & ((cell_atom2(2)-1)*sc_size(3))*natom+&
259 653140 : & ((cell_atom2(3)-1))*natom
260 : end do
261 : end do
262 :
263 :
264 442 : ABI_FREE(rpt_list)
265 :
266 442 : end subroutine effpot_mpi_init
267 : !!***
268 :
269 : !****f* m_effective_potential/effpot_mpi_free
270 : !!
271 : !! NAME
272 : !! effpot_mpi_free
273 : !!
274 : !! FUNCTION
275 : !! deallocate all dynamic memory for mpi
276 : !!
277 : !! INPUTS
278 : !! effpot_mpi<type(effpot_mpi_type)()> = effpot_mpi datatype
279 : !!
280 : !! OUTPUT
281 : !!
282 : !! SOURCE
283 :
284 1952 : subroutine effpot_mpi_free(effpot_mpi)
285 :
286 : !Arguments ------------------------------------
287 : !scalars
288 : !array
289 : type(effpot_mpi_type), intent(inout) :: effpot_mpi
290 :
291 : !Local variables-------------------------------
292 : !scalars
293 : !array
294 :
295 : ! *************************************************************************
296 :
297 1952 : effpot_mpi%my_ncell = 0
298 1952 : effpot_mpi%my_nrpt = 0
299 :
300 1952 : if (allocated(effpot_mpi%my_cells)) then
301 3854 : effpot_mpi%my_cells(:) = 0
302 442 : ABI_FREE(effpot_mpi%my_cells)
303 : end if
304 :
305 1952 : if (allocated(effpot_mpi%my_index_cells)) then
306 17502 : effpot_mpi%my_index_cells(:,:) = 0
307 442 : ABI_FREE(effpot_mpi%my_index_cells)
308 : end if
309 :
310 1952 : if (allocated(effpot_mpi%my_atmrpt_index)) then
311 653582 : effpot_mpi%my_atmrpt_index(:,:) = 0
312 442 : ABI_FREE(effpot_mpi%my_atmrpt_index)
313 : end if
314 :
315 1952 : if (allocated(effpot_mpi%my_rpt)) then
316 39212 : effpot_mpi%my_rpt(:) = 0
317 442 : ABI_FREE(effpot_mpi%my_rpt)
318 : end if
319 :
320 1952 : end subroutine effpot_mpi_free
321 : !!***
322 :
323 0 : end module m_effpot_mpi
324 : !!***
|
