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

Context Navigation

source: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 7256

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

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

Download in other formats:

Original Format