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/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 4624

Last change on this file since 4624 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.
  • Property svn:keywords set to Id
File size: 21.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      USE in_out_manager  ! I/O Manager
42      USE iom
43      !!
44      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
45      INTEGER ::  inum                        ! temporary logical unit
46      INTEGER ::  idir                        ! temporary integers
47      INTEGER ::   ios                        ! Local integer output status for namelist read
48      INTEGER ::   &
49         ii, ij, ifreq, il1, il2,          &  ! temporary integers
50         icont, ili, ilj,                  &  !    "          "
51         isurf, ijm1, imil,                &  !    "          "
52         iino, ijno, iiso, ijso,           &  !    "          "
53         iiea, ijea, iiwe, ijwe,           &  !    "          "
54         iinw, ijnw, iine, ijne,           &  !    "          "
55         iisw, ijsw, iise, ijse,           &  !    "          "
56         iresti, irestj, iproc                !    "          "
57      INTEGER, DIMENSION(jpnij) ::   &
58         iin, ijn         
59      INTEGER, DIMENSION(jpni,jpnj) ::   &
60         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace
61         ipproc, ibondj, ibondi, ipolj ,   &  !    "           "
62         ilei  , ilej  , ildi  , ildj  ,   &  !    "           "
63         ioea  , iowe  , ioso  , iono  ,   &  !    "           "
64         ione  , ionw  , iose  , iosw  ,   &  !    "           "
65         ibne  , ibnw  , ibse  , ibsw         !    "           "
66      INTEGER,  DIMENSION(jpiglo,jpjglo) ::   &
67         imask                                ! temporary global workspace
68      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
69         zdta                   ! temporary data workspace
70      REAL(wp) ::   zidom , zjdom          ! temporary scalars
71
72      ! read namelist for ln_zco
73      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
74
75      !!----------------------------------------------------------------------
76      !!  OPA 9.0 , LOCEAN-IPSL (2005)
77      !! $Id$
78      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
79      !!----------------------------------------------------------------------
80
81      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
82      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901)
83901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
84
85      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
86      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
87902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
88      IF(lwm) WRITE ( numond, namzgr )
89
90      IF(lwp)WRITE(numout,*)
91      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
92      IF(lwp)WRITE(numout,*) '~~~~~~~~'
93      IF(lwp)WRITE(numout,*) ' '
94
95      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
96
97      ! 0. initialisation
98      ! -----------------
99
100      ! open the file
101      ! Remember that at this level in the code, mpp is not yet initialized, so
102      ! the file must be open with jpdom_unknown, and kstart amd kcount forced
103      IF ( ln_zco ) THEN
104         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
105         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
106      ELSE
107         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
108         CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
109      ENDIF
110      CALL iom_close (inum)
111
112      ! land/sea mask over the global/zoom domain
113
114      imask(:,:)=1
115      WHERE ( zdta(:,:) <= 0. ) imask = 0
116
117      !  1. Dimension arrays for subdomains
118      ! -----------------------------------
119
120      !  Computation of local domain sizes ilci() ilcj()
121      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
122      !  The subdomains are squares leeser than or equal to the global
123      !  dimensions divided by the number of processors minus the overlap
124      !  array.
125
126      nreci=2*jpreci
127      nrecj=2*jprecj
128      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
129      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
130
131#if defined key_nemocice_decomp
132      ! Change padding to be consistent with CICE
133      ilci(1:jpni-1      ,:) = jpi
134      ilci(jpni          ,:) = jpiglo - (jpni - 1) * (jpi - nreci)
135
136      ilcj(:,      1:jpnj-1) = jpj
137      ilcj(:,          jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj)
138#else
139      ilci(1:iresti      ,:) = jpi
140      ilci(iresti+1:jpni ,:) = jpi-1
141
142      ilcj(:,      1:irestj) = jpj
143      ilcj(:, irestj+1:jpnj) = jpj-1
144#endif
145
146      IF(lwp) WRITE(numout,*)
147      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
148      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
149      IF(lwp) WRITE(numout,*)
150      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
151      IF(lwp) WRITE(numout,*)
152      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
153
154      zidom = nreci + sum(ilci(:,1) - nreci )
155      IF(lwp) WRITE(numout,*)
156      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
157
158      zjdom = nrecj + sum(ilcj(1,:) - nrecj )
159      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
160      IF(lwp) WRITE(numout,*)
161
162
163      !  2. Index arrays for subdomains
164      ! -------------------------------
165
166      iimppt(:,:) = 1
167      ijmppt(:,:) = 1
168      ipproc(:,:) = -1
169
170      IF( jpni > 1 )THEN
171         DO jj = 1, jpnj
172            DO ji = 2, jpni
173               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
174            END DO
175         END DO
176      ENDIF
177
178      IF( jpnj > 1 )THEN
179         DO jj = 2, jpnj
180            DO ji = 1, jpni
181               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
182            END DO
183         END DO
184      ENDIF
185
186
187      ! 3. Subdomain description in the Regular Case
188      ! --------------------------------------------
189
190      nperio = 0
191      icont = -1
192      DO jarea = 1, jpni*jpnj
193         ii = 1 + MOD(jarea-1,jpni)
194         ij = 1 +    (jarea-1)/jpni
195         ili = ilci(ii,ij)
196         ilj = ilcj(ii,ij)
197
198         ibondj(ii,ij) = -1
199         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
200         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
201         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
202
203         ibondi(ii,ij) = 0
204         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
205         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
206         IF( jpni            == 1 )   ibondi(ii,ij) =  2
207
208         ! 2.4 Subdomain neighbors
209
210         iproc = jarea - 1
211         ioso(ii,ij) = iproc - jpni
212         iowe(ii,ij) = iproc - 1
213         ioea(ii,ij) = iproc + 1
214         iono(ii,ij) = iproc + jpni
215         ildi(ii,ij) = 1 + jpreci
216         ilei(ii,ij) = ili -jpreci
217         ionw(ii,ij) = iono(ii,ij) - 1
218         ione(ii,ij) = iono(ii,ij) + 1
219         iosw(ii,ij) = ioso(ii,ij) - 1
220         iose(ii,ij) = ioso(ii,ij) + 1
221         ibsw(ii,ij) = 1
222         ibnw(ii,ij) = 1
223         IF( MOD(iproc,jpni) == 0 ) THEN
224            ibsw(ii,ij) = 0
225            ibnw(ii,ij) = 0
226         ENDIF
227         ibse(ii,ij) = 1
228         ibne(ii,ij) = 1
229         IF( MOD(iproc,jpni) == jpni-1 ) THEN
230            ibse(ii,ij) = 0
231            ibne(ii,ij) = 0
232         ENDIF
233         IF( iproc < jpni ) THEN
234            ibsw(ii,ij) = 0
235            ibse(ii,ij) = 0
236         ENDIF
237         IF( iproc >= (jpnj-1)*jpni ) THEN
238            ibnw(ii,ij) = 0
239            ibne(ii,ij) = 0
240         ENDIF
241         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
242         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
243         ildj(ii,ij) =  1  + jprecj
244         ilej(ii,ij) = ilj - jprecj
245         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
246         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
247
248         ! warning ii*ij (zone) /= nproc (processors)!
249
250         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
251            IF( jpni == 1 )THEN
252               ibondi(ii,ij) = 2
253               nperio = 1
254            ELSE
255               ibondi(ii,ij) = 0
256            ENDIF
257            IF( MOD(jarea,jpni) == 0 ) THEN
258               ioea(ii,ij) = iproc - (jpni-1)
259               ione(ii,ij) = ione(ii,ij) - jpni
260               iose(ii,ij) = iose(ii,ij) - jpni
261            ENDIF
262            IF( MOD(jarea,jpni) == 1 ) THEN
263               iowe(ii,ij) = iproc + jpni - 1
264               ionw(ii,ij) = ionw(ii,ij) + jpni
265               iosw(ii,ij) = iosw(ii,ij) + jpni
266            ENDIF
267            ibsw(ii,ij) = 1
268            ibnw(ii,ij) = 1
269            ibse(ii,ij) = 1
270            ibne(ii,ij) = 1
271            IF( iproc < jpni ) THEN
272               ibsw(ii,ij) = 0
273               ibse(ii,ij) = 0
274            ENDIF
275            IF( iproc >= (jpnj-1)*jpni ) THEN
276               ibnw(ii,ij) = 0
277               ibne(ii,ij) = 0
278            ENDIF
279         ENDIF
280         ipolj(ii,ij) = 0
281         IF( jperio == 3 .OR. jperio == 4 ) THEN
282            ijm1 = jpni*(jpnj-1)
283            imil = ijm1+(jpni+1)/2
284            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
285            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
286            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1 - 1   ! MPI rank of northern neighbour
287         ENDIF
288         IF( jperio == 5 .OR. jperio == 6 ) THEN
289            ijm1 = jpni*(jpnj-1)
290            imil = ijm1+(jpni+1)/2
291            IF( jarea > ijm1) ipolj(ii,ij) = 5
292            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
293            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1 - 1    ! MPI rank of northern neighbour
294         ENDIF
295
296         isurf = 0
297         DO jj = 1+jprecj, ilj-jprecj
298            DO  ji = 1+jpreci, ili-jpreci
299               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
300            END DO
301         END DO
302         IF(isurf /= 0) THEN
303            icont = icont + 1
304            ipproc(ii,ij) = icont
305            iin(icont+1) = ii
306            ijn(icont+1) = ij
307         ENDIF
308      END DO
309
310      ! Control
311      IF(icont+1 /= jpnij) THEN
312         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
313         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'
314         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
315         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
316      ENDIF
317
318      ! 4. Subdomain print
319      ! ------------------
320
321      IF(lwp) THEN
322         ifreq = 4
323         il1 = 1
324         DO jn = 1,(jpni-1)/ifreq+1
325            il2 = MIN(jpni,il1+ifreq-1)
326            WRITE(numout,*)
327            WRITE(numout,9400) ('***',ji=il1,il2-1)
328            DO jj = jpnj, 1, -1
329               WRITE(numout,9403) ('   ',ji=il1,il2-1)
330               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
331               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
332               WRITE(numout,9403) ('   ',ji=il1,il2-1)
333               WRITE(numout,9400) ('***',ji=il1,il2-1)
334            END DO
335            WRITE(numout,9401) (ji,ji=il1,il2)
336            il1 = il1+ifreq
337         END DO
338 9400     FORMAT('     ***',20('*************',a3))
339 9403     FORMAT('     *     ',20('         *   ',a3))
340 9401     FORMAT('        ',20('   ',i3,'          '))
341 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
342 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
343      ENDIF
344
345
346      ! 5. neighbour treatment
347      ! ----------------------
348
349      DO jarea = 1, jpni*jpnj
350         iproc = jarea-1
351         ii = 1 + MOD(jarea-1,jpni)
352         ij = 1 +    (jarea-1)/jpni
353         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
354            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
355            iino = 1 + MOD(iono(ii,ij),jpni)
356            ijno = 1 +    (iono(ii,ij))/jpni
357              ! Need to reverse the logical direction of communication
358              ! for northern neighbours of northern row processors (north-fold)
359              ! i.e. need to check that the northern neighbour only communicates
360              ! to the SOUTH (or not at all) if this area is land-only (#1057)
361            idir = 1
362            IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1   
363            IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
364            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
365         ENDIF
366         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
367            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
368            iiso = 1 + MOD(ioso(ii,ij),jpni)
369            ijso = 1 +    (ioso(ii,ij))/jpni
370            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
371            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
372         ENDIF
373         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
374            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
375            iiea = 1 + MOD(ioea(ii,ij),jpni)
376            ijea = 1 +    (ioea(ii,ij))/jpni
377            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
378            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
379         ENDIF
380         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
381            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
382            iiwe = 1 + MOD(iowe(ii,ij),jpni)
383            ijwe = 1 +    (iowe(ii,ij))/jpni
384            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
385            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
386         ENDIF
387         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
388            iine = 1 + MOD(ione(ii,ij),jpni)
389            ijne = 1 +    (ione(ii,ij))/jpni
390            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
391         ENDIF
392         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
393            iisw = 1 + MOD(iosw(ii,ij),jpni)
394            ijsw = 1 +    (iosw(ii,ij))/jpni
395            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
396         ENDIF
397         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
398            iinw = 1 + MOD(ionw(ii,ij),jpni)
399            ijnw = 1 +    (ionw(ii,ij))/jpni
400            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
401         ENDIF
402         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
403            iise = 1 + MOD(iose(ii,ij),jpni)
404            ijse = 1 +    (iose(ii,ij))/jpni
405            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
406         ENDIF
407      END DO
408
409
410      ! 6. Change processor name
411      ! ------------------------
412
413      nproc = narea-1
414      ii = iin(narea)
415      ij = ijn(narea)
416      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
417         iiso = 1 + MOD(ioso(ii,ij),jpni)
418         ijso = 1 +    (ioso(ii,ij))/jpni
419         noso = ipproc(iiso,ijso)
420      ENDIF
421      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
422         iiwe = 1 + MOD(iowe(ii,ij),jpni)
423         ijwe = 1 +    (iowe(ii,ij))/jpni
424         nowe = ipproc(iiwe,ijwe)
425      ENDIF
426      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
427         iiea = 1 + MOD(ioea(ii,ij),jpni)
428         ijea = 1 +    (ioea(ii,ij))/jpni
429         noea = ipproc(iiea,ijea)
430      ENDIF
431      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
432         iino = 1 + MOD(iono(ii,ij),jpni)
433         ijno = 1 +    (iono(ii,ij))/jpni
434         nono = ipproc(iino,ijno)
435      ENDIF
436      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN
437         iise = 1 + MOD(iose(ii,ij),jpni)
438         ijse = 1 +    (iose(ii,ij))/jpni
439         npse = ipproc(iise,ijse)
440      ENDIF
441      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN
442         iisw = 1 + MOD(iosw(ii,ij),jpni)
443         ijsw = 1 +    (iosw(ii,ij))/jpni
444         npsw = ipproc(iisw,ijsw)
445      ENDIF
446      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN
447         iine = 1 + MOD(ione(ii,ij),jpni)
448         ijne = 1 +    (ione(ii,ij))/jpni
449         npne = ipproc(iine,ijne)
450      ENDIF
451      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN
452         iinw = 1 + MOD(ionw(ii,ij),jpni)
453         ijnw = 1 +    (ionw(ii,ij))/jpni
454         npnw = ipproc(iinw,ijnw)
455      ENDIF
456      nbnw = ibnw(ii,ij)
457      nbne = ibne(ii,ij)
458      nbsw = ibsw(ii,ij)
459      nbse = ibse(ii,ij)
460      nlcj = ilcj(ii,ij) 
461      nlci = ilci(ii,ij) 
462      nldi = ildi(ii,ij)
463      nlei = ilei(ii,ij)
464      nldj = ildj(ii,ij)
465      nlej = ilej(ii,ij)
466      nbondi = ibondi(ii,ij)
467      nbondj = ibondj(ii,ij)
468      nimpp = iimppt(ii,ij) 
469      njmpp = ijmppt(ii,ij) 
470      DO jproc = 1, jpnij
471         ii = iin(jproc)
472         ij = ijn(jproc)
473         nimppt(jproc) = iimppt(ii,ij) 
474         njmppt(jproc) = ijmppt(ii,ij) 
475         nlcjt(jproc) = ilcj(ii,ij)
476         nlcit(jproc) = ilci(ii,ij)
477         nldit(jproc) = ildi(ii,ij)
478         nleit(jproc) = ilei(ii,ij)
479         nldjt(jproc) = ildj(ii,ij)
480         nlejt(jproc) = ilej(ii,ij)
481      END DO
482
483      ! Save processor layout in ascii file
484      IF (lwp) THEN
485         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
486         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
487         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
488
489        DO  jproc = 1, jpnij
490         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
491                                      nldit(jproc), nldjt(jproc), &
492                                      nleit(jproc), nlejt(jproc), &
493                                      nimppt(jproc), njmppt(jproc)
494        END DO
495        CLOSE(inum)   
496      END IF
497
498      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' )
499
500      ! Prepare mpp north fold
501
502      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
503         CALL mpp_ini_north
504         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
505      ENDIF
506
507      ! Defined npolj, either 0, 3 , 4 , 5 , 6
508      ! In this case the important thing is that npolj /= 0
509      ! Because if we go through these line it is because jpni >1 and thus
510      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
511
512      npolj = 0
513      ij = ijn(narea)
514
515      IF( jperio == 3 .OR. jperio == 4 ) THEN
516         IF( ij == jpnj ) npolj = 3
517      ENDIF
518
519      IF( jperio == 5 .OR. jperio == 6 ) THEN
520         IF( ij == jpnj ) npolj = 5
521      ENDIF
522
523      ! Prepare NetCDF output file (if necessary)
524      CALL mpp_init_ioipsl
525
526      ! Periodicity : no corner if nbondi = 2 and nperio != 1
527
528      IF(lwp) THEN
529         WRITE(numout,*) ' nproc=  ',nproc
530         WRITE(numout,*) ' nowe=   ',nowe
531         WRITE(numout,*) ' noea=   ',noea
532         WRITE(numout,*) ' nono=   ',nono
533         WRITE(numout,*) ' noso=   ',noso
534         WRITE(numout,*) ' nbondi= ',nbondi
535         WRITE(numout,*) ' nbondj= ',nbondj
536         WRITE(numout,*) ' npolj=  ',npolj
537         WRITE(numout,*) ' nperio= ',nperio
538         WRITE(numout,*) ' nlci=   ',nlci
539         WRITE(numout,*) ' nlcj=   ',nlcj
540         WRITE(numout,*) ' nimpp=  ',nimpp
541         WRITE(numout,*) ' njmpp=  ',njmpp
542         WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse
543         WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw
544         WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne
545         WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw
546      ENDIF
547
548   END SUBROUTINE mpp_init2
Note: See TracBrowser for help on using the repository browser.