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

Last change on this file since 1587 was 1581, checked in by smasson, 15 years ago
ctlopn cleanup, see ticket:515 and ticket:237
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 19.8 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	!! * Modules used
42	USE in_out_manager ! I/O Manager
43	USE iom
44
45	!! Local variables
46	INTEGER :: ji, jj, jn, jproc, jarea ! dummy loop indices
47	INTEGER :: inum ! temporary logical unit
48	INTEGER :: &
49	ii, ij, ifreq, il1, il2, & ! temporary integers
50	icont, ili, ilj, & ! " "
51	isurf, ijm1, imil, & ! " "
52	iino, ijno, iiso, ijso, & ! " "
53	iiea, ijea, iiwe, ijwe, & ! " "
54	iinw, ijnw, iine, ijne, & ! " "
55	iisw, ijsw, iise, ijse, & ! " "
56	iresti, irestj, iproc ! " "
57	INTEGER, DIMENSION(jpnij) :: &
58	iin, ijn
59	INTEGER, DIMENSION(jpni,jpnj) :: &
60	iimppt, ijmppt, ilci , ilcj , & ! temporary workspace
61	ipproc, ibondj, ibondi, ipolj , & ! " "
62	ilei , ilej , ildi , ildj , & ! " "
63	ioea , iowe , ioso , iono , & ! " "
64	ione , ionw , iose , iosw , & ! " "
65	ibne , ibnw , ibse , ibsw ! " "
66	INTEGER, DIMENSION(jpiglo,jpjglo) :: &
67	imask ! temporary global workspace
68	REAL(wp), DIMENSION(jpiglo,jpjglo) :: &
69	zdta ! temporary data workspace
70	REAL(wp) :: zidom , zjdom ! temporary scalars
71
72	! read namelist for ln_zco
73	NAMELIST/nam_zgr/ ln_zco, ln_zps, ln_sco
74
75	!!----------------------------------------------------------------------
76	!! OPA 9.0 , LOCEAN-IPSL (2005)
77	!! $Id$
78	!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
79	!!----------------------------------------------------------------------
80	! Read Namelist nam_zgr : vertical coordinate'
81	! ---------------------
82	REWIND ( numnam )
83	READ ( numnam, nam_zgr )
84
85	IF(lwp)WRITE(numout,*)
86	IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
87	IF(lwp)WRITE(numout,*) '~~~~~~~~'
88	IF(lwp)WRITE(numout,*) ' '
89
90	IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
91
92	! 0. initialisation
93	! -----------------
94
95	! open the file
96	! Remember that at this level in the code, mpp is not yet initialized, so
97	! the file must be open with jpdom_unknown, and kstart amd kcount forced
98	IF ( ln_zco ) THEN
99	CALL iom_open ( 'bathy_level.nc', inum ) ! Level bathymetry
100	CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
101	ELSE
102	CALL iom_open ( 'bathy_meter.nc', inum ) ! Meter bathy in case of partial steps
103	CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
104	ENDIF
105	CALL iom_close (inum)
106
107	! land/sea mask over the global/zoom domain
108
109	imask(:,:)=1
110	WHERE ( zdta(:,:) <= 0. ) imask = 0
111
112	! 1. Dimension arrays for subdomains
113	! -----------------------------------
114
115	! Computation of local domain sizes ilci() ilcj()
116	! These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
117	! The subdomains are squares leeser than or equal to the global
118	! dimensions divided by the number of processors minus the overlap
119	! array.
120
121	nreci=2*jpreci
122	nrecj=2*jprecj
123	iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
124	irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
125
126	ilci(1:iresti ,:) = jpi
127	ilci(iresti+1:jpni ,:) = jpi-1
128
129	ilcj(:, 1:irestj) = jpj
130	ilcj(:, irestj+1:jpnj) = jpj-1
131
132	IF(lwp) WRITE(numout,*)
133	IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
134	IF(lwp) WRITE(numout,*) ' ~~~~~~ ----------------------'
135	IF(lwp) WRITE(numout,*)
136	IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
137	IF(lwp) WRITE(numout,*)
138	IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
139
140	zidom = nreci + sum(ilci(:,1) - nreci )
141	IF(lwp) WRITE(numout,*)
142	IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
143
144	zjdom = nrecj + sum(ilcj(1,:) - nrecj )
145	IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
146	IF(lwp) WRITE(numout,*)
147
148
149	! 2. Index arrays for subdomains
150	! -------------------------------
151
152	iimppt(:,:) = 1
153	ijmppt(:,:) = 1
154	ipproc(:,:) = -1
155
156	IF( jpni > 1 )THEN
157	DO jj = 1, jpnj
158	DO ji = 2, jpni
159	iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
160	END DO
161	END DO
162	ENDIF
163
164	IF( jpnj > 1 )THEN
165	DO jj = 2, jpnj
166	DO ji = 1, jpni
167	ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
168	END DO
169	END DO
170	ENDIF
171
172
173	! 3. Subdomain description in the Regular Case
174	! --------------------------------------------
175
176	nperio = 0
177	icont = -1
178	DO jarea = 1, jpni*jpnj
179	ii = 1 + MOD(jarea-1,jpni)
180	ij = 1 + (jarea-1)/jpni
181	ili = ilci(ii,ij)
182	ilj = ilcj(ii,ij)
183
184	ibondj(ii,ij) = -1
185	IF( jarea > jpni ) ibondj(ii,ij) = 0
186	IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1
187	IF( jpnj == 1 ) ibondj(ii,ij) = 2
188
189	ibondi(ii,ij) = 0
190	IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1
191	IF( MOD(jarea,jpni) == 0 ) ibondi(ii,ij) = 1
192	IF( jpni == 1 ) ibondi(ii,ij) = 2
193
194	! 2.4 Subdomain neighbors
195
196	iproc = jarea - 1
197	ioso(ii,ij) = iproc - jpni
198	iowe(ii,ij) = iproc - 1
199	ioea(ii,ij) = iproc + 1
200	iono(ii,ij) = iproc + jpni
201	ildi(ii,ij) = 1 + jpreci
202	ilei(ii,ij) = ili -jpreci
203	ionw(ii,ij) = iono(ii,ij) - 1
204	ione(ii,ij) = iono(ii,ij) + 1
205	iosw(ii,ij) = ioso(ii,ij) - 1
206	iose(ii,ij) = ioso(ii,ij) + 1
207	ibsw(ii,ij) = 1
208	ibnw(ii,ij) = 1
209	IF( MOD(iproc,jpni) == 0 ) THEN
210	ibsw(ii,ij) = 0
211	ibnw(ii,ij) = 0
212	ENDIF
213	ibse(ii,ij) = 1
214	ibne(ii,ij) = 1
215	IF( MOD(iproc,jpni) == jpni-1 ) THEN
216	ibse(ii,ij) = 0
217	ibne(ii,ij) = 0
218	ENDIF
219	IF( iproc < jpni ) THEN
220	ibsw(ii,ij) = 0
221	ibse(ii,ij) = 0
222	ENDIF
223	IF( iproc >= (jpnj-1)*jpni ) THEN
224	ibnw(ii,ij) = 0
225	ibne(ii,ij) = 0
226	ENDIF
227	IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
228	IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
229	ildj(ii,ij) = 1 + jprecj
230	ilej(ii,ij) = ilj - jprecj
231	IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
232	IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
233
234	! warning ii*ij (zone) /= nproc (processors)!
235
236	IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
237	IF( jpni == 1 )THEN
238	ibondi(ii,ij) = 2
239	nperio = 1
240	ELSE
241	ibondi(ii,ij) = 0
242	ENDIF
243	IF( MOD(jarea,jpni) == 0 ) THEN
244	ioea(ii,ij) = iproc - (jpni-1)
245	ione(ii,ij) = ione(ii,ij) - jpni
246	iose(ii,ij) = iose(ii,ij) - jpni
247	ENDIF
248	IF( MOD(jarea,jpni) == 1 ) THEN
249	iowe(ii,ij) = iproc + jpni - 1
250	ionw(ii,ij) = ionw(ii,ij) + jpni
251	iosw(ii,ij) = iosw(ii,ij) + jpni
252	ENDIF
253	ibsw(ii,ij) = 1
254	ibnw(ii,ij) = 1
255	ibse(ii,ij) = 1
256	ibne(ii,ij) = 1
257	IF( iproc < jpni ) THEN
258	ibsw(ii,ij) = 0
259	ibse(ii,ij) = 0
260	ENDIF
261	IF( iproc >= (jpnj-1)*jpni ) THEN
262	ibnw(ii,ij) = 0
263	ibne(ii,ij) = 0
264	ENDIF
265	ENDIF
266	ipolj(ii,ij) = 0
267	IF( jperio == 3 .OR. jperio == 4 ) THEN
268	ijm1 = jpni*(jpnj-1)
269	imil = ijm1+(jpni+1)/2
270	IF( jarea > ijm1 ) ipolj(ii,ij) = 3
271	IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
272	IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1
273	ENDIF
274	IF( jperio == 5 .OR. jperio == 6 ) THEN
275	ijm1 = jpni*(jpnj-1)
276	imil = ijm1+(jpni+1)/2
277	IF( jarea > ijm1) ipolj(ii,ij) = 5
278	IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
279	IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1
280	ENDIF
281
282	isurf = 0
283	DO jj = 1+jprecj, ilj-jprecj
284	DO ji = 1+jpreci, ili-jpreci
285	IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
286	END DO
287	END DO
288	IF(isurf /= 0) THEN
289	icont = icont + 1
290	ipproc(ii,ij) = icont
291	iin(icont+1) = ii
292	ijn(icont+1) = ij
293	ENDIF
294	END DO
295
296	! Control
297	IF(icont+1 /= jpnij) THEN
298	WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
299	WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'
300	WRITE(ctmp3,) ' **********, mpp_init2 finds jpnij=',icont+1
301	CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
302	ENDIF
303
304	! 4. Subdomain print
305	! ------------------
306
307	IF(lwp) THEN
308	ifreq = 4
309	il1 = 1
310	DO jn = 1,(jpni-1)/ifreq+1
311	il2 = MIN(jpni,il1+ifreq-1)
312	WRITE(numout,*)
313	WRITE(numout,9400) ('***',ji=il1,il2-1)
314	DO jj = jpnj, 1, -1
315	WRITE(numout,9403) (' ',ji=il1,il2-1)
316	WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
317	WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
318	WRITE(numout,9403) (' ',ji=il1,il2-1)
319	WRITE(numout,9400) ('***',ji=il1,il2-1)
320	END DO
321	WRITE(numout,9401) (ji,ji=il1,il2)
322	il1 = il1+ifreq
323	END DO
324	9400 FORMAT(' *',20('***********',a3))
325	9403 FORMAT(' * ',20(' * ',a3))
326	9401 FORMAT(' ',20(' ',i3,' '))
327	9402 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * '))
328	9404 FORMAT(' * ',20(' ',i3,' * '))
329	ENDIF
330
331
332	! 5. neighbour treatment
333	! ----------------------
334
335	DO jarea = 1, jpni*jpnj
336	iproc = jarea-1
337	ii = 1 + MOD(jarea-1,jpni)
338	ij = 1 + (jarea-1)/jpni
339	IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0 &
340	.AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
341	iino = 1 + MOD(iono(ii,ij),jpni)
342	ijno = 1 + (iono(ii,ij))/jpni
343	IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2
344	IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1
345	ENDIF
346	IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0 &
347	.AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
348	iiso = 1 + MOD(ioso(ii,ij),jpni)
349	ijso = 1 + (ioso(ii,ij))/jpni
350	IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
351	IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1
352	ENDIF
353	IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0 &
354	.AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
355	iiea = 1 + MOD(ioea(ii,ij),jpni)
356	ijea = 1 + (ioea(ii,ij))/jpni
357	IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
358	IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
359	ENDIF
360	IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0 &
361	.AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
362	iiwe = 1 + MOD(iowe(ii,ij),jpni)
363	ijwe = 1 + (iowe(ii,ij))/jpni
364	IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
365	IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1
366	ENDIF
367	IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
368	iine = 1 + MOD(ione(ii,ij),jpni)
369	ijne = 1 + (ione(ii,ij))/jpni
370	IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
371	ENDIF
372	IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
373	iisw = 1 + MOD(iosw(ii,ij),jpni)
374	ijsw = 1 + (iosw(ii,ij))/jpni
375	IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
376	ENDIF
377	IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
378	iinw = 1 + MOD(ionw(ii,ij),jpni)
379	ijnw = 1 + (ionw(ii,ij))/jpni
380	IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
381	ENDIF
382	IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
383	iise = 1 + MOD(iose(ii,ij),jpni)
384	ijse = 1 + (iose(ii,ij))/jpni
385	IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
386	ENDIF
387	END DO
388
389
390	! 6. Change processor name
391	! ------------------------
392
393	nproc = narea-1
394	ii = iin(narea)
395	ij = ijn(narea)
396	IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
397	iiso = 1 + MOD(ioso(ii,ij),jpni)
398	ijso = 1 + (ioso(ii,ij))/jpni
399	noso = ipproc(iiso,ijso)
400	ENDIF
401	IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
402	iiwe = 1 + MOD(iowe(ii,ij),jpni)
403	ijwe = 1 + (iowe(ii,ij))/jpni
404	nowe = ipproc(iiwe,ijwe)
405	ENDIF
406	IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
407	iiea = 1 + MOD(ioea(ii,ij),jpni)
408	ijea = 1 + (ioea(ii,ij))/jpni
409	noea = ipproc(iiea,ijea)
410	ENDIF
411	IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
412	iino = 1 + MOD(iono(ii,ij),jpni)
413	ijno = 1 + (iono(ii,ij))/jpni
414	nono = ipproc(iino,ijno)
415	ENDIF
416	IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN
417	iise = 1 + MOD(iose(ii,ij),jpni)
418	ijse = 1 + (iose(ii,ij))/jpni
419	npse = ipproc(iise,ijse)
420	ENDIF
421	IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN
422	iisw = 1 + MOD(iosw(ii,ij),jpni)
423	ijsw = 1 + (iosw(ii,ij))/jpni
424	npsw = ipproc(iisw,ijsw)
425	ENDIF
426	IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN
427	iine = 1 + MOD(ione(ii,ij),jpni)
428	ijne = 1 + (ione(ii,ij))/jpni
429	npne = ipproc(iine,ijne)
430	ENDIF
431	IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN
432	iinw = 1 + MOD(ionw(ii,ij),jpni)
433	ijnw = 1 + (ionw(ii,ij))/jpni
434	npnw = ipproc(iinw,ijnw)
435	ENDIF
436	nbnw = ibnw(ii,ij)
437	nbne = ibne(ii,ij)
438	nbsw = ibsw(ii,ij)
439	nbse = ibse(ii,ij)
440	nlcj = ilcj(ii,ij)
441	nlci = ilci(ii,ij)
442	nldi = ildi(ii,ij)
443	nlei = ilei(ii,ij)
444	nldj = ildj(ii,ij)
445	nlej = ilej(ii,ij)
446	nbondi = ibondi(ii,ij)
447	nbondj = ibondj(ii,ij)
448	nimpp = iimppt(ii,ij)
449	njmpp = ijmppt(ii,ij)
450	DO jproc = 1, jpnij
451	ii = iin(jproc)
452	ij = ijn(jproc)
453	nimppt(jproc) = iimppt(ii,ij)
454	njmppt(jproc) = ijmppt(ii,ij)
455	nlcjt(jproc) = ilcj(ii,ij)
456	nlcit(jproc) = ilci(ii,ij)
457	nldit(jproc) = ildi(ii,ij)
458	nleit(jproc) = ilei(ii,ij)
459	nldjt(jproc) = ildj(ii,ij)
460	nlejt(jproc) = ilej(ii,ij)
461	END DO
462
463	! Save processor layout in ascii file
464	IF (lwp) THEN
465	CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
466	WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
467	WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
468
469	DO jproc = 1, jpnij
470	WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
471	nldit(jproc), nldjt(jproc), &
472	nleit(jproc), nlejt(jproc), &
473	nimppt(jproc), njmppt(jproc)
474	END DO
475	CLOSE(inum)
476	END IF
477
478	IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )
479
480	! Prepare mpp north fold
481
482	IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
483	CALL mpp_ini_north
484	IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
485	ENDIF
486
487	! Defined npolj, either 0, 3 , 4 , 5 , 6
488	! In this case the important thing is that npolj /= 0
489	! Because if we go through these line it is because jpni >1 and thus
490	! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
491
492	npolj = 0
493	ij = ijn(narea)
494
495	IF( jperio == 3 .OR. jperio == 4 ) THEN
496	IF( ij == jpnj ) npolj = 3
497	ENDIF
498
499	IF( jperio == 5 .OR. jperio == 6 ) THEN
500	IF( ij == jpnj ) npolj = 5
501	ENDIF
502
503	! Prepare NetCDF output file (if necessary)
504	CALL mpp_init_ioipsl
505
506	! Periodicity : no corner if nbondi = 2 and nperio != 1
507
508	IF(lwp) THEN
509	WRITE(numout,*) ' nproc= ',nproc
510	WRITE(numout,*) ' nowe= ',nowe
511	WRITE(numout,*) ' noea= ',noea
512	WRITE(numout,*) ' nono= ',nono
513	WRITE(numout,*) ' noso= ',noso
514	WRITE(numout,*) ' nbondi= ',nbondi
515	WRITE(numout,*) ' nbondj= ',nbondj
516	WRITE(numout,*) ' npolj= ',npolj
517	WRITE(numout,*) ' nperio= ',nperio
518	WRITE(numout,*) ' nlci= ',nlci
519	WRITE(numout,*) ' nlcj= ',nlcj
520	WRITE(numout,*) ' nimpp= ',nimpp
521	WRITE(numout,*) ' njmpp= ',njmpp
522	WRITE(numout,*) ' nbse= ',nbse,' npse= ',npse
523	WRITE(numout,*) ' nbsw= ',nbsw,' npsw= ',npsw
524	WRITE(numout,*) ' nbne= ',nbne,' npne= ',npne
525	WRITE(numout,*) ' nbnw= ',nbnw,' npnw= ',npnw
526	ENDIF
527
528	END SUBROUTINE mpp_init2

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

Download in other formats:

Original Format