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 trunk/NEMO/OPA_SRC – NEMO

Context Navigation

source: trunk/NEMO/OPA_SRC/mppini_2.h90 @ 648

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

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

Download in other formats:

Original Format