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 @ 69

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

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

Download in other formats:

Original Format