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

Context Navigation

source: branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 7278

Last change on this file since 7278 was 7278, checked in by flavoni, 8 years ago
update branch CNRS-2016 to trunk 6720
Property svn:keywords set to `Id`
File size: 21.0 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 requires the presence of the domain configuration 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 : ! 1994-11 (M. Guyon) Original code
35	!! OPA ! 1995-04 (J. Escobar, M. Imbard)
36	!! ! 1998-02 (M. Guyon) FETI method
37	!! ! 1998-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions
38	!! NEMO 1.0 ! 2004-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1
39	!! 4.0 ! 2016-06 (G. Madec) use domain configuration file instead of bathymetry file
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 :: jstartrow ! temporary integers
48	INTEGER :: ios ! Local integer output status for namelist read
49	INTEGER :: &
50	ii, ij, ifreq, il1, il2, & ! temporary integers
51	icont, ili, ilj, & ! " "
52	isurf, ijm1, imil, & ! " "
53	iino, ijno, iiso, ijso, & ! " "
54	iiea, ijea, iiwe, ijwe, & ! " "
55	iinw, ijnw, iine, ijne, & ! " "
56	iisw, ijsw, iise, ijse, & ! " "
57	iresti, irestj, iproc ! " "
58	INTEGER, DIMENSION(jpnij) :: &
59	iin, ijn
60	INTEGER, DIMENSION(jpni,jpnj) :: &
61	iimppt, ijmppt, ilci , ilcj , & ! temporary workspace
62	ipproc, ibondj, ibondi, ipolj , & ! " "
63	ilei , ilej , ildi , ildj , & ! " "
64	ioea , iowe , ioso , iono , & ! " "
65	ione , ionw , iose , iosw , & ! " "
66	ibne , ibnw , ibse , ibsw ! " "
67	INTEGER, DIMENSION(jpiglo,jpjglo) :: imask ! global workspace
68	REAL(wp), DIMENSION(jpiglo,jpjglo) :: zbot, ztop ! global workspace
69	REAL(wp) :: zidom , zjdom ! local scalars
70	!!----------------------------------------------------------------------
71	!! NEMO/OPA 4.0 , NEMO Consortium (2016)
72	!! $Id$
73	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
74	!!----------------------------------------------------------------------
75
76	IF(lwp)WRITE(numout,*)
77	IF(lwp)WRITE(numout,*) 'mpp_init_2 : Message Passing MPI'
78	IF(lwp)WRITE(numout,*) '~~~~~~~~~~'
79	IF(lwp)WRITE(numout,*) ' '
80
81	IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
82
83	! 0. initialisation
84	! -----------------
85	CALL iom_open( cn_domcfg, inum )
86	!
87	! ! ocean top and bottom level
88	CALL iom_get( inum, jpdom_data, 'bottom_level' , zbot ) ! nb of ocean T-points
89	CALL iom_get( inum, jpdom_data, 'top_level' , ztop ) ! nb of ocean T-points (ISF)
90	!
91	CALL iom_close( inum )
92	!
93	! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise)
94	WHERE( zbot(:,:) - ztop(:,:) + 1 > 0 ) ; imask(:,:) = 1
95	ELSEWHERE ; imask(:,:) = 0
96	END WHERE
97
98	! 1. Dimension arrays for subdomains
99	! -----------------------------------
100
101	! Computation of local domain sizes ilci() ilcj()
102	! These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
103	! The subdomains are squares leeser than or equal to the global
104	! dimensions divided by the number of processors minus the overlap
105	! array.
106
107	nreci=2*jpreci
108	nrecj=2*jprecj
109	iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
110	irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
111
112	#if defined key_nemocice_decomp
113	! Change padding to be consistent with CICE
114	ilci(1:jpni-1 ,:) = jpi
115	ilci(jpni ,:) = jpiglo - (jpni - 1) * (jpi - nreci)
116
117	ilcj(:, 1:jpnj-1) = jpj
118	ilcj(:, jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj)
119	#else
120	ilci(1:iresti ,:) = jpi
121	ilci(iresti+1:jpni ,:) = jpi-1
122
123	ilcj(:, 1:irestj) = jpj
124	ilcj(:, irestj+1:jpnj) = jpj-1
125	#endif
126
127	nfilcit(:,:) = ilci(:,:)
128
129	IF(lwp) WRITE(numout,*)
130	IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
131	IF(lwp) WRITE(numout,*) ' ~~~~~~ ----------------------'
132	IF(lwp) WRITE(numout,*)
133	IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
134	IF(lwp) WRITE(numout,*)
135	IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
136
137	zidom = nreci + sum(ilci(:,1) - nreci )
138	IF(lwp) WRITE(numout,*)
139	IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
140
141	zjdom = nrecj + sum(ilcj(1,:) - nrecj )
142	IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
143	IF(lwp) WRITE(numout,*)
144
145
146	! 2. Index arrays for subdomains
147	! -------------------------------
148
149	iimppt(:,:) = 1
150	ijmppt(:,:) = 1
151	ipproc(:,:) = -1
152
153	IF( jpni > 1 )THEN
154	DO jj = 1, jpnj
155	DO ji = 2, jpni
156	iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
157	END DO
158	END DO
159	ENDIF
160	nfiimpp(:,:) = iimppt(:,:)
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	ibondj(ii,ij) = -1
182	IF( jarea > jpni ) ibondj(ii,ij) = 0
183	IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1
184	IF( jpnj == 1 ) ibondj(ii,ij) = 2
185	ibondi(ii,ij) = 0
186	IF( MOD(jarea,jpni) == 1 ) ibondi(ii,ij) = -1
187	IF( MOD(jarea,jpni) == 0 ) ibondi(ii,ij) = 1
188	IF( jpni == 1 ) ibondi(ii,ij) = 2
189
190	! 2.4 Subdomain neighbors
191
192	iproc = jarea - 1
193	ioso(ii,ij) = iproc - jpni
194	iowe(ii,ij) = iproc - 1
195	ioea(ii,ij) = iproc + 1
196	iono(ii,ij) = iproc + jpni
197	ildi(ii,ij) = 1 + jpreci
198	ilei(ii,ij) = ili -jpreci
199	ionw(ii,ij) = iono(ii,ij) - 1
200	ione(ii,ij) = iono(ii,ij) + 1
201	iosw(ii,ij) = ioso(ii,ij) - 1
202	iose(ii,ij) = ioso(ii,ij) + 1
203	ibsw(ii,ij) = 1
204	ibnw(ii,ij) = 1
205	IF( MOD(iproc,jpni) == 0 ) THEN
206	ibsw(ii,ij) = 0
207	ibnw(ii,ij) = 0
208	ENDIF
209	ibse(ii,ij) = 1
210	ibne(ii,ij) = 1
211	IF( MOD(iproc,jpni) == jpni-1 ) THEN
212	ibse(ii,ij) = 0
213	ibne(ii,ij) = 0
214	ENDIF
215	IF( iproc < jpni ) THEN
216	ibsw(ii,ij) = 0
217	ibse(ii,ij) = 0
218	ENDIF
219	IF( iproc >= (jpnj-1)*jpni ) THEN
220	ibnw(ii,ij) = 0
221	ibne(ii,ij) = 0
222	ENDIF
223	IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
224	IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
225	ildj(ii,ij) = 1 + jprecj
226	ilej(ii,ij) = ilj - jprecj
227	IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
228	IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
229
230	! warning ii*ij (zone) /= nproc (processors)!
231
232	IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
233	IF( jpni == 1 )THEN
234	ibondi(ii,ij) = 2
235	nperio = 1
236	ELSE
237	ibondi(ii,ij) = 0
238	ENDIF
239	IF( MOD(jarea,jpni) == 0 ) THEN
240	ioea(ii,ij) = iproc - (jpni-1)
241	ione(ii,ij) = ione(ii,ij) - jpni
242	iose(ii,ij) = iose(ii,ij) - jpni
243	ENDIF
244	IF( MOD(jarea,jpni) == 1 ) THEN
245	iowe(ii,ij) = iproc + jpni - 1
246	ionw(ii,ij) = ionw(ii,ij) + jpni
247	iosw(ii,ij) = iosw(ii,ij) + jpni
248	ENDIF
249	ibsw(ii,ij) = 1
250	ibnw(ii,ij) = 1
251	ibse(ii,ij) = 1
252	ibne(ii,ij) = 1
253	IF( iproc < jpni ) THEN
254	ibsw(ii,ij) = 0
255	ibse(ii,ij) = 0
256	ENDIF
257	IF( iproc >= (jpnj-1)*jpni ) THEN
258	ibnw(ii,ij) = 0
259	ibne(ii,ij) = 0
260	ENDIF
261	ENDIF
262	ipolj(ii,ij) = 0
263	IF( jperio == 3 .OR. jperio == 4 ) THEN
264	ijm1 = jpni*(jpnj-1)
265	imil = ijm1+(jpni+1)/2
266	IF( jarea > ijm1 ) ipolj(ii,ij) = 3
267	IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
268	IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1 ! MPI rank of northern neighbour
269	ENDIF
270	IF( jperio == 5 .OR. jperio == 6 ) THEN
271	ijm1 = jpni*(jpnj-1)
272	imil = ijm1+(jpni+1)/2
273	IF( jarea > ijm1) ipolj(ii,ij) = 5
274	IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
275	IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1 ! MPI rank of northern neighbour
276	ENDIF
277
278	! Check wet points over the entire domain to preserve the MPI communication stencil
279	isurf = 0
280	DO jj = 1, ilj
281	DO ji = 1, ili
282	IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
283	END DO
284	END DO
285
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	nfipproc(:,:) = ipproc(:,:)
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	! Need to reverse the logical direction of communication
344	! for northern neighbours of northern row processors (north-fold)
345	! i.e. need to check that the northern neighbour only communicates
346	! to the SOUTH (or not at all) if this area is land-only (#1057)
347	idir = 1
348	IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1
349	IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
350	IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
351	ENDIF
352	IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0 &
353	.AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
354	iiso = 1 + MOD(ioso(ii,ij),jpni)
355	ijso = 1 + (ioso(ii,ij))/jpni
356	IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
357	IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1
358	ENDIF
359	IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0 &
360	.AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
361	iiea = 1 + MOD(ioea(ii,ij),jpni)
362	ijea = 1 + (ioea(ii,ij))/jpni
363	IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
364	IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
365	ENDIF
366	IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0 &
367	.AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
368	iiwe = 1 + MOD(iowe(ii,ij),jpni)
369	ijwe = 1 + (iowe(ii,ij))/jpni
370	IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
371	IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1
372	ENDIF
373	IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
374	iine = 1 + MOD(ione(ii,ij),jpni)
375	ijne = 1 + (ione(ii,ij))/jpni
376	IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
377	ENDIF
378	IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
379	iisw = 1 + MOD(iosw(ii,ij),jpni)
380	ijsw = 1 + (iosw(ii,ij))/jpni
381	IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
382	ENDIF
383	IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
384	iinw = 1 + MOD(ionw(ii,ij),jpni)
385	ijnw = 1 + (ionw(ii,ij))/jpni
386	IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
387	ENDIF
388	IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
389	iise = 1 + MOD(iose(ii,ij),jpni)
390	ijse = 1 + (iose(ii,ij))/jpni
391	IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
392	ENDIF
393	END DO
394
395
396	! 6. Change processor name
397	! ------------------------
398
399	nproc = narea-1
400	ii = iin(narea)
401	ij = ijn(narea)
402
403	! set default neighbours
404	noso = ioso(ii,ij)
405	nowe = iowe(ii,ij)
406	noea = ioea(ii,ij)
407	nono = iono(ii,ij)
408	npse = iose(ii,ij)
409	npsw = iosw(ii,ij)
410	npne = ione(ii,ij)
411	npnw = ionw(ii,ij)
412
413	! check neighbours location
414	IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
415	iiso = 1 + MOD(ioso(ii,ij),jpni)
416	ijso = 1 + (ioso(ii,ij))/jpni
417	noso = ipproc(iiso,ijso)
418	ENDIF
419	IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
420	iiwe = 1 + MOD(iowe(ii,ij),jpni)
421	ijwe = 1 + (iowe(ii,ij))/jpni
422	nowe = ipproc(iiwe,ijwe)
423	ENDIF
424	IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
425	iiea = 1 + MOD(ioea(ii,ij),jpni)
426	ijea = 1 + (ioea(ii,ij))/jpni
427	noea = ipproc(iiea,ijea)
428	ENDIF
429	IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
430	iino = 1 + MOD(iono(ii,ij),jpni)
431	ijno = 1 + (iono(ii,ij))/jpni
432	nono = ipproc(iino,ijno)
433	ENDIF
434	IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN
435	iise = 1 + MOD(iose(ii,ij),jpni)
436	ijse = 1 + (iose(ii,ij))/jpni
437	npse = ipproc(iise,ijse)
438	ENDIF
439	IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN
440	iisw = 1 + MOD(iosw(ii,ij),jpni)
441	ijsw = 1 + (iosw(ii,ij))/jpni
442	npsw = ipproc(iisw,ijsw)
443	ENDIF
444	IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN
445	iine = 1 + MOD(ione(ii,ij),jpni)
446	ijne = 1 + (ione(ii,ij))/jpni
447	npne = ipproc(iine,ijne)
448	ENDIF
449	IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN
450	iinw = 1 + MOD(ionw(ii,ij),jpni)
451	ijnw = 1 + (ionw(ii,ij))/jpni
452	npnw = ipproc(iinw,ijnw)
453	ENDIF
454	nbnw = ibnw(ii,ij)
455	nbne = ibne(ii,ij)
456	nbsw = ibsw(ii,ij)
457	nbse = ibse(ii,ij)
458	nlcj = ilcj(ii,ij)
459	nlci = ilci(ii,ij)
460	nldi = ildi(ii,ij)
461	nlei = ilei(ii,ij)
462	nldj = ildj(ii,ij)
463	nlej = ilej(ii,ij)
464	nbondi = ibondi(ii,ij)
465	nbondj = ibondj(ii,ij)
466	nimpp = iimppt(ii,ij)
467	njmpp = ijmppt(ii,ij)
468	DO jproc = 1, jpnij
469	ii = iin(jproc)
470	ij = ijn(jproc)
471	nimppt(jproc) = iimppt(ii,ij)
472	njmppt(jproc) = ijmppt(ii,ij)
473	nlcjt(jproc) = ilcj(ii,ij)
474	nlcit(jproc) = ilci(ii,ij)
475	nldit(jproc) = ildi(ii,ij)
476	nleit(jproc) = ilei(ii,ij)
477	nldjt(jproc) = ildj(ii,ij)
478	nlejt(jproc) = ilej(ii,ij)
479	END DO
480
481	! Save processor layout in ascii file
482	IF (lwp) THEN
483	CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
484	WRITE(inum,'(a)') ' jpnij jpi jpj jpk jpiglo jpjglo'
485	WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
486	WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
487
488	DO jproc = 1, jpnij
489	WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
490	nldit(jproc), nldjt(jproc), &
491	nleit(jproc), nlejt(jproc), &
492	nimppt(jproc), njmppt(jproc)
493	END DO
494	CLOSE(inum)
495	END IF
496
497	! Defined npolj, either 0, 3 , 4 , 5 , 6
498	! In this case the important thing is that npolj /= 0
499	! Because if we go through these line it is because jpni >1 and thus
500	! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
501
502	npolj = 0
503	ij = ijn(narea)
504
505	IF( jperio == 3 .OR. jperio == 4 ) THEN
506	IF( ij == jpnj ) npolj = 3
507	ENDIF
508
509	IF( jperio == 5 .OR. jperio == 6 ) THEN
510	IF( ij == jpnj ) npolj = 5
511	ENDIF
512
513	! Periodicity : no corner if nbondi = 2 and nperio != 1
514
515	IF(lwp) THEN
516	WRITE(numout,*) ' nproc = ', nproc
517	WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea
518	WRITE(numout,*) ' nono = ', nono , ' noso = ', noso
519	WRITE(numout,*) ' nbondi = ', nbondi
520	WRITE(numout,*) ' nbondj = ', nbondj
521	WRITE(numout,*) ' npolj = ', npolj
522	WRITE(numout,*) ' nperio = ', nperio
523	WRITE(numout,*) ' nlci = ', nlci
524	WRITE(numout,*) ' nlcj = ', nlcj
525	WRITE(numout,*) ' nimpp = ', nimpp
526	WRITE(numout,*) ' njmpp = ', njmpp
527	WRITE(numout,*) ' nreci = ', nreci , ' npse = ', npse
528	WRITE(numout,*) ' nrecj = ', nrecj , ' npsw = ', npsw
529	WRITE(numout,*) ' jpreci = ', jpreci , ' npne = ', npne
530	WRITE(numout,*) ' jprecj = ', jprecj , ' npnw = ', npnw
531	WRITE(numout,*)
532	ENDIF
533
534	IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )
535
536	! Prepare mpp north fold
537
538	IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
539	CALL mpp_ini_north
540	IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
541	ENDIF
542
543	! Prepare NetCDF output file (if necessary)
544	CALL mpp_init_ioipsl
545
546
547	END SUBROUTINE mpp_init2

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

Download in other formats:

Original Format