Context Navigation

mppini_2.h90 @ 3344

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

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

Download in other formats:

Original Format