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

Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 3986

Last change on this file since 3986 was 3986, checked in by charris, 11 years ago
#1138 Changes for land suppression when running with CICE.
Property svn:keywords set to `Id`
File size: 20.6 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	#if defined key_nemocice_decomp
125	! Change padding to be consistent with CICE
126	ilci(1:jpni-1 ,:) = jpi
127	ilci(jpni ,:) = jpiglo - (jpni - 1) * (jpi - nreci)
128
129	ilcj(:, 1:jpnj-1) = jpj
130	ilcj(:, jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj)
131	#else
132	ilci(1:iresti ,:) = jpi
133	ilci(iresti+1:jpni ,:) = jpi-1
134
135	ilcj(:, 1:irestj) = jpj
136	ilcj(:, irestj+1:jpnj) = jpj-1
137	#endif
138
139	IF(lwp) WRITE(numout,*)
140	IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
141	IF(lwp) WRITE(numout,*) ' ~~~~~~ ----------------------'
142	IF(lwp) WRITE(numout,*)
143	IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
144	IF(lwp) WRITE(numout,*)
145	IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
146
147	zidom = nreci + sum(ilci(:,1) - nreci )
148	IF(lwp) WRITE(numout,*)
149	IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
150
151	zjdom = nrecj + sum(ilcj(1,:) - nrecj )
152	IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
153	IF(lwp) WRITE(numout,*)
154
155
156	! 2. Index arrays for subdomains
157	! -------------------------------
158
159	iimppt(:,:) = 1
160	ijmppt(:,:) = 1
161	ipproc(:,:) = -1
162
163	IF( jpni > 1 )THEN
164	DO jj = 1, jpnj
165	DO ji = 2, jpni
166	iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
167	END DO
168	END DO
169	ENDIF
170
171	IF( jpnj > 1 )THEN
172	DO jj = 2, jpnj
173	DO ji = 1, jpni
174	ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
175	END DO
176	END DO
177	ENDIF
178
179
180	! 3. Subdomain description in the Regular Case
181	! --------------------------------------------
182
183	nperio = 0
184	icont = -1
185	DO jarea = 1, jpni*jpnj
186	ii = 1 + MOD(jarea-1,jpni)
187	ij = 1 + (jarea-1)/jpni
188	ili = ilci(ii,ij)
189	ilj = ilcj(ii,ij)
190
191	ibondj(ii,ij) = -1
192	IF( jarea > jpni ) ibondj(ii,ij) = 0
193	IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1
194	IF( jpnj == 1 ) ibondj(ii,ij) = 2
195
196	ibondi(ii,ij) = 0
197	IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1
198	IF( MOD(jarea,jpni) == 0 ) ibondi(ii,ij) = 1
199	IF( jpni == 1 ) ibondi(ii,ij) = 2
200
201	! 2.4 Subdomain neighbors
202
203	iproc = jarea - 1
204	ioso(ii,ij) = iproc - jpni
205	iowe(ii,ij) = iproc - 1
206	ioea(ii,ij) = iproc + 1
207	iono(ii,ij) = iproc + jpni
208	ildi(ii,ij) = 1 + jpreci
209	ilei(ii,ij) = ili -jpreci
210	ionw(ii,ij) = iono(ii,ij) - 1
211	ione(ii,ij) = iono(ii,ij) + 1
212	iosw(ii,ij) = ioso(ii,ij) - 1
213	iose(ii,ij) = ioso(ii,ij) + 1
214	ibsw(ii,ij) = 1
215	ibnw(ii,ij) = 1
216	IF( MOD(iproc,jpni) == 0 ) THEN
217	ibsw(ii,ij) = 0
218	ibnw(ii,ij) = 0
219	ENDIF
220	ibse(ii,ij) = 1
221	ibne(ii,ij) = 1
222	IF( MOD(iproc,jpni) == jpni-1 ) THEN
223	ibse(ii,ij) = 0
224	ibne(ii,ij) = 0
225	ENDIF
226	IF( iproc < jpni ) THEN
227	ibsw(ii,ij) = 0
228	ibse(ii,ij) = 0
229	ENDIF
230	IF( iproc >= (jpnj-1)*jpni ) THEN
231	ibnw(ii,ij) = 0
232	ibne(ii,ij) = 0
233	ENDIF
234	IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
235	IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
236	ildj(ii,ij) = 1 + jprecj
237	ilej(ii,ij) = ilj - jprecj
238	IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
239	IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
240
241	! warning ii*ij (zone) /= nproc (processors)!
242
243	IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
244	IF( jpni == 1 )THEN
245	ibondi(ii,ij) = 2
246	nperio = 1
247	ELSE
248	ibondi(ii,ij) = 0
249	ENDIF
250	IF( MOD(jarea,jpni) == 0 ) THEN
251	ioea(ii,ij) = iproc - (jpni-1)
252	ione(ii,ij) = ione(ii,ij) - jpni
253	iose(ii,ij) = iose(ii,ij) - jpni
254	ENDIF
255	IF( MOD(jarea,jpni) == 1 ) THEN
256	iowe(ii,ij) = iproc + jpni - 1
257	ionw(ii,ij) = ionw(ii,ij) + jpni
258	iosw(ii,ij) = iosw(ii,ij) + jpni
259	ENDIF
260	ibsw(ii,ij) = 1
261	ibnw(ii,ij) = 1
262	ibse(ii,ij) = 1
263	ibne(ii,ij) = 1
264	IF( iproc < jpni ) THEN
265	ibsw(ii,ij) = 0
266	ibse(ii,ij) = 0
267	ENDIF
268	IF( iproc >= (jpnj-1)*jpni ) THEN
269	ibnw(ii,ij) = 0
270	ibne(ii,ij) = 0
271	ENDIF
272	ENDIF
273	ipolj(ii,ij) = 0
274	IF( jperio == 3 .OR. jperio == 4 ) THEN
275	ijm1 = jpni*(jpnj-1)
276	imil = ijm1+(jpni+1)/2
277	IF( jarea > ijm1 ) ipolj(ii,ij) = 3
278	IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
279	IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1 - 1 ! MPI rank of northern neighbour
280	ENDIF
281	IF( jperio == 5 .OR. jperio == 6 ) THEN
282	ijm1 = jpni*(jpnj-1)
283	imil = ijm1+(jpni+1)/2
284	IF( jarea > ijm1) ipolj(ii,ij) = 5
285	IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
286	IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1 - 1 ! MPI rank of northern neighbour
287	ENDIF
288
289	isurf = 0
290	DO jj = 1+jprecj, ilj-jprecj
291	DO ji = 1+jpreci, ili-jpreci
292	IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
293	END DO
294	END DO
295	IF(isurf /= 0) THEN
296	icont = icont + 1
297	ipproc(ii,ij) = icont
298	iin(icont+1) = ii
299	ijn(icont+1) = ij
300	ENDIF
301	END DO
302
303	! Control
304	IF(icont+1 /= jpnij) THEN
305	WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
306	WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'
307	WRITE(ctmp3,) ' **********, mpp_init2 finds jpnij=',icont+1
308	CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
309	ENDIF
310
311	! 4. Subdomain print
312	! ------------------
313
314	IF(lwp) THEN
315	ifreq = 4
316	il1 = 1
317	DO jn = 1,(jpni-1)/ifreq+1
318	il2 = MIN(jpni,il1+ifreq-1)
319	WRITE(numout,*)
320	WRITE(numout,9400) ('***',ji=il1,il2-1)
321	DO jj = jpnj, 1, -1
322	WRITE(numout,9403) (' ',ji=il1,il2-1)
323	WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
324	WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
325	WRITE(numout,9403) (' ',ji=il1,il2-1)
326	WRITE(numout,9400) ('***',ji=il1,il2-1)
327	END DO
328	WRITE(numout,9401) (ji,ji=il1,il2)
329	il1 = il1+ifreq
330	END DO
331	9400 FORMAT(' *',20('***********',a3))
332	9403 FORMAT(' * ',20(' * ',a3))
333	9401 FORMAT(' ',20(' ',i3,' '))
334	9402 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * '))
335	9404 FORMAT(' * ',20(' ',i3,' * '))
336	ENDIF
337
338
339	! 5. neighbour treatment
340	! ----------------------
341
342	DO jarea = 1, jpni*jpnj
343	iproc = jarea-1
344	ii = 1 + MOD(jarea-1,jpni)
345	ij = 1 + (jarea-1)/jpni
346	IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0 &
347	.AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
348	iino = 1 + MOD(iono(ii,ij),jpni)
349	ijno = 1 + (iono(ii,ij))/jpni
350	! Need to reverse the logical direction of communication
351	! for northern neighbours of northern row processors (north-fold)
352	! i.e. need to check that the northern neighbour only communicates
353	! to the SOUTH (or not at all) if this area is land-only (#1057)
354	idir = 1
355	IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1
356	IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
357	IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
358	ENDIF
359	IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0 &
360	.AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
361	iiso = 1 + MOD(ioso(ii,ij),jpni)
362	ijso = 1 + (ioso(ii,ij))/jpni
363	IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
364	IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1
365	ENDIF
366	IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0 &
367	.AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
368	iiea = 1 + MOD(ioea(ii,ij),jpni)
369	ijea = 1 + (ioea(ii,ij))/jpni
370	IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
371	IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
372	ENDIF
373	IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0 &
374	.AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
375	iiwe = 1 + MOD(iowe(ii,ij),jpni)
376	ijwe = 1 + (iowe(ii,ij))/jpni
377	IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
378	IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1
379	ENDIF
380	IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
381	iine = 1 + MOD(ione(ii,ij),jpni)
382	ijne = 1 + (ione(ii,ij))/jpni
383	IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
384	ENDIF
385	IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
386	iisw = 1 + MOD(iosw(ii,ij),jpni)
387	ijsw = 1 + (iosw(ii,ij))/jpni
388	IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
389	ENDIF
390	IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
391	iinw = 1 + MOD(ionw(ii,ij),jpni)
392	ijnw = 1 + (ionw(ii,ij))/jpni
393	IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
394	ENDIF
395	IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
396	iise = 1 + MOD(iose(ii,ij),jpni)
397	ijse = 1 + (iose(ii,ij))/jpni
398	IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
399	ENDIF
400	END DO
401
402
403	! 6. Change processor name
404	! ------------------------
405
406	nproc = narea-1
407	ii = iin(narea)
408	ij = ijn(narea)
409	IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
410	iiso = 1 + MOD(ioso(ii,ij),jpni)
411	ijso = 1 + (ioso(ii,ij))/jpni
412	noso = ipproc(iiso,ijso)
413	ENDIF
414	IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
415	iiwe = 1 + MOD(iowe(ii,ij),jpni)
416	ijwe = 1 + (iowe(ii,ij))/jpni
417	nowe = ipproc(iiwe,ijwe)
418	ENDIF
419	IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
420	iiea = 1 + MOD(ioea(ii,ij),jpni)
421	ijea = 1 + (ioea(ii,ij))/jpni
422	noea = ipproc(iiea,ijea)
423	ENDIF
424	IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
425	iino = 1 + MOD(iono(ii,ij),jpni)
426	ijno = 1 + (iono(ii,ij))/jpni
427	nono = ipproc(iino,ijno)
428	ENDIF
429	IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN
430	iise = 1 + MOD(iose(ii,ij),jpni)
431	ijse = 1 + (iose(ii,ij))/jpni
432	npse = ipproc(iise,ijse)
433	ENDIF
434	IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN
435	iisw = 1 + MOD(iosw(ii,ij),jpni)
436	ijsw = 1 + (iosw(ii,ij))/jpni
437	npsw = ipproc(iisw,ijsw)
438	ENDIF
439	IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN
440	iine = 1 + MOD(ione(ii,ij),jpni)
441	ijne = 1 + (ione(ii,ij))/jpni
442	npne = ipproc(iine,ijne)
443	ENDIF
444	IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN
445	iinw = 1 + MOD(ionw(ii,ij),jpni)
446	ijnw = 1 + (ionw(ii,ij))/jpni
447	npnw = ipproc(iinw,ijnw)
448	ENDIF
449	nbnw = ibnw(ii,ij)
450	nbne = ibne(ii,ij)
451	nbsw = ibsw(ii,ij)
452	nbse = ibse(ii,ij)
453	nlcj = ilcj(ii,ij)
454	nlci = ilci(ii,ij)
455	nldi = ildi(ii,ij)
456	nlei = ilei(ii,ij)
457	nldj = ildj(ii,ij)
458	nlej = ilej(ii,ij)
459	nbondi = ibondi(ii,ij)
460	nbondj = ibondj(ii,ij)
461	nimpp = iimppt(ii,ij)
462	njmpp = ijmppt(ii,ij)
463	DO jproc = 1, jpnij
464	ii = iin(jproc)
465	ij = ijn(jproc)
466	nimppt(jproc) = iimppt(ii,ij)
467	njmppt(jproc) = ijmppt(ii,ij)
468	nlcjt(jproc) = ilcj(ii,ij)
469	nlcit(jproc) = ilci(ii,ij)
470	nldit(jproc) = ildi(ii,ij)
471	nleit(jproc) = ilei(ii,ij)
472	nldjt(jproc) = ildj(ii,ij)
473	nlejt(jproc) = ilej(ii,ij)
474	END DO
475
476	! Save processor layout in ascii file
477	IF (lwp) THEN
478	CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
479	WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
480	WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
481
482	DO jproc = 1, jpnij
483	WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
484	nldit(jproc), nldjt(jproc), &
485	nleit(jproc), nlejt(jproc), &
486	nimppt(jproc), njmppt(jproc)
487	END DO
488	CLOSE(inum)
489	END IF
490
491	IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )
492
493	! Prepare mpp north fold
494
495	IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
496	CALL mpp_ini_north
497	IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
498	ENDIF
499
500	! Defined npolj, either 0, 3 , 4 , 5 , 6
501	! In this case the important thing is that npolj /= 0
502	! Because if we go through these line it is because jpni >1 and thus
503	! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
504
505	npolj = 0
506	ij = ijn(narea)
507
508	IF( jperio == 3 .OR. jperio == 4 ) THEN
509	IF( ij == jpnj ) npolj = 3
510	ENDIF
511
512	IF( jperio == 5 .OR. jperio == 6 ) THEN
513	IF( ij == jpnj ) npolj = 5
514	ENDIF
515
516	! Prepare NetCDF output file (if necessary)
517	CALL mpp_init_ioipsl
518
519	! Periodicity : no corner if nbondi = 2 and nperio != 1
520
521	IF(lwp) THEN
522	WRITE(numout,*) ' nproc= ',nproc
523	WRITE(numout,*) ' nowe= ',nowe
524	WRITE(numout,*) ' noea= ',noea
525	WRITE(numout,*) ' nono= ',nono
526	WRITE(numout,*) ' noso= ',noso
527	WRITE(numout,*) ' nbondi= ',nbondi
528	WRITE(numout,*) ' nbondj= ',nbondj
529	WRITE(numout,*) ' npolj= ',npolj
530	WRITE(numout,*) ' nperio= ',nperio
531	WRITE(numout,*) ' nlci= ',nlci
532	WRITE(numout,*) ' nlcj= ',nlcj
533	WRITE(numout,*) ' nimpp= ',nimpp
534	WRITE(numout,*) ' njmpp= ',njmpp
535	WRITE(numout,*) ' nbse= ',nbse,' npse= ',npse
536	WRITE(numout,*) ' nbsw= ',nbsw,' npsw= ',npsw
537	WRITE(numout,*) ' nbne= ',nbne,' npne= ',npne
538	WRITE(numout,*) ' nbnw= ',nbnw,' npnw= ',npnw
539	ENDIF
540
541	END SUBROUTINE mpp_init2

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

Download in other formats:

Original Format