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

Last change on this file since 128 was 128, checked in by opalod, 20 years ago
CT : UPDATE080 : Now the previous bathymetry level file (bathy_level) which was in ASCII format must be converted into NetCDF format (bathy_level.nc) to be read
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 22.1 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) :: clexp, & ! 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	iim, ijm, 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(jpidta,jpjdta) :: &
74	idata ! temporary data workspace
75	INTEGER, DIMENSION(jpiglo,jpjglo) :: &
76	imask ! temporary global workspace
77
78	REAL(wp), DIMENSION(jpidta,jpjdta) :: &
79	zlamt, zphit, zdta ! temporary data workspace
80	REAL(wp), DIMENSION(jpk) :: &
81	zdept ! temporary workspace (NetCDF read)
82	REAL(wp) :: zidom , zjdom, & ! temporary scalars
83	zdt, zdate0
84
85	!!----------------------------------------------------------------------
86	!! OPA 8.5, LODYC-IPSL (2002)
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 level bathymetry in ', clname
129	IF(lwp) WRITE(numout,*)
130	itime = 1
131	ipi = jpidta
132	ipj = jpjdta
133	ipk = 1
134	zdt = rdt
135	CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE., &
136	ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum )
137	CALL flinget( inum, clvar, jpidta, jpjdta, 1, &
138	itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) )
139	CALL flinclo( inum )
140	ELSE
141	IF(lwp) WRITE(numout,cform_err)
142	IF(lwp) WRITE(numout,*)' mppini_2 : unable to read the file', clname
143	nstop = nstop + 1
144	ENDIF
145
146	! land/sea mask over the global/zoom domain
147
148	WHERE ( zdta(jpizoom:jpiglo+jpizoom-1, jpjzoom:jpjglo+jpjzoom-1) == 0. ) imask = 0
149
150
151	! 1. Dimension arrays for subdomains
152	! -----------------------------------
153
154	! Computation of local domain sizes ilci() ilcj()
155	! These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
156	! The subdomains are squares leeser than or equal to the global
157	! dimensions divided by the number of processors minus the overlap
158	! array.
159
160	nreci=2*jpreci
161	nrecj=2*jprecj
162	iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
163	irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
164
165	ilci(1:iresti ,:) = jpi
166	ilci(iresti+1:jpni ,:) = jpi-1
167
168	ilcj(1:irestj ,:) = jpj
169	ilcj(irestj+1:jpnj ,:) = jpj-1
170
171	IF(lwp) WRITE(numout,*)
172	IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
173	IF(lwp) WRITE(numout,*) ' ~~~~~~ ----------------------'
174	IF(lwp) WRITE(numout,*)
175	IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
176	IF(lwp) WRITE(numout,*)
177	IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
178
179	zidom = nreci + sum(ilci(:,1) - nreci )
180	IF(lwp) WRITE(numout,*)
181	IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
182
183	zjdom = nrecj + sum(ilcj(1,:) - nrecj )
184	IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
185	IF(lwp) WRITE(numout,*)
186
187
188	! 2. Index arrays for subdomains
189	! -------------------------------
190
191	iimppt(:,:) = 1
192	ijmppt(:,:) = 1
193	ipproc(:,:) = -1
194
195	IF( jpni > 1 )THEN
196	DO jj = 1, jpnj
197	DO ji = 2, jpni
198	iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
199	END DO
200	END DO
201	ENDIF
202
203	IF( jpnj > 1 )THEN
204	DO jj = 2, jpnj
205	DO ji = 1, jpni
206	ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
207	END DO
208	END DO
209	ENDIF
210
211
212	! 3. Subdomain description in the Regular Case
213	! --------------------------------------------
214
215	nperio = 0
216	icont = -1
217	DO jarea = 1, jpni*jpnj
218	ii = 1 + MOD(jarea-1,jpni)
219	ij = 1 + (jarea-1)/jpni
220	ili = ilci(ii,ij)
221	ilj = ilcj(ii,ij)
222
223	ibondj(ii,ij) = -1
224	IF( jarea > jpni ) ibondj(ii,ij) = 0
225	IF( jarea > (jpnj-1)*jpni ) ibondj(ii,ij) = 1
226	IF( jpnj == 1 ) ibondj(ii,ij) = 2
227
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,jj) = 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
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
319	ENDIF
320
321	isurf = 0
322	DO jj = 1, ilj
323	DO ji = 1, ili
324	IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
325	END DO
326	END DO
327	IF(isurf /= 0) THEN
328	icont = icont + 1
329	ipproc(ii,ij) = icont
330	iin(icont+1) = ii
331	ijn(icont+1) = ij
332	ENDIF
333	END DO
334
335	! Control
336	IF(icont+1 /= jpnij) THEN
337	IF(lwp) THEN
338	WRITE(numout,*) ' Eliminate land processors algorithm'
339	WRITE(numout,*)
340	WRITE(numout,*) ' jpni =',jpni,' jpnj =',jpnj
341	WRITE(numout,*) ' jpnij =',jpnij, '< jpni x jpnj'
342	WRITE(numout,*)
343	WRITE(numout,*) ' E R R O R '
344	WRITE(numout,) ' **********, mpp_init2 finds jpnij=',icont+1
345	WRITE(numout,*) ' we stop'
346	ENDIF
347	STOP 'mpp_init2'
348	ENDIF
349
350
351	! 4. Subdomain print
352	! ------------------
353
354	IF(lwp) THEN
355	ifreq = 4
356	il1 = 1
357	DO jn = 1,(jpni-1)/ifreq+1
358	il2 = MIN(jpni,il1+ifreq-1)
359	WRITE(numout,*)
360	WRITE(numout,9401) (ji,ji=il1,il2)
361	WRITE(numout,9400) ('***',ji=il1,il2-1)
362	DO jj = 1, jpnj
363	! WRITE(numout,9400)
364	WRITE(numout,9403) (' ',ji=il1,il2-1)
365	WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
366	WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
367	WRITE(numout,9403) (' ',ji=il1,il2-1)
368	WRITE(numout,9400) ('***',ji=il1,il2-1)
369	! WRITE(numout,9400)
370	END DO
371	il1 = il1+ifreq
372	END DO
373	9400 FORMAT(' *',20('***********',a3))
374	9403 FORMAT(' * ',20(' * ',a3))
375	9401 FORMAT(' ',20(' ',i3,' '))
376	9402 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * '))
377	9404 FORMAT(' * ',20(' ',i3,' * '))
378	ENDIF
379
380
381	! 5. neighbour treatment
382	! ----------------------
383
384	DO jarea = 1, jpni*jpnj
385	iproc = jarea-1
386	ii = 1 + MOD(jarea-1,jpni)
387	ij = 1 + (jarea-1)/jpni
388	IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0 &
389	.AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
390	iino = 1 + MOD(iono(ii,ij),jpni)
391	ijno = 1 + (iono(ii,ij))/jpni
392	IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2
393	IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1
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	IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
446	iiso = 1 + MOD(ioso(ii,ij),jpni)
447	ijso = 1 + (ioso(ii,ij))/jpni
448	noso = ipproc(iiso,ijso)
449	ENDIF
450	IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
451	iiwe = 1 + MOD(iowe(ii,ij),jpni)
452	ijwe = 1 + (iowe(ii,ij))/jpni
453	nowe = ipproc(iiwe,ijwe)
454	ENDIF
455	IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
456	iiea = 1 + MOD(ioea(ii,ij),jpni)
457	ijea = 1 + (ioea(ii,ij))/jpni
458	noea = ipproc(iiea,ijea)
459	ENDIF
460	IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
461	iino = 1 + MOD(iono(ii,ij),jpni)
462	ijno = 1 + (iono(ii,ij))/jpni
463	nono = ipproc(iino,ijno)
464	ENDIF
465	IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN
466	iise = 1 + MOD(iose(ii,ij),jpni)
467	ijse = 1 + (iose(ii,ij))/jpni
468	npse = ipproc(iise,ijse)
469	ENDIF
470	IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN
471	iisw = 1 + MOD(iosw(ii,ij),jpni)
472	ijsw = 1 + (iosw(ii,ij))/jpni
473	npsw = ipproc(iisw,ijsw)
474	ENDIF
475	IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN
476	iine = 1 + MOD(ione(ii,ij),jpni)
477	ijne = 1 + (ione(ii,ij))/jpni
478	npne = ipproc(iine,ijne)
479	ENDIF
480	IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN
481	iinw = 1 + MOD(ionw(ii,ij),jpni)
482	ijnw = 1 + (ionw(ii,ij))/jpni
483	npnw = ipproc(iinw,ijnw)
484	ENDIF
485	nbnw = ibnw(ii,ij)
486	nbne = ibne(ii,ij)
487	nbsw = ibsw(ii,ij)
488	nbse = ibse(ii,ij)
489	nlcj = ilcj(ii,ij)
490	nlci = ilci(ii,ij)
491	nldi = ildi(ii,ij)
492	nlei = ilei(ii,ij)
493	nldj = ildj(ii,ij)
494	nlej = ilej(ii,ij)
495	nbondi = ibondi(ii,ij)
496	nbondj = ibondj(ii,ij)
497	nimpp = iimppt(ii,ij)
498	njmpp = ijmppt(ii,ij)
499	DO jproc = 1, jpnij
500	ii = iin(jproc)
501	ij = ijn(jproc)
502	nimppt(jproc) = iimppt(ii,ij)
503	njmppt(jproc) = ijmppt(ii,ij)
504	nlcjt(jproc) = ilcj(ii,ij)
505	nlcit(jproc) = ilci(ii,ij)
506	nldit(jproc) = ildi(ii,ij)
507	nleit(jproc) = ilei(ii,ij)
508	nldjt(jproc) = ildj(ii,ij)
509	nlejt(jproc) = ilej(ii,ij)
510	END DO
511
512	! Save processor layout in ascii file
513	IF (lwp) THEN
514	OPEN(inum,FILE='layout.dat')
515	WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
516	WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
517
518	DO jproc = 1, jpnij
519	WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
520	nldit(jproc), nldjt(jproc), &
521	nleit(jproc), nlejt(jproc), &
522	nimppt(jproc), njmppt(jproc)
523	END DO
524	CLOSE(inum)
525	END IF
526
527
528	! FETI method
529
530	IF( nperio == 1 .AND. nsolv == 3 ) THEN
531
532	! general CASE : Earth == infinite tube
533
534	nbnw = 1
535	npnw = narea
536	nbne = 1
537	npne = narea
538	nbsw = 1
539	npsw = (narea-2)
540	nbse = 1
541	npse = (narea-2)
542
543	! REAL boundary condition
544
545	IF( nbondj == -1 .OR. nbondj == 2 ) THEN
546	nbsw = 0
547	nbse = 0
548	ENDIF
549
550	IF( nbondj == -1 .OR. nbondj == 2 ) THEN
551	nbsw = 0
552	nbse = 0
553	ENDIF
554
555	IF( nbondj == 1 .OR. nbondj == 2 ) THEN
556	nbnw = 0
557	nbne = 0
558	ENDIF
559	ENDIF
560
561	! Periodicity : no corner if nbondi = 2 and nperio != 1
562
563	IF(lwp) WRITE(numout,*) ' nproc= ',nproc
564	IF(lwp) WRITE(numout,*) ' nowe= ',nowe
565	IF(lwp) WRITE(numout,*) ' noea= ',noea
566	IF(lwp) WRITE(numout,*) ' nono= ',nono
567	IF(lwp) WRITE(numout,*) ' noso= ',noso
568	IF(lwp) WRITE(numout,*) ' nbondi= ',nbondi
569	IF(lwp) WRITE(numout,*) ' nbondj= ',nbondj
570	IF(lwp) WRITE(numout,*) ' npolj= ',npolj
571	IF(lwp) WRITE(numout,*) ' nperio= ',nperio
572	IF(lwp) WRITE(numout,*) ' nlci= ',nlci
573	IF(lwp) WRITE(numout,*) ' nlcj= ',nlcj
574	IF(lwp) WRITE(numout,*) ' nimpp= ',nimpp
575	IF(lwp) WRITE(numout,*) ' njmpp= ',njmpp
576	IF(lwp) WRITE(numout,*) ' nbse= ',nbse,' npse= ',npse
577	IF(lwp) WRITE(numout,*) ' nbsw= ',nbsw,' npsw= ',npsw
578	IF(lwp) WRITE(numout,*) ' nbne= ',nbne,' npne= ',npne
579	IF(lwp) WRITE(numout,*) ' nbnw= ',nbnw,' npnw= ',npnw
580
581	IF( nperio == 1 .AND.jpni /= 1 ) THEN
582	IF(lwp) WRITE(numout,cform_err)
583	IF(lwp) WRITE(numout,*) ' mpp_init2: error on cyclicity'
584	nstop = nstop + 1
585	ENDIF
586
587	! Prepare mpp north fold
588
589	IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
590	CALL mpp_ini_north
591	IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
592	END IF
593
594	! Defined npolj, either 0, 3 , 4 , 5 , 6
595	! In this case the important thing is that npolj /= 0
596	! Because if we go through these line it is because jpni >1 and thus
597	! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
598
599	npolj = 0
600	ij = ijn(narea)
601
602	IF (jperio == 3 .OR. jperio == 4 ) THEN
603	IF ( ij == jpnj ) npolj = 3
604	ENDIF
605
606	IF( jperio == 5 .OR. jperio == 6 ) THEN
607	IF ( ij == jpnj ) npolj = 5
608	ENDIF
609
610
611	END SUBROUTINE mpp_init2

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

Download in other formats:

Original Format