New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

mppini_2.h90 in trunk/NEMO/OPA_SRC – NEMO

Context Navigation

source: trunk/NEMO/OPA_SRC/mppini_2.h90 @ 15

Last change on this file since 15 was 15, checked in by opalod, 20 years ago
CT : UPDATE001 : First major NEMO update
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 21.7 KB

Line
1	SUBROUTINE mpp_init2
2	!!----------------------------------------------------------------------
3	!! * ROUTINE mpp_init2 *
4	!!
5	!! * Purpose : Lay out the global domain over processors.
6	!! FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
7	!! FOR DEFINING BETTER CUTTING OUT.
8	!! This routine is used with a the bathymetry file.
9	!! In this version, the land processors are avoided and the adress
10	!! processor (nproc, narea,noea, ...) are calculated again.
11	!! The jpnij parameter can be lesser than jpni x jpnj
12	!! and this jpnij parameter must be calculated before with an
13	!! algoritmic preprocessing program.
14	!!
15	!! ** Method : Global domain is distributed in smaller local domains.
16	!! Periodic condition is a function of the local domain position
17	!! (global boundary or neighbouring domain) and of the global
18	!! periodic
19	!! Type : jperio global periodic condition
20	!! nperio local periodic condition
21	!!
22	!! ** Action : nimpp : longitudinal index
23	!! njmpp : latitudinal index
24	!! nperio : lateral condition type
25	!! narea : number for local area
26	!! nlci : first dimension
27	!! nlcj : second dimension
28	!! nproc : number for local processor
29	!! noea : number for local neighboring processor
30	!! nowe : number for local neighboring processor
31	!! noso : number for local neighboring processor
32	!! nono : number for local neighboring processor
33	!!
34	!! History :
35	!! ! 94-11 (M. Guyon) Original code
36	!! ! 95-04 (J. Escobar, M. Imbard)
37	!! ! 98-02 (M. Guyon) FETI method
38	!! ! 98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions
39	!! 9.0 ! 04-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1
40	!!----------------------------------------------------------------------
41	!! Local variables
42	CHARACTER (len=25) :: clexp ! temporary name
43	INTEGER :: ji, jj, jn, jproc, jarea ! dummy loop indices
44	INTEGER :: inum = 11 ! temporary logical unit
45	INTEGER :: &
46	ii, ij, ifreq, il1, il2, & ! temporary integers
47	iim, ijm, icont, ili, ilj, & ! " "
48	isurf, ijm1, imil, & ! " "
49	iino, ijno, iiso, ijso, & ! " "
50	iiea, ijea, iiwe, ijwe, & ! " "
51	iinw, ijnw, iine, ijne, & ! " "
52	iisw, ijsw, iise, ijse, & ! " "
53	iresti, irestj, iproc ! " "
54	INTEGER, DIMENSION(jpnij) :: &
55	iin, ijn
56	INTEGER, DIMENSION(jpni,jpnj) :: &
57	iimppt, ijmppt, ilci , ilcj , & ! temporary workspace
58	ipproc, ibondj, ibondi, ipolj , & ! " "
59	ilei , ilej , ildi , ildj , & ! " "
60	ioea , iowe , ioso , iono , & ! " "
61	ione , ionw , iose , iosw , & ! " "
62	ibne , ibnw , ibse , ibsw ! " "
63	INTEGER, DIMENSION(jpidta,jpjdta) :: &
64	idata ! temporary data workspace
65	INTEGER, DIMENSION(jpiglo,jpjglo) :: &
66	imask ! temporary global workspace
67	REAL(wp) :: zidom , zjdom ! temporary scalars
68	!!----------------------------------------------------------------------
69	!! OPA 8.5, LODYC-IPSL (2002)
70	!!----------------------------------------------------------------------
71
72	#if defined key_mpp_shmem
73	IF(lwp)WRITE(numout,*)
74	IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing PVM T3E + SHMEM'
75	IF(lwp)WRITE(numout,*) '~~~~~~~~'
76	IF(lwp)WRITE(numout,*) ' '
77
78	CALL mppshmem ! Initialisation of shmem array
79
80	#endif
81	#if defined key_mpp_mpi
82	IF(lwp)WRITE(numout,*)
83	IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
84	IF(lwp)WRITE(numout,*) '~~~~~~~~'
85	IF(lwp)WRITE(numout,*) ' '
86	#endif
87
88
89	IF( jpni*jpnj < jpnij ) THEN
90	IF(lwp) WRITE(numout,cform_err)
91	IF(lwp) WRITE(numout,*) ' jpnij > jpni x jpnj impossible'
92	nstop = nstop + 1
93	ENDIF
94
95
96	! 0. initialisation
97	! -----------------
98
99	! open the file
100	IF(lwp) WRITE(numout,*) ' bathymetry file in levels'
101	CALL ctlopn( inum, 'bathymetry', 'OLD', 'FORMATTED', 'SEQUENTIAL', &
102	1 , numout , lwp , 1 )
103
104	! read bathymetry file
105	REWIND inum
106	READ(inum,9001) clexp, iim, ijm
107	READ(inum,'(/)')
108	ifreq=40
109	il1=1
110	DO jn=1,jpidta/ifreq+1
111	READ(inum,'(/)')
112	il2 = MIN( jpidta, il1+ifreq-1 )
113	READ(inum,9002) ( ii, ji = il1, il2, 5 )
114	READ(inum,'(/)')
115	DO jj = jpjdta, 1, -1
116	READ(inum,9003) ij, ( idata(ji,jj), ji = il1, il2 )
117	END DO
118	il1 = il1 + ifreq
119	END DO
120	CLOSE(inum)
121
122	9001 FORMAT(1x,a15,2i8)
123	9002 FORMAT(3x,13(i3,12x))
124	9003 FORMAT(i3,41i3)
125
126	! land/sea mask over the global/zoom domain
127	DO jj = 1, jpjglo
128	DO ji = 1, jpiglo
129	imask(ji,jj) = MIN( 1, MAX( 0, idata(ji+jpizoom-1,jj+jpjzoom-1) ) )
130	END DO
131	END DO
132
133
134	! 1. Dimension arrays for subdomains
135	! -----------------------------------
136
137	! Computation of local domain sizes ilci() ilcj()
138	! These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
139	! The subdomains are squares leeser than or equal to the global
140	! dimensions divided by the number of processors minus the overlap
141	! array.
142
143	nreci=2*jpreci
144	nrecj=2*jprecj
145	iresti = MOD( jpiglo - nreci , jpni )
146	irestj = MOD( jpjglo - nrecj , jpnj )
147
148	IF( iresti == 0 ) iresti = jpni
149	DO jj = 1, jpnj
150	DO ji = 1, iresti
151	ilci(ji,jj) = jpi
152	END DO
153	DO ji = iresti+1, jpni
154	ilci(ji,jj) = jpi - 1
155	END DO
156	END DO
157
158	IF(irestj == 0) irestj = jpnj
159	DO ji = 1, jpni
160	DO jj = 1, irestj
161	ilcj(ji,jj) = jpj
162	END DO
163	DO jj = irestj+1, jpnj
164	ilcj(ji,jj) = jpj - 1
165	END DO
166	END DO
167
168	IF(lwp) WRITE(numout,*)
169	IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
170	IF(lwp) WRITE(numout,*) ' ~~~~~~ ----------------------'
171	IF(lwp) WRITE(numout,*)
172	IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
173	IF(lwp) WRITE(numout,*)
174	IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
175
176	zidom = nreci
177	DO ji = 1, jpni
178	zidom = zidom + ilci(ji,1) - nreci
179	END DO
180	IF(lwp) WRITE(numout,*)
181	IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
182
183	zjdom = nrecj
184	DO jj = 1, jpnj
185	zjdom = zjdom + ilcj(1,jj) - nrecj
186	END DO
187	IF(lwp) WRITE(numout,*) ' sum ilci(1,j)=',zjdom,' jpjglo=',jpjglo
188	IF(lwp) WRITE(numout,*)
189
190
191	! 2. Index arrays for subdomains
192	! -------------------------------
193
194	DO jj = 1, jpnj
195	DO ji = 1, jpni
196	iimppt(ji,jj) = 1
197	ijmppt(ji,jj) = 1
198	ipproc(ji,jj) = -1
199	END DO
200	END DO
201
202	IF( jpni > 1 )THEN
203	DO jj = 1, jpnj
204	DO ji = 2, jpni
205	iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
206	END DO
207	END DO
208	ENDIF
209
210	IF( jpnj > 1 )THEN
211	DO jj = 2, jpnj
212	DO ji = 1, jpni
213	ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
214	END DO
215	END DO
216	ENDIF
217
218
219	! 3. Subdomain description in the Regular Case
220	! --------------------------------------------
221
222	nperio = 0
223	icont = -1
224	DO jarea = 1, jpni*jpnj
225	ii = 1 + MOD(jarea-1,jpni)
226	ij = 1 + (jarea-1)/jpni
227	ili = ilci(ii,ij)
228	ilj = ilcj(ii,ij)
229
230	ibondj(ii,ij) = -1
231	IF( jarea > jpni ) ibondj(ii,ij) = 0
232	IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1
233	IF( jpnj == 1 ) ibondj(ii,ij) = 2
234
235	ibondi(ii,ij) = 0
236	IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1
237	IF( MOD(jarea,jpni) == 0 ) ibondi(ii,ij) = 1
238	IF( jpni == 1 ) ibondi(ii,ij) = 2
239
240	! 2.4 Subdomain neighbors
241
242	iproc = jarea - 1
243	ioso(ii,ij) = iproc - jpni
244	iowe(ii,ij) = iproc - 1
245	ioea(ii,ij) = iproc + 1
246	iono(ii,ij) = iproc + jpni
247	ildi(ii,ij) = 1 + jpreci
248	ilei(ii,ij) = ili -jpreci
249	ionw(ii,ij) = iono(ii,ij) - 1
250	ione(ii,ij) = iono(ii,ij) + 1
251	iosw(ii,ij) = ioso(ii,ij) - 1
252	iose(ii,ij) = ioso(ii,ij) + 1
253	ibsw(ii,ij) = 1
254	ibnw(ii,ij) = 1
255	IF( MOD(iproc,jpni) == 0 ) THEN
256	ibsw(ii,ij) = 0
257	ibnw(ii,ij) = 0
258	ENDIF
259	ibse(ii,ij) = 1
260	ibne(ii,ij) = 1
261	IF( MOD(iproc,jpni) == jpni-1 ) THEN
262	ibse(ii,ij) = 0
263	ibne(ii,ij) = 0
264	ENDIF
265	IF( iproc < jpni ) THEN
266	ibsw(ii,ij) = 0
267	ibse(ii,ij) = 0
268	ENDIF
269	IF( iproc >= (jpnj-1)*jpni ) THEN
270	ibnw(ii,ij) = 0
271	ibne(ii,ij) = 0
272	ENDIF
273	IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
274	IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
275	ildj(ii,ij) = 1 + jprecj
276	ilej(ii,ij) = ilj - jprecj
277	IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
278	IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
279
280	! warning ii*ij (zone) /= nproc (processors)!
281
282	IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
283	IF( jpni == 1 )THEN
284	ibondi(ii,ij) = 2
285	nperio = 1
286	ELSE
287	ibondi(ii,ij) = 0
288	ENDIF
289	IF( MOD(jarea,jpni) == 0 ) THEN
290	ioea(ii,ij) = iproc - (jpni-1)
291	ione(ii,ij) = ione(ii,ij) - jpni
292	iose(ii,ij) = iose(ii,ij) - jpni
293	ENDIF
294	IF( MOD(jarea,jpni) == 1 ) THEN
295	iowe(ii,ij) = iproc + jpni - 1
296	ionw(ii,ij) = ionw(ii,ij) + jpni
297	iosw(ii,ij) = iosw(ii,ij) + jpni
298	ENDIF
299	ibsw(ii,ij) = 1
300	ibnw(ii,ij) = 1
301	ibse(ii,ij) = 1
302	ibne(ii,ij) = 1
303	IF( iproc < jpni ) THEN
304	ibsw(ii,ij) = 0
305	ibse(ii,ij) = 0
306	ENDIF
307	IF( iproc >= (jpnj-1)*jpni ) THEN
308	ibnw(ii,ij) = 0
309	ibne(ii,ij) = 0
310	ENDIF
311	ENDIF
312	ipolj(ii,jj) = 0
313	IF( jperio == 3 .OR. jperio == 4 ) THEN
314	ijm1 = jpni*(jpnj-1)
315	imil = ijm1+(jpni+1)/2
316	IF( jarea > ijm1 ) ipolj(ii,ij) = 3
317	IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
318	IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1
319	ENDIF
320	IF( jperio == 5 .OR. jperio == 6 ) THEN
321	ijm1 = jpni*(jpnj-1)
322	imil = ijm1+(jpni+1)/2
323	IF( jarea > ijm1) ipolj(ii,ij) = 5
324	IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
325	IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1
326	ENDIF
327
328	isurf = 0
329	DO jj = 1, ilj
330	DO ji = 1, ili
331	IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
332	END DO
333	END DO
334	IF(isurf /= 0) THEN
335	icont = icont + 1
336	ipproc(ii,ij) = icont
337	iin(icont+1) = ii
338	ijn(icont+1) = ij
339	ENDIF
340	END DO
341
342	! Control
343	IF(icont+1 /= jpnij) THEN
344	IF(lwp) THEN
345	WRITE(numout,*) ' Eliminate land processors algorithm'
346	WRITE(numout,*)
347	WRITE(numout,*) ' jpni =',jpni,' jpnj =',jpnj
348	WRITE(numout,*) ' jpnij =',jpnij, '< jpni x jpnj'
349	WRITE(numout,*)
350	WRITE(numout,*) ' E R R O R '
351	WRITE(numout,) ' **********, mpp_init2 finds jpnij=',icont+1
352	WRITE(numout,*) ' we stop'
353	ENDIF
354	STOP 'mpp_init2'
355	ENDIF
356
357
358	! 4. Subdomain print
359	! ------------------
360
361	IF(lwp) THEN
362	ifreq = 4
363	il1 = 1
364	DO jn = 1,(jpni-1)/ifreq+1
365	il2 = MIN(jpni,il1+ifreq-1)
366	WRITE(numout,*)
367	WRITE(numout,9401) (ji,ji=il1,il2)
368	WRITE(numout,9400) ('***',ji=il1,il2-1)
369	DO jj = 1, jpnj
370	! WRITE(numout,9400)
371	WRITE(numout,9403) (' ',ji=il1,il2-1)
372	WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
373	WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
374	WRITE(numout,9403) (' ',ji=il1,il2-1)
375	WRITE(numout,9400) ('***',ji=il1,il2-1)
376	! WRITE(numout,9400)
377	END DO
378	il1 = il1+ifreq
379	END DO
380	9400 FORMAT(' *',20('***********',a3))
381	9403 FORMAT(' * ',20(' * ',a3))
382	9401 FORMAT(' ',20(' ',i3,' '))
383	9402 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * '))
384	9404 FORMAT(' * ',20(' ',i3,' * '))
385	ENDIF
386
387
388	! 5. neighbour treatment
389	! ----------------------
390
391	DO jarea = 1, jpni*jpnj
392	iproc = jarea-1
393	ii = 1 + MOD(jarea-1,jpni)
394	ij = 1 + (jarea-1)/jpni
395	IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0 &
396	.AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
397	iino = 1 + MOD(iono(ii,ij),jpni)
398	ijno = 1 + (iono(ii,ij))/jpni
399	IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2
400	IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1
401	ENDIF
402	IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0 &
403	.AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
404	iiso = 1 + MOD(ioso(ii,ij),jpni)
405	ijso = 1 + (ioso(ii,ij))/jpni
406	IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
407	IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1
408	ENDIF
409	IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0 &
410	.AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
411	iiea = 1 + MOD(ioea(ii,ij),jpni)
412	ijea = 1 + (ioea(ii,ij))/jpni
413	IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
414	IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
415	ENDIF
416	IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0 &
417	.AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
418	iiwe = 1 + MOD(iowe(ii,ij),jpni)
419	ijwe = 1 + (iowe(ii,ij))/jpni
420	IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
421	IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1
422	ENDIF
423	IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
424	iine = 1 + MOD(ione(ii,ij),jpni)
425	ijne = 1 + (ione(ii,ij))/jpni
426	IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
427	ENDIF
428	IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
429	iisw = 1 + MOD(iosw(ii,ij),jpni)
430	ijsw = 1 + (iosw(ii,ij))/jpni
431	IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
432	ENDIF
433	IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
434	iinw = 1 + MOD(ionw(ii,ij),jpni)
435	ijnw = 1 + (ionw(ii,ij))/jpni
436	IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
437	ENDIF
438	IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
439	iise = 1 + MOD(iose(ii,ij),jpni)
440	ijse = 1 + (iose(ii,ij))/jpni
441	IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
442	ENDIF
443	END DO
444
445
446	! 6. Change processor name
447	! ------------------------
448
449	nproc = narea-1
450	ii = iin(narea)
451	ij = ijn(narea)
452	IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
453	iiso = 1 + MOD(ioso(ii,ij),jpni)
454	ijso = 1 + (ioso(ii,ij))/jpni
455	noso = ipproc(iiso,ijso)
456	ENDIF
457	IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
458	iiwe = 1 + MOD(iowe(ii,ij),jpni)
459	ijwe = 1 + (iowe(ii,ij))/jpni
460	nowe = ipproc(iiwe,ijwe)
461	ENDIF
462	IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
463	iiea = 1 + MOD(ioea(ii,ij),jpni)
464	ijea = 1 + (ioea(ii,ij))/jpni
465	noea = ipproc(iiea,ijea)
466	ENDIF
467	IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
468	iino = 1 + MOD(iono(ii,ij),jpni)
469	ijno = 1 + (iono(ii,ij))/jpni
470	nono = ipproc(iino,ijno)
471	ENDIF
472	IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN
473	iise = 1 + MOD(iose(ii,ij),jpni)
474	ijse = 1 + (iose(ii,ij))/jpni
475	npse = ipproc(iise,ijse)
476	ENDIF
477	IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN
478	iisw = 1 + MOD(iosw(ii,ij),jpni)
479	ijsw = 1 + (iosw(ii,ij))/jpni
480	npsw = ipproc(iisw,ijsw)
481	ENDIF
482	IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN
483	iine = 1 + MOD(ione(ii,ij),jpni)
484	ijne = 1 + (ione(ii,ij))/jpni
485	npne = ipproc(iine,ijne)
486	ENDIF
487	IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN
488	iinw = 1 + MOD(ionw(ii,ij),jpni)
489	ijnw = 1 + (ionw(ii,ij))/jpni
490	npnw = ipproc(iinw,ijnw)
491	ENDIF
492	nbnw = ibnw(ii,ij)
493	nbne = ibne(ii,ij)
494	nbsw = ibsw(ii,ij)
495	nbse = ibse(ii,ij)
496	nlcj = ilcj(ii,ij)
497	nlci = ilci(ii,ij)
498	nldi = ildi(ii,ij)
499	nlei = ilei(ii,ij)
500	nldj = ildj(ii,ij)
501	nlej = ilej(ii,ij)
502	nbondi = ibondi(ii,ij)
503	nbondj = ibondj(ii,ij)
504	nimpp = iimppt(ii,ij)
505	njmpp = ijmppt(ii,ij)
506	DO jproc = 1, jpnij
507	ii = iin(jproc)
508	ij = ijn(jproc)
509	nimppt(jproc) = iimppt(ii,ij)
510	njmppt(jproc) = ijmppt(ii,ij)
511	nlcjt(jproc) = ilcj(ii,ij)
512	nlcit(jproc) = ilci(ii,ij)
513	nldit(jproc) = ildi(ii,ij)
514	nleit(jproc) = ilei(ii,ij)
515	nldjt(jproc) = ildj(ii,ij)
516	nlejt(jproc) = ilej(ii,ij)
517	END DO
518
519	! Save processor layout in ascii file
520	IF (lwp) THEN
521	OPEN(inum,FILE='layout.dat')
522	WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
523	WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
524
525	DO jproc = 1, jpnij
526	WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
527	nldit(jproc), nldjt(jproc), &
528	nleit(jproc), nlejt(jproc), &
529	nimppt(jproc), njmppt(jproc)
530	END DO
531	CLOSE(inum)
532	END IF
533
534
535	! FETI method
536
537	IF( nperio == 1 .AND. nsolv == 3 ) THEN
538
539	! general CASE : Earth == infinite tube
540
541	nbnw = 1
542	npnw = narea
543	nbne = 1
544	npne = narea
545	nbsw = 1
546	npsw = (narea-2)
547	nbse = 1
548	npse = (narea-2)
549
550	! REAL boundary condition
551
552	IF( nbondj == -1 .OR. nbondj == 2 ) THEN
553	nbsw = 0
554	nbse = 0
555	ENDIF
556
557	IF( nbondj == -1 .OR. nbondj == 2 ) THEN
558	nbsw = 0
559	nbse = 0
560	ENDIF
561
562	IF( nbondj == 1 .OR. nbondj == 2 ) THEN
563	nbnw = 0
564	nbne = 0
565	ENDIF
566	ENDIF
567
568	! Periodicity : no corner if nbondi = 2 and nperio != 1
569
570	IF(lwp) WRITE(numout,*) ' nproc= ',nproc
571	IF(lwp) WRITE(numout,*) ' nowe= ',nowe
572	IF(lwp) WRITE(numout,*) ' noea= ',noea
573	IF(lwp) WRITE(numout,*) ' nono= ',nono
574	IF(lwp) WRITE(numout,*) ' noso= ',noso
575	IF(lwp) WRITE(numout,*) ' nbondi= ',nbondi
576	IF(lwp) WRITE(numout,*) ' nbondj= ',nbondj
577	IF(lwp) WRITE(numout,*) ' npolj= ',npolj
578	IF(lwp) WRITE(numout,*) ' nperio= ',nperio
579	IF(lwp) WRITE(numout,*) ' nlci= ',nlci
580	IF(lwp) WRITE(numout,*) ' nlcj= ',nlcj
581	IF(lwp) WRITE(numout,*) ' nimpp= ',nimpp
582	IF(lwp) WRITE(numout,*) ' njmpp= ',njmpp
583	IF(lwp) WRITE(numout,*) ' nbse= ',nbse,' npse= ',npse
584	IF(lwp) WRITE(numout,*) ' nbsw= ',nbsw,' npsw= ',npsw
585	IF(lwp) WRITE(numout,*) ' nbne= ',nbne,' npne= ',npne
586	IF(lwp) WRITE(numout,*) ' nbnw= ',nbnw,' npnw= ',npnw
587
588	IF( nperio == 1 .AND.jpni /= 1 ) THEN
589	IF(lwp) WRITE(numout,cform_err)
590	IF(lwp) WRITE(numout,*) ' mpp_init2: error on cyclicity'
591	nstop = nstop + 1
592	ENDIF
593
594	! Prepare mpp north fold
595
596	IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
597	CALL mpp_ini_north
598	IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
599	END IF
600
601	! Defined npolj, either 0, 3 , 4 , 5 , 6
602	! In this case the important thing is that npolj /= 0
603	! Because if we go through these line it is because jpni >1 and thus
604	! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
605
606	npolj = 0
607	ij = ijn(narea)
608
609	IF (jperio == 3 .OR. jperio == 4 ) THEN
610	IF ( ij == jpnj ) npolj = 3
611	ENDIF
612
613	IF( jperio == 5 .OR. jperio == 6 ) THEN
614	IF ( ij == jpnj ) npolj = 5
615	ENDIF
616
617
618	END SUBROUTINE mpp_init2

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

Download in other formats:

Original Format