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

Context Navigation

source: branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 7428

Last change on this file since 7428 was 7428, checked in by flavoni, 7 years ago
correct mppini_2.h90: rmeoved jpizoom does note exist anymore
Property svn:keywords set to `Id`
File size: 22.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 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	USE bdy_oce
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) :: imask ! global workspace
69	REAL(wp), DIMENSION(jpiglo,jpjglo) :: zbot, ztop ! global workspace
70	REAL(wp) :: zidom , zjdom ! local scalars
71	NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file, &
72	& ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta, &
73	& cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta, &
74	& ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
75	& cn_ice_lim, nn_ice_lim_dta, &
76	& rn_ice_tem, rn_ice_sal, rn_ice_age, &
77	& ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy
78	!!----------------------------------------------------------------------
79	!! NEMO/OPA 4.0 , NEMO Consortium (2016)
80	!! $Id$
81	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
82	!!----------------------------------------------------------------------
83
84	IF(lwp)WRITE(numout,*)
85	IF(lwp)WRITE(numout,*) 'mpp_init_2 : Message Passing MPI'
86	IF(lwp)WRITE(numout,*) '~~~~~~~~~~'
87	IF(lwp)WRITE(numout,*) ' '
88
89	IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
90
91	! 0. initialisation
92	! -----------------
93	CALL iom_open( cn_domcfg, inum )
94	!
95	! ! ocean top and bottom level
96	CALL iom_get( inum, jpdom_data, 'bottom_level' , zbot ) ! nb of ocean T-points
97	CALL iom_get( inum, jpdom_data, 'top_level' , ztop ) ! nb of ocean T-points (ISF)
98	!
99	CALL iom_close( inum )
100	!
101	! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise)
102	WHERE( zbot(:,:) - ztop(:,:) + 1 > 0 ) ; imask(:,:) = 1
103	ELSEWHERE ; imask(:,:) = 0
104	END WHERE
105
106	! Adjust imask with bdy_msk if exists
107
108	REWIND( numnam_ref ) ! Namelist nambdy in reference namelist : BDY
109	READ ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
110	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini_2)', lwp )
111
112	REWIND( numnam_cfg ) ! Namelist nambdy in configuration namelist : BDY
113	READ ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
114	904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini_2)', lwp )
115	IF(lwm) WRITE ( numond, namzgr )
116
117	IF( ln_bdy .AND. ln_mask_file ) THEN
118	CALL iom_open( cn_mask_file, inum )
119	CALL iom_get ( inum, jpdom_unknown, 'bdy_msk', zdta(:,:) )
120	CALL iom_close( inum )
121	WHERE ( zdta(:,:) <= 0. ) imask = 0
122	ENDIF
123
124	! 1. Dimension arrays for subdomains
125	! -----------------------------------
126
127	! Computation of local domain sizes ilci() ilcj()
128	! These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
129	! The subdomains are squares leeser than or equal to the global
130	! dimensions divided by the number of processors minus the overlap
131	! array.
132
133	nreci=2*jpreci
134	nrecj=2*jprecj
135	iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
136	irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
137
138	#if defined key_nemocice_decomp
139	! Change padding to be consistent with CICE
140	ilci(1:jpni-1 ,:) = jpi
141	ilci(jpni ,:) = jpiglo - (jpni - 1) * (jpi - nreci)
142
143	ilcj(:, 1:jpnj-1) = jpj
144	ilcj(:, jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj)
145	#else
146	ilci(1:iresti ,:) = jpi
147	ilci(iresti+1:jpni ,:) = jpi-1
148
149	ilcj(:, 1:irestj) = jpj
150	ilcj(:, irestj+1:jpnj) = jpj-1
151	#endif
152
153	nfilcit(:,:) = ilci(:,:)
154
155	IF(lwp) WRITE(numout,*)
156	IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
157	IF(lwp) WRITE(numout,*) ' ~~~~~~ ----------------------'
158	IF(lwp) WRITE(numout,*)
159	IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
160	IF(lwp) WRITE(numout,*)
161	IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
162
163	zidom = nreci + sum(ilci(:,1) - nreci )
164	IF(lwp) WRITE(numout,*)
165	IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
166
167	zjdom = nrecj + sum(ilcj(1,:) - nrecj )
168	IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
169	IF(lwp) WRITE(numout,*)
170
171
172	! 2. Index arrays for subdomains
173	! -------------------------------
174
175	iimppt(:,:) = 1
176	ijmppt(:,:) = 1
177	ipproc(:,:) = -1
178
179	IF( jpni > 1 )THEN
180	DO jj = 1, jpnj
181	DO ji = 2, jpni
182	iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
183	END DO
184	END DO
185	ENDIF
186	nfiimpp(:,:) = iimppt(:,:)
187
188	IF( jpnj > 1 )THEN
189	DO jj = 2, jpnj
190	DO ji = 1, jpni
191	ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
192	END DO
193	END DO
194	ENDIF
195
196
197	! 3. Subdomain description in the Regular Case
198	! --------------------------------------------
199
200	nperio = 0
201	icont = -1
202	DO jarea = 1, jpni*jpnj
203	ii = 1 + MOD(jarea-1,jpni)
204	ij = 1 + (jarea-1)/jpni
205	ili = ilci(ii,ij)
206	ilj = ilcj(ii,ij)
207	ibondj(ii,ij) = -1
208	IF( jarea > jpni ) ibondj(ii,ij) = 0
209	IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1
210	IF( jpnj == 1 ) ibondj(ii,ij) = 2
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	! Check wet points over the entire domain to preserve the MPI communication stencil
305	isurf = 0
306	DO jj = 1, ilj
307	DO ji = 1, ili
308	IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
309	END DO
310	END DO
311
312	IF(isurf /= 0) THEN
313	icont = icont + 1
314	ipproc(ii,ij) = icont
315	iin(icont+1) = ii
316	ijn(icont+1) = ij
317	ENDIF
318	END DO
319
320	nfipproc(:,:) = ipproc(:,:)
321
322	! Control
323	IF(icont+1 /= jpnij) THEN
324	WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
325	WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'
326	WRITE(ctmp3,) ' **********, mpp_init2 finds jpnij=',icont+1
327	CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
328	ENDIF
329
330	! 4. Subdomain print
331	! ------------------
332
333	IF(lwp) THEN
334	ifreq = 4
335	il1 = 1
336	DO jn = 1,(jpni-1)/ifreq+1
337	il2 = MIN(jpni,il1+ifreq-1)
338	WRITE(numout,*)
339	WRITE(numout,9400) ('***',ji=il1,il2-1)
340	DO jj = jpnj, 1, -1
341	WRITE(numout,9403) (' ',ji=il1,il2-1)
342	WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
343	WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
344	WRITE(numout,9403) (' ',ji=il1,il2-1)
345	WRITE(numout,9400) ('***',ji=il1,il2-1)
346	END DO
347	WRITE(numout,9401) (ji,ji=il1,il2)
348	il1 = il1+ifreq
349	END DO
350	9400 FORMAT(' *',20('***********',a3))
351	9403 FORMAT(' * ',20(' * ',a3))
352	9401 FORMAT(' ',20(' ',i3,' '))
353	9402 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * '))
354	9404 FORMAT(' * ',20(' ',i3,' * '))
355	ENDIF
356
357
358	! 5. neighbour treatment
359	! ----------------------
360
361	DO jarea = 1, jpni*jpnj
362	iproc = jarea-1
363	ii = 1 + MOD(jarea-1,jpni)
364	ij = 1 + (jarea-1)/jpni
365	IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0 &
366	.AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
367	iino = 1 + MOD(iono(ii,ij),jpni)
368	ijno = 1 + (iono(ii,ij))/jpni
369	! Need to reverse the logical direction of communication
370	! for northern neighbours of northern row processors (north-fold)
371	! i.e. need to check that the northern neighbour only communicates
372	! to the SOUTH (or not at all) if this area is land-only (#1057)
373	idir = 1
374	IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1
375	IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
376	IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
377	ENDIF
378	IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0 &
379	.AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
380	iiso = 1 + MOD(ioso(ii,ij),jpni)
381	ijso = 1 + (ioso(ii,ij))/jpni
382	IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
383	IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1
384	ENDIF
385	IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0 &
386	.AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
387	iiea = 1 + MOD(ioea(ii,ij),jpni)
388	ijea = 1 + (ioea(ii,ij))/jpni
389	IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
390	IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
391	ENDIF
392	IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0 &
393	.AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
394	iiwe = 1 + MOD(iowe(ii,ij),jpni)
395	ijwe = 1 + (iowe(ii,ij))/jpni
396	IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
397	IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1
398	ENDIF
399	IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
400	iine = 1 + MOD(ione(ii,ij),jpni)
401	ijne = 1 + (ione(ii,ij))/jpni
402	IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
403	ENDIF
404	IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
405	iisw = 1 + MOD(iosw(ii,ij),jpni)
406	ijsw = 1 + (iosw(ii,ij))/jpni
407	IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
408	ENDIF
409	IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
410	iinw = 1 + MOD(ionw(ii,ij),jpni)
411	ijnw = 1 + (ionw(ii,ij))/jpni
412	IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
413	ENDIF
414	IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
415	iise = 1 + MOD(iose(ii,ij),jpni)
416	ijse = 1 + (iose(ii,ij))/jpni
417	IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
418	ENDIF
419	END DO
420
421
422	! 6. Change processor name
423	! ------------------------
424
425	nproc = narea-1
426	ii = iin(narea)
427	ij = ijn(narea)
428
429	! set default neighbours
430	noso = ioso(ii,ij)
431	nowe = iowe(ii,ij)
432	noea = ioea(ii,ij)
433	nono = iono(ii,ij)
434	npse = iose(ii,ij)
435	npsw = iosw(ii,ij)
436	npne = ione(ii,ij)
437	npnw = ionw(ii,ij)
438
439	! check neighbours location
440	IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
441	iiso = 1 + MOD(ioso(ii,ij),jpni)
442	ijso = 1 + (ioso(ii,ij))/jpni
443	noso = ipproc(iiso,ijso)
444	ENDIF
445	IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
446	iiwe = 1 + MOD(iowe(ii,ij),jpni)
447	ijwe = 1 + (iowe(ii,ij))/jpni
448	nowe = ipproc(iiwe,ijwe)
449	ENDIF
450	IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
451	iiea = 1 + MOD(ioea(ii,ij),jpni)
452	ijea = 1 + (ioea(ii,ij))/jpni
453	noea = ipproc(iiea,ijea)
454	ENDIF
455	IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
456	iino = 1 + MOD(iono(ii,ij),jpni)
457	ijno = 1 + (iono(ii,ij))/jpni
458	nono = ipproc(iino,ijno)
459	ENDIF
460	IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN
461	iise = 1 + MOD(iose(ii,ij),jpni)
462	ijse = 1 + (iose(ii,ij))/jpni
463	npse = ipproc(iise,ijse)
464	ENDIF
465	IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN
466	iisw = 1 + MOD(iosw(ii,ij),jpni)
467	ijsw = 1 + (iosw(ii,ij))/jpni
468	npsw = ipproc(iisw,ijsw)
469	ENDIF
470	IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN
471	iine = 1 + MOD(ione(ii,ij),jpni)
472	ijne = 1 + (ione(ii,ij))/jpni
473	npne = ipproc(iine,ijne)
474	ENDIF
475	IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN
476	iinw = 1 + MOD(ionw(ii,ij),jpni)
477	ijnw = 1 + (ionw(ii,ij))/jpni
478	npnw = ipproc(iinw,ijnw)
479	ENDIF
480	nbnw = ibnw(ii,ij)
481	nbne = ibne(ii,ij)
482	nbsw = ibsw(ii,ij)
483	nbse = ibse(ii,ij)
484	nlcj = ilcj(ii,ij)
485	nlci = ilci(ii,ij)
486	nldi = ildi(ii,ij)
487	nlei = ilei(ii,ij)
488	nldj = ildj(ii,ij)
489	nlej = ilej(ii,ij)
490	nbondi = ibondi(ii,ij)
491	nbondj = ibondj(ii,ij)
492	nimpp = iimppt(ii,ij)
493	njmpp = ijmppt(ii,ij)
494	DO jproc = 1, jpnij
495	ii = iin(jproc)
496	ij = ijn(jproc)
497	nimppt(jproc) = iimppt(ii,ij)
498	njmppt(jproc) = ijmppt(ii,ij)
499	nlcjt(jproc) = ilcj(ii,ij)
500	nlcit(jproc) = ilci(ii,ij)
501	nldit(jproc) = ildi(ii,ij)
502	nleit(jproc) = ilei(ii,ij)
503	nldjt(jproc) = ildj(ii,ij)
504	nlejt(jproc) = ilej(ii,ij)
505	END DO
506
507	! Save processor layout in ascii file
508	IF (lwp) THEN
509	CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
510	WRITE(inum,'(a)') ' jpnij jpi jpj jpk jpiglo jpjglo'
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	! Defined npolj, either 0, 3 , 4 , 5 , 6
524	! In this case the important thing is that npolj /= 0
525	! Because if we go through these line it is because jpni >1 and thus
526	! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
527
528	npolj = 0
529	ij = ijn(narea)
530
531	IF( jperio == 3 .OR. jperio == 4 ) THEN
532	IF( ij == jpnj ) npolj = 3
533	ENDIF
534
535	IF( jperio == 5 .OR. jperio == 6 ) THEN
536	IF( ij == jpnj ) npolj = 5
537	ENDIF
538
539	! Periodicity : no corner if nbondi = 2 and nperio != 1
540
541	IF(lwp) THEN
542	WRITE(numout,*) ' nproc = ', nproc
543	WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea
544	WRITE(numout,*) ' nono = ', nono , ' noso = ', noso
545	WRITE(numout,*) ' nbondi = ', nbondi
546	WRITE(numout,*) ' nbondj = ', nbondj
547	WRITE(numout,*) ' npolj = ', npolj
548	WRITE(numout,*) ' nperio = ', nperio
549	WRITE(numout,*) ' nlci = ', nlci
550	WRITE(numout,*) ' nlcj = ', nlcj
551	WRITE(numout,*) ' nimpp = ', nimpp
552	WRITE(numout,*) ' njmpp = ', njmpp
553	WRITE(numout,*) ' nreci = ', nreci , ' npse = ', npse
554	WRITE(numout,*) ' nrecj = ', nrecj , ' npsw = ', npsw
555	WRITE(numout,*) ' jpreci = ', jpreci , ' npne = ', npne
556	WRITE(numout,*) ' jprecj = ', jprecj , ' npnw = ', npnw
557	WRITE(numout,*)
558	ENDIF
559
560	IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )
561
562	! Prepare mpp north fold
563
564	IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
565	CALL mpp_ini_north
566	IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
567	ENDIF
568
569	! Prepare NetCDF output file (if necessary)
570	CALL mpp_init_ioipsl
571
572
573	END SUBROUTINE mpp_init2

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

Download in other formats:

Original Format