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

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

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

Download in other formats:

Original Format