1 | include(dom.inc)
2 |
3 | SUBROUTINE partition
4 |
5 | ! ================================================================!
6 | ! !
7 | ! partition.F : Calculates de 'begin' and 'end' directions !
8 | ! and bands for each processor. Vactors will be !
9 | ! partitioned using this values. !
10 | ! !
11 | ! out : Vectors containing information on first/last !
12 | ! direction/band to treat for each processor. !
13 | ! !
14 | ! comments : When using GRAYCASE there is no band integration!
15 | ! so the partitioning is only made over the !
16 | ! directions. A 3rd kind of parallelism could be !
17 | ! done over the domain, leting each processor !
18 | ! calculate only part of the cells. !
19 | ! !
20 | ! nota : with this kind of partitioning if the number of !
21 | ! directions is < than the number of processors !
22 | ! for a gray case, there will be some UNUSED !
23 | ! processors!! !
24 | ! !
25 | ! nota 2 : epsilon = 1e-5 is needed beacause in some cases !
26 | ! it would be possible to have a sum equal to the !
27 | ! number of processors, but with a floating sum !
28 | ! slightly superior to this value (p.e. 24.00001) !
29 | ! To avoid errors an epsilon value is substracted !
30 | ! from the sum. !
31 | ! !
32 | ! author : D. Poitou (september 2011) !
33 | ! J. AMAYA (september 2007) !
34 | ! !
35 | ! ================================================================!
36 |
37 | USE mod_pmm
38 | USE mod_prissma
39 | USE mod_inout
40 |
41 | IMPLICIT NONE
42 |
43 | include 'pmm_constants.h'
44 |
45 | ! LOCAL
46 | DOM_INT :: ntasks, ipart, itask
47 | DOM_INT :: task_step, task_reste
48 | DOM_INT :: base_step, step, reste
49 | DOM_INT :: node_reste, node_step
50 | DOM_INT :: node_beg, node_end
51 | DOM_INT :: cell_reste, cell_step
52 | DOM_INT :: cell_beg, cell_end
53 | DOM_INT :: bf_reste, bf_step
54 | DOM_INT :: bfbeg, bfend
55 | DOM_INT :: idir_reste, idir_step, ndir_proc
56 | DOM_INT :: idir_beg, idir_end
57 | DOM_INT :: iproc, partitype, nspec
58 | DOM_INT, PARAMETER :: buffersize =28
59 | DOM_INT :: buffer(buffersize)
60 | DOM_REAL :: flostep, fdirbeg, fdirend
61 | DOM_REAL :: epsilon
62 |
63 | DOM_INT :: icell, iface, ibuffer, k, buffersize2
64 | DOM_INT, allocatable, dimension(:) :: buffer2
65 |
66 | PRINT*," >>> Partitionning in subdomains on "
67 | PRINT*," directions, frequencies, subsubdomains"
68 | PRINT*
69 |
70 | ! -----------------!
71 | ! Allocate vectors !
72 | ! -----------------!
73 |
74 | IF (ALLOCATED(cd)) DEALLOCATE(cd)
75 | IF (ALLOCATED(cf)) DEALLOCATE(cf)
76 | IF (ALLOCATED(dir_d)) DEALLOCATE(dir_d)
77 | IF (ALLOCATED(dir_f)) DEALLOCATE(dir_f)
78 |
79 | ALLOCATE(cd(pmm_n_p))
80 | ALLOCATE(cf(pmm_n_p))
81 | ALLOCATE(dir_d(pmm_n_p))
82 | ALLOCATE(dir_f(pmm_n_p))
83 |
84 | ALLOCATE(ip_proc1(i_dom_npart))
85 |
86 | ! -------------------------------------------------!
87 | ! Detect which processors will calculate each part !
88 | ! -------------------------------------------------!
89 |
90 | IF (i_dom_npart.gt.pmm_n_p) THEN
91 | WRITE(*,*) " ERROR: The number of subdomains is larger than"
92 | WRITE(*,*) " the number of allowed processors."
93 | STOP
94 | ENDIF
95 |
96 | task_step = INT (pmm_n_p / i_dom_npart)
97 | task_reste = MOD (pmm_n_p, i_dom_npart)
98 |
99 | iproc = 0
100 |
101 | DO ipart = 1, i_dom_npart
102 |
103 | ntasks = task_step
104 | IF (task_reste.gt.0) THEN
105 | ntasks = ntasks + 1
106 | task_reste = task_reste - 1
107 | ENDIF
108 |
109 | ! -------------------------------------!
110 | ! Calculate domain decomposition steps !
111 | ! -------------------------------------!
112 |
113 | node_step = INT(ip_nnodes(ipart)/ntasks)
114 | node_reste = MOD(ip_nnodes(ipart),ntasks)
115 | node_end = 0
116 |
117 | cell_step = INT(ip_len(ipart)/ntasks)
118 | cell_reste = MOD(ip_len(ipart),ntasks)
119 | cell_end = 0
120 |
121 | bf_step = INT(ip_nbfaces(ipart)/ntasks)
122 | bf_reste = MOD(ip_nbfaces(ipart),ntasks)
123 | bfend = 0
124 |
125 | ! ----------------------!
126 | ! Calculate 'step' size !
127 | ! ----------------------!
128 |
129 | idir_step = INT(ndir/ntasks)
130 | idir_reste = MOD(ndir,ntasks)
131 | idir_end = 0
132 |
133 | epsilon = 1e-5
134 |
135 | IF (trim(mediumtype).eq.'CK') THEN
136 | nspec = nallbandes
137 | ELSE
138 | nspec = nkabs
139 | ENDIF
140 |
141 | base_step = INT(nspec*ndir/ntasks)
142 | reste = MOD(nspec*ndir,ntasks)
143 |
144 | fdirend = 0.
145 |
146 | partitype = 2
147 | IF (ntasks.gt.ndir) partitype = 1
148 | !$ IF (i_dom_nthread.ge.ndir) THEN
149 | !$ partitype = 1
150 | !$ base_step = INT(nspec/ntasks)
151 | !$ reste = MOD(nspec,ntasks)
152 | !$ ENDIF
153 |
154 | DO itask = 1, ntasks
155 |
156 | IF (itask.eq.1) ip_proc1(ipart) = iproc
157 | iproc = iproc + 1
158 |
159 | ! --------------------------!
160 | ! Subsubdomain partitioning !
161 | ! --------------------------!
162 |
163 | node_beg = node_end + 1
164 | node_end = node_beg + node_step - 1
165 | IF (node_reste.gt.0) THEN
166 | node_end = node_end + 1
167 | node_reste = node_reste - 1
168 | ENDIF
169 |
170 | cell_beg = cell_end + 1
171 | cell_end = cell_beg + cell_step - 1
172 | IF (cell_reste.gt.0) THEN
173 | cell_end = cell_end + 1
174 | cell_reste = cell_reste - 1
175 | ENDIF
176 |
177 | ! ---------------------------!
178 | ! Boundary face partitioning !
179 | ! ---------------------------!
180 |
181 | bfbeg = bfend + 1
182 | bfend = bfbeg + bf_step - 1
183 | IF (bf_reste.gt.0) THEN
184 | bfend = bfend + 1
185 | bf_reste = bf_reste - 1
186 | ENDIF
187 |
188 | ! --------------------!
189 | ! Partitioning type 1 !
190 | ! --------------------!
191 |
192 | IF (partitype.eq.1) THEN
193 |
194 | ! ------------------------------!
195 | ! Capture bands for this domain !
196 | ! ------------------------------!
197 | IF (itask.eq.1) THEN
198 | cd(iproc) = 1
199 | dir_d(iproc) = 1
200 | ELSE
201 | cd(iproc) = cf(iproc-1)+1
202 | dir_d(iproc)= dir_f(iproc-1)
203 | IF(cd(iproc).eq.1) dir_d(iproc)= dir_f(iproc-1)+1
204 | ENDIF
205 | IF (cd(iproc).gt.nspec) THEN
206 | cd(iproc) = 1
207 | dir_d(iproc)= dir_f(iproc-1)+1
208 | ENDIF
209 |
210 | step = base_step
211 | IF (reste > 0) THEN
212 | step=step+1
213 | reste = reste-1
214 | ENDIF
215 | cf(iproc) = cd(iproc)+(step-1)
216 |
217 | DO WHILE(cf(iproc).gt.nspec)
218 | PRINT*, cf(iproc)
219 | cf(iproc) = cf(iproc) - nspec
220 | ENDDO
221 |
222 | ! -----------------------!
223 | ! Capture the directions !
224 | ! -----------------------!
225 |
226 | fdirbeg = fdirend
227 | flostep = REAL(step)/REAL(nspec)
228 | fdirend = fdirbeg + flostep - epsilon
229 |
230 | dir_f(iproc) = CEILING(fdirend)
231 |
232 | !$ IF (i_dom_nthread.ge.ndir) THEN
233 | !$ dir_d(iproc) = 1
234 | !$ dir_f(iproc) = ndir
235 | !$ ENDIF
236 |
237 | ! ------------------------------!
238 | ! Partitioning 2 (nproc < ndir) !
239 | ! ------------------------------!
240 |
241 | ELSE
242 |
243 | cd(iproc) = 1
244 | cf(iproc) = nspec
245 |
246 | idir_beg = idir_end + 1
247 | idir_end = idir_beg + idir_step - 1
248 | IF (idir_reste.gt.0) THEN
249 | idir_end = idir_end + 1
250 | idir_reste = idir_reste - 1
251 | ENDIF
252 |
253 | dir_d(iproc) = idir_beg
254 | dir_f(iproc) = idir_end
255 |
256 | ENDIF
257 |
258 | ! --------------------------------------------------------!
259 | ! Filling buffer with partitioning and global information !
260 | ! --------------------------------------------------------!
261 |
262 | buffer(1) = ip_nnodes(ipart)
263 | buffer(2) = ip_len(ipart)
264 | buffer(3) = cd(iproc)
265 | buffer(4) = cf(iproc)
266 | buffer(5) = ndir
267 | buffer(6) = dir_d(iproc)
268 | buffer(7) = dir_f(iproc)
269 | buffer(8) = i_dom_nfacesmax
270 | buffer(9) = n_gaz
271 | buffer(10) = nallbandes
272 | buffer(11)= node_beg
273 | buffer(12)= node_end
274 | buffer(13)= ip_nbfaces(ipart)
275 | buffer(14)= bfbeg
276 | buffer(15)= bfend
277 | buffer(16)= cell_beg
278 | buffer(17)= cell_end
279 | buffer(18)= ip_nfaces(ipart)
280 |
281 | print*, " + Partitionning on proc ", iproc,"in the domain",ipart,":"
282 | ! print*, buffer(8) , "nfacemax"
283 | ! print*, buffer(18), "Faces"
284 | print*, buffer(13), "Bfaces "!: ", buffer(14), "-->",buffer(15)
285 | ! print*, " ngas :", buffer(9)
286 |
287 | IF (trim(mediumtype).eq.'CK') THEN
288 | print*, buffer(2) , "Cells : ", buffer(16), "-->",buffer(17)
289 | print*, buffer(10), "Nbands : ", buffer(3) , "-->",buffer(4)
290 | print*, nkabs , "Nq pts"
291 | ELSE
292 | print*, buffer(1) , "Nodes : ", buffer(11), "-->",buffer(12)
293 | print*, nkabs , "Nq pts : ", buffer(3) , "-->",buffer(4)
294 | ENDIF
295 |
296 | print*, buffer(5) , "Ndirs : ", buffer(6) , "-->",buffer(7)
297 | !$ IF(i_dom_nthread.gt.1) THEN
298 | !$ ndir_proc = dir_f(iproc)-dir_d(iproc)+1
299 | !$ IF(i_dom_nthread.gt.ndir_proc) THEN
300 | !$ print*, " << Error:", i_dom_nthread ,"threads for ", ndir_proc, " directions on this processor."
301 | !$ STOP
302 | !$ ENDIF
303 | !$ print*," ++ Parallels threads: ", i_dom_nthread, "with", int(ndir_proc/i_dom_nthread),"directions"
304 | !$ ENDIF
305 | print*
306 |
307 | buffersize2 = &
308 | & 2*ip_len(ipart) + SUM(ip_cnodes(:, ipart)) + &
309 | & ip_nbfaces(ipart) + SUM(ip_bface_nnode(:,ipart)) + &
310 | & i_dom_ncells + i_dom_nnodes + 4*i_dom_nvfaces
311 |
312 |
313 | buffer(19) = buffersize2
314 | buffer(20) = i_dom_ncells
315 | buffer(21) = i_dom_nnodes
316 | buffer(22) = i_dom_nbfaces
317 | buffer(23) = i_dom_nvfaces
318 | buffer(24) = ip_nvfaces(ipart)
319 | buffer(25) = SUM(ip_nvfaces(1:ipart))-ip_nvfaces(ipart)
320 | buffer(26) = ipart
321 | buffer(27) = itask-1
322 | buffer(28) = ntasks
323 |
324 | CALL pmm_sendpartition(buffer,buffersize,iproc,1)
325 |
326 | ! --------------------------------------!
327 | ! Filling buffer with mesh partitioning !
328 | ! --------------------------------------!
329 |
330 | ALLOCATE(buffer2(buffersize2))
331 | ibuffer = 1
332 |
333 | DO icell = 1, ip_len(ipart)
334 |
335 | buffer2(ibuffer) = ip_partition(ip_beg(ipart)+icell-1)
336 | ibuffer = ibuffer + 1
337 |
338 | buffer2(ibuffer) = ip_cnodes(icell, ipart)
339 | ibuffer = ibuffer + 1
340 |
341 | DO k = 1, ip_cnodes(icell, ipart)
342 | buffer2(ibuffer) = ip_cnnode(k,icell,ipart)
343 | ibuffer = ibuffer + 1
344 | ENDDO
345 |
346 | ENDDO
347 |
348 | DO iface = 1, ip_nbfaces(ipart)
349 | buffer2(ibuffer) = ip_bface_nnode(iface,ipart)
350 | ibuffer = ibuffer + 1
351 | DO k=1, ip_bface_nnode(iface,ipart)
352 | buffer2(ibuffer) = ip_bface_nodes(k,iface,ipart)
353 | ibuffer = ibuffer + 1
354 | ENDDO
355 | ENDDO
356 |
357 |
358 | buffer2(ibuffer:ibuffer+i_dom_ncells-1) = ip_golo_cells(:,ipart)
359 | ibuffer = ibuffer + i_dom_ncells
360 |
361 | buffer2(ibuffer:ibuffer+i_dom_nnodes-1) = ip_golo_nodes(:,ipart)
362 | ibuffer = ibuffer + i_dom_nnodes
363 |
364 | DO iface=1, i_dom_nvfaces
365 | buffer2(ibuffer) = ip_golo_cells(i_vface(1,iface),ipart)
366 | ibuffer = ibuffer + 1
367 | ENDDO
368 |
369 | buffer2(ibuffer:ibuffer+i_dom_nvfaces-1) = i_vface(2,:)
370 | ibuffer = ibuffer + i_dom_nvfaces
371 |
372 | DO iface=1, i_dom_nvfaces
373 | buffer2(ibuffer) = ip_golo_cells(i_vface(3,iface),ipart)
374 | ibuffer = ibuffer + 1
375 | ENDDO
376 |
377 | buffer2(ibuffer:ibuffer+i_dom_nvfaces-1) = i_vface(4,:)
378 | ibuffer = ibuffer + i_dom_nvfaces
379 |
380 | ! PRINT*,"Test Buffer", ibuffer-1,"/",buffersize2
381 | CALL pmm_sendpartition(buffer2,buffersize2,iproc,2)
382 | DEALLOCATE(buffer2)
383 |
384 | ENDDO
385 | ENDDO
386 |
387 | DEALLOCATE(ip_partition)
388 | DEALLOCATE(ip_len)
389 | DEALLOCATE(ip_beg)
390 | DEALLOCATE(ip_nfaces)
391 | DEALLOCATE(ip_cnodes)
392 | DEALLOCATE(ip_cnnode)
393 |
394 | DEALLOCATE(ip_golo_cells)
395 | DEALLOCATE(ip_golo_nodes)
396 |
397 | DEALLOCATE(ip_bface_nodes)
398 | DEALLOCATE(ip_bface_nnode)
399 |
400 | END SUBROUTINE partition
partition.F could be called by: