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

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.
File size: 23.4 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 ::  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) ::   &
68         imask                                ! temporary global workspace
69      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
70         zdta, zdtaisf                     ! temporary data workspace
71      REAL(wp) ::   zidom , zjdom          ! temporary scalars
72
73      ! read namelist for ln_zco
74      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
75
76      !!----------------------------------------------------------------------
77      !!  OPA 9.0 , LOCEAN-IPSL (2005)
78      !! $Id$
79      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
80      !!----------------------------------------------------------------------
81
82      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
83      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901)
84901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
85
86      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
87      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
88902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
89      IF(lwm .AND. nprint > 2) WRITE ( numond, namzgr )
90
91      IF(lwp)WRITE(numout,*)
92      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
93      IF(lwp)WRITE(numout,*) '~~~~~~~~'
94      IF(lwp)WRITE(numout,*) ' '
95      IF(lwp .AND. lflush) CALL flush(numout)
96
97      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
98
99      ! 0. initialisation
100      ! -----------------
101
102      ! open the file
103      ! Remember that at this level in the code, mpp is not yet initialized, so
104      ! the file must be open with jpdom_unknown, and kstart and kcount forced
105      jstartrow = 1
106      IF ( ln_zco ) THEN
107         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
108          ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
109          ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
110         CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
111         jstartrow = MAX(1,jstartrow)
112         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) )
113      ELSE
114         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
115         IF ( ln_isfcav ) THEN
116             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
117         ELSE
118             ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
119             ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
120             CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
121             jstartrow = MAX(1,jstartrow)
122             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/)   &
123                &                                                   , kcount=(/jpiglo,jpjglo/) )
124         ENDIF
125      ENDIF
126      CALL iom_close (inum)
127     
128      ! used to compute the land processor in case of not masked bathy file.
129      zdtaisf(:,:) = 0.0_wp
130      IF ( ln_isfcav ) THEN
131         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
132         CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
133      END IF
134      CALL iom_close (inum)
135
136      ! land/sea mask over the global/zoom domain
137
138      imask(:,:)=1
139      WHERE ( zdta(:,:) - zdtaisf(:,:) <= 0. ) imask = 0
140
141      !  1. Dimension arrays for subdomains
142      ! -----------------------------------
143
144      !  Computation of local domain sizes ilci() ilcj()
145      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
146      !  The subdomains are squares leeser than or equal to the global
147      !  dimensions divided by the number of processors minus the overlap
148      !  array.
149
150      nreci=2*jpreci
151      nrecj=2*jprecj
152      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
153      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
154
155#if defined key_nemocice_decomp
156      ! Change padding to be consistent with CICE
157      ilci(1:jpni-1      ,:) = jpi
158      ilci(jpni          ,:) = jpiglo - (jpni - 1) * (jpi - nreci)
159
160      ilcj(:,      1:jpnj-1) = jpj
161      ilcj(:,          jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj)
162#else
163      ilci(1:iresti      ,:) = jpi
164      ilci(iresti+1:jpni ,:) = jpi-1
165
166      ilcj(:,      1:irestj) = jpj
167      ilcj(:, irestj+1:jpnj) = jpj-1
168#endif
169
170      nfilcit(:,:) = ilci(:,:)
171
172      IF(lwp) WRITE(numout,*)
173      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
174      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
175      IF(lwp) WRITE(numout,*)
176      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
177      IF(lwp) WRITE(numout,*)
178      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
179
180      zidom = nreci + sum(ilci(:,1) - nreci )
181      IF(lwp) WRITE(numout,*)
182      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
183
184      zjdom = nrecj + sum(ilcj(1,:) - nrecj )
185      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
186      IF(lwp) WRITE(numout,*)
187      IF(lwp .AND. lflush) CALL flush(numout)
188
189
190      !  2. Index arrays for subdomains
191      ! -------------------------------
192
193      iimppt(:,:) = 1
194      ijmppt(:,:) = 1
195      ipproc(:,:) = -1
196
197      IF( jpni > 1 )THEN
198         DO jj = 1, jpnj
199            DO ji = 2, jpni
200               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
201            END DO
202         END DO
203      ENDIF
204      nfiimpp(:,:) = iimppt(:,:)
205
206      IF( jpnj > 1 )THEN
207         DO jj = 2, jpnj
208            DO ji = 1, jpni
209               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
210            END DO
211         END DO
212      ENDIF
213
214
215      ! 3. Subdomain description in the Regular Case
216      ! --------------------------------------------
217
218      nperio = 0
219      icont = -1
220      DO jarea = 1, jpni*jpnj
221         ii = 1 + MOD(jarea-1,jpni)
222         ij = 1 +    (jarea-1)/jpni
223         ili = ilci(ii,ij)
224         ilj = ilcj(ii,ij)
225         ibondj(ii,ij) = -1
226         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
227         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
228         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
229         ibondi(ii,ij) = 0
230         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
231         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
232         IF( jpni            == 1 )   ibondi(ii,ij) =  2
233
234         ! 2.4 Subdomain neighbors
235
236         iproc = jarea - 1
237         ioso(ii,ij) = iproc - jpni
238         iowe(ii,ij) = iproc - 1
239         ioea(ii,ij) = iproc + 1
240         iono(ii,ij) = iproc + jpni
241         ildi(ii,ij) = 1 + jpreci
242         ilei(ii,ij) = ili -jpreci
243         ionw(ii,ij) = iono(ii,ij) - 1
244         ione(ii,ij) = iono(ii,ij) + 1
245         iosw(ii,ij) = ioso(ii,ij) - 1
246         iose(ii,ij) = ioso(ii,ij) + 1
247         ibsw(ii,ij) = 1
248         ibnw(ii,ij) = 1
249         IF( MOD(iproc,jpni) == 0 ) THEN
250            ibsw(ii,ij) = 0
251            ibnw(ii,ij) = 0
252         ENDIF
253         ibse(ii,ij) = 1
254         ibne(ii,ij) = 1
255         IF( MOD(iproc,jpni) == jpni-1 ) THEN
256            ibse(ii,ij) = 0
257            ibne(ii,ij) = 0
258         ENDIF
259         IF( iproc < jpni ) THEN
260            ibsw(ii,ij) = 0
261            ibse(ii,ij) = 0
262         ENDIF
263         IF( iproc >= (jpnj-1)*jpni ) THEN
264            ibnw(ii,ij) = 0
265            ibne(ii,ij) = 0
266         ENDIF
267         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
268         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
269         ildj(ii,ij) =  1  + jprecj
270         ilej(ii,ij) = ilj - jprecj
271         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
272         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
273
274         ! warning ii*ij (zone) /= nproc (processors)!
275
276         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
277            IF( jpni == 1 )THEN
278               ibondi(ii,ij) = 2
279               nperio = 1
280            ELSE
281               ibondi(ii,ij) = 0
282            ENDIF
283            IF( MOD(jarea,jpni) == 0 ) THEN
284               ioea(ii,ij) = iproc - (jpni-1)
285               ione(ii,ij) = ione(ii,ij) - jpni
286               iose(ii,ij) = iose(ii,ij) - jpni
287            ENDIF
288            IF( MOD(jarea,jpni) == 1 ) THEN
289               iowe(ii,ij) = iproc + jpni - 1
290               ionw(ii,ij) = ionw(ii,ij) + jpni
291               iosw(ii,ij) = iosw(ii,ij) + jpni
292            ENDIF
293            ibsw(ii,ij) = 1
294            ibnw(ii,ij) = 1
295            ibse(ii,ij) = 1
296            ibne(ii,ij) = 1
297            IF( iproc < jpni ) THEN
298               ibsw(ii,ij) = 0
299               ibse(ii,ij) = 0
300            ENDIF
301            IF( iproc >= (jpnj-1)*jpni ) THEN
302               ibnw(ii,ij) = 0
303               ibne(ii,ij) = 0
304            ENDIF
305         ENDIF
306         ipolj(ii,ij) = 0
307         IF( jperio == 3 .OR. jperio == 4 ) THEN
308            ijm1 = jpni*(jpnj-1)
309            imil = ijm1+(jpni+1)/2
310            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
311            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
312            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1   ! MPI rank of northern neighbour
313         ENDIF
314         IF( jperio == 5 .OR. jperio == 6 ) THEN
315            ijm1 = jpni*(jpnj-1)
316            imil = ijm1+(jpni+1)/2
317            IF( jarea > ijm1) ipolj(ii,ij) = 5
318            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
319            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1    ! MPI rank of northern neighbour
320         ENDIF
321
322         ! Check wet points over the entire domain to preserve the MPI communication stencil
323         isurf = 0
324         DO jj = 1, ilj
325            DO  ji = 1, ili
326               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
327            END DO
328         END DO
329
330         IF(isurf /= 0) THEN
331            icont = icont + 1
332            ipproc(ii,ij) = icont
333            iin(icont+1) = ii
334            ijn(icont+1) = ij
335         ENDIF
336      END DO
337
338      nfipproc(:,:) = ipproc(:,:)
339
340      ! Control
341      IF(icont+1 /= jpnij) THEN
342         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
343         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'
344         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
345         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
346      ENDIF
347
348      ! 4. Subdomain print
349      ! ------------------
350
351      IF(lwp) THEN
352         ifreq = 4
353         il1 = 1
354         DO jn = 1,(jpni-1)/ifreq+1
355            il2 = MIN(jpni,il1+ifreq-1)
356            WRITE(numout,*)
357            WRITE(numout,9400) ('***',ji=il1,il2-1)
358            DO jj = jpnj, 1, -1
359               WRITE(numout,9403) ('   ',ji=il1,il2-1)
360               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
361               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
362               WRITE(numout,9403) ('   ',ji=il1,il2-1)
363               WRITE(numout,9400) ('***',ji=il1,il2-1)
364            END DO
365            WRITE(numout,9401) (ji,ji=il1,il2)
366            il1 = il1+ifreq
367         END DO
368         IF(lflush) CALL flush(numout)
369 9400     FORMAT('     ***',20('*************',a3))
370 9403     FORMAT('     *     ',20('         *   ',a3))
371 9401     FORMAT('        ',20('   ',i3,'          '))
372 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
373 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
374      ENDIF
375
376
377      ! 5. neighbour treatment
378      ! ----------------------
379
380      DO jarea = 1, jpni*jpnj
381         iproc = jarea-1
382         ii = 1 + MOD(jarea-1,jpni)
383         ij = 1 +    (jarea-1)/jpni
384         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
385            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
386            iino = 1 + MOD(iono(ii,ij),jpni)
387            ijno = 1 +    (iono(ii,ij))/jpni
388              ! Need to reverse the logical direction of communication
389              ! for northern neighbours of northern row processors (north-fold)
390              ! i.e. need to check that the northern neighbour only communicates
391              ! to the SOUTH (or not at all) if this area is land-only (#1057)
392            idir = 1
393            IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1   
394            IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
395            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
396         ENDIF
397         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
398            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
399            iiso = 1 + MOD(ioso(ii,ij),jpni)
400            ijso = 1 +    (ioso(ii,ij))/jpni
401            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
402            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
403         ENDIF
404         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
405            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
406            iiea = 1 + MOD(ioea(ii,ij),jpni)
407            ijea = 1 +    (ioea(ii,ij))/jpni
408            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
409            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
410         ENDIF
411         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
412            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
413            iiwe = 1 + MOD(iowe(ii,ij),jpni)
414            ijwe = 1 +    (iowe(ii,ij))/jpni
415            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
416            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
417         ENDIF
418         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
419            iine = 1 + MOD(ione(ii,ij),jpni)
420            ijne = 1 +    (ione(ii,ij))/jpni
421            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
422         ENDIF
423         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
424            iisw = 1 + MOD(iosw(ii,ij),jpni)
425            ijsw = 1 +    (iosw(ii,ij))/jpni
426            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
427         ENDIF
428         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
429            iinw = 1 + MOD(ionw(ii,ij),jpni)
430            ijnw = 1 +    (ionw(ii,ij))/jpni
431            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
432         ENDIF
433         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
434            iise = 1 + MOD(iose(ii,ij),jpni)
435            ijse = 1 +    (iose(ii,ij))/jpni
436            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
437         ENDIF
438      END DO
439
440
441      ! 6. Change processor name
442      ! ------------------------
443
444      nproc = narea-1
445      ii = iin(narea)
446      ij = ijn(narea)
447
448      ! set default neighbours
449      noso = ioso(ii,ij)
450      nowe = iowe(ii,ij)
451      noea = ioea(ii,ij)
452      nono = iono(ii,ij)
453      npse = iose(ii,ij)
454      npsw = iosw(ii,ij)
455      npne = ione(ii,ij)
456      npnw = ionw(ii,ij)
457
458      ! check neighbours location
459      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
460         iiso = 1 + MOD(ioso(ii,ij),jpni)
461         ijso = 1 +    (ioso(ii,ij))/jpni
462         noso = ipproc(iiso,ijso)
463      ENDIF
464      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
465         iiwe = 1 + MOD(iowe(ii,ij),jpni)
466         ijwe = 1 +    (iowe(ii,ij))/jpni
467         nowe = ipproc(iiwe,ijwe)
468      ENDIF
469      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
470         iiea = 1 + MOD(ioea(ii,ij),jpni)
471         ijea = 1 +    (ioea(ii,ij))/jpni
472         noea = ipproc(iiea,ijea)
473      ENDIF
474      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
475         iino = 1 + MOD(iono(ii,ij),jpni)
476         ijno = 1 +    (iono(ii,ij))/jpni
477         nono = ipproc(iino,ijno)
478      ENDIF
479      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN
480         iise = 1 + MOD(iose(ii,ij),jpni)
481         ijse = 1 +    (iose(ii,ij))/jpni
482         npse = ipproc(iise,ijse)
483      ENDIF
484      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN
485         iisw = 1 + MOD(iosw(ii,ij),jpni)
486         ijsw = 1 +    (iosw(ii,ij))/jpni
487         npsw = ipproc(iisw,ijsw)
488      ENDIF
489      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN
490         iine = 1 + MOD(ione(ii,ij),jpni)
491         ijne = 1 +    (ione(ii,ij))/jpni
492         npne = ipproc(iine,ijne)
493      ENDIF
494      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN
495         iinw = 1 + MOD(ionw(ii,ij),jpni)
496         ijnw = 1 +    (ionw(ii,ij))/jpni
497         npnw = ipproc(iinw,ijnw)
498      ENDIF
499      nbnw = ibnw(ii,ij)
500      nbne = ibne(ii,ij)
501      nbsw = ibsw(ii,ij)
502      nbse = ibse(ii,ij)
503      nlcj = ilcj(ii,ij) 
504      nlci = ilci(ii,ij) 
505      nldi = ildi(ii,ij)
506      nlei = ilei(ii,ij)
507      nldj = ildj(ii,ij)
508      nlej = ilej(ii,ij)
509      nbondi = ibondi(ii,ij)
510      nbondj = ibondj(ii,ij)
511      nimpp = iimppt(ii,ij) 
512      njmpp = ijmppt(ii,ij) 
513      DO jproc = 1, jpnij
514         ii = iin(jproc)
515         ij = ijn(jproc)
516         nimppt(jproc) = iimppt(ii,ij) 
517         njmppt(jproc) = ijmppt(ii,ij) 
518         nlcjt(jproc) = ilcj(ii,ij)
519         nlcit(jproc) = ilci(ii,ij)
520         nldit(jproc) = ildi(ii,ij)
521         nleit(jproc) = ilei(ii,ij)
522         nldjt(jproc) = ildj(ii,ij)
523         nlejt(jproc) = ilej(ii,ij)
524      END DO
525
526      ! Save processor layout in ascii file
527      IF (lwp) THEN
528         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
529         WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
530         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
531         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
532
533        DO  jproc = 1, jpnij
534         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
535                                      nldit(jproc), nldjt(jproc), &
536                                      nleit(jproc), nlejt(jproc), &
537                                      nimppt(jproc), njmppt(jproc)
538        END DO
539        CLOSE(inum)   
540      END IF
541
542      ! Defined npolj, either 0, 3 , 4 , 5 , 6
543      ! In this case the important thing is that npolj /= 0
544      ! Because if we go through these line it is because jpni >1 and thus
545      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
546
547      npolj = 0
548      ij = ijn(narea)
549
550      IF( jperio == 3 .OR. jperio == 4 ) THEN
551         IF( ij == jpnj ) npolj = 3
552      ENDIF
553
554      IF( jperio == 5 .OR. jperio == 6 ) THEN
555         IF( ij == jpnj ) npolj = 5
556      ENDIF
557
558      ! Periodicity : no corner if nbondi = 2 and nperio != 1
559
560      IF(lwp) THEN
561         WRITE(numout,*) ' nproc  = ', nproc
562         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
563         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
564         WRITE(numout,*) ' nbondi = ', nbondi
565         WRITE(numout,*) ' nbondj = ', nbondj
566         WRITE(numout,*) ' npolj  = ', npolj
567         WRITE(numout,*) ' nperio = ', nperio
568         WRITE(numout,*) ' nlci   = ', nlci
569         WRITE(numout,*) ' nlcj   = ', nlcj
570         WRITE(numout,*) ' nimpp  = ', nimpp
571         WRITE(numout,*) ' njmpp  = ', njmpp
572         WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse
573         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw
574         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne
575         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw
576         WRITE(numout,*)
577         IF(lflush) CALL flush(numout)
578      ENDIF
579
580      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )
581
582      ! Prepare mpp north fold
583
584      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
585         CALL mpp_ini_north
586         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
587         IF(lwp .AND. lflush) CALL flush(numout)
588      ENDIF
589
590      ! Prepare NetCDF output file (if necessary)
591      CALL mpp_init_ioipsl
592
593
594   END SUBROUTINE mpp_init2
Note: See TracBrowser for help on using the repository browser.