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 NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90 @ 12760

Last change on this file since 12760 was 12760, checked in by smasson, 4 years ago
Extra_Halo: update do_loop_substitute for nn_hls=2, see #2366
Property svn:keywords set to `Id`
File size: 62.3 KB

Line
1	MODULE mppini
2	!!======================================================================
3	!! * MODULE mppini *
4	!! Ocean initialization : distributed memory computing initialization
5	!!======================================================================
6	!! History : 6.0 ! 1994-11 (M. Guyon) Original code
7	!! OPA 7.0 ! 1995-04 (J. Escobar, M. Imbard)
8	!! 8.0 ! 1998-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions
9	!! NEMO 1.0 ! 2004-01 (G. Madec, J.M Molines) F90 : free form , north fold jpni > 1
10	!! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add init_nfdcom
11	!! 3. ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) init_nfdcom: setup avoiding MPI communication
12	!! 4.0 ! 2016-06 (G. Madec) use domain configuration file instead of bathymetry file
13	!! 4.0 ! 2017-06 (J.M. Molines, T. Lovato) merge of mppini and mppini_2
14	!!----------------------------------------------------------------------
15
16	!!----------------------------------------------------------------------
17	!! mpp_init : Lay out the global domain over processors with/without land processor elimination
18	!! init_ioipsl: IOIPSL initialization in mpp
19	!! init_nfdcom: Setup for north fold exchanges with explicit point-to-point messaging
20	!! init_doloop: set the starting/ending indices of DO-loop used in do_loop_substitute
21	!!----------------------------------------------------------------------
22	USE dom_oce ! ocean space and time domain
23	USE bdy_oce ! open BounDarY
24	!
25	USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges
26	USE lib_mpp ! distribued memory computing library
27	USE iom ! nemo I/O library
28	USE ioipsl ! I/O IPSL library
29	USE in_out_manager ! I/O Manager
30
31	IMPLICIT NONE
32	PRIVATE
33
34	PUBLIC mpp_init ! called by opa.F90
35
36	INTEGER :: numbot = -1 ! 'bottom_level' local logical unit
37	INTEGER :: numbdy = -1 ! 'bdy_msk' local logical unit
38
39	!!----------------------------------------------------------------------
40	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
41	!! $Id$
42	!! Software governed by the CeCILL license (see ./LICENSE)
43	!!----------------------------------------------------------------------
44	CONTAINS
45
46	#if ! defined key_mpp_mpi
47	!!----------------------------------------------------------------------
48	!! Default option : shared memory computing
49	!!----------------------------------------------------------------------
50
51	SUBROUTINE mpp_init
52	!!----------------------------------------------------------------------
53	!! * ROUTINE mpp_init *
54	!!
55	!! ** Purpose : Lay out the global domain over processors.
56	!!
57	!! ** Method : Shared memory computing, set the local processor
58	!! variables to the value of the global domain
59	!!----------------------------------------------------------------------
60	!
61	jpimax = jpiglo
62	jpjmax = jpjglo
63	jpi = jpiglo
64	jpj = jpjglo
65	jpk = jpkglo
66	jpim1 = jpi-1 ! inner domain indices
67	jpjm1 = jpj-1 ! " "
68	jpkm1 = MAX( 1, jpk-1 ) ! " "
69	!
70	CALL init_doloop ! set start/end indices or do-loop depending on the halo width value (nn_hls)
71	!
72	jpij = jpi*jpj
73	jpni = 1
74	jpnj = 1
75	jpnij = jpni*jpnj
76	nimpp = 1 !
77	njmpp = 1
78	nlci = jpi
79	nlcj = jpj
80	nldi = 1
81	nldj = 1
82	nlei = jpi
83	nlej = jpj
84	nbondi = 2
85	nbondj = 2
86	nidom = FLIO_DOM_NONE
87	npolj = 0
88	IF( jperio == 3 .OR. jperio == 4 ) npolj = 3
89	IF( jperio == 5 .OR. jperio == 6 ) npolj = 5
90	l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7)
91	l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7)
92	!
93	IF(lwp) THEN
94	WRITE(numout,*)
95	WRITE(numout,*) 'mpp_init : NO massively parallel processing'
96	WRITE(numout,*) '~~~~~~~~ '
97	WRITE(numout,*) ' l_Iperio = ', l_Iperio, ' l_Jperio = ', l_Jperio
98	WRITE(numout,*) ' npolj = ', npolj , ' njmpp = ', njmpp
99	ENDIF
100	!
101	IF( jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) &
102	CALL ctl_stop( 'mpp_init: equality jpni = jpnj = jpnij = 1 is not satisfied', &
103	& 'the domain is lay out for distributed memory computing!' )
104	!
105	END SUBROUTINE mpp_init
106
107	#else
108	!!----------------------------------------------------------------------
109	!! 'key_mpp_mpi' MPI massively parallel processing
110	!!----------------------------------------------------------------------
111
112
113	SUBROUTINE mpp_init
114	!!----------------------------------------------------------------------
115	!! * ROUTINE mpp_init *
116	!!
117	!! ** Purpose : Lay out the global domain over processors.
118	!! If land processors are to be eliminated, this program requires the
119	!! presence of the domain configuration file. Land processors elimination
120	!! is performed if jpni x jpnj /= jpnij. In this case, using the MPP_PREP
121	!! preprocessing tool, help for defining the best cutting out.
122	!!
123	!! ** Method : Global domain is distributed in smaller local domains.
124	!! Periodic condition is a function of the local domain position
125	!! (global boundary or neighbouring domain) and of the global
126	!! periodic
127	!! Type : jperio global periodic condition
128	!!
129	!! ** Action : - set domain parameters
130	!! nimpp : longitudinal index
131	!! njmpp : latitudinal index
132	!! narea : number for local area
133	!! nlci : first dimension
134	!! nlcj : second dimension
135	!! nbondi : mark for "east-west local boundary"
136	!! nbondj : mark for "north-south local boundary"
137	!! nproc : number for local processor
138	!! noea : number for local neighboring processor
139	!! nowe : number for local neighboring processor
140	!! noso : number for local neighboring processor
141	!! nono : number for local neighboring processor
142	!!----------------------------------------------------------------------
143	INTEGER :: ji, jj, jn, jproc, jarea ! dummy loop indices
144	INTEGER :: inijmin
145	INTEGER :: i2add
146	INTEGER :: inum ! local logical unit
147	INTEGER :: idir, ifreq, icont ! local integers
148	INTEGER :: ii, il1, ili, imil ! - -
149	INTEGER :: ij, il2, ilj, ijm1 ! - -
150	INTEGER :: iino, ijno, iiso, ijso ! - -
151	INTEGER :: iiea, ijea, iiwe, ijwe ! - -
152	INTEGER :: iarea0 ! - -
153	INTEGER :: ierr, ios !
154	INTEGER :: inbi, inbj, iimax, ijmax, icnt1, icnt2
155	LOGICAL :: llbest, llauto
156	LOGICAL :: llwrtlay
157	LOGICAL :: ln_listonly
158	INTEGER, ALLOCATABLE, DIMENSION(:) :: iin, ii_nono, ii_noea ! 1D workspace
159	INTEGER, ALLOCATABLE, DIMENSION(:) :: ijn, ii_noso, ii_nowe ! - -
160	INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iimppt, ilci, ibondi, ipproc ! 2D workspace
161	INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ijmppt, ilcj, ibondj, ipolj ! - -
162	INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ilei, ildi, iono, ioea ! - -
163	INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ilej, ildj, ioso, iowe ! - -
164	LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: llisoce ! - -
165	NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file, &
166	& ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta, &
167	& cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta, &
168	& ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
169	& cn_ice, nn_ice_dta, &
170	& ln_vol, nn_volctl, nn_rimwidth
171	NAMELIST/nammpp/ jpni, jpnj, ln_nnogather, ln_listonly
172	!!----------------------------------------------------------------------
173	!
174	llwrtlay = lwm .OR. sn_cfctl%l_layout
175	!
176	! 0. read namelists parameters
177	! -----------------------------------
178	!
179	READ ( numnam_ref, nammpp, IOSTAT = ios, ERR = 901 )
180	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in reference namelist' )
181	READ ( numnam_cfg, nammpp, IOSTAT = ios, ERR = 902 )
182	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist' )
183	!
184	IF(lwp) THEN
185	WRITE(numout,*) ' Namelist nammpp'
186	IF( jpni < 1 .OR. jpnj < 1 ) THEN
187	WRITE(numout,*) ' jpni and jpnj will be calculated automatically'
188	ELSE
189	WRITE(numout,*) ' processor grid extent in i jpni = ', jpni
190	WRITE(numout,*) ' processor grid extent in j jpnj = ', jpnj
191	ENDIF
192	WRITE(numout,*) ' avoid use of mpi_allgather at the north fold ln_nnogather = ', ln_nnogather
193	ENDIF
194	!
195	IF(lwm) WRITE( numond, nammpp )
196
197	! do we need to take into account bdy_msk?
198	READ ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
199	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)' )
200	READ ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
201	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)' )
202	!
203	IF( ln_read_cfg ) CALL iom_open( cn_domcfg, numbot )
204	IF( ln_bdy .AND. ln_mask_file ) CALL iom_open( cn_mask_file, numbdy )
205	!
206	IF( ln_listonly ) CALL mpp_init_bestpartition( MAX(mppsize,jpni*jpnj), ldlist = .TRUE. ) ! must be done by all core
207	!
208	! 1. Dimension arrays for subdomains
209	! -----------------------------------
210	!
211	! If dimensions of processor grid weren't specified in the namelist file
212	! then we calculate them here now that we have our communicator size
213	IF(lwp) THEN
214	WRITE(numout,*) 'mpp_init:'
215	WRITE(numout,*) '~~~~~~~~ '
216	WRITE(numout,*)
217	ENDIF
218	IF( jpni < 1 .OR. jpnj < 1 ) THEN
219	CALL mpp_init_bestpartition( mppsize, jpni, jpnj ) ! best mpi decomposition for mppsize mpi processes
220	llauto = .TRUE.
221	llbest = .TRUE.
222	ELSE
223	llauto = .FALSE.
224	CALL mpp_init_bestpartition( mppsize, inbi, inbj, icnt2 ) ! best mpi decomposition for mppsize mpi processes
225	! largest subdomain size for mpi decoposition jpni*jpnj given in the namelist
226	CALL mpp_basic_decomposition( jpni, jpnj, jpimax, jpjmax )
227	! largest subdomain size for mpi decoposition inbi*inbj given by mpp_init_bestpartition
228	CALL mpp_basic_decomposition( inbi, inbj, iimax, ijmax )
229	icnt1 = jpni*jpnj - mppsize ! number of land subdomains that should be removed to use mppsize mpi processes
230	IF(lwp) THEN
231	WRITE(numout,9000) ' The chosen domain decomposition ', jpni, ' x ', jpnj, ' with ', icnt1, ' land subdomains'
232	WRITE(numout,9002) ' - uses a total of ', mppsize,' mpi process'
233	WRITE(numout,9000) ' - has mpi subdomains with a maximum size of (jpi = ', jpimax, ', jpj = ', jpjmax, &
234	& ', jpijpj = ', jpimaxjpjmax, ')'
235	WRITE(numout,9000) ' The best domain decompostion ', inbi, ' x ', inbj, ' with ', icnt2, ' land subdomains'
236	WRITE(numout,9002) ' - uses a total of ', inbi*inbj-icnt2,' mpi process'
237	WRITE(numout,9000) ' - has mpi subdomains with a maximum size of (jpi = ', iimax, ', jpj = ', ijmax, &
238	& ', jpijpj = ', iimax ijmax, ')'
239	ENDIF
240	IF( iimaxijmax < jpimaxjpjmax ) THEN ! chosen subdomain size is larger that the best subdomain size
241	llbest = .FALSE.
242	IF ( inbi*inbj-icnt2 < mppsize ) THEN
243	WRITE(ctmp1,*) ' ==> You could therefore have smaller mpi subdomains with less mpi processes'
244	ELSE
245	WRITE(ctmp1,*) ' ==> You could therefore have smaller mpi subdomains with the same number of mpi processes'
246	ENDIF
247	CALL ctl_warn( ' ', ctmp1, ' ', ' --- YOU ARE WASTING CPU... ---', ' ' )
248	ELSE IF ( iimaxijmax == jpimaxjpjmax .AND. (inbi*inbj-icnt2) < mppsize) THEN
249	llbest = .FALSE.
250	WRITE(ctmp1,*) ' ==> You could therefore have the same mpi subdomains size with less mpi processes'
251	CALL ctl_warn( ' ', ctmp1, ' ', ' --- YOU ARE WASTING CPU... ---', ' ' )
252	ELSE
253	llbest = .TRUE.
254	ENDIF
255	ENDIF
256
257	! look for land mpi subdomains...
258	ALLOCATE( llisoce(jpni,jpnj) )
259	CALL mpp_init_isoce( jpni, jpnj, llisoce )
260	inijmin = COUNT( llisoce ) ! number of oce subdomains
261
262	IF( mppsize < inijmin ) THEN ! too many oce subdomains: can happen only if jpni and jpnj are prescribed...
263	WRITE(ctmp1,9001) ' With this specified domain decomposition: jpni = ', jpni, ' jpnj = ', jpnj
264	WRITE(ctmp2,9002) ' we can eliminate only ', jpni*jpnj - inijmin, ' land mpi subdomains therefore '
265	WRITE(ctmp3,9001) ' the number of ocean mpi subdomains (', inijmin,') exceed the number of MPI processes:', mppsize
266	WRITE(ctmp4,*) ' ==>>> There is the list of best domain decompositions you should use: '
267	CALL ctl_stop( ctmp1, ctmp2, ctmp3, ' ', ctmp4, ' ' )
268	CALL mpp_init_bestpartition( mppsize, ldlist = .TRUE. ) ! must be done by all core
269	ENDIF
270
271	IF( mppsize > jpni*jpnj ) THEN ! not enough mpi subdomains for the total number of mpi processes
272	IF(lwp) THEN
273	WRITE(numout,9003) ' The number of mpi processes: ', mppsize
274	WRITE(numout,9003) ' exceeds the maximum number of subdomains (ocean+land) = ', jpni*jpnj
275	WRITE(numout,9001) ' defined by the following domain decomposition: jpni = ', jpni, ' jpnj = ', jpnj
276	WRITE(numout, *) ' You should: '
277	IF( llauto ) THEN
278	WRITE(numout,*) ' - either prescribe your domain decomposition with the namelist variables'
279	WRITE(numout,*) ' jpni and jpnj to match the number of mpi process you want to use, '
280	WRITE(numout,*) ' even IF it not the best choice...'
281	WRITE(numout,*) ' - or keep the automatic and optimal domain decomposition by picking up one'
282	WRITE(numout,*) ' of the number of mpi process proposed in the list bellow'
283	ELSE
284	WRITE(numout,*) ' - either properly prescribe your domain decomposition with jpni and jpnj'
285	WRITE(numout,*) ' in order to be consistent with the number of mpi process you want to use'
286	WRITE(numout,*) ' even IF it not the best choice...'
287	WRITE(numout,*) ' - or use the automatic and optimal domain decomposition and pick up one of'
288	WRITE(numout,*) ' the domain decomposition proposed in the list bellow'
289	ENDIF
290	WRITE(numout,*)
291	ENDIF
292	CALL mpp_init_bestpartition( mppsize, ldlist = .TRUE. ) ! must be done by all core
293	ENDIF
294
295	jpnij = mppsize ! force jpnij definition <-- remove as much land subdomains as needed to reach this condition
296	IF( mppsize > inijmin ) THEN
297	WRITE(ctmp1,9003) ' The number of mpi processes: ', mppsize
298	WRITE(ctmp2,9003) ' exceeds the maximum number of ocean subdomains = ', inijmin
299	WRITE(ctmp3,9002) ' we suppressed ', jpni*jpnj - mppsize, ' land subdomains '
300	WRITE(ctmp4,9002) ' BUT we had to keep ', mppsize - inijmin, ' land subdomains that are useless...'
301	CALL ctl_warn( ctmp1, ctmp2, ctmp3, ctmp4, ' ', ' --- YOU ARE WASTING CPU... ---', ' ' )
302	ELSE ! mppsize = inijmin
303	IF(lwp) THEN
304	IF(llbest) WRITE(numout,*) ' ==> you use the best mpi decomposition'
305	WRITE(numout,*)
306	WRITE(numout,9003) ' Number of mpi processes: ', mppsize
307	WRITE(numout,9003) ' Number of ocean subdomains = ', inijmin
308	WRITE(numout,9003) ' Number of suppressed land subdomains = ', jpni*jpnj - inijmin
309	WRITE(numout,*)
310	ENDIF
311	ENDIF
312	9000 FORMAT (a, i4, a, i4, a, i7, a)
313	9001 FORMAT (a, i4, a, i4)
314	9002 FORMAT (a, i4, a)
315	9003 FORMAT (a, i5)
316
317	IF( numbot /= -1 ) CALL iom_close( numbot )
318	IF( numbdy /= -1 ) CALL iom_close( numbdy )
319
320	ALLOCATE( nfiimpp(jpni,jpnj), nfipproc(jpni,jpnj), nfilcit(jpni,jpnj) , &
321	& nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) , &
322	& njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) , &
323	& nleit(jpnij) , nlejt(jpnij) , &
324	& iin(jpnij), ii_nono(jpnij), ii_noea(jpnij), &
325	& ijn(jpnij), ii_noso(jpnij), ii_nowe(jpnij), &
326	& iimppt(jpni,jpnj), ilci(jpni,jpnj), ibondi(jpni,jpnj), ipproc(jpni,jpnj), &
327	& ijmppt(jpni,jpnj), ilcj(jpni,jpnj), ibondj(jpni,jpnj), ipolj(jpni,jpnj), &
328	& ilei(jpni,jpnj), ildi(jpni,jpnj), iono(jpni,jpnj), ioea(jpni,jpnj), &
329	& ilej(jpni,jpnj), ildj(jpni,jpnj), ioso(jpni,jpnj), iowe(jpni,jpnj), &
330	& STAT=ierr )
331	CALL mpp_sum( 'mppini', ierr )
332	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'mpp_init: unable to allocate standard ocean arrays' )
333
334	#if defined key_agrif
335	IF( .NOT. Agrif_Root() ) THEN ! AGRIF children: specific setting (cf. agrif_user.F90)
336	IF( jpiglo /= nbcellsx + 2 + 2*nbghostcells ) &
337	CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nbghostcells' )
338	IF( jpjglo /= nbcellsy + 2 + 2*nbghostcells ) &
339	CALL ctl_stop( 'STOP', 'mpp_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nbghostcells' )
340	IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'mpp_init:Agrif children requires ln_use_jattr = .false. ' )
341	ENDIF
342	#endif
343	!
344	! 2. Index arrays for subdomains
345	! -----------------------------------
346	!
347	nreci = 2 * nn_hls
348	nrecj = 2 * nn_hls
349	CALL mpp_basic_decomposition( jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ilci, ilcj )
350	nfiimpp(:,:) = iimppt(:,:)
351	nfilcit(:,:) = ilci(:,:)
352	!
353	IF(lwp) THEN
354	WRITE(numout,*)
355	WRITE(numout,*) 'MPI Message Passing MPI - domain lay out over processors'
356	WRITE(numout,*)
357	WRITE(numout,*) ' defines mpp subdomains'
358	WRITE(numout,*) ' jpni = ', jpni
359	WRITE(numout,*) ' jpnj = ', jpnj
360	WRITE(numout,*)
361	WRITE(numout,*) ' sum ilci(i,1) = ', sum(ilci(:,1)), ' jpiglo = ', jpiglo
362	WRITE(numout,*) ' sum ilcj(1,j) = ', sum(ilcj(1,:)), ' jpjglo = ', jpjglo
363	ENDIF
364
365	! 3. Subdomain description in the Regular Case
366	! --------------------------------------------
367	! specific cases where there is no communication -> must do the periodicity by itself
368	! Warning: because of potential land-area suppression, do not use nbond[ij] == 2
369	l_Iperio = jpni == 1 .AND. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7)
370	l_Jperio = jpnj == 1 .AND. (jperio == 2 .OR. jperio == 7)
371
372	DO jarea = 1, jpni*jpnj
373	!
374	iarea0 = jarea - 1
375	ii = 1 + MOD(iarea0,jpni)
376	ij = 1 + iarea0/jpni
377	ili = ilci(ii,ij)
378	ilj = ilcj(ii,ij)
379	ibondi(ii,ij) = 0 ! default: has e-w neighbours
380	IF( ii == 1 ) ibondi(ii,ij) = -1 ! first column, has only e neighbour
381	IF( ii == jpni ) ibondi(ii,ij) = 1 ! last column, has only w neighbour
382	IF( jpni == 1 ) ibondi(ii,ij) = 2 ! has no e-w neighbour
383	ibondj(ii,ij) = 0 ! default: has n-s neighbours
384	IF( ij == 1 ) ibondj(ii,ij) = -1 ! first row, has only n neighbour
385	IF( ij == jpnj ) ibondj(ii,ij) = 1 ! last row, has only s neighbour
386	IF( jpnj == 1 ) ibondj(ii,ij) = 2 ! has no n-s neighbour
387
388	! Subdomain neighbors (get their zone number): default definition
389	ioso(ii,ij) = iarea0 - jpni
390	iowe(ii,ij) = iarea0 - 1
391	ioea(ii,ij) = iarea0 + 1
392	iono(ii,ij) = iarea0 + jpni
393	ildi(ii,ij) = 1 + nn_hls
394	ilei(ii,ij) = ili - nn_hls
395	ildj(ii,ij) = 1 + nn_hls
396	ilej(ii,ij) = ilj - nn_hls
397
398	! East-West periodicity: change ibondi, ioea, iowe
399	IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN
400	IF( jpni /= 1 ) ibondi(ii,ij) = 0 ! redefine: all have e-w neighbours
401	IF( ii == 1 ) iowe(ii,ij) = iarea0 + (jpni-1) ! redefine: first column, address of w neighbour
402	IF( ii == jpni ) ioea(ii,ij) = iarea0 - (jpni-1) ! redefine: last column, address of e neighbour
403	ENDIF
404
405	! Simple North-South periodicity: change ibondj, ioso, iono
406	IF( jperio == 2 .OR. jperio == 7 ) THEN
407	IF( jpnj /= 1 ) ibondj(ii,ij) = 0 ! redefine: all have n-s neighbours
408	IF( ij == 1 ) ioso(ii,ij) = iarea0 + jpni * (jpnj-1) ! redefine: first row, address of s neighbour
409	IF( ij == jpnj ) iono(ii,ij) = iarea0 - jpni * (jpnj-1) ! redefine: last row, address of n neighbour
410	ENDIF
411
412	! North fold: define ipolj, change iono. Warning: we do not change ibondj...
413	ipolj(ii,ij) = 0
414	IF( jperio == 3 .OR. jperio == 4 ) THEN
415	ijm1 = jpni*(jpnj-1)
416	imil = ijm1+(jpni+1)/2
417	IF( jarea > ijm1 ) ipolj(ii,ij) = 3
418	IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
419	IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1 ! MPI rank of northern neighbour
420	ENDIF
421	IF( jperio == 5 .OR. jperio == 6 ) THEN
422	ijm1 = jpni*(jpnj-1)
423	imil = ijm1+(jpni+1)/2
424	IF( jarea > ijm1) ipolj(ii,ij) = 5
425	IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
426	IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1 ! MPI rank of northern neighbour
427	ENDIF
428	!
429	END DO
430
431	! 4. deal with land subdomains
432	! ----------------------------
433	!
434	! specify which subdomains are oce subdomains; other are land subdomains
435	ipproc(:,:) = -1
436	icont = -1
437	DO jarea = 1, jpni*jpnj
438	iarea0 = jarea - 1
439	ii = 1 + MOD(iarea0,jpni)
440	ij = 1 + iarea0/jpni
441	IF( llisoce(ii,ij) ) THEN
442	icont = icont + 1
443	ipproc(ii,ij) = icont
444	iin(icont+1) = ii
445	ijn(icont+1) = ij
446	ENDIF
447	END DO
448	! if needed add some land subdomains to reach jpnij active subdomains
449	i2add = jpnij - inijmin
450	DO jarea = 1, jpni*jpnj
451	iarea0 = jarea - 1
452	ii = 1 + MOD(iarea0,jpni)
453	ij = 1 + iarea0/jpni
454	IF( .NOT. llisoce(ii,ij) .AND. i2add > 0 ) THEN
455	icont = icont + 1
456	ipproc(ii,ij) = icont
457	iin(icont+1) = ii
458	ijn(icont+1) = ij
459	i2add = i2add - 1
460	ENDIF
461	END DO
462	nfipproc(:,:) = ipproc(:,:)
463
464	! neighbour treatment: change ibondi, ibondj if next to a land zone
465	DO jarea = 1, jpni*jpnj
466	ii = 1 + MOD( jarea-1 , jpni )
467	ij = 1 + (jarea-1) / jpni
468	! land-only area with an active n neigbour
469	IF ( ipproc(ii,ij) == -1 .AND. 0 <= iono(ii,ij) .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
470	iino = 1 + MOD( iono(ii,ij) , jpni ) ! ii index of this n neigbour
471	ijno = 1 + iono(ii,ij) / jpni ! ij index of this n neigbour
472	! In case of north fold exchange: I am the n neigbour of my n neigbour!! (#1057)
473	! --> for northern neighbours of northern row processors (in case of north-fold)
474	! need to reverse the LOGICAL direction of communication
475	idir = 1 ! we are indeed the s neigbour of this n neigbour
476	IF( ij == jpnj .AND. ijno == jpnj ) idir = -1 ! both are on the last row, we are in fact the n neigbour
477	IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno) = 2 ! this n neigbour had only a s/n neigbour -> no more
478	IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir ! this n neigbour had both, n-s neighbours -> keep 1
479	ENDIF
480	! land-only area with an active s neigbour
481	IF( ipproc(ii,ij) == -1 .AND. 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
482	iiso = 1 + MOD( ioso(ii,ij) , jpni ) ! ii index of this s neigbour
483	ijso = 1 + ioso(ii,ij) / jpni ! ij index of this s neigbour
484	IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2 ! this s neigbour had only a n neigbour -> no more neigbour
485	IF( ibondj(iiso,ijso) == 0 ) ibondj(iiso,ijso) = 1 ! this s neigbour had both, n-s neighbours -> keep s neigbour
486	ENDIF
487	! land-only area with an active e neigbour
488	IF( ipproc(ii,ij) == -1 .AND. 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= jpni*jpnj-1 ) THEN
489	iiea = 1 + MOD( ioea(ii,ij) , jpni ) ! ii index of this e neigbour
490	ijea = 1 + ioea(ii,ij) / jpni ! ij index of this e neigbour
491	IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2 ! this e neigbour had only a w neigbour -> no more neigbour
492	IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1 ! this e neigbour had both, e-w neighbours -> keep e neigbour
493	ENDIF
494	! land-only area with an active w neigbour
495	IF( ipproc(ii,ij) == -1 .AND. 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
496	iiwe = 1 + MOD( iowe(ii,ij) , jpni ) ! ii index of this w neigbour
497	ijwe = 1 + iowe(ii,ij) / jpni ! ij index of this w neigbour
498	IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2 ! this w neigbour had only a e neigbour -> no more neigbour
499	IF( ibondi(iiwe,ijwe) == 0 ) ibondi(iiwe,ijwe) = 1 ! this w neigbour had both, e-w neighbours -> keep w neigbour
500	ENDIF
501	END DO
502
503	! Update il[de][ij] according to modified ibond[ij]
504	! ----------------------
505	DO jproc = 1, jpnij
506	ii = iin(jproc)
507	ij = ijn(jproc)
508	IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
509	IF( ibondi(ii,ij) == 1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ilci(ii,ij)
510	IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
511	IF( ibondj(ii,ij) == 1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilcj(ii,ij)
512	END DO
513
514	! 5. Subdomain print
515	! ------------------
516	IF(lwp) THEN
517	ifreq = 4
518	il1 = 1
519	DO jn = 1, (jpni-1)/ifreq+1
520	il2 = MIN(jpni,il1+ifreq-1)
521	WRITE(numout,*)
522	WRITE(numout,9400) ('***',ji=il1,il2-1)
523	DO jj = jpnj, 1, -1
524	WRITE(numout,9403) (' ',ji=il1,il2-1)
525	WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
526	WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
527	WRITE(numout,9403) (' ',ji=il1,il2-1)
528	WRITE(numout,9400) ('***',ji=il1,il2-1)
529	END DO
530	WRITE(numout,9401) (ji,ji=il1,il2)
531	il1 = il1+ifreq
532	END DO
533	9400 FORMAT(' *' ,20('***********',a3) )
534	9403 FORMAT(' * ',20(' * ',a3) )
535	9401 FORMAT(' ' ,20(' ',i3,' ') )
536	9402 FORMAT(' ',i3,' * ',20(i3,' x',i3,' * ') )
537	9404 FORMAT(' * ' ,20(' ' ,i4,' * ') )
538	ENDIF
539
540	! just to save nono etc for all proc
541	! warning ii*ij (zone) /= nproc (processors)!
542	! ioso = zone number, ii_noso = proc number
543	ii_noso(:) = -1
544	ii_nono(:) = -1
545	ii_noea(:) = -1
546	ii_nowe(:) = -1
547	DO jproc = 1, jpnij
548	ii = iin(jproc)
549	ij = ijn(jproc)
550	IF( 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
551	iiso = 1 + MOD( ioso(ii,ij) , jpni )
552	ijso = 1 + ioso(ii,ij) / jpni
553	ii_noso(jproc) = ipproc(iiso,ijso)
554	ENDIF
555	IF( 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
556	iiwe = 1 + MOD( iowe(ii,ij) , jpni )
557	ijwe = 1 + iowe(ii,ij) / jpni
558	ii_nowe(jproc) = ipproc(iiwe,ijwe)
559	ENDIF
560	IF( 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
561	iiea = 1 + MOD( ioea(ii,ij) , jpni )
562	ijea = 1 + ioea(ii,ij) / jpni
563	ii_noea(jproc)= ipproc(iiea,ijea)
564	ENDIF
565	IF( 0 <= iono(ii,ij) .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
566	iino = 1 + MOD( iono(ii,ij) , jpni )
567	ijno = 1 + iono(ii,ij) / jpni
568	ii_nono(jproc)= ipproc(iino,ijno)
569	ENDIF
570	END DO
571
572	! 6. Change processor name
573	! ------------------------
574	ii = iin(narea)
575	ij = ijn(narea)
576	!
577	! set default neighbours
578	noso = ii_noso(narea)
579	nowe = ii_nowe(narea)
580	noea = ii_noea(narea)
581	nono = ii_nono(narea)
582	nlci = ilci(ii,ij)
583	nldi = ildi(ii,ij)
584	nlei = ilei(ii,ij)
585	nlcj = ilcj(ii,ij)
586	nldj = ildj(ii,ij)
587	nlej = ilej(ii,ij)
588	nbondi = ibondi(ii,ij)
589	nbondj = ibondj(ii,ij)
590	nimpp = iimppt(ii,ij)
591	njmpp = ijmppt(ii,ij)
592	jpi = nlci
593	jpj = nlcj
594	jpk = jpkglo ! third dim
595	#if defined key_agrif
596	! simple trick to use same vertical grid as parent but different number of levels:
597	! Save maximum number of levels in jpkglo, then define all vertical grids with this number.
598	! Suppress once vertical online interpolation is ok
599	!!$ IF(.NOT.Agrif_Root()) jpkglo = Agrif_Parent( jpkglo )
600	#endif
601	!
602	CALL init_doloop ! set start/end indices of do-loop, depending on the halo width value (nn_hls)
603	!
604	jpim1 = jpi-1 ! inner domain indices
605	jpjm1 = jpj-1 ! " "
606	jpkm1 = MAX( 1, jpk-1 ) ! " "
607	jpij = jpi*jpj ! jpi x j
608	DO jproc = 1, jpnij
609	ii = iin(jproc)
610	ij = ijn(jproc)
611	nlcit(jproc) = ilci(ii,ij)
612	nldit(jproc) = ildi(ii,ij)
613	nleit(jproc) = ilei(ii,ij)
614	nlcjt(jproc) = ilcj(ii,ij)
615	nldjt(jproc) = ildj(ii,ij)
616	nlejt(jproc) = ilej(ii,ij)
617	ibonit(jproc) = ibondi(ii,ij)
618	ibonjt(jproc) = ibondj(ii,ij)
619	nimppt(jproc) = iimppt(ii,ij)
620	njmppt(jproc) = ijmppt(ii,ij)
621	END DO
622
623	! Save processor layout in ascii file
624	IF (llwrtlay) THEN
625	CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
626	WRITE(inum,'(a)') ' jpnij jpimax jpjmax jpk jpiglo jpjglo'//&
627	& ' ( local: narea jpi jpj )'
628	WRITE(inum,'(6i8,a,3i8,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,&
629	& ' ( local: ',narea,jpi,jpj,' )'
630	WRITE(inum,'(a)') 'nproc nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj '
631
632	DO jproc = 1, jpnij
633	WRITE(inum,'(13i5,2i7)') jproc-1, nlcit (jproc), nlcjt (jproc), &
634	& nldit (jproc), nldjt (jproc), &
635	& nleit (jproc), nlejt (jproc), &
636	& nimppt (jproc), njmppt (jproc), &
637	& ii_nono(jproc), ii_noso(jproc), &
638	& ii_nowe(jproc), ii_noea(jproc), &
639	& ibonit (jproc), ibonjt (jproc)
640	END DO
641	END IF
642
643	! ! north fold parameter
644	! Defined npolj, either 0, 3 , 4 , 5 , 6
645	! In this case the important thing is that npolj /= 0
646	! Because if we go through these line it is because jpni >1 and thus
647	! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
648	npolj = 0
649	ij = ijn(narea)
650	IF( jperio == 3 .OR. jperio == 4 ) THEN
651	IF( ij == jpnj ) npolj = 3
652	ENDIF
653	IF( jperio == 5 .OR. jperio == 6 ) THEN
654	IF( ij == jpnj ) npolj = 5
655	ENDIF
656	!
657	nproc = narea-1
658	IF(lwp) THEN
659	WRITE(numout,*)
660	WRITE(numout,*) ' resulting internal parameters : '
661	WRITE(numout,*) ' nproc = ', nproc
662	WRITE(numout,*) ' nowe = ', nowe , ' noea = ', noea
663	WRITE(numout,*) ' nono = ', nono , ' noso = ', noso
664	WRITE(numout,*) ' nbondi = ', nbondi
665	WRITE(numout,*) ' nbondj = ', nbondj
666	WRITE(numout,*) ' npolj = ', npolj
667	WRITE(numout,*) ' l_Iperio = ', l_Iperio
668	WRITE(numout,*) ' l_Jperio = ', l_Jperio
669	WRITE(numout,*) ' nlci = ', nlci
670	WRITE(numout,*) ' nlcj = ', nlcj
671	WRITE(numout,*) ' nimpp = ', nimpp
672	WRITE(numout,*) ' njmpp = ', njmpp
673	WRITE(numout,*) ' nreci = ', nreci
674	WRITE(numout,*) ' nrecj = ', nrecj
675	WRITE(numout,*) ' nn_hls = ', nn_hls
676	ENDIF
677
678	! ! Prepare mpp north fold
679	IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
680	CALL mpp_ini_north
681	IF (lwp) THEN
682	WRITE(numout,*)
683	WRITE(numout,*) ' ==>>> North fold boundary prepared for jpni >1'
684	! additional prints in layout.dat
685	ENDIF
686	IF (llwrtlay) THEN
687	WRITE(inum,*)
688	WRITE(inum,*)
689	WRITE(inum,*) 'number of subdomains located along the north fold : ', ndim_rank_north
690	WRITE(inum,*) 'Rank of the subdomains located along the north fold : ', ndim_rank_north
691	DO jproc = 1, ndim_rank_north, 5
692	WRITE(inum,*) nrank_north( jproc:MINVAL( (/jproc+4,ndim_rank_north/) ) )
693	END DO
694	ENDIF
695	ENDIF
696	!
697	CALL init_ioipsl ! Prepare NetCDF output file (if necessary)
698	!
699	IF (( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ).AND.( ln_nnogather )) THEN
700	CALL init_nfdcom ! northfold neighbour lists
701	IF (llwrtlay) THEN
702	WRITE(inum,*)
703	WRITE(inum,*)
704	WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :'
705	WRITE(inum,*) 'nsndto : ', nsndto
706	WRITE(inum,*) 'isendto : ', isendto
707	ENDIF
708	ENDIF
709	!
710	IF (llwrtlay) CLOSE(inum)
711	!
712	DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe, &
713	& iimppt, ijmppt, ibondi, ibondj, ipproc, ipolj, &
714	& ilci, ilcj, ilei, ilej, ildi, ildj, &
715	& iono, ioea, ioso, iowe, llisoce)
716	!
717	END SUBROUTINE mpp_init
718
719
720	SUBROUTINE mpp_basic_decomposition( knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj)
721	!!----------------------------------------------------------------------
722	!! * ROUTINE mpp_basic_decomposition *
723	!!
724	!! ** Purpose : Lay out the global domain over processors.
725	!!
726	!! ** Method : Global domain is distributed in smaller local domains.
727	!!
728	!! ** Action : - set for all knbi*knbj domains:
729	!! kimppt : longitudinal index
730	!! kjmppt : latitudinal index
731	!! klci : first dimension
732	!! klcj : second dimension
733	!!----------------------------------------------------------------------
734	INTEGER, INTENT(in ) :: knbi, knbj
735	INTEGER, INTENT( out) :: kimax, kjmax
736	INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT( out) :: kimppt, kjmppt
737	INTEGER, DIMENSION(knbi,knbj), OPTIONAL, INTENT( out) :: klci, klcj
738	!
739	INTEGER :: ji, jj
740	INTEGER :: iresti, irestj, irm, ijpjmin
741	INTEGER :: ireci, irecj
742	!!----------------------------------------------------------------------
743	!
744	#if defined key_nemocice_decomp
745	kimax = ( nx_global+2-2nn_hls + (knbi-1) ) / knbi + 2nn_hls ! first dim.
746	kjmax = ( ny_global+2-2nn_hls + (knbj-1) ) / knbj + 2nn_hls ! second dim.
747	#else
748	kimax = ( jpiglo - 2nn_hls + (knbi-1) ) / knbi + 2nn_hls ! first dim.
749	kjmax = ( jpjglo - 2nn_hls + (knbj-1) ) / knbj + 2nn_hls ! second dim.
750	#endif
751	IF( .NOT. PRESENT(kimppt) ) RETURN
752	!
753	! 1. Dimension arrays for subdomains
754	! -----------------------------------
755	! Computation of local domain sizes klci() klcj()
756	! These dimensions depend on global sizes knbi,knbj and jpiglo,jpjglo
757	! The subdomains are squares lesser than or equal to the global
758	! dimensions divided by the number of processors minus the overlap array.
759	!
760	ireci = 2 * nn_hls
761	irecj = 2 * nn_hls
762	iresti = 1 + MOD( jpiglo - ireci -1 , knbi )
763	irestj = 1 + MOD( jpjglo - irecj -1 , knbj )
764	!
765	! Need to use kimax and kjmax here since jpi and jpj not yet defined
766	#if defined key_nemocice_decomp
767	! Change padding to be consistent with CICE
768	klci(1:knbi-1 ,:) = kimax
769	klci(knbi ,:) = jpiglo - (knbi - 1) * (kimax - nreci)
770	klcj(:, 1:knbj-1) = kjmax
771	klcj(:, knbj) = jpjglo - (knbj - 1) * (kjmax - nrecj)
772	#else
773	klci(1:iresti ,:) = kimax
774	klci(iresti+1:knbi ,:) = kimax-1
775	IF( MINVAL(klci) < 3 ) THEN
776	WRITE(ctmp1,*) ' mpp_basic_decomposition: minimum value of jpi must be >= 3'
777	WRITE(ctmp2,*) ' We have ', MINVAL(klci)
778	CALL ctl_stop( 'STOP', ctmp1, ctmp2 )
779	ENDIF
780	IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6 ) THEN
781	! minimize the size of the last row to compensate for the north pole folding coast
782	IF( jperio == 3 .OR. jperio == 4 ) ijpjmin = 5 ! V and F folding involves line jpj-3 that must not be south boundary
783	IF( jperio == 5 .OR. jperio == 6 ) ijpjmin = 4 ! V and F folding involves line jpj-2 that must not be south boundary
784	irm = knbj - irestj ! total number of lines to be removed
785	klcj(:, knbj) = MAX( ijpjmin, kjmax-irm ) ! we must have jpj >= ijpjmin in the last row
786	irm = irm - ( kjmax - klcj(1,knbj) ) ! remaining number of lines to remove
787	irestj = knbj - 1 - irm
788	klcj(:, 1:irestj) = kjmax
789	klcj(:, irestj+1:knbj-1) = kjmax-1
790	ELSE
791	ijpjmin = 3
792	klcj(:, 1:irestj) = kjmax
793	klcj(:, irestj+1:knbj) = kjmax-1
794	ENDIF
795	IF( MINVAL(klcj) < ijpjmin ) THEN
796	WRITE(ctmp1,*) ' mpp_basic_decomposition: minimum value of jpj must be >= ', ijpjmin
797	WRITE(ctmp2,*) ' We have ', MINVAL(klcj)
798	CALL ctl_stop( 'STOP', ctmp1, ctmp2 )
799	ENDIF
800	#endif
801
802	! 2. Index arrays for subdomains
803	! -------------------------------
804	kimppt(:,:) = 1
805	kjmppt(:,:) = 1
806	!
807	IF( knbi > 1 ) THEN
808	DO jj = 1, knbj
809	DO ji = 2, knbi
810	kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - ireci
811	END DO
812	END DO
813	ENDIF
814	!
815	IF( knbj > 1 )THEN
816	DO jj = 2, knbj
817	DO ji = 1, knbi
818	kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - irecj
819	END DO
820	END DO
821	ENDIF
822
823	END SUBROUTINE mpp_basic_decomposition
824
825
826	SUBROUTINE mpp_init_bestpartition( knbij, knbi, knbj, knbcnt, ldlist )
827	!!----------------------------------------------------------------------
828	!! * ROUTINE mpp_init_bestpartition *
829	!!
830	!! ** Purpose :
831	!!
832	!! ** Method :
833	!!----------------------------------------------------------------------
834	INTEGER, INTENT(in ) :: knbij ! total number if subdomains (knbi*knbj)
835	INTEGER, OPTIONAL, INTENT( out) :: knbi, knbj ! number if subdomains along i and j (knbi and knbj)
836	INTEGER, OPTIONAL, INTENT( out) :: knbcnt ! number of land subdomains
837	LOGICAL, OPTIONAL, INTENT(in ) :: ldlist ! .true.: print the list the best domain decompositions (with land)
838	!
839	INTEGER :: ji, jj, ii, iitarget
840	INTEGER :: iszitst, iszjtst
841	INTEGER :: isziref, iszjref
842	INTEGER :: inbij, iszij
843	INTEGER :: inbimax, inbjmax, inbijmax, inbijold
844	INTEGER :: isz0, isz1
845	INTEGER, DIMENSION( :), ALLOCATABLE :: indexok
846	INTEGER, DIMENSION( :), ALLOCATABLE :: inbi0, inbj0, inbij0 ! number of subdomains along i,j
847	INTEGER, DIMENSION( :), ALLOCATABLE :: iszi0, iszj0, iszij0 ! max size of the subdomains along i,j
848	INTEGER, DIMENSION( :), ALLOCATABLE :: inbi1, inbj1, inbij1 ! number of subdomains along i,j
849	INTEGER, DIMENSION( :), ALLOCATABLE :: iszi1, iszj1, iszij1 ! max size of the subdomains along i,j
850	LOGICAL :: llist
851	LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llmsk2d ! max size of the subdomains along i,j
852	LOGICAL, DIMENSION(:,:), ALLOCATABLE :: llisoce ! - -
853	REAL(wp):: zpropland
854	!!----------------------------------------------------------------------
855	!
856	llist = .FALSE.
857	IF( PRESENT(ldlist) ) llist = ldlist
858
859	CALL mpp_init_landprop( zpropland ) ! get the proportion of land point over the gloal domain
860	inbij = NINT( REAL(knbij, wp) / ( 1.0 - zpropland ) ) ! define the largest possible value for jpni*jpnj
861	!
862	IF( llist ) THEN ; inbijmax = inbij*2
863	ELSE ; inbijmax = inbij
864	ENDIF
865	!
866	ALLOCATE(inbi0(inbijmax),inbj0(inbijmax),iszi0(inbijmax),iszj0(inbijmax))
867	!
868	inbimax = 0
869	inbjmax = 0
870	isziref = jpiglo*jpjglo+1
871	iszjref = jpiglo*jpjglo+1
872	!
873	! get the list of knbi that gives a smaller jpimax than knbi-1
874	! get the list of knbj that gives a smaller jpjmax than knbj-1
875	DO ji = 1, inbijmax
876	#if defined key_nemocice_decomp
877	iszitst = ( nx_global+2-2nn_hls + (ji-1) ) / ji + 2nn_hls ! first dim.
878	#else
879	iszitst = ( jpiglo - 2nn_hls + (ji-1) ) / ji + 2nn_hls
880	#endif
881	IF( iszitst < isziref ) THEN
882	isziref = iszitst
883	inbimax = inbimax + 1
884	inbi0(inbimax) = ji
885	iszi0(inbimax) = isziref
886	ENDIF
887	#if defined key_nemocice_decomp
888	iszjtst = ( ny_global+2-2nn_hls + (ji-1) ) / ji + 2nn_hls ! first dim.
889	#else
890	iszjtst = ( jpjglo - 2nn_hls + (ji-1) ) / ji + 2nn_hls
891	#endif
892	IF( iszjtst < iszjref ) THEN
893	iszjref = iszjtst
894	inbjmax = inbjmax + 1
895	inbj0(inbjmax) = ji
896	iszj0(inbjmax) = iszjref
897	ENDIF
898	END DO
899
900	! combine these 2 lists to get all possible knbi*knbj < inbijmax
901	ALLOCATE( llmsk2d(inbimax,inbjmax) )
902	DO jj = 1, inbjmax
903	DO ji = 1, inbimax
904	IF ( inbi0(ji) * inbj0(jj) <= inbijmax ) THEN ; llmsk2d(ji,jj) = .TRUE.
905	ELSE ; llmsk2d(ji,jj) = .FALSE.
906	ENDIF
907	END DO
908	END DO
909	isz1 = COUNT(llmsk2d)
910	ALLOCATE( inbi1(isz1), inbj1(isz1), iszi1(isz1), iszj1(isz1) )
911	ii = 0
912	DO jj = 1, inbjmax
913	DO ji = 1, inbimax
914	IF( llmsk2d(ji,jj) .EQV. .TRUE. ) THEN
915	ii = ii + 1
916	inbi1(ii) = inbi0(ji)
917	inbj1(ii) = inbj0(jj)
918	iszi1(ii) = iszi0(ji)
919	iszj1(ii) = iszj0(jj)
920	END IF
921	END DO
922	END DO
923	DEALLOCATE( inbi0, inbj0, iszi0, iszj0 )
924	DEALLOCATE( llmsk2d )
925
926	ALLOCATE( inbij1(isz1), iszij1(isz1) )
927	inbij1(:) = inbi1(:) * inbj1(:)
928	iszij1(:) = iszi1(:) * iszj1(:)
929
930	! if therr is no land and no print
931	IF( .NOT. llist .AND. numbot == -1 .AND. numbdy == -1 ) THEN
932	! get the smaller partition which gives the smallest subdomain size
933	ii = MINLOC(inbij1, mask = iszij1 == MINVAL(iszij1), dim = 1)
934	knbi = inbi1(ii)
935	knbj = inbj1(ii)
936	IF(PRESENT(knbcnt)) knbcnt = 0
937	DEALLOCATE( inbi1, inbj1, inbij1, iszi1, iszj1, iszij1 )
938	RETURN
939	ENDIF
940
941	! extract only the partitions which reduce the subdomain size in comparison with smaller partitions
942	ALLOCATE( indexok(isz1) ) ! to store indices of the best partitions
943	isz0 = 0 ! number of best partitions
944	inbij = 1 ! start with the min value of inbij1 => 1
945	iszij = jpiglo*jpjglo+1 ! default: larger than global domain
946	DO WHILE( inbij <= inbijmax ) ! if we did not reach the max of inbij1
947	ii = MINLOC(iszij1, mask = inbij1 == inbij, dim = 1) ! warning: send back the first occurence if multiple results
948	IF ( iszij1(ii) < iszij ) THEN
949	isz0 = isz0 + 1
950	indexok(isz0) = ii
951	iszij = iszij1(ii)
952	ENDIF
953	inbij = MINVAL(inbij1, mask = inbij1 > inbij) ! warning: return largest integer value if mask = .false. everywhere
954	END DO
955	DEALLOCATE( inbij1, iszij1 )
956
957	! keep only the best partitions (sorted by increasing order of subdomains number and decreassing subdomain size)
958	ALLOCATE( inbi0(isz0), inbj0(isz0), iszi0(isz0), iszj0(isz0) )
959	DO ji = 1, isz0
960	ii = indexok(ji)
961	inbi0(ji) = inbi1(ii)
962	inbj0(ji) = inbj1(ii)
963	iszi0(ji) = iszi1(ii)
964	iszj0(ji) = iszj1(ii)
965	END DO
966	DEALLOCATE( indexok, inbi1, inbj1, iszi1, iszj1 )
967
968	IF( llist ) THEN
969	IF(lwp) THEN
970	WRITE(numout,*)
971	WRITE(numout,*) ' For your information:'
972	WRITE(numout,*) ' list of the best partitions including land supression'
973	WRITE(numout,*) ' -----------------------------------------------------'
974	WRITE(numout,*)
975	END IF
976	ji = isz0 ! initialization with the largest value
977	ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) )
978	CALL mpp_init_isoce( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum)
979	inbijold = COUNT(llisoce)
980	DEALLOCATE( llisoce )
981	DO ji =isz0-1,1,-1
982	ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) )
983	CALL mpp_init_isoce( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum)
984	inbij = COUNT(llisoce)
985	DEALLOCATE( llisoce )
986	IF(lwp .AND. inbij < inbijold) THEN
987	WRITE(numout,'(a, i6, a, i6, a, f4.1, a, i9, a, i6, a, i6, a)') &
988	& 'nb_cores oce: ', inbij, ', land domains excluded: ', inbi0(ji)*inbj0(ji) - inbij, &
989	& ' (', REAL(inbi0(ji)inbj0(ji) - inbij,wp) / REAL(inbi0(ji)inbj0(ji),wp) *100., &
990	& '%), largest oce domain: ', iszi0(ji)*iszj0(ji), ' ( ', iszi0(ji),' x ', iszj0(ji), ' )'
991	inbijold = inbij
992	END IF
993	END DO
994	DEALLOCATE( inbi0, inbj0, iszi0, iszj0 )
995	IF(lwp) THEN
996	WRITE(numout,*)
997	WRITE(numout,*) ' -----------------------------------------------------------'
998	ENDIF
999	CALL mppsync
1000	CALL mppstop( ld_abort = .TRUE. )
1001	ENDIF
1002
1003	DEALLOCATE( iszi0, iszj0 )
1004	inbij = inbijmax + 1 ! default: larger than possible
1005	ii = isz0+1 ! start from the end of the list (smaller subdomains)
1006	DO WHILE( inbij > knbij ) ! while the number of ocean subdomains exceed the number of procs
1007	ii = ii -1
1008	ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) )
1009	CALL mpp_init_isoce( inbi0(ii), inbj0(ii), llisoce ) ! must be done by all core
1010	inbij = COUNT(llisoce)
1011	DEALLOCATE( llisoce )
1012	END DO
1013	knbi = inbi0(ii)
1014	knbj = inbj0(ii)
1015	IF(PRESENT(knbcnt)) knbcnt = knbi * knbj - inbij
1016	DEALLOCATE( inbi0, inbj0 )
1017	!
1018	END SUBROUTINE mpp_init_bestpartition
1019
1020
1021	SUBROUTINE mpp_init_landprop( propland )
1022	!!----------------------------------------------------------------------
1023	!! * ROUTINE mpp_init_landprop *
1024	!!
1025	!! ** Purpose : the the proportion of land points in the surface land-sea mask
1026	!!
1027	!! ** Method : read iproc strips (of length jpiglo) of the land-sea mask
1028	!!----------------------------------------------------------------------
1029	REAL(wp), INTENT( out) :: propland ! proportion of land points in the global domain (between 0 and 1)
1030	!
1031	INTEGER, DIMENSION(jpni*jpnj) :: kusedom_1d
1032	INTEGER :: inboce, iarea
1033	INTEGER :: iproc, idiv, ijsz
1034	INTEGER :: ijstr
1035	LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce
1036	!!----------------------------------------------------------------------
1037	! do nothing if there is no land-sea mask
1038	IF( numbot == -1 .and. numbdy == -1 ) THEN
1039	propland = 0.
1040	RETURN
1041	ENDIF
1042
1043	! number of processes reading the bathymetry file
1044	iproc = MINVAL( (/mppsize, jpjglo/2, 100/) ) ! read a least 2 lines, no more that 100 processes reading at the same time
1045
1046	! we want to read iproc strips of the land-sea mask. -> pick up iproc processes every idiv processes starting at 1
1047	IF( iproc == 1 ) THEN ; idiv = mppsize
1048	ELSE ; idiv = ( mppsize - 1 ) / ( iproc - 1 )
1049	ENDIF
1050
1051	iarea = (narea-1)/idiv ! involed process number (starting counting at 0)
1052	IF( MOD( narea-1, idiv ) == 0 .AND. iarea < iproc ) THEN ! beware idiv can be = to 1
1053	!
1054	ijsz = jpjglo / iproc ! width of the stripe to read
1055	IF( iarea < MOD(jpjglo,iproc) ) ijsz = ijsz + 1
1056	ijstr = iarea*(jpjglo/iproc) + MIN(iarea, MOD(jpjglo,iproc)) + 1 ! starting j position of the reading
1057	!
1058	ALLOCATE( lloce(jpiglo, ijsz) ) ! allocate the strip
1059	CALL mpp_init_readbot_strip( ijstr, ijsz, lloce )
1060	inboce = COUNT(lloce) ! number of ocean point in the stripe
1061	DEALLOCATE(lloce)
1062	!
1063	ELSE
1064	inboce = 0
1065	ENDIF
1066	CALL mpp_sum( 'mppini', inboce ) ! total number of ocean points over the global domain
1067	!
1068	propland = REAL( jpiglojpjglo - inboce, wp ) / REAL( jpiglojpjglo, wp )
1069	!
1070	END SUBROUTINE mpp_init_landprop
1071
1072
1073	SUBROUTINE mpp_init_isoce( knbi, knbj, ldisoce )
1074	!!----------------------------------------------------------------------
1075	!! * ROUTINE mpp_init_nboce *
1076	!!
1077	!! ** Purpose : check for a mpi domain decomposition knbi x knbj which
1078	!! subdomains contain at least 1 ocean point
1079	!!
1080	!! ** Method : read knbj strips (of length jpiglo) of the land-sea mask
1081	!!----------------------------------------------------------------------
1082	INTEGER, INTENT(in ) :: knbi, knbj ! domain decomposition
1083	LOGICAL, DIMENSION(knbi,knbj), INTENT( out) :: ldisoce ! .true. if a sub domain constains 1 ocean point
1084	!
1085	INTEGER, DIMENSION(knbi,knbj) :: inboce ! number oce oce pint in each mpi subdomain
1086	INTEGER, DIMENSION(knbi*knbj) :: inboce_1d
1087	INTEGER :: idiv, iimax, ijmax, iarea
1088	INTEGER :: ji, jn
1089	LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean
1090	INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iimppt, ilci
1091	INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ijmppt, ilcj
1092	!!----------------------------------------------------------------------
1093	! do nothing if there is no land-sea mask
1094	IF( numbot == -1 .AND. numbdy == -1 ) THEN
1095	ldisoce(:,:) = .TRUE.
1096	RETURN
1097	ENDIF
1098
1099	! we want to read knbj strips of the land-sea mask. -> pick up knbj processes every idiv processes starting at 1
1100	IF ( knbj == 1 ) THEN ; idiv = mppsize
1101	ELSE IF ( mppsize < knbj ) THEN ; idiv = 1
1102	ELSE ; idiv = ( mppsize - 1 ) / ( knbj - 1 )
1103	ENDIF
1104	inboce(:,:) = 0 ! default no ocean point found
1105
1106	DO jn = 0, (knbj-1)/mppsize ! if mppsize < knbj : more strips than mpi processes (because of potential land domains)
1107	!
1108	iarea = (narea-1)/idiv + jn * mppsize ! involed process number (starting counting at 0)
1109	IF( MOD( narea-1, idiv ) == 0 .AND. iarea < knbj ) THEN ! beware idiv can be = to 1
1110	!
1111	ALLOCATE( iimppt(knbi,knbj), ijmppt(knbi,knbj), ilci(knbi,knbj), ilcj(knbi,knbj) )
1112	CALL mpp_basic_decomposition( knbi, knbj, iimax, ijmax, iimppt, ijmppt, ilci, ilcj )
1113	!
1114	ALLOCATE( lloce(jpiglo, ilcj(1,iarea+1)) ) ! allocate the strip
1115	CALL mpp_init_readbot_strip( ijmppt(1,iarea+1), ilcj(1,iarea+1), lloce ) ! read the strip
1116	DO ji = 1, knbi
1117	inboce(ji,iarea+1) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ilci(ji,1)-1,:) ) ! number of ocean point in subdomain
1118	END DO
1119	!
1120	DEALLOCATE(lloce)
1121	DEALLOCATE(iimppt, ijmppt, ilci, ilcj)
1122	!
1123	ENDIF
1124	END DO
1125
1126	inboce_1d = RESHAPE(inboce, (/ knbi*knbj /))
1127	CALL mpp_sum( 'mppini', inboce_1d )
1128	inboce = RESHAPE(inboce_1d, (/knbi, knbj/))
1129	ldisoce(:,:) = inboce(:,:) /= 0
1130	!
1131	END SUBROUTINE mpp_init_isoce
1132
1133
1134	SUBROUTINE mpp_init_readbot_strip( kjstr, kjcnt, ldoce )
1135	!!----------------------------------------------------------------------
1136	!! * ROUTINE mpp_init_readbot_strip *
1137	!!
1138	!! ** Purpose : Read relevant bathymetric information in order to
1139	!! provide a land/sea mask used for the elimination
1140	!! of land domains, in an mpp computation.
1141	!!
1142	!! ** Method : read stipe of size (jpiglo,...)
1143	!!----------------------------------------------------------------------
1144	INTEGER , INTENT(in ) :: kjstr ! starting j position of the reading
1145	INTEGER , INTENT(in ) :: kjcnt ! number of lines to read
1146	LOGICAL, DIMENSION(jpiglo,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean
1147	!
1148	INTEGER :: inumsave ! local logical unit
1149	REAL(wp), DIMENSION(jpiglo,kjcnt) :: zbot, zbdy
1150	!!----------------------------------------------------------------------
1151	!
1152	inumsave = numout ; numout = numnul ! redirect all print to /dev/null
1153	!
1154	IF( numbot /= -1 ) THEN
1155	CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/jpiglo, kjcnt/) )
1156	ELSE
1157	zbot(:,:) = 1. ! put a non-null value
1158	ENDIF
1159
1160	IF( numbdy /= -1 ) THEN ! Adjust with bdy_msk if it exists
1161	CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/jpiglo, kjcnt/) )
1162	zbot(:,:) = zbot(:,:) * zbdy(:,:)
1163	ENDIF
1164	!
1165	ldoce(:,:) = zbot(:,:) > 0.
1166	numout = inumsave
1167	!
1168	END SUBROUTINE mpp_init_readbot_strip
1169
1170
1171	SUBROUTINE init_ioipsl
1172	!!----------------------------------------------------------------------
1173	!! * ROUTINE init_ioipsl *
1174	!!
1175	!! ** Purpose :
1176	!!
1177	!! ** Method :
1178	!!
1179	!! History :
1180	!! 9.0 ! 04-03 (G. Madec ) MPP-IOIPSL
1181	!! " " ! 08-12 (A. Coward) addition in case of jpni*jpnj < jpnij
1182	!!----------------------------------------------------------------------
1183	INTEGER, DIMENSION(2) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid
1184	!!----------------------------------------------------------------------
1185
1186	! The domain is split only horizontally along i- or/and j- direction
1187	! So we need at the most only 1D arrays with 2 elements.
1188	! Set idompar values equivalent to the jpdom_local_noextra definition
1189	! used in IOM. This works even if jpnij .ne. jpni*jpnj.
1190	iglo(1) = jpiglo
1191	iglo(2) = jpjglo
1192	iloc(1) = nlci
1193	iloc(2) = nlcj
1194	iabsf(1) = nimppt(narea)
1195	iabsf(2) = njmppt(narea)
1196	iabsl(:) = iabsf(:) + iloc(:) - 1
1197	ihals(1) = nldi - 1
1198	ihals(2) = nldj - 1
1199	ihale(1) = nlci - nlei
1200	ihale(2) = nlcj - nlej
1201	idid(1) = 1
1202	idid(2) = 2
1203
1204	IF(lwp) THEN
1205	WRITE(numout,*)
1206	WRITE(numout,*) 'mpp init_ioipsl : iloc = ', iloc (1), iloc (2)
1207	WRITE(numout,*) '~~~~~~~~~~~~~~~ iabsf = ', iabsf(1), iabsf(2)
1208	WRITE(numout,*) ' ihals = ', ihals(1), ihals(2)
1209	WRITE(numout,*) ' ihale = ', ihale(1), ihale(2)
1210	ENDIF
1211	!
1212	CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
1213	!
1214	END SUBROUTINE init_ioipsl
1215
1216
1217	SUBROUTINE init_nfdcom
1218	!!----------------------------------------------------------------------
1219	!! * ROUTINE init_nfdcom *
1220	!! ** Purpose : Setup for north fold exchanges with explicit
1221	!! point-to-point messaging
1222	!!
1223	!! ** Method : Initialization of the northern neighbours lists.
1224	!!----------------------------------------------------------------------
1225	!! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE)
1226	!! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)
1227	!!----------------------------------------------------------------------
1228	INTEGER :: sxM, dxM, sxT, dxT, jn
1229	INTEGER :: njmppmax
1230	!!----------------------------------------------------------------------
1231	!
1232	njmppmax = MAXVAL( njmppt )
1233	!
1234	!initializes the north-fold communication variables
1235	isendto(:) = 0
1236	nsndto = 0
1237	!
1238	IF ( njmpp == njmppmax ) THEN ! if I am a process in the north
1239	!
1240	!sxM is the first point (in the global domain) needed to compute the north-fold for the current process
1241	sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
1242	!dxM is the last point (in the global domain) needed to compute the north-fold for the current process
1243	dxM = jpiglo - nimppt(narea) + 2
1244	!
1245	! loop over the other north-fold processes to find the processes
1246	! managing the points belonging to the sxT-dxT range
1247	!
1248	DO jn = 1, jpni
1249	!
1250	sxT = nfiimpp(jn, jpnj) ! sxT = 1st point (in the global domain) of the jn process
1251	dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 ! dxT = last point (in the global domain) of the jn process
1252	!
1253	IF ( sxT < sxM .AND. sxM < dxT ) THEN
1254	nsndto = nsndto + 1
1255	isendto(nsndto) = jn
1256	ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN
1257	nsndto = nsndto + 1
1258	isendto(nsndto) = jn
1259	ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN
1260	nsndto = nsndto + 1
1261	isendto(nsndto) = jn
1262	ENDIF
1263	!
1264	END DO
1265	!
1266	ENDIF
1267	l_north_nogather = .TRUE.
1268	!
1269	END SUBROUTINE init_nfdcom
1270
1271	#endif
1272
1273	SUBROUTINE init_doloop
1274	!!----------------------------------------------------------------------
1275	!! * ROUTINE init_doloop *
1276	!!
1277	!! ** Purpose : set the starting/ending indices of DO-loop
1278	!! These indices are used in do_loop_substitute.h90
1279	!!----------------------------------------------------------------------
1280	!
1281	IF( nn_hls == 1 ) THEN !* halo size of 1
1282	!
1283	nIs_0 = 2 ; nIs_1 = 1 ; nIs_1nxt2 = nIs_0 ; nIs_2 = nIs_1
1284	nJs_0 = 2 ; nJs_1 = 1 ; nJs_1nxt2 = nJs_0 ; nJs_2 = nJs_1
1285	!
1286	nIe_0 = jpi-1 ; nIe_1 = jpi ; nIe_1nxt2 = nIe_0 ; nIe_2 = nIe_1
1287	nJe_0 = jpj-1 ; nJe_1 = jpj ; nJe_1nxt2 = nJe_0 ; nJe_2 = nJe_1
1288	!
1289	ELSEIF( nn_hls == 2 ) THEN !* halo size of 2
1290	!
1291	nIs_0 = 3 ; nIs_1 = 2 ; nIs_1nxt2 = nIs_1 ; nIs_2 = 1
1292	nJs_0 = 3 ; nJs_1 = 2 ; nJs_1nxt2 = nJs_1 ; nJs_2 = 1
1293	!
1294	nIe_0 = jpi-2 ; nIe_1 = jpi-1 ; nIe_1nxt2 = nIe_1 ; nIe_2 = jpi
1295	nJe_0 = jpj-2 ; nJe_1 = jpj-1 ; nJe_1nxt2 = nJe_1 ; nJe_2 = jpj
1296	!
1297	ELSE !* unexpected halo size
1298	CALL ctl_stop( 'STOP', 'ini_mpp: wrong value of halo size : nn_hls= 1 or 2 only !')
1299	ENDIF
1300	!
1301	END SUBROUTINE init_doloop
1302
1303	!!======================================================================
1304	END MODULE mppini

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

Download in other formats: