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