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

Context Navigation

source: branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 4747

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

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

Download in other formats:

Original Format