Context Navigation

source: codes/icosagcm/trunk/src/parallel/domain.f90 @ 881

Last change on this file since 881 was 881, checked in by ymipsl, 5 years ago

Implement small cell balancing for ownership. Call to physic will be done with an aqul number of cells.

YM

File size: 20.2 KB

Line
1	MODULE domain_mod
2	USE domain_param
3
4	TYPE t_domain
5	INTEGER :: face
6	INTEGER :: iim
7	INTEGER :: jjm
8	INTEGER :: ii_begin
9	INTEGER :: jj_begin
10	INTEGER :: ii_end
11	INTEGER :: jj_end
12	INTEGER :: ii_nb
13	INTEGER :: jj_nb
14	INTEGER :: ii_begin_glo
15	INTEGER :: jj_begin_glo
16	INTEGER :: ii_end_glo
17	INTEGER :: jj_end_glo
18	INTEGER,POINTER :: assign_domain(:,:)
19	INTEGER,POINTER :: assign_cell_glo(:,:)
20	INTEGER,POINTER :: assign_i(:,:)
21	INTEGER,POINTER :: assign_j(:,:)
22	INTEGER,POINTER :: edge_assign_domain(:,:,:)
23	INTEGER,POINTER :: edge_assign_i(:,:,:)
24	INTEGER,POINTER :: edge_assign_j(:,:,:)
25	INTEGER,POINTER :: edge_assign_pos(:,:,:)
26	INTEGER,POINTER :: edge_assign_sign(:,:,:)
27	INTEGER,POINTER :: vertex_assign_domain(:,:,:)
28	INTEGER,POINTER :: vertex_assign_i(:,:,:)
29	INTEGER,POINTER :: vertex_assign_j(:,:,:)
30	INTEGER,POINTER :: vertex_assign_pos(:,:,:)
31	REAL,POINTER :: xyz(:,:,:)
32	REAL,POINTER :: neighbour(:,:,:,:)
33	INTEGER,POINTER :: delta(:,:)
34	REAL,POINTER :: vertex(:,:,:,:)
35	LOGICAL,POINTER :: own(:,:)
36	INTEGER,POINTER :: ne(:,:,:)
37
38	INTEGER :: t_right
39	INTEGER :: t_rup
40	INTEGER :: t_lup
41	INTEGER :: t_left
42	INTEGER :: t_ldown
43	INTEGER :: t_rdown
44
45	INTEGER :: u_right
46	INTEGER :: u_rup
47	INTEGER :: u_lup
48	INTEGER :: u_left
49	INTEGER :: u_ldown
50	INTEGER :: u_rdown
51
52	INTEGER :: z_rup
53	INTEGER :: z_up
54	INTEGER :: z_lup
55	INTEGER :: z_ldown
56	INTEGER :: z_down
57	INTEGER :: z_rdown
58
59	INTEGER :: t_pos(6)
60	INTEGER :: u_pos(6)
61	INTEGER :: z_pos(6)
62
63	END TYPE t_domain
64
65	INTEGER,SAVE :: ndomain
66	INTEGER,SAVE :: ndomain_glo
67
68	TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain(:)
69	TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain_glo(:)
70
71	INTEGER,ALLOCATABLE,SAVE :: domglo_rank(:) ! size : ndomain_glo : mpi rank assigned to a domain
72	INTEGER,ALLOCATABLE,SAVE :: domglo_loc_ind(:) ! size : ndomain_glo : corresponding local indice for a global domain indice
73	INTEGER,ALLOCATABLE,SAVE :: domloc_glo_ind(:) ! size : ndomain : corresponding global indice for a local domain indice
74
75	LOGICAL, ALLOCATABLE, SAVE :: assigned_domain(:) ! size : ndomain : is an omp task is assigned to this domain
76	!$OMP THREADPRIVATE(assigned_domain)
77
78	CONTAINS
79
80	SUBROUTINE create_domain
81	USE grid_param
82	USE mpipara
83	USE ioipsl
84	IMPLICIT NONE
85	INTEGER :: ind,nf,ni,nj,i,j
86	INTEGER :: quotient, rest
87	INTEGER :: halo_i,halo_j
88
89	TYPE(t_domain),POINTER :: d
90
91	ndomain_glo=nsplit_insplit_jnb_face
92	ALLOCATE(domain_glo(ndomain_glo))
93	ALLOCATE(domglo_rank(ndomain_glo))
94	ALLOCATE(domglo_loc_ind(ndomain_glo))
95
96	halo_i=0
97	CALL getin("halo_i",halo_i)
98	halo_j=1
99	CALL getin("halo_j",halo_j)
100
101	ind=0
102	DO nf=1,nb_face
103	DO nj=1,nsplit_j
104	DO ni=1,nsplit_i
105	ind=ind+1
106	d=>domain_glo(ind)
107	quotient=(iim_glo/nsplit_i)
108	rest=MOD(iim_glo,nsplit_i)
109	IF (ni-1 < rest) THEN
110	d%ii_nb=quotient+1
111	d%ii_begin_glo=(quotient+1)*(ni-1)+1
112	ELSE
113	d%ii_nb=quotient
114	d%ii_begin_glo=(quotient+1)rest+(ni-1-rest) quotient+1
115	ENDIF
116	d%ii_end_glo=d%ii_begin_glo+d%ii_nb-1
117
118	IF (ni/=1) THEN
119	d%ii_nb=d%ii_nb+1
120	d%ii_begin_glo=d%ii_begin_glo-1
121	ENDIF
122
123
124	quotient=(jjm_glo/nsplit_j)
125	rest=MOD(jjm_glo,nsplit_j)
126	IF (nj-1 < rest) THEN
127	d%jj_nb=quotient+1
128	d%jj_begin_glo=(quotient+1)*(nj-1)+1
129	ELSE
130	d%jj_nb=quotient
131	d%jj_begin_glo=(quotient+1)rest+(nj-1-rest) quotient+1
132	ENDIF
133	d%jj_end_glo=d%jj_begin_glo+d%jj_nb-1
134
135	IF (nj/=1) THEN
136	d%jj_nb=d%jj_nb+1
137	d%jj_begin_glo=d%jj_begin_glo-1
138	ENDIF
139
140
141	d%iim=d%ii_nb+2halo + halo_i2
142	d%jjm=d%jj_nb+2halo + halo_j2
143	d%ii_begin=halo+1 + halo_i
144	d%jj_begin=halo+1 + halo_j
145	d%ii_end=d%ii_begin+d%ii_nb-1
146	d%jj_end=d%jj_begin+d%jj_nb-1
147	d%face=nf
148	ALLOCATE(d%assign_domain(d%iim,d%jjm))
149	ALLOCATE(d%assign_cell_glo(d%iim,d%jjm))
150	ALLOCATE(d%assign_i(d%iim,d%jjm))
151	ALLOCATE(d%assign_j(d%iim,d%jjm))
152	ALLOCATE(d%edge_assign_domain(0:5,d%iim,d%jjm))
153	ALLOCATE(d%edge_assign_i(0:5,d%iim,d%jjm))
154	ALLOCATE(d%edge_assign_j(0:5,d%iim,d%jjm))
155	ALLOCATE(d%edge_assign_pos(0:5,d%iim,d%jjm))
156	ALLOCATE(d%edge_assign_sign(0:5,d%iim,d%jjm))
157	ALLOCATE(d%vertex_assign_domain(0:5,d%iim,d%jjm))
158	ALLOCATE(d%vertex_assign_i(0:5,d%iim,d%jjm))
159	ALLOCATE(d%vertex_assign_j(0:5,d%iim,d%jjm))
160	ALLOCATE(d%vertex_assign_pos(0:5,d%iim,d%jjm))
161	ALLOCATE(d%delta(d%iim,d%jjm))
162	ALLOCATE(d%xyz(3,d%iim,d%jjm))
163	ALLOCATE(d%vertex(3,0:5,d%iim,d%jjm))
164	ALLOCATE(d%neighbour(3,0:5,d%iim,d%jjm))
165	ALLOCATE(d%own(d%iim,d%jjm))
166	ALLOCATE(d%ne(0:5,d%iim,d%jjm))
167
168	IF (is_mpi_root) PRINT *,"Domain ",ind," : size ",d%ii_nb,"x",d%jj_nb
169
170	END DO
171	END DO
172	END DO
173
174	END SUBROUTINE create_domain
175
176	SUBROUTINE copy_domain(d1,d2)
177	IMPLICIT NONE
178	INTEGER :: face
179	TYPE(t_domain),TARGET,INTENT(IN) :: d1
180	TYPE(t_domain), INTENT(OUT) :: d2
181
182	d2%iim = d1%iim
183	d2%jjm = d1%jjm
184	d2%ii_begin = d1%ii_begin
185	d2%jj_begin = d1%jj_begin
186	d2%ii_end = d1%ii_end
187	d2%jj_end = d1%jj_end
188	d2%ii_nb = d1%ii_nb
189	d2%jj_nb = d1%jj_nb
190	d2%ii_begin_glo = d1%ii_begin_glo
191	d2%jj_begin_glo = d1%jj_begin_glo
192	d2%ii_end_glo = d1%ii_end_glo
193	d2%jj_end_glo = d1%jj_end_glo
194	d2%assign_domain => d1%assign_domain
195	d2%assign_cell_glo => d1%assign_cell_glo
196	d2%assign_i => d1%assign_i
197	d2%assign_j => d1%assign_j
198	d2%edge_assign_domain => d1%edge_assign_domain
199	d2%edge_assign_i => d1%edge_assign_i
200	d2%edge_assign_j => d1%edge_assign_j
201	d2%edge_assign_pos => d1%edge_assign_pos
202	d2%edge_assign_sign => d1%edge_assign_sign
203	d2%vertex_assign_domain => d1%vertex_assign_domain
204	d2%vertex_assign_i => d1%vertex_assign_i
205	d2%vertex_assign_j => d1%vertex_assign_j
206	d2%vertex_assign_pos => d1%vertex_assign_pos
207	d2%xyz => d1%xyz
208	d2%neighbour => d1%neighbour
209	d2%delta => d1%delta
210	d2%vertex => d1%vertex
211	d2%own => d1%own
212	d2%ne => d1%ne
213
214	d2%t_right = d1%t_right
215	d2%t_rup = d1%t_rup
216	d2%t_lup = d1%t_lup
217	d2%t_left = d1%t_left
218	d2%t_ldown = d1%t_ldown
219	d2%t_rdown = d1%t_rdown
220
221	d2%u_right = d1%u_right
222	d2%u_rup = d1%u_rup
223	d2%u_lup = d1%u_lup
224	d2%u_left = d1%u_left
225	d2%u_ldown = d1%u_ldown
226	d2%u_rdown = d1%u_rdown
227
228	d2%z_rup = d1%z_rup
229	d2%z_up = d1%z_up
230	d2%z_lup = d1%z_lup
231	d2%z_ldown = d1%z_ldown
232	d2%z_down = d1%z_down
233	d2%z_rdown = d1%z_rdown
234
235	d2%t_pos = d1%t_pos
236	d2%u_pos = d1%u_pos
237	d2%z_pos = d1%z_pos
238
239	END SUBROUTINE copy_domain
240
241
242	SUBROUTINE assign_cell
243	USE metric
244	USE mpipara
245	USE ioipsl
246	IMPLICIT NONE
247	INTEGER :: ind_d,ind,ind2,e,v
248	INTEGER :: nf,nf2
249	INTEGER :: i,j,k,ii,jj
250	TYPE(t_domain),POINTER :: d
251	INTEGER :: delta
252	INTEGER :: nbp, nn, M
253	REAL :: rn
254	INTEGER, ALLOCATABLE :: nb_own(:)
255	INTEGER :: mean_own, side
256
257	ALLOCATE(nb_own(0:ndomain_glo))
258	nb_own(:)=0
259
260	DO ind_d=1,ndomain_glo
261	d=>domain_glo(ind_d)
262	nf=d%face
263	DO j=d%jj_begin,d%jj_end
264	DO i=d%ii_begin,d%ii_end
265	ii=d%ii_begin_glo-d%ii_begin+i
266	jj=d%jj_begin_glo-d%jj_begin+j
267	ind=vertex_glo(ii,jj,nf)%ind
268	cell_glo(ind)%assign_domain=0
269	ENDDO
270	ENDDO
271	ENDDO
272
273
274
275	nbp=0
276	DO ind_d=1,ndomain_glo
277	d=>domain_glo(ind_d)
278	nf=d%face
279	DO j=d%jj_begin,d%jj_end
280	DO i=d%ii_begin,d%ii_end
281	ii=d%ii_begin_glo-d%ii_begin+i
282	jj=d%jj_begin_glo-d%jj_begin+j
283	ind=vertex_glo(ii,jj,nf)%ind
284	delta=vertex_glo(ii,jj,nf)%delta
285	IF (cell_glo(ind)%assign_face==nf) THEN
286	nb_own(cell_glo(ind)%assign_domain)=nb_own(cell_glo(ind)%assign_domain)-1
287	nb_own(ind_d)=nb_own(ind_d)+1
288	cell_glo(ind)%assign_domain=ind_d
289	cell_glo(ind)%assign_i=i
290	cell_glo(ind)%assign_j=j
291	ENDIF
292
293	IF ( i+1 <= d%ii_end ) CALL assign_edge(ind_d,ind,i,j,delta,0)
294	IF ( j+1 <= d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,1)
295	IF ( i-1 >= d%ii_begin .AND. j+1<=d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,2)
296	IF ( i-1 >= d%ii_begin ) CALL assign_edge(ind_d,ind,i,j,delta,3)
297	IF ( j-1 >= d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,4)
298	IF ( i+1 <= d%ii_end .AND. j-1 >=d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,5)
299
300	IF ( i+1 <= d%ii_end .AND. j+1 <= d%jj_end) CALL assign_vertex(ind_d,ind,i,j,delta,0)
301	IF ( i-1 >= d%ii_begin .AND. j+1 <= d%jj_end) CALL assign_vertex(ind_d,ind,i,j,delta,1)
302	IF ( i-1 >= d%ii_begin .AND. j+1 <= d%jj_end) CALL assign_vertex(ind_d,ind,i,j,delta,2)
303	IF ( i-1 >= d%ii_begin .AND. j-1 >= d%jj_begin) CALL assign_vertex(ind_d,ind,i,j,delta,3)
304	IF ( i+1 <= d%ii_end .AND. j-1 >= d%jj_begin) CALL assign_vertex(ind_d,ind,i,j,delta,4)
305	IF ( i+1 <= d%ii_end .AND. j-1 >= d%jj_begin) CALL assign_vertex(ind_d,ind,i,j,delta,5)
306
307	IF (j==d%jj_begin .OR. j==d%jj_begin .OR. i==d%ii_begin .OR. i==d%ii_end) nbp=nbp+1
308
309	ENDDO
310	ENDDO
311	ENDDO
312
313
314	! dynamic load balancing for owned cells. Get ownership of a cell if local cells number < mean cell number
315	! use random shot on frontier
316
317	mean_own=sum(nb_own(1:ndomain_glo))/ndomain_glo
318	IF (is_mpi_master) PRINT*,"Before balance : Mean own ", sum(nb_own(1:ndomain_glo))/ndomain_glo, "Min own", minval(nb_own(1:ndomain_glo)), "Max own", maxval(nb_own(1:ndomain_glo))
319	! set random seed to get reproductibility when using a different number of process
320
321	CALL RANDOM_SEED(size=M)
322	CALL RANDOM_SEED(put=(/(i,i=1,M)/))
323
324	DO nn=1,1000*nbp
325
326	CALL random_number(rn)
327	ind_d = INT(ndomain_glo*rn)+1
328	IF (nb_own(ind_d) >= mean_own) CYCLE
329
330	d=>domain_glo(ind_d)
331	nf=d%face
332
333	CALL random_number(rn)
334	side=INT(4*rn)
335	IF (side==0) THEN
336	CALL random_number(rn)
337	i = INT((d%ii_end-d%ii_begin+1)*rn)+d%ii_begin
338	j = d%jj_begin
339	ELSE IF (side==1) THEN
340	CALL random_number(rn)
341	i = INT((d%ii_end-d%ii_begin+1)*rn)+d%ii_begin
342	j = d%jj_end
343	ELSE IF (side==2) THEN
344	CALL random_number(rn)
345	j = INT((d%jj_end-d%jj_begin+1)*rn)+d%jj_begin
346	i = d%ii_begin
347	ELSE IF (side==3) THEN
348	CALL random_number(rn)
349	j = INT((d%jj_end-d%jj_begin+1)*rn)+d%jj_begin
350	i = d%ii_end
351	ENDIF
352
353	ii=d%ii_begin_glo-d%ii_begin+i
354	jj=d%jj_begin_glo-d%jj_begin+j
355	ind=vertex_glo(ii,jj,nf)%ind
356	delta=vertex_glo(ii,jj,nf)%delta
357	IF (cell_glo(ind)%assign_face==nf) THEN
358	nb_own(cell_glo(ind)%assign_domain)=nb_own(cell_glo(ind)%assign_domain)-1
359	nb_own(ind_d)=nb_own(ind_d)+1
360	cell_glo(ind)%assign_domain=ind_d
361	cell_glo(ind)%assign_i=i
362	cell_glo(ind)%assign_j=j
363	ENDIF
364
365	ENDDO
366
367	IF (is_mpi_master) PRINT*,"After balance :Mean own ", sum(nb_own(1:ndomain_glo))/ndomain_glo, "Min own", minval(nb_own(1:ndomain_glo)), "Max own", maxval(nb_own(1:ndomain_glo))
368
369
370	DO ind_d=1,ndomain_glo
371	d=>domain_glo(ind_d)
372	nf=d%face
373	DO j=d%jj_begin-1,d%jj_end+1
374	DO i=d%ii_begin-1,d%ii_end+1
375	ii=d%ii_begin_glo-d%ii_begin+i
376	jj=d%jj_begin_glo-d%jj_begin+j
377	ind=vertex_glo(ii,jj,nf)%ind
378	d%assign_cell_glo(i,j) = ind
379	d%assign_domain(i,j)=cell_glo(ind)%assign_domain
380	d%assign_i(i,j)=cell_glo(ind)%assign_i
381	d%assign_j(i,j)=cell_glo(ind)%assign_j
382	delta=vertex_glo(ii,jj,nf)%delta
383	d%delta(i,j)=vertex_glo(ii,jj,nf)%delta
384	DO k=0,5
385	ind2=vertex_glo(ii,jj,nf)%neighbour(k)
386	d%neighbour(:,k,i,j)=cell_glo(ind2)%xyz(:)
387
388	d%ne(k,i,j)=1-2*MOD(k,2)
389
390	e=cell_glo(ind)%edge(MOD(k+delta+6,6))
391	d%edge_assign_domain(k,i,j)=edge_glo(e)%assign_domain
392	d%edge_assign_i(k,i,j)=edge_glo(e)%assign_i
393	d%edge_assign_j(k,i,j)=edge_glo(e)%assign_j
394	d%edge_assign_pos(k,i,j)=edge_glo(e)%assign_pos
395	nf2=domain_glo(edge_glo(e)%assign_domain)%face
396	d%edge_assign_sign(k,i,j)=1-2*MOD(12+tab_index(nf,nf2,0),2)
397	IF (MOD(6+k+tab_index(nf,nf2,0),6)/=edge_glo(e)%assign_pos .AND. MOD(6+k+tab_index(nf,nf2,0),6) &
398	/= MOD(edge_glo(e)%assign_pos+3,6)) THEN
399	d%edge_assign_sign(k,i,j)=-d%edge_assign_sign(k,i,j)
400	ENDIF
401
402	v=cell_glo(ind)%vertex(MOD(k+delta+6,6))
403	d%vertex_assign_domain(k,i,j)=vertices_glo(v)%assign_domain
404	d%vertex_assign_i(k,i,j)=vertices_glo(v)%assign_i
405	d%vertex_assign_j(k,i,j)=vertices_glo(v)%assign_j
406	d%vertex_assign_pos(k,i,j)=vertices_glo(v)%assign_pos
407
408	ENDDO
409	d%xyz(:,i,j)=cell_glo(ind)%xyz(:)
410	IF (d%assign_domain(i,j)==ind_d) THEN
411	d%own(i,j)=.TRUE.
412	ELSE
413	d%own(i,j)=.FALSE.
414	ENDIF
415	ENDDO
416	ENDDO
417	ENDDO
418
419	CONTAINS
420
421	SUBROUTINE assign_edge(ind_d,ind,i,j,delta,k)
422	INTEGER :: ind_d,ind,i,j,delta,k
423	INTEGER :: e
424	e=cell_glo(ind)%edge(MOD(k+delta+6,6))
425	edge_glo(e)%assign_domain=ind_d
426	edge_glo(e)%assign_i=i
427	edge_glo(e)%assign_j=j
428	edge_glo(e)%assign_pos=k
429	edge_glo(e)%assign_delta=delta
430
431	END SUBROUTINE assign_edge
432
433	SUBROUTINE assign_vertex(ind_d,ind,i,j,delta,k)
434	INTEGER :: ind_d,ind,i,j,delta,k
435	INTEGER :: e
436
437	e=cell_glo(ind)%vertex(MOD(k+delta+6,6))
438	vertices_glo(e)%assign_domain=ind_d
439	vertices_glo(e)%assign_i=i
440	vertices_glo(e)%assign_j=j
441	vertices_glo(e)%assign_pos=k
442	vertices_glo(e)%assign_delta=delta
443
444	END SUBROUTINE assign_vertex
445
446	END SUBROUTINE assign_cell
447
448	SUBROUTINE compute_boundary
449	USE spherical_geom_mod
450	IMPLICIT NONE
451	INTEGER :: ind_d
452	INTEGER :: i,j,k
453	TYPE(t_domain),POINTER :: d
454	REAL(rstd) :: ng1(3),ng2(3)
455
456	DO ind_d=1,ndomain_glo
457	d=>domain_glo(ind_d)
458	DO j=d%jj_begin-1,d%jj_end+1
459	DO i=d%ii_begin-1,d%ii_end+1
460	DO k=0,5
461	ng1=d%neighbour(:,MOD(k,6),i,j)
462	ng2=d%neighbour(:,MOD(k+1,6),i,j)
463	IF (sqrt(sum((ng1-ng2)**2))<1e-16) ng2=d%neighbour(:,MOD(k+2,6),i,j)
464	CALL circumcenter(d%xyz(:,i,j),ng1,ng2,d%vertex(:,k,i,j))
465	ENDDO
466	ENDDO
467	ENDDO
468	ENDDO
469	END SUBROUTINE compute_boundary
470
471	SUBROUTINE set_neighbour_indice
472	USE metric
473	IMPLICIT NONE
474	INTEGER :: ind_d
475	TYPE(t_domain),POINTER :: d
476
477	DO ind_d=1,ndomain_glo
478	d=>domain_glo(ind_d)
479	d%t_right=1
480	d%t_left=-1
481	d%t_rup=d%iim
482	d%t_lup=d%iim-1
483	d%t_ldown=-d%iim
484	d%t_rdown=-d%iim+1
485
486	d%u_right=0
487	d%u_lup=d%iim*d%jjm
488	d%u_ldown=2d%iimd%jjm
489
490	d%u_rup=d%t_rup+d%u_ldown
491	d%u_left=d%t_left+d%u_right
492	d%u_rdown=d%t_rdown+d%u_lup
493
494	d%z_up=0
495	d%z_down=d%iim*d%jjm
496	d%z_rup=d%t_rup+d%z_down
497	d%z_lup=d%t_lup+d%z_down
498	d%z_ldown=d%t_ldown+d%z_up
499	d%z_rdown=d%t_rdown+d%z_up
500
501	d%t_pos(right)=d%t_right
502	d%t_pos(rup)=d%t_rup
503	d%t_pos(lup)=d%t_lup
504	d%t_pos(left)=d%t_left
505	d%t_pos(ldown)=d%t_ldown
506	d%t_pos(rdown)=d%t_rdown
507
508	d%u_pos(right)=d%u_right
509	d%u_pos(rup)=d%u_rup
510	d%u_pos(lup)=d%u_lup
511	d%u_pos(left)=d%u_left
512	d%u_pos(ldown)=d%u_ldown
513	d%u_pos(rdown)=d%u_rdown
514
515	d%z_pos(vrup)=d%z_rup
516	d%z_pos(vup)=d%z_up
517	d%z_pos(vlup)=d%z_lup
518	d%z_pos(vldown)=d%z_ldown
519	d%z_pos(vdown)=d%z_down
520	d%z_pos(vrdown)=d%z_rdown
521
522	ENDDO
523
524	END SUBROUTINE set_neighbour_indice
525
526	SUBROUTINE assign_domain
527	USE mpipara
528	USE grid_param
529	IMPLICIT NONE
530	INTEGER :: nb_domain(0:mpi_size-1)
531	INTEGER :: rank, ind,ind_glo
532	INTEGER :: block_j,jb,i,j,nd_glo,n,nf
533	LOGICAL :: exit
534
535	DO rank=0,mpi_size-1
536	nb_domain(rank)=ndomain_glo/mpi_size
537	IF ( rank < MOD(ndomain_glo,mpi_size) ) nb_domain(rank)=nb_domain(rank)+1
538	ENDDO
539
540	ndomain=nb_domain(mpi_rank)
541	ALLOCATE(domain(ndomain))
542	ALLOCATE(domloc_glo_ind(ndomain))
543
544
545	block_j=sqrt(nsplit_insplit_jnb_face*1./mpi_size)
546	exit=.FALSE.
547	jb=1
548	i=1
549	j=1
550	ind=1
551	nd_glo=0
552	rank=0
553	DO WHILE (.NOT. exit)
554
555	IF (j==MIN(jb+block_j,nsplit_j*nb_face+1)) THEN
556	j=jb
557	i=i+1
558	ENDIF
559
560	IF (i>nsplit_i) THEN
561	i=1
562	jb=jb+block_j
563	j=jb
564	ENDIF
565
566	IF (ind>nb_domain(rank)) THEN
567	rank=rank+1
568	ind=1
569	ENDIF
570	ind_glo=(j-1)*nsplit_i+i
571
572	nd_glo=nd_glo+1
573	IF (nd_glo==ndomain_glo) THEN
574
575	exit=.TRUE.
576	IF (.NOT. (rank==mpi_size-1 .AND. ind==nb_domain(rank) )) THEN
577	PRINT *, "Distribution problem in assign_domain"
578	STOP
579	ENDIF
580
581	ENDIF
582
583	domglo_rank(ind_glo)=rank
584	domglo_loc_ind(ind_glo)=ind
585	IF (rank==mpi_rank) THEN
586	CALL copy_domain(domain_glo(ind_glo),domain(ind))
587	domloc_glo_ind(ind)=ind_glo
588	ENDIF
589
590	j=j+1
591	ind=ind+1
592
593	ENDDO
594
595	IF (is_mpi_master) THEN
596
597	ind_glo=0
598	PRINT *,''
599	PRINT*, ' MPI PROCESS DISTRIBUTION'
600	PRINT *,''
601
602	WRITE(*,"(' ')", ADVANCE='NO')
603	DO n=1,nsplit_i*7-1
604	WRITE(*,"('=')", ADVANCE='NO')
605	ENDDO
606	PRINT *,''
607
608	DO nf=1,nb_face
609	DO j=1,nsplit_j
610	IF (j>1) THEN
611	WRITE(*,"(' ')", ADVANCE='NO')
612	DO n=1,nsplit_i*7-1
613	WRITE(*,"('-')", ADVANCE='NO')
614	ENDDO
615	PRINT *,''
616	ENDIF
617
618	WRITE(*,"('\|')", ADVANCE='NO')
619	DO i=1,nsplit_i
620	WRITE(*,"(' ',' ',' \|')",ADVANCE='NO')
621	ENDDO
622	PRINT *,''
623
624	WRITE(*,"('\|')", ADVANCE='NO')
625	DO i=1,nsplit_i
626	ind_glo=ind_glo+1
627	WRITE(*,"(' ',i4.4 ,' \|')",ADVANCE='NO'),domglo_rank(ind_glo)
628	END DO
629	PRINT *,''
630
631	WRITE(*,"('\|')", ADVANCE='NO')
632	DO i=1,nsplit_i
633	WRITE(*,"(' ',' ',' \|')",ADVANCE='NO')
634	ENDDO
635	PRINT *,''
636
637	ENDDO
638
639	WRITE(*,"(' ')", ADVANCE='NO')
640	DO n=1,nsplit_i*7-1
641	WRITE(*,"('=')", ADVANCE='NO')
642	ENDDO
643	PRINT *,''
644	ENDDO
645	ENDIF
646
647	! rank=0
648	! ind=0
649	! DO ind_glo=1,ndomain_glo
650	! ind=ind+1
651	! domglo_rank(ind_glo)=rank
652	! domglo_loc_ind(ind_glo)=ind
653	! IF (rank==mpi_rank) THEN
654	! CALL copy_domain(domain_glo(ind_glo),domain(ind))
655	! domloc_glo_ind(ind)=ind_glo
656	! ENDIF
657	!
658	! IF (ind==nb_domain(rank)) THEN
659	! rank=rank+1
660	! ind=0
661	! ENDIF
662	! ENDDO
663
664	!$OMP PARALLEL
665	CALL assign_domain_omp
666	!$OMP END PARALLEL
667
668
669	END SUBROUTINE assign_domain
670
671	SUBROUTINE assign_domain_omp
672	USE omp_para
673	USE mpipara
674	IMPLICIT NONE
675	INTEGER :: nb_domain
676	INTEGER :: rank, ind, i
677
678	ALLOCATE(assigned_domain(ndomain))
679
680	ind=0
681	DO rank=0,omp_domain_size-1
682	nb_domain=ndomain/omp_domain_size
683	IF ( rank < MOD(ndomain,omp_domain_size) ) nb_domain=nb_domain+1
684
685	DO i=1,nb_domain
686	ind=ind+1
687	IF (rank==omp_domain_rank) THEN
688	assigned_domain(ind)=.TRUE.
689	WRITE(*,'(A,I6.6,A,I4.4,A,I4.4,A,I8.8)') "Rank ",mpi_rank," task ",rank," local domain ",ind, &
690	" global domain ",domloc_glo_ind(ind)
691	ELSE
692	assigned_domain(ind)=.FALSE.
693	ENDIF
694	ENDDO
695
696	ENDDO
697
698	END SUBROUTINE assign_domain_omp
699
700
701
702	SUBROUTINE compute_domain
703	IMPLICIT NONE
704	CALL init_domain_param
705	CALL create_domain
706	CALL assign_cell
707	CALL compute_boundary
708	CALL set_neighbour_indice
709	CALL assign_domain
710
711	END SUBROUTINE compute_domain
712
713	END MODULE domain_mod
714

Note: See TracBrowser for help on using the repository browser.

Download in other formats: