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 : J. AMAYA (september 2007) !
33 | ! !
34 | ! ================================================================!
35 |
36 | USE mod_pmm
37 | USE mod_prissma
38 | USE mod_inout
39 |
40 | IMPLICIT NONE
41 |
42 | include 'pmm_constants.h'
43 |
44 | ! LOCAL
45 | DOM_INT :: base_step, step, reste, instep, i
46 | DOM_INT :: node_reste, node_step
47 | DOM_INT :: node_beg, node_end
48 | DOM_INT :: cell_reste, cell_step
49 | DOM_INT :: cell_beg, cell_end
50 | DOM_INT :: bf_reste, bf_step
51 | DOM_INT :: bfbeg, bfend
52 | DOM_INT :: idir_reste, idir_step
53 | DOM_INT :: idir_beg, idir_end
54 | DOM_INT :: iproc, addi, ierr, partitype
55 | DOM_INT, PARAMETER :: buffersize =17
56 | DOM_INT :: buffer(buffersize)
57 | DOM_REAL :: flostep, fdirbeg, fdirend, graystep, head
58 | DOM_REAL :: epsilon
59 |
60 | ! -----------------!
61 | ! Allocate vectors !
62 | ! -----------------!
63 |
64 | IF (ALLOCATED(cd)) DEALLOCATE(cd)
65 | IF (ALLOCATED(cf)) DEALLOCATE(cf)
66 | IF (ALLOCATED(dir_d)) DEALLOCATE(dir_d)
67 | IF (ALLOCATED(dir_f)) DEALLOCATE(dir_f)
68 |
69 | ALLOCATE(cd(pmm_n_p))
70 | ALLOCATE(cf(pmm_n_p))
71 | ALLOCATE(dir_d(pmm_n_p))
72 | ALLOCATE(dir_f(pmm_n_p))
73 |
74 | ! ----------------------!
75 | ! Calculate 'step' size !
76 | ! ----------------------!
77 |
78 | epsilon = 1e-5
79 |
80 | base_step = INT(nallbandes*ndir/pmm_n_p)
81 | reste = MOD(nallbandes*ndir,pmm_n_p)
82 |
83 | graystep = real(ndir)/real(pmm_n_p)
84 |
85 | fdirend = 0.
86 |
87 | partitype = 2
88 | IF (trim(mediumtype).eq.'SNB-CK') THEN
89 | IF (pmm_n_p.gt.ndir) partitype = 1
90 | ENDIF
91 |
92 | ! --------------------------------------------!
93 | ! Calculate domaine decomposition cell 'step' !
94 | ! --------------------------------------------!
95 |
96 | node_step = INT(i_dom_nnodes/pmm_n_p)
97 | node_reste = MOD(i_dom_nnodes,pmm_n_p)
98 | node_end = 0
99 |
100 | cell_step = INT(i_dom_ncells/pmm_n_p)
101 | cell_reste = MOD(i_dom_ncells,pmm_n_p)
102 | cell_end = 0
103 |
104 | bf_step = INT(i_dom_nbfaces/pmm_n_p)
105 | bf_reste = MOD(i_dom_nbfaces,pmm_n_p)
106 | bfend = 0
107 |
108 | idir_step = INT(ndir/pmm_n_p)
109 | idir_reste = MOD(ndir,pmm_n_p)
110 | idir_end = 0
111 |
112 | ! print*, " ++ MASTER > cell_step :", cell_step
113 | ! print*, " ++ MASTER > cell_reste:", cell_reste
114 |
115 | DO iproc=1,pmm_n_p
116 |
117 | ! ---------------------------------!
118 | ! Partitioning type 1 (for SNB-CK) !
119 | ! ---------------------------------!
120 |
121 | IF (partitype.eq.1) THEN
122 |
123 | ! ----------------------------!
124 | ! Capture bands for this proc !
125 | ! ----------------------------!
126 | IF (iproc.eq.1) THEN
127 | cd(iproc)=1
128 | ELSE
129 | cd(iproc) = cf(iproc-1)+1
130 | ENDIF
131 | IF (cd(iproc).gt.nallbandes) cd(iproc) = 1
132 |
133 | step = base_step
134 | IF (reste > 0) THEN
135 | step=step+1
136 | reste = reste-1
137 | ENDIF
138 | cf(iproc) = cd(iproc)+(step-1)
139 |
140 | DO WHILE(cf(iproc).gt.nallbandes)
141 | cf(iproc) = cf(iproc) - nallbandes
142 | ENDDO
143 |
144 | ! -----------------------!
145 | ! Capture the directions !
146 | ! -----------------------!
147 |
148 | fdirbeg = fdirend
149 | flostep = REAL(step)/REAL(nallbandes)
150 | fdirend = fdirbeg + flostep - epsilon
151 |
152 | addi = 0
153 | IF (fdirbeg.eq.INT(fdirbeg)) addi = 1
154 |
155 | dir_d(iproc) = CEILING(fdirbeg) + addi
156 | dir_f(iproc) = CEILING(fdirend)
157 |
158 | ! ---------------------------------------------------!
159 | ! Partitioning type for ALL cases (including SNB-CK) !
160 | ! ---------------------------------------------------!
161 |
162 | ELSE
163 |
164 | cd(iproc) = 1
165 | cf(iproc) = nallbandes
166 |
167 | IF (pmm_n_p.gt.ndir) THEN
168 |
169 | IF (iproc.eq.1) THEN
170 | WRITE(*,*) " WARNING: The number of processors is"
171 | WRITE(*,*) " bigger than the number of directions."
172 | WRITE(*,*) " In a gray gas case this mean that"
173 | WRITE(*,*) " some processors will remain unused!"
174 | ENDIF
175 |
176 | if (iproc.le.ndir) then
177 | dir_d(iproc) = iproc
178 | dir_f(iproc) = iproc
179 | else
180 | dir_d(iproc) = 0
181 | dir_f(iproc) = 0
182 | WRITE(*,*) " << WARNING: unused processor: ", iproc
183 | endif
184 |
185 | ! print*, " PART >> iproc, pmm_n_p: ", iproc, pmm_n_p
186 | ! print*, " PART >> dir_d, dir_f: ", dir_d, dir_f
187 |
188 | ELSE
189 |
190 | idir_beg = idir_end + 1
191 | idir_end = idir_beg + idir_step - 1
192 | IF (idir_reste.gt.0) THEN
193 | idir_end = idir_end + 1
194 | idir_reste = idir_reste - 1
195 | ENDIF
196 |
197 | dir_d(iproc) = idir_beg
198 | dir_f(iproc) = idir_end
199 |
200 | ENDIF
201 |
202 | ENDIF
203 |
204 | ! ---------------------!
205 | ! Domaine partitioning !
206 | ! ---------------------!
207 |
208 | node_beg = node_end + 1
209 | node_end = node_beg + node_step - 1
210 | IF (node_reste.gt.0) THEN
211 | node_end = node_end + 1
212 | node_reste = node_reste - 1
213 | ENDIF
214 |
215 | cell_beg = cell_end + 1
216 | cell_end = cell_beg + cell_step - 1
217 | IF (cell_reste.gt.0) THEN
218 | cell_end = cell_end + 1
219 | cell_reste = cell_reste - 1
220 | ENDIF
221 |
222 | ! ---------------------------!
223 | ! Boundary face partitioning !
224 | ! ---------------------------!
225 |
226 | bfbeg = bfend + 1
227 | bfend = bfbeg + bf_step - 1
228 | IF (bf_reste.gt.0) THEN
229 | bfend = bfend + 1
230 | bf_reste = bf_reste - 1
231 | ENDIF
232 |
233 | ! --------------------------------------------------------!
234 | ! Filling buffer with partitioning and global information !
235 | ! --------------------------------------------------------!
236 |
237 | buffer(1) = i_dom_nnodes
238 | buffer(2) = i_dom_ncells
239 | buffer(3) = cd(iproc)
240 | buffer(4) = cf(iproc)
241 | buffer(5) = dir_d(iproc)
242 | buffer(6) = dir_f(iproc)
243 | buffer(7) = i_dom_nfacesmax
244 | buffer(8) = n_gaz
245 | buffer(9) = nallbandes
246 | buffer(10)= node_beg
247 | buffer(11)= node_end
248 | buffer(12)= i_dom_nbfaces
249 | buffer(13)= bfbeg
250 | buffer(14)= bfend
251 | buffer(15)= cell_beg
252 | buffer(16)= cell_end
253 | buffer(17)= i_dom_nfaces
254 |
255 | print*, " Sending data to proc ", iproc,":",buffer
256 | CALL pmm_sendpartition(buffer,buffersize,iproc)
257 |
258 | ENDDO
259 |
260 | END SUBROUTINE partition
partition.F could be called by: