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 branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

Context Navigation

source: branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 3818

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

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

Download in other formats:

Original Format