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

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

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

Download in other formats:

Original Format