Context Navigation

source: codes/icosagcm/devel/src/parallel/domain.f90 @ 862

Last change on this file since 862 was 856, checked in by dubos, 5 years ago
devel : towards Fortran driver for unstructured/LAM meshes
File size: 17.9 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	LOGICAL :: swap_needed=.TRUE. ! .FALSE. if a thread always computes on the same domain
69	!$OMP THREADPRIVATE(swap_needed)
70
71	TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain(:)
72	TYPE(t_domain),SAVE,ALLOCATABLE,TARGET :: domain_glo(:)
73
74	INTEGER,ALLOCATABLE,SAVE :: domglo_rank(:) ! size : ndomain_glo : mpi rank assigned to a domain
75	INTEGER,ALLOCATABLE,SAVE :: domglo_loc_ind(:) ! size : ndomain_glo : corresponding local indice for a global domain indice
76	INTEGER,ALLOCATABLE,SAVE :: domloc_glo_ind(:) ! size : ndomain : corresponding global indice for a local domain indice
77
78	LOGICAL, ALLOCATABLE, SAVE :: assigned_domain(:) ! size : ndomain : is an omp task is assigned to this domain
79	!$OMP THREADPRIVATE(assigned_domain)
80
81	CONTAINS
82
83	SUBROUTINE create_domain
84	USE grid_param
85	USE mpipara
86	USE ioipsl
87	IMPLICIT NONE
88	INTEGER :: ind,nf,ni,nj,i,j
89	INTEGER :: quotient, rest
90	INTEGER :: halo_i,halo_j
91
92	TYPE(t_domain),POINTER :: d
93
94	ndomain_glo=nsplit_insplit_jnb_face
95	ALLOCATE(domain_glo(ndomain_glo))
96	ALLOCATE(domglo_rank(ndomain_glo))
97	ALLOCATE(domglo_loc_ind(ndomain_glo))
98
99	halo_i=0
100	CALL getin("halo_i",halo_i)
101	halo_j=1
102	CALL getin("halo_j",halo_j)
103
104	ind=0
105	DO nf=1,nb_face
106	DO nj=1,nsplit_j
107	DO ni=1,nsplit_i
108	ind=ind+1
109	d=>domain_glo(ind)
110	quotient=(iim_glo/nsplit_i)
111	rest=MOD(iim_glo,nsplit_i)
112	IF (ni-1 < rest) THEN
113	d%ii_nb=quotient+1
114	d%ii_begin_glo=(quotient+1)*(ni-1)+1
115	ELSE
116	d%ii_nb=quotient
117	d%ii_begin_glo=(quotient+1)rest+(ni-1-rest) quotient+1
118	ENDIF
119	d%ii_end_glo=d%ii_begin_glo+d%ii_nb-1
120
121	IF (ni/=1) THEN
122	d%ii_nb=d%ii_nb+1
123	d%ii_begin_glo=d%ii_begin_glo-1
124	ENDIF
125
126
127	quotient=(jjm_glo/nsplit_j)
128	rest=MOD(jjm_glo,nsplit_j)
129	IF (nj-1 < rest) THEN
130	d%jj_nb=quotient+1
131	d%jj_begin_glo=(quotient+1)*(nj-1)+1
132	ELSE
133	d%jj_nb=quotient
134	d%jj_begin_glo=(quotient+1)rest+(nj-1-rest) quotient+1
135	ENDIF
136	d%jj_end_glo=d%jj_begin_glo+d%jj_nb-1
137
138	IF (nj/=1) THEN
139	d%jj_nb=d%jj_nb+1
140	d%jj_begin_glo=d%jj_begin_glo-1
141	ENDIF
142
143
144	d%iim=d%ii_nb+2halo + halo_i2
145	d%jjm=d%jj_nb+2halo + halo_j2
146	d%ii_begin=halo+1 + halo_i
147	d%jj_begin=halo+1 + halo_j
148	d%ii_end=d%ii_begin+d%ii_nb-1
149	d%jj_end=d%jj_begin+d%jj_nb-1
150	d%face=nf
151	ALLOCATE(d%assign_domain(d%iim,d%jjm))
152	ALLOCATE(d%assign_cell_glo(d%iim,d%jjm))
153	ALLOCATE(d%assign_i(d%iim,d%jjm))
154	ALLOCATE(d%assign_j(d%iim,d%jjm))
155	ALLOCATE(d%edge_assign_domain(0:5,d%iim,d%jjm))
156	ALLOCATE(d%edge_assign_i(0:5,d%iim,d%jjm))
157	ALLOCATE(d%edge_assign_j(0:5,d%iim,d%jjm))
158	ALLOCATE(d%edge_assign_pos(0:5,d%iim,d%jjm))
159	ALLOCATE(d%edge_assign_sign(0:5,d%iim,d%jjm))
160	ALLOCATE(d%vertex_assign_domain(0:5,d%iim,d%jjm))
161	ALLOCATE(d%vertex_assign_i(0:5,d%iim,d%jjm))
162	ALLOCATE(d%vertex_assign_j(0:5,d%iim,d%jjm))
163	ALLOCATE(d%vertex_assign_pos(0:5,d%iim,d%jjm))
164	ALLOCATE(d%delta(d%iim,d%jjm))
165	ALLOCATE(d%xyz(3,d%iim,d%jjm))
166	ALLOCATE(d%vertex(3,0:5,d%iim,d%jjm))
167	ALLOCATE(d%neighbour(3,0:5,d%iim,d%jjm))
168	ALLOCATE(d%own(d%iim,d%jjm))
169	ALLOCATE(d%ne(0:5,d%iim,d%jjm))
170
171	IF (is_mpi_root) PRINT *,"Domain ",ind," : size ",d%ii_nb,"x",d%jj_nb
172
173	END DO
174	END DO
175	END DO
176
177	END SUBROUTINE create_domain
178
179	SUBROUTINE copy_domain(d1,d2)
180	IMPLICIT NONE
181	INTEGER :: face
182	TYPE(t_domain),TARGET,INTENT(IN) :: d1
183	TYPE(t_domain), INTENT(OUT) :: d2
184
185	d2%iim = d1%iim
186	d2%jjm = d1%jjm
187	d2%ii_begin = d1%ii_begin
188	d2%jj_begin = d1%jj_begin
189	d2%ii_end = d1%ii_end
190	d2%jj_end = d1%jj_end
191	d2%ii_nb = d1%ii_nb
192	d2%jj_nb = d1%jj_nb
193	d2%ii_begin_glo = d1%ii_begin_glo
194	d2%jj_begin_glo = d1%jj_begin_glo
195	d2%ii_end_glo = d1%ii_end_glo
196	d2%jj_end_glo = d1%jj_end_glo
197	d2%assign_domain => d1%assign_domain
198	d2%assign_cell_glo => d1%assign_cell_glo
199	d2%assign_i => d1%assign_i
200	d2%assign_j => d1%assign_j
201	d2%edge_assign_domain => d1%edge_assign_domain
202	d2%edge_assign_i => d1%edge_assign_i
203	d2%edge_assign_j => d1%edge_assign_j
204	d2%edge_assign_pos => d1%edge_assign_pos
205	d2%edge_assign_sign => d1%edge_assign_sign
206	d2%vertex_assign_domain => d1%vertex_assign_domain
207	d2%vertex_assign_i => d1%vertex_assign_i
208	d2%vertex_assign_j => d1%vertex_assign_j
209	d2%vertex_assign_pos => d1%vertex_assign_pos
210	d2%xyz => d1%xyz
211	d2%neighbour => d1%neighbour
212	d2%delta => d1%delta
213	d2%vertex => d1%vertex
214	d2%own => d1%own
215	d2%ne => d1%ne
216
217	d2%t_right = d1%t_right
218	d2%t_rup = d1%t_rup
219	d2%t_lup = d1%t_lup
220	d2%t_left = d1%t_left
221	d2%t_ldown = d1%t_ldown
222	d2%t_rdown = d1%t_rdown
223
224	d2%u_right = d1%u_right
225	d2%u_rup = d1%u_rup
226	d2%u_lup = d1%u_lup
227	d2%u_left = d1%u_left
228	d2%u_ldown = d1%u_ldown
229	d2%u_rdown = d1%u_rdown
230
231	d2%z_rup = d1%z_rup
232	d2%z_up = d1%z_up
233	d2%z_lup = d1%z_lup
234	d2%z_ldown = d1%z_ldown
235	d2%z_down = d1%z_down
236	d2%z_rdown = d1%z_rdown
237
238	d2%t_pos = d1%t_pos
239	d2%u_pos = d1%u_pos
240	d2%z_pos = d1%z_pos
241
242	END SUBROUTINE copy_domain
243
244
245	SUBROUTINE assign_cell
246	USE metric
247	IMPLICIT NONE
248	INTEGER :: ind_d,ind,ind2,e,v
249	INTEGER :: nf,nf2
250	INTEGER :: i,j,k,ii,jj
251	TYPE(t_domain),POINTER :: d
252	INTEGER :: delta
253
254
255	DO ind_d=1,ndomain_glo
256	d=>domain_glo(ind_d)
257	nf=d%face
258	DO j=d%jj_begin,d%jj_end
259	DO i=d%ii_begin,d%ii_end
260	ii=d%ii_begin_glo-d%ii_begin+i
261	jj=d%jj_begin_glo-d%jj_begin+j
262	ind=vertex_glo(ii,jj,nf)%ind
263	delta=vertex_glo(ii,jj,nf)%delta
264	IF (cell_glo(ind)%assign_face==nf) THEN
265	cell_glo(ind)%assign_domain=ind_d
266	cell_glo(ind)%assign_i=i
267	cell_glo(ind)%assign_j=j
268	ENDIF
269	IF ( i+1 <= d%ii_end ) CALL assign_edge(ind_d,ind,i,j,delta,0)
270	IF ( j+1 <= d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,1)
271	IF ( i-1 >= d%ii_begin .AND. j+1<=d%jj_end ) CALL assign_edge(ind_d,ind,i,j,delta,2)
272	IF ( i-1 >= d%ii_begin ) CALL assign_edge(ind_d,ind,i,j,delta,3)
273	IF ( j-1 >= d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,4)
274	IF ( i+1 <= d%ii_end .AND. j-1 >=d%jj_begin ) CALL assign_edge(ind_d,ind,i,j,delta,5)
275
276	IF ( i+1 <= d%ii_end .AND. j+1 <= d%jj_end) CALL assign_vertex(ind_d,ind,i,j,delta,0)
277	IF ( i-1 >= d%ii_begin .AND. j+1 <= d%jj_end) CALL assign_vertex(ind_d,ind,i,j,delta,1)
278	IF ( i-1 >= d%ii_begin .AND. j+1 <= d%jj_end) CALL assign_vertex(ind_d,ind,i,j,delta,2)
279	IF ( i-1 >= d%ii_begin .AND. j-1 >= d%jj_begin) CALL assign_vertex(ind_d,ind,i,j,delta,3)
280	IF ( i+1 <= d%ii_end .AND. j-1 >= d%jj_begin) CALL assign_vertex(ind_d,ind,i,j,delta,4)
281	IF ( i+1 <= d%ii_end .AND. j-1 >= d%jj_begin) CALL assign_vertex(ind_d,ind,i,j,delta,5)
282	ENDDO
283	ENDDO
284	ENDDO
285
286
287	DO ind_d=1,ndomain_glo
288	d=>domain_glo(ind_d)
289	nf=d%face
290	DO j=d%jj_begin-1,d%jj_end+1
291	DO i=d%ii_begin-1,d%ii_end+1
292	ii=d%ii_begin_glo-d%ii_begin+i
293	jj=d%jj_begin_glo-d%jj_begin+j
294	ind=vertex_glo(ii,jj,nf)%ind
295	d%assign_cell_glo(i,j) = ind
296	d%assign_domain(i,j)=cell_glo(ind)%assign_domain
297	d%assign_i(i,j)=cell_glo(ind)%assign_i
298	d%assign_j(i,j)=cell_glo(ind)%assign_j
299	delta=vertex_glo(ii,jj,nf)%delta
300	d%delta(i,j)=vertex_glo(ii,jj,nf)%delta
301	DO k=0,5
302	ind2=vertex_glo(ii,jj,nf)%neighbour(k)
303	d%neighbour(:,k,i,j)=cell_glo(ind2)%xyz(:)
304
305	d%ne(k,i,j)=1-2*MOD(k,2)
306
307	e=cell_glo(ind)%edge(MOD(k+delta+6,6))
308	d%edge_assign_domain(k,i,j)=edge_glo(e)%assign_domain
309	d%edge_assign_i(k,i,j)=edge_glo(e)%assign_i
310	d%edge_assign_j(k,i,j)=edge_glo(e)%assign_j
311	d%edge_assign_pos(k,i,j)=edge_glo(e)%assign_pos
312	nf2=domain_glo(edge_glo(e)%assign_domain)%face
313	d%edge_assign_sign(k,i,j)=1-2*MOD(12+tab_index(nf,nf2,0),2)
314	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) &
315	/= MOD(edge_glo(e)%assign_pos+3,6)) THEN
316	d%edge_assign_sign(k,i,j)=-d%edge_assign_sign(k,i,j)
317	ENDIF
318
319	v=cell_glo(ind)%vertex(MOD(k+delta+6,6))
320	d%vertex_assign_domain(k,i,j)=vertices_glo(v)%assign_domain
321	d%vertex_assign_i(k,i,j)=vertices_glo(v)%assign_i
322	d%vertex_assign_j(k,i,j)=vertices_glo(v)%assign_j
323	d%vertex_assign_pos(k,i,j)=vertices_glo(v)%assign_pos
324
325	ENDDO
326	d%xyz(:,i,j)=cell_glo(ind)%xyz(:)
327	IF (d%assign_domain(i,j)==ind_d) THEN
328	d%own(i,j)=.TRUE.
329	ELSE
330	d%own(i,j)=.FALSE.
331	ENDIF
332	ENDDO
333	ENDDO
334	ENDDO
335
336	CONTAINS
337
338	SUBROUTINE assign_edge(ind_d,ind,i,j,delta,k)
339	INTEGER :: ind_d,ind,i,j,delta,k
340	INTEGER :: e
341	e=cell_glo(ind)%edge(MOD(k+delta+6,6))
342	edge_glo(e)%assign_domain=ind_d
343	edge_glo(e)%assign_i=i
344	edge_glo(e)%assign_j=j
345	edge_glo(e)%assign_pos=k
346	edge_glo(e)%assign_delta=delta
347
348	END SUBROUTINE assign_edge
349
350	SUBROUTINE assign_vertex(ind_d,ind,i,j,delta,k)
351	INTEGER :: ind_d,ind,i,j,delta,k
352	INTEGER :: e
353
354	e=cell_glo(ind)%vertex(MOD(k+delta+6,6))
355	vertices_glo(e)%assign_domain=ind_d
356	vertices_glo(e)%assign_i=i
357	vertices_glo(e)%assign_j=j
358	vertices_glo(e)%assign_pos=k
359	vertices_glo(e)%assign_delta=delta
360
361	END SUBROUTINE assign_vertex
362
363	END SUBROUTINE assign_cell
364
365	SUBROUTINE compute_boundary
366	USE spherical_geom_mod
367	IMPLICIT NONE
368	INTEGER :: ind_d
369	INTEGER :: i,j,k
370	TYPE(t_domain),POINTER :: d
371	REAL(rstd) :: ng1(3),ng2(3)
372
373	DO ind_d=1,ndomain_glo
374	d=>domain_glo(ind_d)
375	DO j=d%jj_begin-1,d%jj_end+1
376	DO i=d%ii_begin-1,d%ii_end+1
377	DO k=0,5
378	ng1=d%neighbour(:,MOD(k,6),i,j)
379	ng2=d%neighbour(:,MOD(k+1,6),i,j)
380	IF (sqrt(sum((ng1-ng2)**2))<1e-16) ng2=d%neighbour(:,MOD(k+2,6),i,j)
381	CALL circumcenter(d%xyz(:,i,j),ng1,ng2,d%vertex(:,k,i,j))
382	ENDDO
383	ENDDO
384	ENDDO
385	ENDDO
386	END SUBROUTINE compute_boundary
387
388	SUBROUTINE set_neighbour_indice
389	USE metric
390	IMPLICIT NONE
391	INTEGER :: ind_d
392	TYPE(t_domain),POINTER :: d
393
394	DO ind_d=1,ndomain_glo
395	d=>domain_glo(ind_d)
396	d%t_right=1
397	d%t_left=-1
398	d%t_rup=d%iim
399	d%t_lup=d%iim-1
400	d%t_ldown=-d%iim
401	d%t_rdown=-d%iim+1
402
403	d%u_right=0
404	d%u_lup=d%iim*d%jjm
405	d%u_ldown=2d%iimd%jjm
406
407	d%u_rup=d%t_rup+d%u_ldown
408	d%u_left=d%t_left+d%u_right
409	d%u_rdown=d%t_rdown+d%u_lup
410
411	d%z_up=0
412	d%z_down=d%iim*d%jjm
413	d%z_rup=d%t_rup+d%z_down
414	d%z_lup=d%t_lup+d%z_down
415	d%z_ldown=d%t_ldown+d%z_up
416	d%z_rdown=d%t_rdown+d%z_up
417
418	d%t_pos(right)=d%t_right
419	d%t_pos(rup)=d%t_rup
420	d%t_pos(lup)=d%t_lup
421	d%t_pos(left)=d%t_left
422	d%t_pos(ldown)=d%t_ldown
423	d%t_pos(rdown)=d%t_rdown
424
425	d%u_pos(right)=d%u_right
426	d%u_pos(rup)=d%u_rup
427	d%u_pos(lup)=d%u_lup
428	d%u_pos(left)=d%u_left
429	d%u_pos(ldown)=d%u_ldown
430	d%u_pos(rdown)=d%u_rdown
431
432	d%z_pos(vrup)=d%z_rup
433	d%z_pos(vup)=d%z_up
434	d%z_pos(vlup)=d%z_lup
435	d%z_pos(vldown)=d%z_ldown
436	d%z_pos(vdown)=d%z_down
437	d%z_pos(vrdown)=d%z_rdown
438
439	ENDDO
440
441	END SUBROUTINE set_neighbour_indice
442
443	SUBROUTINE assign_domain
444	USE mpipara
445	USE grid_param
446	IMPLICIT NONE
447	INTEGER :: nb_domain(0:mpi_size-1)
448	INTEGER :: rank, ind,ind_glo
449	INTEGER :: block_j,jb,i,j,nd_glo,n,nf
450	LOGICAL :: exit
451
452	DO rank=0,mpi_size-1
453	nb_domain(rank)=ndomain_glo/mpi_size
454	IF ( rank < MOD(ndomain_glo,mpi_size) ) nb_domain(rank)=nb_domain(rank)+1
455	ENDDO
456
457	ndomain=nb_domain(mpi_rank)
458	ALLOCATE(domain(ndomain))
459	ALLOCATE(domloc_glo_ind(ndomain))
460
461
462	block_j=sqrt(nsplit_insplit_jnb_face*1./mpi_size)
463	exit=.FALSE.
464	jb=1
465	i=1
466	j=1
467	ind=1
468	nd_glo=0
469	rank=0
470	DO WHILE (.NOT. exit)
471
472	IF (j==MIN(jb+block_j,nsplit_j*nb_face+1)) THEN
473	j=jb
474	i=i+1
475	ENDIF
476
477	IF (i>nsplit_i) THEN
478	i=1
479	jb=jb+block_j
480	j=jb
481	ENDIF
482
483	IF (ind>nb_domain(rank)) THEN
484	rank=rank+1
485	ind=1
486	ENDIF
487	ind_glo=(j-1)*nsplit_i+i
488
489	nd_glo=nd_glo+1
490	IF (nd_glo==ndomain_glo) THEN
491
492	exit=.TRUE.
493	IF (.NOT. (rank==mpi_size-1 .AND. ind==nb_domain(rank) )) THEN
494	PRINT *, "Distribution problem in assign_domain"
495	STOP
496	ENDIF
497
498	ENDIF
499
500	domglo_rank(ind_glo)=rank
501	domglo_loc_ind(ind_glo)=ind
502	IF (rank==mpi_rank) THEN
503	CALL copy_domain(domain_glo(ind_glo),domain(ind))
504	domloc_glo_ind(ind)=ind_glo
505	ENDIF
506
507	j=j+1
508	ind=ind+1
509
510	ENDDO
511
512	IF (is_mpi_master) THEN
513
514	ind_glo=0
515	PRINT *,''
516	PRINT*, ' MPI PROCESS DISTRIBUTION'
517	PRINT *,''
518
519	WRITE(*,"(' ')", ADVANCE='NO')
520	DO n=1,nsplit_i*7-1
521	WRITE(*,"('=')", ADVANCE='NO')
522	ENDDO
523	PRINT *,''
524
525	DO nf=1,nb_face
526	DO j=1,nsplit_j
527	IF (j>1) THEN
528	WRITE(*,"(' ')", ADVANCE='NO')
529	DO n=1,nsplit_i*7-1
530	WRITE(*,"('-')", ADVANCE='NO')
531	ENDDO
532	PRINT *,''
533	ENDIF
534
535	WRITE(*,"('\|')", ADVANCE='NO')
536	DO i=1,nsplit_i
537	WRITE(*,"(' ',' ',' \|')",ADVANCE='NO')
538	ENDDO
539	PRINT *,''
540
541	WRITE(*,"('\|')", ADVANCE='NO')
542	DO i=1,nsplit_i
543	ind_glo=ind_glo+1
544	WRITE(*,"(' ',i4.4 ,' \|')", ADVANCE='NO') domglo_rank(ind_glo)
545	END DO
546	PRINT *,''
547
548	WRITE(*,"('\|')", ADVANCE='NO')
549	DO i=1,nsplit_i
550	WRITE(*,"(' ',' ',' \|')", ADVANCE='NO')
551	ENDDO
552	PRINT *,''
553
554	ENDDO
555
556	WRITE(*,"(' ')", ADVANCE='NO')
557	DO n=1,nsplit_i*7-1
558	WRITE(*,"('=')", ADVANCE='NO')
559	ENDDO
560	PRINT *,''
561	ENDDO
562	ENDIF
563
564	! rank=0
565	! ind=0
566	! DO ind_glo=1,ndomain_glo
567	! ind=ind+1
568	! domglo_rank(ind_glo)=rank
569	! domglo_loc_ind(ind_glo)=ind
570	! IF (rank==mpi_rank) THEN
571	! CALL copy_domain(domain_glo(ind_glo),domain(ind))
572	! domloc_glo_ind(ind)=ind_glo
573	! ENDIF
574	!
575	! IF (ind==nb_domain(rank)) THEN
576	! rank=rank+1
577	! ind=0
578	! ENDIF
579	! ENDDO
580
581	!$OMP PARALLEL
582	CALL assign_domain_omp
583	!$OMP END PARALLEL
584
585	END SUBROUTINE assign_domain
586
587	SUBROUTINE assign_domain_omp
588	USE omp_para
589	USE mpipara
590	IMPLICIT NONE
591	INTEGER :: nb_domain
592	INTEGER :: rank, ind, i
593
594	ALLOCATE(assigned_domain(ndomain))
595
596	ind=0
597	DO rank=0,omp_domain_size-1
598	nb_domain=ndomain/omp_domain_size
599	IF ( rank < MOD(ndomain,omp_domain_size) ) nb_domain=nb_domain+1
600
601	DO i=1,nb_domain
602	ind=ind+1
603	IF (rank==omp_domain_rank) THEN
604	assigned_domain(ind)=.TRUE.
605	WRITE(*,'(A,I6.6,A,I4.4,A,I4.4,A,I8.8)') "Rank ",mpi_rank," task ",rank," local domain ",ind, &
606	" global domain ",domloc_glo_ind(ind)
607	ELSE
608	assigned_domain(ind)=.FALSE.
609	ENDIF
610	ENDDO
611
612	ENDDO
613
614	END SUBROUTINE assign_domain_omp
615
616
617	SUBROUTINE compute_domain
618	USE grid_param, ONLY : grid_type, grid_unst, grid_ico
619	IMPLICIT NONE
620	SELECT CASE(grid_type)
621	CASE(grid_unst)
622	ndomain=1
623	ALLOCATE(assigned_domain(1))
624	assigned_domain=.TRUE.
625	CASE DEFAULT
626	CALL init_domain_param
627	CALL create_domain
628	CALL assign_cell
629	CALL compute_boundary
630	CALL set_neighbour_indice
631	CALL assign_domain
632	END SELECT
633	END SUBROUTINE compute_domain
634
635	END MODULE domain_mod

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

Download in other formats: