Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

domain.f90

Last change on this file was 963, checked in by adurocher, 5 years ago
Merge 'mpi_rewrite' into trunk
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
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	TYPE(t_domain),TARGET,INTENT(IN) :: d1
179	TYPE(t_domain), INTENT(OUT) :: d2
180
181	d2%iim = d1%iim
182	d2%jjm = d1%jjm
183	d2%ii_begin = d1%ii_begin
184	d2%jj_begin = d1%jj_begin
185	d2%ii_end = d1%ii_end
186	d2%jj_end = d1%jj_end
187	d2%ii_nb = d1%ii_nb
188	d2%jj_nb = d1%jj_nb
189	d2%ii_begin_glo = d1%ii_begin_glo
190	d2%jj_begin_glo = d1%jj_begin_glo
191	d2%ii_end_glo = d1%ii_end_glo
192	d2%jj_end_glo = d1%jj_end_glo
193	d2%assign_domain => d1%assign_domain
194	d2%assign_cell_glo => d1%assign_cell_glo
195	d2%assign_i => d1%assign_i
196	d2%assign_j => d1%assign_j
197	d2%edge_assign_domain => d1%edge_assign_domain
198	d2%edge_assign_i => d1%edge_assign_i
199	d2%edge_assign_j => d1%edge_assign_j
200	d2%edge_assign_pos => d1%edge_assign_pos
201	d2%edge_assign_sign => d1%edge_assign_sign
202	d2%vertex_assign_domain => d1%vertex_assign_domain
203	d2%vertex_assign_i => d1%vertex_assign_i
204	d2%vertex_assign_j => d1%vertex_assign_j
205	d2%vertex_assign_pos => d1%vertex_assign_pos
206	d2%xyz => d1%xyz
207	d2%neighbour => d1%neighbour
208	d2%delta => d1%delta
209	d2%vertex => d1%vertex
210	d2%own => d1%own
211	d2%ne => d1%ne
212
213	d2%t_right = d1%t_right
214	d2%t_rup = d1%t_rup
215	d2%t_lup = d1%t_lup
216	d2%t_left = d1%t_left
217	d2%t_ldown = d1%t_ldown
218	d2%t_rdown = d1%t_rdown
219
220	d2%u_right = d1%u_right
221	d2%u_rup = d1%u_rup
222	d2%u_lup = d1%u_lup
223	d2%u_left = d1%u_left
224	d2%u_ldown = d1%u_ldown
225	d2%u_rdown = d1%u_rdown
226
227	d2%z_rup = d1%z_rup
228	d2%z_up = d1%z_up
229	d2%z_lup = d1%z_lup
230	d2%z_ldown = d1%z_ldown
231	d2%z_down = d1%z_down
232	d2%z_rdown = d1%z_rdown
233
234	d2%t_pos = d1%t_pos
235	d2%u_pos = d1%u_pos
236	d2%z_pos = d1%z_pos
237
238	END SUBROUTINE copy_domain
239
240
241	SUBROUTINE assign_cell
242	USE metric
243	USE mpipara
244	USE ioipsl
245	IMPLICIT NONE
246	INTEGER :: ind_d,ind,ind2,e,v
247	INTEGER :: nf,nf2
248	INTEGER :: i,j,k,ii,jj
249	TYPE(t_domain),POINTER :: d
250	INTEGER :: delta
251	INTEGER :: nbp, nn, M
252	REAL :: rn
253	INTEGER, ALLOCATABLE :: nb_own(:)
254	INTEGER :: mean_own, side
255
256	ALLOCATE(nb_own(0:ndomain_glo))
257	nb_own(:)=0
258
259	DO ind_d=1,ndomain_glo
260	d=>domain_glo(ind_d)
261	nf=d%face
262	DO j=d%jj_begin,d%jj_end
263	DO i=d%ii_begin,d%ii_end
264	ii=d%ii_begin_glo-d%ii_begin+i
265	jj=d%jj_begin_glo-d%jj_begin+j
266	ind=vertex_glo(ii,jj,nf)%ind
267	cell_glo(ind)%assign_domain=0
268	ENDDO
269	ENDDO
270	ENDDO
271
272
273
274	nbp=0
275	DO ind_d=1,ndomain_glo
276	d=>domain_glo(ind_d)
277	nf=d%face
278	DO j=d%jj_begin,d%jj_end
279	DO i=d%ii_begin,d%ii_end
280	ii=d%ii_begin_glo-d%ii_begin+i
281	jj=d%jj_begin_glo-d%jj_begin+j
282	ind=vertex_glo(ii,jj,nf)%ind
283	delta=vertex_glo(ii,jj,nf)%delta
284	IF (cell_glo(ind)%assign_face==nf) THEN
285	nb_own(cell_glo(ind)%assign_domain)=nb_own(cell_glo(ind)%assign_domain)-1
286	nb_own(ind_d)=nb_own(ind_d)+1
287	cell_glo(ind)%assign_domain=ind_d
288	cell_glo(ind)%assign_i=i
289	cell_glo(ind)%assign_j=j
290	ENDIF
291
292	IF ( i+1 <= d%ii_end ) CALL assign_edge(ind_d,ind,i,j,delta,0)
293	IF ( j+1 <= d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,1)
294	IF ( i-1 >= d%ii_begin .AND. j+1<=d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,2)
295	IF ( i-1 >= d%ii_begin ) CALL assign_edge(ind_d,ind,i,j,delta,3)
296	IF ( j-1 >= d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,4)
297	IF ( i+1 <= d%ii_end .AND. j-1 >=d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,5)
298
299	IF ( i+1 <= d%ii_end .AND. j+1 <= d%jj_end) CALL assign_vertex(ind_d,ind,i,j,delta,0)
300	IF ( i-1 >= d%ii_begin .AND. j+1 <= d%jj_end) CALL assign_vertex(ind_d,ind,i,j,delta,1)
301	IF ( i-1 >= d%ii_begin .AND. j+1 <= d%jj_end) CALL assign_vertex(ind_d,ind,i,j,delta,2)
302	IF ( i-1 >= d%ii_begin .AND. j-1 >= d%jj_begin) CALL assign_vertex(ind_d,ind,i,j,delta,3)
303	IF ( i+1 <= d%ii_end .AND. j-1 >= d%jj_begin) CALL assign_vertex(ind_d,ind,i,j,delta,4)
304	IF ( i+1 <= d%ii_end .AND. j-1 >= d%jj_begin) CALL assign_vertex(ind_d,ind,i,j,delta,5)
305
306	IF (j==d%jj_begin .OR. j==d%jj_begin .OR. i==d%ii_begin .OR. i==d%ii_end) nbp=nbp+1
307
308	ENDDO
309	ENDDO
310	ENDDO
311
312
313	! dynamic load balancing for owned cells. Get ownership of a cell if local cells number < mean cell number
314	! use random shot on frontier
315
316	mean_own=sum(nb_own(1:ndomain_glo))/ndomain_glo
317	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))
318	! set random seed to get reproductibility when using a different number of process
319
320	CALL RANDOM_SEED(size=M)
321	CALL RANDOM_SEED(put=(/(i,i=1,M)/))
322
323	DO nn=1,1000*nbp
324
325	CALL random_number(rn)
326	ind_d = INT(ndomain_glo*rn)+1
327	IF (nb_own(ind_d) >= mean_own) CYCLE
328
329	d=>domain_glo(ind_d)
330	nf=d%face
331
332	CALL random_number(rn)
333	side=INT(4*rn)
334	IF (side==0) THEN
335	CALL random_number(rn)
336	i = INT((d%ii_end-d%ii_begin+1)*rn)+d%ii_begin
337	j = d%jj_begin
338	ELSE IF (side==1) THEN
339	CALL random_number(rn)
340	i = INT((d%ii_end-d%ii_begin+1)*rn)+d%ii_begin
341	j = d%jj_end
342	ELSE IF (side==2) THEN
343	CALL random_number(rn)
344	j = INT((d%jj_end-d%jj_begin+1)*rn)+d%jj_begin
345	i = d%ii_begin
346	ELSE IF (side==3) THEN
347	CALL random_number(rn)
348	j = INT((d%jj_end-d%jj_begin+1)*rn)+d%jj_begin
349	i = d%ii_end
350	ENDIF
351
352	ii=d%ii_begin_glo-d%ii_begin+i
353	jj=d%jj_begin_glo-d%jj_begin+j
354	ind=vertex_glo(ii,jj,nf)%ind
355	delta=vertex_glo(ii,jj,nf)%delta
356	IF (cell_glo(ind)%assign_face==nf) THEN
357	nb_own(cell_glo(ind)%assign_domain)=nb_own(cell_glo(ind)%assign_domain)-1
358	nb_own(ind_d)=nb_own(ind_d)+1
359	cell_glo(ind)%assign_domain=ind_d
360	cell_glo(ind)%assign_i=i
361	cell_glo(ind)%assign_j=j
362	ENDIF
363
364	ENDDO
365
366	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))
367
368
369	DO ind_d=1,ndomain_glo
370	d=>domain_glo(ind_d)
371	nf=d%face
372	DO j=d%jj_begin-1,d%jj_end+1
373	DO i=d%ii_begin-1,d%ii_end+1
374	ii=d%ii_begin_glo-d%ii_begin+i
375	jj=d%jj_begin_glo-d%jj_begin+j
376	ind=vertex_glo(ii,jj,nf)%ind
377	d%assign_cell_glo(i,j) = ind
378	d%assign_domain(i,j)=cell_glo(ind)%assign_domain
379	d%assign_i(i,j)=cell_glo(ind)%assign_i
380	d%assign_j(i,j)=cell_glo(ind)%assign_j
381	delta=vertex_glo(ii,jj,nf)%delta
382	d%delta(i,j)=vertex_glo(ii,jj,nf)%delta
383	DO k=0,5
384	ind2=vertex_glo(ii,jj,nf)%neighbour(k)
385	d%neighbour(:,k,i,j)=cell_glo(ind2)%xyz(:)
386
387	d%ne(k,i,j)=1-2*MOD(k,2)
388
389	e=cell_glo(ind)%edge(MOD(k+delta+6,6))
390	d%edge_assign_domain(k,i,j)=edge_glo(e)%assign_domain
391	d%edge_assign_i(k,i,j)=edge_glo(e)%assign_i
392	d%edge_assign_j(k,i,j)=edge_glo(e)%assign_j
393	d%edge_assign_pos(k,i,j)=edge_glo(e)%assign_pos
394	nf2=domain_glo(edge_glo(e)%assign_domain)%face
395	d%edge_assign_sign(k,i,j)=1-2*MOD(12+tab_index(nf,nf2,0),2)
396	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) &
397	/= MOD(edge_glo(e)%assign_pos+3,6)) THEN
398	d%edge_assign_sign(k,i,j)=-d%edge_assign_sign(k,i,j)
399	ENDIF
400
401	v=cell_glo(ind)%vertex(MOD(k+delta+6,6))
402	d%vertex_assign_domain(k,i,j)=vertices_glo(v)%assign_domain
403	d%vertex_assign_i(k,i,j)=vertices_glo(v)%assign_i
404	d%vertex_assign_j(k,i,j)=vertices_glo(v)%assign_j
405	d%vertex_assign_pos(k,i,j)=vertices_glo(v)%assign_pos
406
407	ENDDO
408	d%xyz(:,i,j)=cell_glo(ind)%xyz(:)
409	IF (d%assign_domain(i,j)==ind_d) THEN
410	d%own(i,j)=.TRUE.
411	ELSE
412	d%own(i,j)=.FALSE.
413	ENDIF
414	ENDDO
415	ENDDO
416	ENDDO
417
418	CONTAINS
419
420	SUBROUTINE assign_edge(ind_d,ind,i,j,delta,k)
421	INTEGER :: ind_d,ind,i,j,delta,k
422	INTEGER :: e
423	e=cell_glo(ind)%edge(MOD(k+delta+6,6))
424	edge_glo(e)%assign_domain=ind_d
425	edge_glo(e)%assign_i=i
426	edge_glo(e)%assign_j=j
427	edge_glo(e)%assign_pos=k
428	edge_glo(e)%assign_delta=delta
429
430	END SUBROUTINE assign_edge
431
432	SUBROUTINE assign_vertex(ind_d,ind,i,j,delta,k)
433	INTEGER :: ind_d,ind,i,j,delta,k
434	INTEGER :: e
435
436	e=cell_glo(ind)%vertex(MOD(k+delta+6,6))
437	vertices_glo(e)%assign_domain=ind_d
438	vertices_glo(e)%assign_i=i
439	vertices_glo(e)%assign_j=j
440	vertices_glo(e)%assign_pos=k
441	vertices_glo(e)%assign_delta=delta
442
443	END SUBROUTINE assign_vertex
444
445	END SUBROUTINE assign_cell
446
447	SUBROUTINE compute_boundary
448	USE spherical_geom_mod
449	IMPLICIT NONE
450	INTEGER :: ind_d
451	INTEGER :: i,j,k
452	TYPE(t_domain),POINTER :: d
453	REAL(rstd) :: ng1(3),ng2(3)
454
455	DO ind_d=1,ndomain_glo
456	d=>domain_glo(ind_d)
457	DO j=d%jj_begin-1,d%jj_end+1
458	DO i=d%ii_begin-1,d%ii_end+1
459	DO k=0,5
460	ng1=d%neighbour(:,MOD(k,6),i,j)
461	ng2=d%neighbour(:,MOD(k+1,6),i,j)
462	IF (sqrt(sum((ng1-ng2)**2))<1e-16) ng2=d%neighbour(:,MOD(k+2,6),i,j)
463	CALL circumcenter(d%xyz(:,i,j),ng1,ng2,d%vertex(:,k,i,j))
464	ENDDO
465	ENDDO
466	ENDDO
467	ENDDO
468	END SUBROUTINE compute_boundary
469
470	SUBROUTINE set_neighbour_indice
471	USE metric
472	IMPLICIT NONE
473	INTEGER :: ind_d
474	TYPE(t_domain),POINTER :: d
475
476	DO ind_d=1,ndomain_glo
477	d=>domain_glo(ind_d)
478	d%t_right=1
479	d%t_left=-1
480	d%t_rup=d%iim
481	d%t_lup=d%iim-1
482	d%t_ldown=-d%iim
483	d%t_rdown=-d%iim+1
484
485	d%u_right=0
486	d%u_lup=d%iim*d%jjm
487	d%u_ldown=2d%iimd%jjm
488
489	d%u_rup=d%t_rup+d%u_ldown
490	d%u_left=d%t_left+d%u_right
491	d%u_rdown=d%t_rdown+d%u_lup
492
493	d%z_up=0
494	d%z_down=d%iim*d%jjm
495	d%z_rup=d%t_rup+d%z_down
496	d%z_lup=d%t_lup+d%z_down
497	d%z_ldown=d%t_ldown+d%z_up
498	d%z_rdown=d%t_rdown+d%z_up
499
500	d%t_pos(right)=d%t_right
501	d%t_pos(rup)=d%t_rup
502	d%t_pos(lup)=d%t_lup
503	d%t_pos(left)=d%t_left
504	d%t_pos(ldown)=d%t_ldown
505	d%t_pos(rdown)=d%t_rdown
506
507	d%u_pos(right)=d%u_right
508	d%u_pos(rup)=d%u_rup
509	d%u_pos(lup)=d%u_lup
510	d%u_pos(left)=d%u_left
511	d%u_pos(ldown)=d%u_ldown
512	d%u_pos(rdown)=d%u_rdown
513
514	d%z_pos(vrup)=d%z_rup
515	d%z_pos(vup)=d%z_up
516	d%z_pos(vlup)=d%z_lup
517	d%z_pos(vldown)=d%z_ldown
518	d%z_pos(vdown)=d%z_down
519	d%z_pos(vrdown)=d%z_rdown
520
521	ENDDO
522
523	END SUBROUTINE set_neighbour_indice
524
525	SUBROUTINE assign_domain
526	USE mpipara
527	USE grid_param
528	IMPLICIT NONE
529	INTEGER :: nb_domain(0:mpi_size-1)
530	INTEGER :: rank, ind,ind_glo
531	INTEGER :: block_j,jb,i,j,nd_glo,n,nf
532	LOGICAL :: exit
533
534	DO rank=0,mpi_size-1
535	nb_domain(rank)=ndomain_glo/mpi_size
536	IF ( rank < MOD(ndomain_glo,mpi_size) ) nb_domain(rank)=nb_domain(rank)+1
537	ENDDO
538
539	ndomain=nb_domain(mpi_rank)
540	ALLOCATE(domain(ndomain))
541	ALLOCATE(domloc_glo_ind(ndomain))
542
543
544	block_j=INT(sqrt(nsplit_insplit_jnb_face*1./mpi_size))
545	exit=.FALSE.
546	jb=1
547	i=1
548	j=1
549	ind=1
550	nd_glo=0
551	rank=0
552	DO WHILE (.NOT. exit)
553
554	IF (j==MIN(jb+block_j,nsplit_j*nb_face+1)) THEN
555	j=jb
556	i=i+1
557	ENDIF
558
559	IF (i>nsplit_i) THEN
560	i=1
561	jb=jb+block_j
562	j=jb
563	ENDIF
564
565	IF (ind>nb_domain(rank)) THEN
566	rank=rank+1
567	ind=1
568	ENDIF
569	ind_glo=(j-1)*nsplit_i+i
570
571	nd_glo=nd_glo+1
572	IF (nd_glo==ndomain_glo) THEN
573
574	exit=.TRUE.
575	IF (.NOT. (rank==mpi_size-1 .AND. ind==nb_domain(rank) )) THEN
576	PRINT *, "Distribution problem in assign_domain"
577	STOP
578	ENDIF
579
580	ENDIF
581
582	domglo_rank(ind_glo)=rank
583	domglo_loc_ind(ind_glo)=ind
584	IF (rank==mpi_rank) THEN
585	CALL copy_domain(domain_glo(ind_glo),domain(ind))
586	domloc_glo_ind(ind)=ind_glo
587	ENDIF
588
589	j=j+1
590	ind=ind+1
591
592	ENDDO
593
594	IF (is_mpi_master) THEN
595
596	ind_glo=0
597	PRINT *,''
598	PRINT*, ' MPI PROCESS DISTRIBUTION'
599	PRINT *,''
600
601	WRITE(*,"(' ')", ADVANCE='NO')
602	DO n=1,nsplit_i*7-1
603	WRITE(*,"('=')", ADVANCE='NO')
604	ENDDO
605	PRINT *,''
606
607	DO nf=1,nb_face
608	DO j=1,nsplit_j
609	IF (j>1) THEN
610	WRITE(*,"(' ')", ADVANCE='NO')
611	DO n=1,nsplit_i*7-1
612	WRITE(*,"('-')", ADVANCE='NO')
613	ENDDO
614	PRINT *,''
615	ENDIF
616
617	WRITE(*,"('\|')", ADVANCE='NO')
618	DO i=1,nsplit_i
619	WRITE(*,"(' ',' ',' \|')",ADVANCE='NO')
620	ENDDO
621	PRINT *,''
622
623	WRITE(*,"('\|')", ADVANCE='NO')
624	DO i=1,nsplit_i
625	ind_glo=ind_glo+1
626	WRITE(*,"(' ',i4.4 ,' \|')",ADVANCE='NO') domglo_rank(ind_glo)
627	END DO
628	PRINT *,''
629
630	WRITE(*,"('\|')", ADVANCE='NO')
631	DO i=1,nsplit_i
632	WRITE(*,"(' ',' ',' \|')",ADVANCE='NO')
633	ENDDO
634	PRINT *,''
635
636	ENDDO
637
638	WRITE(*,"(' ')", ADVANCE='NO')
639	DO n=1,nsplit_i*7-1
640	WRITE(*,"('=')", ADVANCE='NO')
641	ENDDO
642	PRINT *,''
643	ENDDO
644	ENDIF
645
646	! rank=0
647	! ind=0
648	! DO ind_glo=1,ndomain_glo
649	! ind=ind+1
650	! domglo_rank(ind_glo)=rank
651	! domglo_loc_ind(ind_glo)=ind
652	! IF (rank==mpi_rank) THEN
653	! CALL copy_domain(domain_glo(ind_glo),domain(ind))
654	! domloc_glo_ind(ind)=ind_glo
655	! ENDIF
656	!
657	! IF (ind==nb_domain(rank)) THEN
658	! rank=rank+1
659	! ind=0
660	! ENDIF
661	! ENDDO
662
663	!$OMP PARALLEL
664	CALL assign_domain_omp
665	!$OMP END PARALLEL
666
667
668	END SUBROUTINE assign_domain
669
670	SUBROUTINE assign_domain_omp
671	USE omp_para
672	USE mpipara
673	IMPLICIT NONE
674	INTEGER :: nb_domain
675	INTEGER :: rank, ind, i
676
677	ALLOCATE(assigned_domain(ndomain))
678
679	ind=0
680	DO rank=0,omp_domain_size-1
681	nb_domain=ndomain/omp_domain_size
682	IF ( rank < MOD(ndomain,omp_domain_size) ) nb_domain=nb_domain+1
683
684	DO i=1,nb_domain
685	ind=ind+1
686	IF (rank==omp_domain_rank) THEN
687	assigned_domain(ind)=.TRUE.
688	WRITE(*,'(A,I6.6,A,I4.4,A,I4.4,A,I8.8)') "Rank ",mpi_rank," task ",rank," local domain ",ind, &
689	" global domain ",domloc_glo_ind(ind)
690	ELSE
691	assigned_domain(ind)=.FALSE.
692	ENDIF
693	ENDDO
694
695	ENDDO
696
697	!$acc enter data copyin(assigned_domain(:))
698
699	END SUBROUTINE assign_domain_omp
700
701
702
703	SUBROUTINE compute_domain
704	IMPLICIT NONE
705	CALL init_domain_param
706	CALL create_domain
707	CALL assign_cell
708	CALL compute_boundary
709	CALL set_neighbour_indice
710	CALL assign_domain
711
712	END SUBROUTINE compute_domain
713
714	END MODULE domain_mod
715

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

Context Navigation

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

Download in other formats: