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

source: branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 4147

Last change on this file since 4147 was 4147, checked in by cetlod, 10 years ago

merge in dev_LOCEAN_2013, the 1st development branch dev_r3853_CNRS9_Confsetting, from its starting point ( r3853 ) on the trunk: see ticket #1169
  • Property svn:keywords set to Id
File size: 20.8 KB
Line 
1   SUBROUTINE mpp_init2
2      !!----------------------------------------------------------------------
3      !!                  ***  ROUTINE mpp_init2  ***
4      !!
5      !! * Purpose :   Lay out the global domain over processors.
6      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
7      !!     FOR DEFINING BETTER CUTTING OUT.
8      !!       This routine is used with a the bathymetry file.
9      !!       In this version, the land processors are avoided and the adress
10      !!     processor (nproc, narea,noea, ...) are calculated again.
11      !!     The jpnij parameter can be lesser than jpni x jpnj
12      !!     and this jpnij parameter must be calculated before with an
13      !!     algoritmic preprocessing program.
14      !!
15      !! ** Method  :   Global domain is distributed in smaller local domains.
16      !!      Periodic condition is a function of the local domain position
17      !!      (global boundary or neighbouring domain) and of the global
18      !!      periodic
19      !!      Type :         jperio global periodic condition
20      !!                     nperio local  periodic condition
21      !!
22      !! ** Action :        nimpp     : longitudinal index
23      !!                    njmpp     : latitudinal  index
24      !!                    nperio    : lateral condition type
25      !!                    narea     : number for local area
26      !!                    nlci      : first dimension
27      !!                    nlcj      : second dimension
28      !!                    nproc     : number for local processor
29      !!                    noea      : number for local neighboring processor
30      !!                    nowe      : number for local neighboring processor
31      !!                    noso      : number for local neighboring processor
32      !!                    nono      : number for local neighboring processor
33      !!
34      !! History :
35      !!        !  94-11  (M. Guyon)  Original code
36      !!        !  95-04  (J. Escobar, M. Imbard)
37      !!        !  98-02  (M. Guyon)  FETI method
38      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
39      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
40      !!----------------------------------------------------------------------
41      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      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      ilci(1:iresti      ,:) = jpi
132      ilci(iresti+1:jpni ,:) = jpi-1
133
134      ilcj(:,      1:irestj) = jpj
135      ilcj(:, irestj+1:jpnj) = jpj-1
136
137      IF(lwp) WRITE(numout,*)
138      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
139      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
140      IF(lwp) WRITE(numout,*)
141      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
142      IF(lwp) WRITE(numout,*)
143      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
144
145      zidom = nreci + sum(ilci(:,1) - nreci )
146      IF(lwp) WRITE(numout,*)
147      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
148
149      zjdom = nrecj + sum(ilcj(1,:) - nrecj )
150      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
151      IF(lwp) WRITE(numout,*)
152
153
154      !  2. Index arrays for subdomains
155      ! -------------------------------
156
157      iimppt(:,:) = 1
158      ijmppt(:,:) = 1
159      ipproc(:,:) = -1
160
161      IF( jpni > 1 )THEN
162         DO jj = 1, jpnj
163            DO ji = 2, jpni
164               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
165            END DO
166         END DO
167      ENDIF
168
169      IF( jpnj > 1 )THEN
170         DO jj = 2, jpnj
171            DO ji = 1, jpni
172               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
173            END DO
174         END DO
175      ENDIF
176
177
178      ! 3. Subdomain description in the Regular Case
179      ! --------------------------------------------
180
181      nperio = 0
182      icont = -1
183      DO jarea = 1, jpni*jpnj
184         ii = 1 + MOD(jarea-1,jpni)
185         ij = 1 +    (jarea-1)/jpni
186         ili = ilci(ii,ij)
187         ilj = ilcj(ii,ij)
188
189         ibondj(ii,ij) = -1
190         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
191         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
192         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
193
194         ibondi(ii,ij) = 0
195         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
196         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
197         IF( jpni            == 1 )   ibondi(ii,ij) =  2
198
199         ! 2.4 Subdomain neighbors
200
201         iproc = jarea - 1
202         ioso(ii,ij) = iproc - jpni
203         iowe(ii,ij) = iproc - 1
204         ioea(ii,ij) = iproc + 1
205         iono(ii,ij) = iproc + jpni
206         ildi(ii,ij) = 1 + jpreci
207         ilei(ii,ij) = ili -jpreci
208         ionw(ii,ij) = iono(ii,ij) - 1
209         ione(ii,ij) = iono(ii,ij) + 1
210         iosw(ii,ij) = ioso(ii,ij) - 1
211         iose(ii,ij) = ioso(ii,ij) + 1
212         ibsw(ii,ij) = 1
213         ibnw(ii,ij) = 1
214         IF( MOD(iproc,jpni) == 0 ) THEN
215            ibsw(ii,ij) = 0
216            ibnw(ii,ij) = 0
217         ENDIF
218         ibse(ii,ij) = 1
219         ibne(ii,ij) = 1
220         IF( MOD(iproc,jpni) == jpni-1 ) THEN
221            ibse(ii,ij) = 0
222            ibne(ii,ij) = 0
223         ENDIF
224         IF( iproc < jpni ) THEN
225            ibsw(ii,ij) = 0
226            ibse(ii,ij) = 0
227         ENDIF
228         IF( iproc >= (jpnj-1)*jpni ) THEN
229            ibnw(ii,ij) = 0
230            ibne(ii,ij) = 0
231         ENDIF
232         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
233         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
234         ildj(ii,ij) =  1  + jprecj
235         ilej(ii,ij) = ilj - jprecj
236         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
237         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
238
239         ! warning ii*ij (zone) /= nproc (processors)!
240
241         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
242            IF( jpni == 1 )THEN
243               ibondi(ii,ij) = 2
244               nperio = 1
245            ELSE
246               ibondi(ii,ij) = 0
247            ENDIF
248            IF( MOD(jarea,jpni) == 0 ) THEN
249               ioea(ii,ij) = iproc - (jpni-1)
250               ione(ii,ij) = ione(ii,ij) - jpni
251               iose(ii,ij) = iose(ii,ij) - jpni
252            ENDIF
253            IF( MOD(jarea,jpni) == 1 ) THEN
254               iowe(ii,ij) = iproc + jpni - 1
255               ionw(ii,ij) = ionw(ii,ij) + jpni
256               iosw(ii,ij) = iosw(ii,ij) + jpni
257            ENDIF
258            ibsw(ii,ij) = 1
259            ibnw(ii,ij) = 1
260            ibse(ii,ij) = 1
261            ibne(ii,ij) = 1
262            IF( iproc < jpni ) THEN
263               ibsw(ii,ij) = 0
264               ibse(ii,ij) = 0
265            ENDIF
266            IF( iproc >= (jpnj-1)*jpni ) THEN
267               ibnw(ii,ij) = 0
268               ibne(ii,ij) = 0
269            ENDIF
270         ENDIF
271         ipolj(ii,ij) = 0
272         IF( jperio == 3 .OR. jperio == 4 ) THEN
273            ijm1 = jpni*(jpnj-1)
274            imil = ijm1+(jpni+1)/2
275            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
276            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
277            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1 - 1   ! MPI rank of northern neighbour
278         ENDIF
279         IF( jperio == 5 .OR. jperio == 6 ) THEN
280            ijm1 = jpni*(jpnj-1)
281            imil = ijm1+(jpni+1)/2
282            IF( jarea > ijm1) ipolj(ii,ij) = 5
283            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
284            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1 - 1    ! MPI rank of northern neighbour
285         ENDIF
286
287         isurf = 0
288         DO jj = 1+jprecj, ilj-jprecj
289            DO  ji = 1+jpreci, ili-jpreci
290               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
291            END DO
292         END DO
293         IF(isurf /= 0) THEN
294            icont = icont + 1
295            ipproc(ii,ij) = icont
296            iin(icont+1) = ii
297            ijn(icont+1) = ij
298         ENDIF
299      END DO
300
301      ! Control
302      IF(icont+1 /= jpnij) THEN
303         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
304         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'
305         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
306         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
307      ENDIF
308
309      ! 4. Subdomain print
310      ! ------------------
311
312      IF(lwp) THEN
313         ifreq = 4
314         il1 = 1
315         DO jn = 1,(jpni-1)/ifreq+1
316            il2 = MIN(jpni,il1+ifreq-1)
317            WRITE(numout,*)
318            WRITE(numout,9400) ('***',ji=il1,il2-1)
319            DO jj = jpnj, 1, -1
320               WRITE(numout,9403) ('   ',ji=il1,il2-1)
321               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
322               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
323               WRITE(numout,9403) ('   ',ji=il1,il2-1)
324               WRITE(numout,9400) ('***',ji=il1,il2-1)
325            END DO
326            WRITE(numout,9401) (ji,ji=il1,il2)
327            il1 = il1+ifreq
328         END DO
329 9400     FORMAT('     ***',20('*************',a3))
330 9403     FORMAT('     *     ',20('         *   ',a3))
331 9401     FORMAT('        ',20('   ',i3,'          '))
332 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
333 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
334      ENDIF
335
336
337      ! 5. neighbour treatment
338      ! ----------------------
339
340      DO jarea = 1, jpni*jpnj
341         iproc = jarea-1
342         ii = 1 + MOD(jarea-1,jpni)
343         ij = 1 +    (jarea-1)/jpni
344         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
345            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
346            iino = 1 + MOD(iono(ii,ij),jpni)
347            ijno = 1 +    (iono(ii,ij))/jpni
348              ! Need to reverse the logical direction of communication
349              ! for northern neighbours of northern row processors (north-fold)
350              ! i.e. need to check that the northern neighbour only communicates
351              ! to the SOUTH (or not at all) if this area is land-only (#1057)
352            idir = 1
353            IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1   
354            IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
355            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
356         ENDIF
357         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
358            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
359            iiso = 1 + MOD(ioso(ii,ij),jpni)
360            ijso = 1 +    (ioso(ii,ij))/jpni
361            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
362            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
363         ENDIF
364         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
365            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
366            iiea = 1 + MOD(ioea(ii,ij),jpni)
367            ijea = 1 +    (ioea(ii,ij))/jpni
368            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
369            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
370         ENDIF
371         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
372            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
373            iiwe = 1 + MOD(iowe(ii,ij),jpni)
374            ijwe = 1 +    (iowe(ii,ij))/jpni
375            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
376            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
377         ENDIF
378         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
379            iine = 1 + MOD(ione(ii,ij),jpni)
380            ijne = 1 +    (ione(ii,ij))/jpni
381            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
382         ENDIF
383         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
384            iisw = 1 + MOD(iosw(ii,ij),jpni)
385            ijsw = 1 +    (iosw(ii,ij))/jpni
386            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
387         ENDIF
388         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
389            iinw = 1 + MOD(ionw(ii,ij),jpni)
390            ijnw = 1 +    (ionw(ii,ij))/jpni
391            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
392         ENDIF
393         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
394            iise = 1 + MOD(iose(ii,ij),jpni)
395            ijse = 1 +    (iose(ii,ij))/jpni
396            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
397         ENDIF
398      END DO
399
400
401      ! 6. Change processor name
402      ! ------------------------
403
404      nproc = narea-1
405      ii = iin(narea)
406      ij = ijn(narea)
407      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
408         iiso = 1 + MOD(ioso(ii,ij),jpni)
409         ijso = 1 +    (ioso(ii,ij))/jpni
410         noso = ipproc(iiso,ijso)
411      ENDIF
412      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
413         iiwe = 1 + MOD(iowe(ii,ij),jpni)
414         ijwe = 1 +    (iowe(ii,ij))/jpni
415         nowe = ipproc(iiwe,ijwe)
416      ENDIF
417      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
418         iiea = 1 + MOD(ioea(ii,ij),jpni)
419         ijea = 1 +    (ioea(ii,ij))/jpni
420         noea = ipproc(iiea,ijea)
421      ENDIF
422      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
423         iino = 1 + MOD(iono(ii,ij),jpni)
424         ijno = 1 +    (iono(ii,ij))/jpni
425         nono = ipproc(iino,ijno)
426      ENDIF
427      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN
428         iise = 1 + MOD(iose(ii,ij),jpni)
429         ijse = 1 +    (iose(ii,ij))/jpni
430         npse = ipproc(iise,ijse)
431      ENDIF
432      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN
433         iisw = 1 + MOD(iosw(ii,ij),jpni)
434         ijsw = 1 +    (iosw(ii,ij))/jpni
435         npsw = ipproc(iisw,ijsw)
436      ENDIF
437      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN
438         iine = 1 + MOD(ione(ii,ij),jpni)
439         ijne = 1 +    (ione(ii,ij))/jpni
440         npne = ipproc(iine,ijne)
441      ENDIF
442      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN
443         iinw = 1 + MOD(ionw(ii,ij),jpni)
444         ijnw = 1 +    (ionw(ii,ij))/jpni
445         npnw = ipproc(iinw,ijnw)
446      ENDIF
447      nbnw = ibnw(ii,ij)
448      nbne = ibne(ii,ij)
449      nbsw = ibsw(ii,ij)
450      nbse = ibse(ii,ij)
451      nlcj = ilcj(ii,ij) 
452      nlci = ilci(ii,ij) 
453      nldi = ildi(ii,ij)
454      nlei = ilei(ii,ij)
455      nldj = ildj(ii,ij)
456      nlej = ilej(ii,ij)
457      nbondi = ibondi(ii,ij)
458      nbondj = ibondj(ii,ij)
459      nimpp = iimppt(ii,ij) 
460      njmpp = ijmppt(ii,ij) 
461      DO jproc = 1, jpnij
462         ii = iin(jproc)
463         ij = ijn(jproc)
464         nimppt(jproc) = iimppt(ii,ij) 
465         njmppt(jproc) = ijmppt(ii,ij) 
466         nlcjt(jproc) = ilcj(ii,ij)
467         nlcit(jproc) = ilci(ii,ij)
468         nldit(jproc) = ildi(ii,ij)
469         nleit(jproc) = ilei(ii,ij)
470         nldjt(jproc) = ildj(ii,ij)
471         nlejt(jproc) = ilej(ii,ij)
472      END DO
473
474      ! Save processor layout in ascii file
475      IF (lwp) THEN
476         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
477         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
478         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
479
480        DO  jproc = 1, jpnij
481         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
482                                      nldit(jproc), nldjt(jproc), &
483                                      nleit(jproc), nlejt(jproc), &
484                                      nimppt(jproc), njmppt(jproc)
485        END DO
486        CLOSE(inum)   
487      END IF
488
489      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' )
490
491      ! Prepare mpp north fold
492
493      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
494         CALL mpp_ini_north
495         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
496      ENDIF
497
498      ! Defined npolj, either 0, 3 , 4 , 5 , 6
499      ! In this case the important thing is that npolj /= 0
500      ! Because if we go through these line it is because jpni >1 and thus
501      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
502
503      npolj = 0
504      ij = ijn(narea)
505
506      IF( jperio == 3 .OR. jperio == 4 ) THEN
507         IF( ij == jpnj ) npolj = 3
508      ENDIF
509
510      IF( jperio == 5 .OR. jperio == 6 ) THEN
511         IF( ij == jpnj ) npolj = 5
512      ENDIF
513
514      ! Prepare NetCDF output file (if necessary)
515      CALL mpp_init_ioipsl
516
517      ! Periodicity : no corner if nbondi = 2 and nperio != 1
518
519      IF(lwp) THEN
520         WRITE(numout,*) ' nproc=  ',nproc
521         WRITE(numout,*) ' nowe=   ',nowe
522         WRITE(numout,*) ' noea=   ',noea
523         WRITE(numout,*) ' nono=   ',nono
524         WRITE(numout,*) ' noso=   ',noso
525         WRITE(numout,*) ' nbondi= ',nbondi
526         WRITE(numout,*) ' nbondj= ',nbondj
527         WRITE(numout,*) ' npolj=  ',npolj
528         WRITE(numout,*) ' nperio= ',nperio
529         WRITE(numout,*) ' nlci=   ',nlci
530         WRITE(numout,*) ' nlcj=   ',nlcj
531         WRITE(numout,*) ' nimpp=  ',nimpp
532         WRITE(numout,*) ' njmpp=  ',njmpp
533         WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse
534         WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw
535         WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne
536         WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw
537      ENDIF
538
539   END SUBROUTINE mpp_init2
Note: See TracBrowser for help on using the repository browser.