Context Navigation

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

Last change on this file since 815 was 711, checked in by ymipsl, 6 years ago

Adding halo transfer for scalar field ad vorticity point.
=> Use request "req_z1_scal" with transfer function

YM

File size: 17.5 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	IMPLICIT NONE
245	INTEGER :: ind_d,ind,ind2,e,v
246	INTEGER :: nf,nf2
247	INTEGER :: i,j,k,ii,jj
248	TYPE(t_domain),POINTER :: d
249	INTEGER :: delta
250
251
252	DO ind_d=1,ndomain_glo
253	d=>domain_glo(ind_d)
254	nf=d%face
255	DO j=d%jj_begin,d%jj_end
256	DO i=d%ii_begin,d%ii_end
257	ii=d%ii_begin_glo-d%ii_begin+i
258	jj=d%jj_begin_glo-d%jj_begin+j
259	ind=vertex_glo(ii,jj,nf)%ind
260	delta=vertex_glo(ii,jj,nf)%delta
261	IF (cell_glo(ind)%assign_face==nf) THEN
262	cell_glo(ind)%assign_domain=ind_d
263	cell_glo(ind)%assign_i=i
264	cell_glo(ind)%assign_j=j
265	ENDIF
266	IF ( i+1 <= d%ii_end ) CALL assign_edge(ind_d,ind,i,j,delta,0)
267	IF ( j+1 <= d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,1)
268	IF ( i-1 >= d%ii_begin .AND. j+1<=d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,2)
269	IF ( i-1 >= d%ii_begin ) CALL assign_edge(ind_d,ind,i,j,delta,3)
270	IF ( j-1 >= d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,4)
271	IF ( i+1 <= d%ii_end .AND. j-1 >=d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,5)
272
273	IF ( i+1 <= d%ii_end .AND. j+1 <= d%jj_end) CALL assign_vertex(ind_d,ind,i,j,delta,0)
274	IF ( i-1 >= d%ii_begin .AND. j+1 <= d%jj_end) CALL assign_vertex(ind_d,ind,i,j,delta,1)
275	IF ( i-1 >= d%ii_begin .AND. j+1 <= d%jj_end) CALL assign_vertex(ind_d,ind,i,j,delta,2)
276	IF ( i-1 >= d%ii_begin .AND. j-1 >= d%jj_begin) CALL assign_vertex(ind_d,ind,i,j,delta,3)
277	IF ( i+1 <= d%ii_end .AND. j-1 >= d%jj_begin) CALL assign_vertex(ind_d,ind,i,j,delta,4)
278	IF ( i+1 <= d%ii_end .AND. j-1 >= d%jj_begin) CALL assign_vertex(ind_d,ind,i,j,delta,5)
279	ENDDO
280	ENDDO
281	ENDDO
282
283
284	DO ind_d=1,ndomain_glo
285	d=>domain_glo(ind_d)
286	nf=d%face
287	DO j=d%jj_begin-1,d%jj_end+1
288	DO i=d%ii_begin-1,d%ii_end+1
289	ii=d%ii_begin_glo-d%ii_begin+i
290	jj=d%jj_begin_glo-d%jj_begin+j
291	ind=vertex_glo(ii,jj,nf)%ind
292	d%assign_cell_glo(i,j) = ind
293	d%assign_domain(i,j)=cell_glo(ind)%assign_domain
294	d%assign_i(i,j)=cell_glo(ind)%assign_i
295	d%assign_j(i,j)=cell_glo(ind)%assign_j
296	delta=vertex_glo(ii,jj,nf)%delta
297	d%delta(i,j)=vertex_glo(ii,jj,nf)%delta
298	DO k=0,5
299	ind2=vertex_glo(ii,jj,nf)%neighbour(k)
300	d%neighbour(:,k,i,j)=cell_glo(ind2)%xyz(:)
301
302	d%ne(k,i,j)=1-2*MOD(k,2)
303
304	e=cell_glo(ind)%edge(MOD(k+delta+6,6))
305	d%edge_assign_domain(k,i,j)=edge_glo(e)%assign_domain
306	d%edge_assign_i(k,i,j)=edge_glo(e)%assign_i
307	d%edge_assign_j(k,i,j)=edge_glo(e)%assign_j
308	d%edge_assign_pos(k,i,j)=edge_glo(e)%assign_pos
309	nf2=domain_glo(edge_glo(e)%assign_domain)%face
310	d%edge_assign_sign(k,i,j)=1-2*MOD(12+tab_index(nf,nf2,0),2)
311	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) &
312	/= MOD(edge_glo(e)%assign_pos+3,6)) THEN
313	d%edge_assign_sign(k,i,j)=-d%edge_assign_sign(k,i,j)
314	ENDIF
315
316	v=cell_glo(ind)%vertex(MOD(k+delta+6,6))
317	d%vertex_assign_domain(k,i,j)=vertices_glo(v)%assign_domain
318	d%vertex_assign_i(k,i,j)=vertices_glo(v)%assign_i
319	d%vertex_assign_j(k,i,j)=vertices_glo(v)%assign_j
320	d%vertex_assign_pos(k,i,j)=vertices_glo(v)%assign_pos
321
322	ENDDO
323	d%xyz(:,i,j)=cell_glo(ind)%xyz(:)
324	IF (d%assign_domain(i,j)==ind_d) THEN
325	d%own(i,j)=.TRUE.
326	ELSE
327	d%own(i,j)=.FALSE.
328	ENDIF
329	ENDDO
330	ENDDO
331	ENDDO
332
333	CONTAINS
334
335	SUBROUTINE assign_edge(ind_d,ind,i,j,delta,k)
336	INTEGER :: ind_d,ind,i,j,delta,k
337	INTEGER :: e
338	e=cell_glo(ind)%edge(MOD(k+delta+6,6))
339	edge_glo(e)%assign_domain=ind_d
340	edge_glo(e)%assign_i=i
341	edge_glo(e)%assign_j=j
342	edge_glo(e)%assign_pos=k
343	edge_glo(e)%assign_delta=delta
344
345	END SUBROUTINE assign_edge
346
347	SUBROUTINE assign_vertex(ind_d,ind,i,j,delta,k)
348	INTEGER :: ind_d,ind,i,j,delta,k
349	INTEGER :: e
350
351	e=cell_glo(ind)%vertex(MOD(k+delta+6,6))
352	vertices_glo(e)%assign_domain=ind_d
353	vertices_glo(e)%assign_i=i
354	vertices_glo(e)%assign_j=j
355	vertices_glo(e)%assign_pos=k
356	vertices_glo(e)%assign_delta=delta
357
358	END SUBROUTINE assign_vertex
359
360	END SUBROUTINE assign_cell
361
362	SUBROUTINE compute_boundary
363	USE spherical_geom_mod
364	IMPLICIT NONE
365	INTEGER :: ind_d
366	INTEGER :: i,j,k
367	TYPE(t_domain),POINTER :: d
368	REAL(rstd) :: ng1(3),ng2(3)
369
370	DO ind_d=1,ndomain_glo
371	d=>domain_glo(ind_d)
372	DO j=d%jj_begin-1,d%jj_end+1
373	DO i=d%ii_begin-1,d%ii_end+1
374	DO k=0,5
375	ng1=d%neighbour(:,MOD(k,6),i,j)
376	ng2=d%neighbour(:,MOD(k+1,6),i,j)
377	IF (sqrt(sum((ng1-ng2)**2))<1e-16) ng2=d%neighbour(:,MOD(k+2,6),i,j)
378	CALL circumcenter(d%xyz(:,i,j),ng1,ng2,d%vertex(:,k,i,j))
379	ENDDO
380	ENDDO
381	ENDDO
382	ENDDO
383	END SUBROUTINE compute_boundary
384
385	SUBROUTINE set_neighbour_indice
386	USE metric
387	IMPLICIT NONE
388	INTEGER :: ind_d
389	TYPE(t_domain),POINTER :: d
390
391	DO ind_d=1,ndomain_glo
392	d=>domain_glo(ind_d)
393	d%t_right=1
394	d%t_left=-1
395	d%t_rup=d%iim
396	d%t_lup=d%iim-1
397	d%t_ldown=-d%iim
398	d%t_rdown=-d%iim+1
399
400	d%u_right=0
401	d%u_lup=d%iim*d%jjm
402	d%u_ldown=2d%iimd%jjm
403
404	d%u_rup=d%t_rup+d%u_ldown
405	d%u_left=d%t_left+d%u_right
406	d%u_rdown=d%t_rdown+d%u_lup
407
408	d%z_up=0
409	d%z_down=d%iim*d%jjm
410	d%z_rup=d%t_rup+d%z_down
411	d%z_lup=d%t_lup+d%z_down
412	d%z_ldown=d%t_ldown+d%z_up
413	d%z_rdown=d%t_rdown+d%z_up
414
415	d%t_pos(right)=d%t_right
416	d%t_pos(rup)=d%t_rup
417	d%t_pos(lup)=d%t_lup
418	d%t_pos(left)=d%t_left
419	d%t_pos(ldown)=d%t_ldown
420	d%t_pos(rdown)=d%t_rdown
421
422	d%u_pos(right)=d%u_right
423	d%u_pos(rup)=d%u_rup
424	d%u_pos(lup)=d%u_lup
425	d%u_pos(left)=d%u_left
426	d%u_pos(ldown)=d%u_ldown
427	d%u_pos(rdown)=d%u_rdown
428
429	d%z_pos(vrup)=d%z_rup
430	d%z_pos(vup)=d%z_up
431	d%z_pos(vlup)=d%z_lup
432	d%z_pos(vldown)=d%z_ldown
433	d%z_pos(vdown)=d%z_down
434	d%z_pos(vrdown)=d%z_rdown
435
436	ENDDO
437
438	END SUBROUTINE set_neighbour_indice
439
440	SUBROUTINE assign_domain
441	USE mpipara
442	USE grid_param
443	IMPLICIT NONE
444	INTEGER :: nb_domain(0:mpi_size-1)
445	INTEGER :: rank, ind,ind_glo
446	INTEGER :: block_j,jb,i,j,nd_glo,n,nf
447	LOGICAL :: exit
448
449	DO rank=0,mpi_size-1
450	nb_domain(rank)=ndomain_glo/mpi_size
451	IF ( rank < MOD(ndomain_glo,mpi_size) ) nb_domain(rank)=nb_domain(rank)+1
452	ENDDO
453
454	ndomain=nb_domain(mpi_rank)
455	ALLOCATE(domain(ndomain))
456	ALLOCATE(domloc_glo_ind(ndomain))
457
458
459	block_j=sqrt(nsplit_insplit_jnb_face*1./mpi_size)
460	exit=.FALSE.
461	jb=1
462	i=1
463	j=1
464	ind=1
465	nd_glo=0
466	rank=0
467	DO WHILE (.NOT. exit)
468
469	IF (j==MIN(jb+block_j,nsplit_j*nb_face+1)) THEN
470	j=jb
471	i=i+1
472	ENDIF
473
474	IF (i>nsplit_i) THEN
475	i=1
476	jb=jb+block_j
477	j=jb
478	ENDIF
479
480	IF (ind>nb_domain(rank)) THEN
481	rank=rank+1
482	ind=1
483	ENDIF
484	ind_glo=(j-1)*nsplit_i+i
485
486	nd_glo=nd_glo+1
487	IF (nd_glo==ndomain_glo) THEN
488
489	exit=.TRUE.
490	IF (.NOT. (rank==mpi_size-1 .AND. ind==nb_domain(rank) )) THEN
491	PRINT *, "Distribution problem in assign_domain"
492	STOP
493	ENDIF
494
495	ENDIF
496
497	domglo_rank(ind_glo)=rank
498	domglo_loc_ind(ind_glo)=ind
499	IF (rank==mpi_rank) THEN
500	CALL copy_domain(domain_glo(ind_glo),domain(ind))
501	domloc_glo_ind(ind)=ind_glo
502	ENDIF
503
504	j=j+1
505	ind=ind+1
506
507	ENDDO
508
509	IF (is_mpi_master) THEN
510
511	ind_glo=0
512	PRINT *,''
513	PRINT*, ' MPI PROCESS DISTRIBUTION'
514	PRINT *,''
515
516	WRITE(*,"(' ')", ADVANCE='NO')
517	DO n=1,nsplit_i*7-1
518	WRITE(*,"('=')", ADVANCE='NO')
519	ENDDO
520	PRINT *,''
521
522	DO nf=1,nb_face
523	DO j=1,nsplit_j
524	IF (j>1) THEN
525	WRITE(*,"(' ')", ADVANCE='NO')
526	DO n=1,nsplit_i*7-1
527	WRITE(*,"('-')", ADVANCE='NO')
528	ENDDO
529	PRINT *,''
530	ENDIF
531
532	WRITE(*,"('\|')", ADVANCE='NO')
533	DO i=1,nsplit_i
534	WRITE(*,"(' ',' ',' \|')",ADVANCE='NO')
535	ENDDO
536	PRINT *,''
537
538	WRITE(*,"('\|')", ADVANCE='NO')
539	DO i=1,nsplit_i
540	ind_glo=ind_glo+1
541	WRITE(*,"(' ',i4.4 ,' \|')",ADVANCE='NO'),domglo_rank(ind_glo)
542	END DO
543	PRINT *,''
544
545	WRITE(*,"('\|')", ADVANCE='NO')
546	DO i=1,nsplit_i
547	WRITE(*,"(' ',' ',' \|')",ADVANCE='NO')
548	ENDDO
549	PRINT *,''
550
551	ENDDO
552
553	WRITE(*,"(' ')", ADVANCE='NO')
554	DO n=1,nsplit_i*7-1
555	WRITE(*,"('=')", ADVANCE='NO')
556	ENDDO
557	PRINT *,''
558	ENDDO
559	ENDIF
560
561	! rank=0
562	! ind=0
563	! DO ind_glo=1,ndomain_glo
564	! ind=ind+1
565	! domglo_rank(ind_glo)=rank
566	! domglo_loc_ind(ind_glo)=ind
567	! IF (rank==mpi_rank) THEN
568	! CALL copy_domain(domain_glo(ind_glo),domain(ind))
569	! domloc_glo_ind(ind)=ind_glo
570	! ENDIF
571	!
572	! IF (ind==nb_domain(rank)) THEN
573	! rank=rank+1
574	! ind=0
575	! ENDIF
576	! ENDDO
577
578	!$OMP PARALLEL
579	CALL assign_domain_omp
580	!$OMP END PARALLEL
581
582
583	END SUBROUTINE assign_domain
584
585	SUBROUTINE assign_domain_omp
586	USE omp_para
587	USE mpipara
588	IMPLICIT NONE
589	INTEGER :: nb_domain
590	INTEGER :: rank, ind, i
591
592	ALLOCATE(assigned_domain(ndomain))
593
594	ind=0
595	DO rank=0,omp_domain_size-1
596	nb_domain=ndomain/omp_domain_size
597	IF ( rank < MOD(ndomain,omp_domain_size) ) nb_domain=nb_domain+1
598
599	DO i=1,nb_domain
600	ind=ind+1
601	IF (rank==omp_domain_rank) THEN
602	assigned_domain(ind)=.TRUE.
603	WRITE(*,'(A,I6.6,A,I4.4,A,I4.4,A,I8.8)') "Rank ",mpi_rank," task ",rank," local domain ",ind, &
604	" global domain ",domloc_glo_ind(ind)
605	ELSE
606	assigned_domain(ind)=.FALSE.
607	ENDIF
608	ENDDO
609
610	ENDDO
611
612	END SUBROUTINE assign_domain_omp
613
614
615
616	SUBROUTINE compute_domain
617	IMPLICIT NONE
618	CALL init_domain_param
619	CALL create_domain
620	CALL assign_cell
621	CALL compute_boundary
622	CALL set_neighbour_indice
623	CALL assign_domain
624
625	END SUBROUTINE compute_domain
626
627	END MODULE domain_mod
628

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

Download in other formats: