source: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 7753

Last change on this file since 7753 was 7646, checked in by timgraham, 4 years ago

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge —reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

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