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

Context Navigation

source: trunk/NEMO/OPA_SRC/mppini.F90 @ 389

Last change on this file since 389 was 389, checked in by opalod, 18 years ago

RB:nemo_v1_update_038: first integration of Agrif :

configuration parameters are just integer when agrif is used
add call to agrif routines with key_agrif

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 19.1 KB

Line
1	MODULE mppini
2	!!==============================================================================
3	!! * MODULE mppini *
4	!! Ocean initialization : distributed memory computing initialization
5	!!==============================================================================
6
7	!!----------------------------------------------------------------------
8	!! mpp_init : Lay out the global domain over processors
9	!! mpp_init2 : Lay out the global domain over processors
10	!! with land processor elimination
11	!! mpp_init_ioispl: IOIPSL initialization in mpp
12	!!----------------------------------------------------------------------
13	!! * Modules used
14	USE dom_oce ! ocean space and time domain
15	USE in_out_manager ! I/O Manager
16	USE sol_oce ! ocean elliptic solver
17	USE lib_mpp ! distribued memory computing library
18	USE ioipsl
19
20	IMPLICIT NONE
21	PRIVATE
22
23	!! * Routine accessibility
24	PUBLIC mpp_init ! called by opa.F90
25	PUBLIC mpp_init2 ! called by opa.F90
26
27	!! * Substitutions
28	# include "domzgr_substitute.h90"
29	!!----------------------------------------------------------------------
30	!! OPA 9.0 , LOCEAN-IPSL (2005)
31	!! $Header$
32	!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
33	!!----------------------------------------------------------------------
34
35	CONTAINS
36
37	#if ! defined key_mpp_mpi && ! defined key_mpp_shmem
38	!!----------------------------------------------------------------------
39	!! Default option : shared memory computing
40	!!----------------------------------------------------------------------
41
42	SUBROUTINE mpp_init
43	!!----------------------------------------------------------------------
44	!! * ROUTINE mpp_init *
45	!!
46	!! ** Purpose : Lay out the global domain over processors.
47	!!
48	!! ** Method : Shared memory computing, set the local processor
49	!! variables to the value of the global domain
50	!!
51	!! History :
52	!! 9.0 ! 04-01 (G. Madec, J.M. Molines) F90 : free form, north fold jpni >1
53	!!----------------------------------------------------------------------
54
55	! No mpp computation
56	nimpp = 1
57	njmpp = 1
58	nlci = jpi
59	nlcj = jpj
60	nldi = 1
61	nldj = 1
62	nlei = jpi
63	nlej = jpj
64	nperio = jperio
65	nbondi = 2
66	nbondj = 2
67	nidom = FLIO_DOM_NONE
68
69	IF(lwp) THEN
70	WRITE(numout,*)
71	WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing'
72	WRITE(numout,*) '~~~~~~~~~~~: '
73	WRITE(numout,*) ' nperio = ', nperio
74	WRITE(numout,*) ' npolj = ', npolj
75	WRITE(numout,*) ' nimpp = ', nimpp
76	WRITE(numout,*) ' njmpp = ', njmpp
77	ENDIF
78
79	IF( jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) THEN
80	IF(lwp)WRITE(numout,cform_err)
81	IF(lwp)WRITE(numout,*) 'equality jpni = jpnj = jpnij = 1 is not satisfied'
82	IF(lwp)WRITE(numout,*) 'the domain is lay out for distributed memory computing! '
83	nstop = nstop + 1
84	ENDIF
85
86
87	END SUBROUTINE mpp_init
88
89
90	SUBROUTINE mpp_init2
91	CALL mpp_init ! same routine as mpp_init
92	END SUBROUTINE mpp_init2
93
94	#else
95	!!----------------------------------------------------------------------
96	!! 'key_mpp_mpi' OR MPI massively parallel processing
97	!! 'key_mpp_shmem' SHMEM massively parallel processing
98	!!----------------------------------------------------------------------
99
100	SUBROUTINE mpp_init
101	!!----------------------------------------------------------------------
102	!! * ROUTINE mpp_init *
103	!!
104	!! ** Purpose : Lay out the global domain over processors.
105	!!
106	!! ** Method : Global domain is distributed in smaller local domains.
107	!! Periodic condition is a function of the local domain position
108	!! (global boundary or neighbouring domain) and of the global
109	!! periodic
110	!! Type : jperio global periodic condition
111	!! nperio local periodic condition
112	!!
113	!! ** Action : - set domain parameters
114	!! nimpp : longitudinal index
115	!! njmpp : latitudinal index
116	!! nperio : lateral condition type
117	!! narea : number for local area
118	!! nlci : first dimension
119	!! nlcj : second dimension
120	!! nbondi : mark for "east-west local boundary"
121	!! nbondj : mark for "north-south local boundary"
122	!! nproc : number for local processor
123	!! noea : number for local neighboring processor
124	!! nowe : number for local neighboring processor
125	!! noso : number for local neighboring processor
126	!! nono : number for local neighboring processor
127	!!
128	!! History :
129	!! ! 94-11 (M. Guyon) Original code
130	!! ! 95-04 (J. Escobar, M. Imbard)
131	!! ! 98-02 (M. Guyon) FETI method
132	!! ! 98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions
133	!! 8.5 ! 02-08 (G. Madec) F90 : free form
134	!!----------------------------------------------------------------------
135	!! * Local variables
136	INTEGER :: ji, jj, jn ! dummy loop indices
137	INTEGER :: &
138	ii, ij, ifreq, il1, il2, & ! temporary integers
139	iresti, irestj, ijm1, imil, & ! " "
140	inum ! temporary logical unit
141
142	INTEGER, DIMENSION(jpni,jpnj) :: &
143	iimppt, ijmppt, ilcit, ilcjt ! temporary workspace
144	REAL(wp) :: zidom, zjdom ! temporary scalars
145	CHARACTER(len=80) :: clname
146	!!----------------------------------------------------------------------
147
148	#if defined key_mpp_shmem
149	IF(lwp) WRITE(numout,*)
150	IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing PVM T3E + SHMEM'
151	IF(lwp) WRITE(numout,*) '~~~~~~~~'
152
153	CALL mppshmem ! Initialisation of shmem array
154
155	#endif
156	#if defined key_mpp_mpi
157	IF(lwp) WRITE(numout,*)
158	IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI'
159	IF(lwp) WRITE(numout,*) '~~~~~~~~'
160	#endif
161
162
163	! 1. Dimension arrays for subdomains
164	! -----------------------------------
165	! Computation of local domain sizes ilcit() ilcjt()
166	! These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
167	! The subdomains are squares leeser than or equal to the global
168	! dimensions divided by the number of processors minus the overlap
169	! array (cf. par_oce.F90).
170
171	nreci = 2 * jpreci
172	nrecj = 2 * jprecj
173	iresti = MOD( jpiglo - nreci , jpni )
174	irestj = MOD( jpjglo - nrecj , jpnj )
175
176	IF( iresti == 0 ) iresti = jpni
177	DO jj = 1, jpnj
178	DO ji = 1, iresti
179	ilcit(ji,jj) = jpi
180	END DO
181	DO ji = iresti+1, jpni
182	ilcit(ji,jj) = jpi -1
183	END DO
184	END DO
185
186	IF( irestj == 0 ) irestj = jpnj
187	DO ji = 1, jpni
188	DO jj = 1, irestj
189	ilcjt(ji,jj) = jpj
190	END DO
191	DO jj = irestj+1, jpnj
192	ilcjt(ji,jj) = jpj -1
193	END DO
194	END DO
195
196	IF(lwp) THEN
197	WRITE(numout,*)
198	WRITE(numout,*) ' defines mpp subdomains'
199	WRITE(numout,*) ' ----------------------'
200	WRITE(numout,*) ' iresti=',iresti,' irestj=',irestj
201	WRITE(numout,*) ' jpni=',jpni,' jpnj=',jpnj
202	ifreq = 4
203	il1 = 1
204	DO jn = 1, (jpni-1)/ifreq+1
205	il2 = MIN( jpni, il1+ifreq-1 )
206	WRITE(numout,*)
207	WRITE(numout,9201) (ji,ji = il1,il2)
208	WRITE(numout,9200) ('***',ji = il1,il2-1)
209	DO jj = 1, jpnj
210	WRITE(numout,9203) (' ',ji = il1,il2-1)
211	WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
212	WRITE(numout,9203) (' ',ji = il1,il2-1)
213	WRITE(numout,9200) ('***',ji = il1,il2-1)
214	END DO
215	il1 = il1+ifreq
216	END DO
217	9200 FORMAT(' *',20('***********',a3))
218	9203 FORMAT(' * ',20(' * ',a3))
219	9201 FORMAT(' ',20(' ',i3,' '))
220	9202 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * '))
221	ENDIF
222
223	zidom = nreci
224	DO ji = 1, jpni
225	zidom = zidom + ilcit(ji,1) - nreci
226	END DO
227	IF(lwp) WRITE(numout,*)
228	IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo
229
230	zjdom = nrecj
231	DO jj = 1, jpnj
232	zjdom = zjdom + ilcjt(1,jj) - nrecj
233	END DO
234	IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo
235	IF(lwp) WRITE(numout,*)
236
237
238	! 2. Index arrays for subdomains
239	! -------------------------------
240
241	iimppt(:,:) = 1
242	ijmppt(:,:) = 1
243
244	IF( jpni > 1 ) THEN
245	DO jj = 1, jpnj
246	DO ji = 2, jpni
247	iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
248	END DO
249	END DO
250	ENDIF
251
252	IF( jpnj > 1 ) THEN
253	DO jj = 2, jpnj
254	DO ji = 1, jpni
255	ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
256	END DO
257	END DO
258	ENDIF
259
260	! 3. Subdomain description
261	! ------------------------
262
263	DO jn = 1, jpnij
264	ii = 1 + MOD( jn-1, jpni )
265	ij = 1 + (jn-1) / jpni
266	nimppt(jn) = iimppt(ii,ij)
267	njmppt(jn) = ijmppt(ii,ij)
268	nlcit (jn) = ilcit (ii,ij)
269	nlci = nlcit (jn)
270	nlcjt (jn) = ilcjt (ii,ij)
271	nlcj = nlcjt (jn)
272	nbondj = -1 ! general case
273	IF( jn > jpni ) nbondj = 0 ! first row of processor
274	IF( jn > (jpnj-1)*jpni ) nbondj = 1 ! last row of processor
275	IF( jpnj == 1 ) nbondj = 2 ! one processor only in j-direction
276	ibonjt(jn) = nbondj
277
278	nbondi = 0 !
279	IF( MOD( jn, jpni ) == 1 ) nbondi = -1 !
280	IF( MOD( jn, jpni ) == 0 ) nbondi = 1 !
281	IF( jpni == 1 ) nbondi = 2 ! one processor only in i-direction
282	ibonit(jn) = nbondi
283
284	nldi = 1 + jpreci
285	nlei = nlci - jpreci
286	IF( nbondi == -1 .OR. nbondi == 2 ) nldi = 1
287	IF( nbondi == 1 .OR. nbondi == 2 ) nlei = nlci
288	nldj = 1 + jprecj
289	nlej = nlcj - jprecj
290	IF( nbondj == -1 .OR. nbondj == 2 ) nldj = 1
291	IF( nbondj == 1 .OR. nbondj == 2 ) nlej = nlcj
292	nldit(jn) = nldi
293	nleit(jn) = nlei
294	nldjt(jn) = nldj
295	nlejt(jn) = nlej
296	END DO
297
298
299	! 4. From global to local
300	! -----------------------
301
302	nperio = 0
303	IF( jperio == 2 .AND. nbondj == -1 ) nperio = 2
304
305
306	! 5. Subdomain neighbours
307	! ----------------------
308
309	nproc = narea - 1
310	noso = nproc - jpni
311	nowe = nproc - 1
312	noea = nproc + 1
313	nono = nproc + jpni
314	! great neighbours
315	npnw = nono - 1
316	npne = nono + 1
317	npsw = noso - 1
318	npse = noso + 1
319	nbsw = 1
320	nbnw = 1
321	IF( MOD( nproc, jpni ) == 0 ) THEN
322	nbsw = 0
323	nbnw = 0
324	ENDIF
325	nbse = 1
326	nbne = 1
327	IF( MOD( nproc, jpni ) == jpni-1 ) THEN
328	nbse = 0
329	nbne = 0
330	ENDIF
331	IF(nproc < jpni) THEN
332	nbsw = 0
333	nbse = 0
334	ENDIF
335	IF( nproc >= (jpnj-1)*jpni ) THEN
336	nbnw = 0
337	nbne = 0
338	ENDIF
339	nlcj = nlcjt(narea)
340	nlci = nlcit(narea)
341	nldi = nldit(narea)
342	nlei = nleit(narea)
343	nldj = nldjt(narea)
344	nlej = nlejt(narea)
345	nbondi = ibonit(narea)
346	nbondj = ibonjt(narea)
347	nimpp = nimppt(narea)
348	njmpp = njmppt(narea)
349
350	! Save processor layout in layout.dat file
351	IF (lwp) THEN
352	inum = 11
353	clname = 'layout.dat'
354	CALL ctlopn(inum, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 0)
355
356	WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
357	WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
358
359	DO jn = 1, jpnij
360	WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
361	nldit(jn), nldjt(jn), &
362	nleit(jn), nlejt(jn), &
363	nimppt(jn), njmppt(jn)
364	END DO
365	CLOSE(inum)
366	END IF
367
368
369	! w a r n i n g narea (zone) /= nproc (processors)!
370
371	IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
372	IF( jpni == 1 )THEN
373	nbondi = 2
374	nperio = 1
375	ELSE
376	nbondi = 0
377	ENDIF
378	IF( MOD( narea, jpni ) == 0 ) THEN
379	noea = nproc-(jpni-1)
380	npne = npne-jpni
381	npse = npse-jpni
382	ENDIF
383	IF( MOD( narea, jpni ) == 1 ) THEN
384	nowe = nproc+(jpni-1)
385	npnw = npnw+jpni
386	npsw = npsw+jpni
387	ENDIF
388	nbsw = 1
389	nbnw = 1
390	nbse = 1
391	nbne = 1
392	IF( nproc < jpni ) THEN
393	nbsw = 0
394	nbse = 0
395	ENDIF
396	IF( nproc >= (jpnj-1)*jpni ) THEN
397	nbnw = 0
398	nbne = 0
399	ENDIF
400	ENDIF
401	npolj = 0
402	IF( jperio == 3 .OR. jperio == 4 ) THEN
403	ijm1 = jpni*(jpnj-1)
404	imil = ijm1+(jpni+1)/2
405	IF( narea > ijm1 ) npolj = 3
406	IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
407	IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
408	ENDIF
409	IF( jperio == 5 .OR. jperio == 6 ) THEN
410	ijm1 = jpni*(jpnj-1)
411	imil = ijm1+(jpni+1)/2
412	IF( narea > ijm1) npolj = 5
413	IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
414	IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
415	ENDIF
416
417	! FETI method
418
419	IF( nperio == 1 .AND. nsolv == 3 ) THEN
420
421	! general case : Earth == infinite tube
422
423	nbnw = 1
424	npnw = narea
425	nbne = 1
426	npne = narea
427	nbsw = 1
428	npsw = (narea-2)
429	nbse = 1
430	npse = (narea-2)
431
432	! REAL boundary condition
433
434	IF( nbondj == -1 .OR. nbondj == 2 ) THEN
435	nbsw = 0
436	nbse = 0
437	ENDIF
438
439	IF( nbondj == -1 .OR. nbondj == 2 ) THEN
440	nbsw = 0
441	nbse = 0
442	ENDIF
443
444	IF( nbondj == 1 .OR. nbondj == 2 ) THEN
445	nbnw = 0
446	nbne = 0
447	ENDIF
448	ENDIF
449
450	! Periodicity : no corner if nbondi = 2 and nperio != 1
451
452	IF(lwp) THEN
453	WRITE(numout,*) ' nproc = ', nproc
454	WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea
455	WRITE(numout,*) ' nono = ', nono , ' noso = ', noso
456	WRITE(numout,*) ' nbondi = ', nbondi
457	WRITE(numout,*) ' nbondj = ', nbondj
458	WRITE(numout,*) ' npolj = ', npolj
459	WRITE(numout,*) ' nperio = ', nperio
460	WRITE(numout,*) ' nlci = ', nlci
461	WRITE(numout,*) ' nlcj = ', nlcj
462	WRITE(numout,*) ' nimpp = ', nimpp
463	WRITE(numout,*) ' njmpp = ', njmpp
464	WRITE(numout,*) ' nbse = ', nbse , ' npse = ', npse
465	WRITE(numout,*) ' nbsw = ', nbsw , ' npsw = ', npsw
466	WRITE(numout,*) ' nbne = ', nbne , ' npne = ', npne
467	WRITE(numout,*) ' nbnw = ', nbnw , ' npnw = ', npnw
468	ENDIF
469
470	IF( nperio == 1 .AND. jpni /= 1 )THEN
471	IF(lwp) WRITE(numout,cform_err)
472	IF(lwp) WRITE(numout,*) ' mpp_init: error on cyclicity'
473	nstop = nstop + 1
474	ENDIF
475
476	! Prepare mpp north fold
477
478	IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
479	CALL mpp_ini_north
480	END IF
481
482	! Prepare NetCDF output file (if necessary)
483	CALL mpp_init_ioipsl
484
485	END SUBROUTINE mpp_init
486
487	# include "mppini_2.h90"
488
489	# if defined key_dimgout
490	!!----------------------------------------------------------------------
491	!! 'key_dimgout' NO use of NetCDF files
492	!!----------------------------------------------------------------------
493	SUBROUTINE mpp_init_ioipsl ! Dummy routine
494	END SUBROUTINE mpp_init_ioipsl
495	# else
496	SUBROUTINE mpp_init_ioipsl
497	!!----------------------------------------------------------------------
498	!! * ROUTINE mpp_init_ioipsl *
499	!!
500	!! ** Purpose :
501	!!
502	!! ** Method :
503	!!
504	!! History :
505	!! 9.0 ! 04-03 (G. Madec) MPP-IOIPSL
506	!!----------------------------------------------------------------------
507	!! Local declarations
508
509	INTEGER, DIMENSION(2) :: &
510	iglo, iloc, iabsf, iabsl, ihals, ihale, idid
511	INTEGER :: &
512	inbondi, inbondj
513	!!----------------------------------------------------------------------
514
515	! The domain is splitted only horizontally along i- or/and j- direction
516	! So we need at the most only 1D arrays with 2 elements
517	iglo(1) = jpiglo
518	iglo(2) = jpjglo
519	iloc(1) = nlci
520	iloc(2) = nlcj
521	iabsf(1) = nimppt(narea)
522	iabsf(2) = njmppt(narea)
523	iabsl(:) = iabsf(:) + iloc(:) - 1
524	ihals(1) = jpreci
525	ihals(2) = jprecj
526	ihale(1) = jpreci
527	ihale(2) = jprecj
528	idid(1) = 1
529	idid(2) = 2
530
531	inbondj = -1 ! general case
532	IF( narea > jpni ) inbondj = 0 ! first row of processor
533	IF( narea > (jpnj-1)*jpni ) inbondj = 1 ! last row of processor
534	IF( jpnj == 1 ) inbondj = 2 ! one processor only in j-direction
535	IF( inbondj == -1 .OR. inbondj == 2 ) ihals(2) = 0
536	IF( inbondj == 1 .OR. inbondj == 2 ) ihale(2) = 0
537
538	inbondi = 0 !
539	IF( MOD( narea, jpni ) == 1 ) inbondi = -1 !
540	IF( MOD( narea, jpni ) == 0 ) inbondi = 1 !
541	IF( jpni == 1 ) inbondi = 2 ! one processor only in i-direction
542	IF( inbondi == -1 .OR. inbondi == 2 ) ihals(1) = 0
543	IF( inbondi == 1 .OR. inbondi == 2 ) ihale(1) = 0
544
545
546	IF(lwp) THEN
547	WRITE(numout,*) 'mpp_init_ioipsl : iloc = ', iloc (1), iloc (2)
548	WRITE(numout,*) '~~~~~~~~~~~~~~~ iabsf = ', iabsf(1), iabsf(2)
549	WRITE(numout,*) ' ihals = ', ihals(1), ihals(2)
550	WRITE(numout,*) ' ihale = ', ihale(1), ihale(2)
551	ENDIF
552
553	CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
554
555	END SUBROUTINE mpp_init_ioipsl
556
557	# endif
558	#endif
559
560	!!======================================================================
561	END MODULE mppini

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

Download in other formats: