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 @ 169

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

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

Download in other formats:

Original Format