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

source: branches/NERC/dev_r6998_ORCHESTRA/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 7029

Last change on this file since 7029 was 7029, checked in by jamesharle, 8 years ago

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