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/OFF_SRC – NEMO

Context Navigation

source: trunk/NEMO/OFF_SRC/mppini_2.h90 @ 325

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

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

Download in other formats:

Original Format