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

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 2442

Last change on this file since 2442 was 2442, checked in by gm, 13 years ago

v3.3beta: #765 Creation of LBC directory, move of istate.F90 in DOM

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