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

source: branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 6977

Last change on this file since 6977 was 6977, checked in by flavoni, 7 years ago

fix bug in variable name

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