source: CONFIG/UNIFORM/v6/IPSLCM6/SOURCES/NEMO/mppini_2.h90 @ 3344

Last change on this file since 3344 was 3344, checked in by cetlod, 4 years ago

CM6.0.12: Adding modified NEMO routines to properly handle outputs when removing land processors

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      USE dom_xios
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) ::   &
69         imask                                ! temporary global workspace
70      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
71         zdta, zdtaisf                     ! temporary data workspace
72      REAL(wp) ::   zidom , zjdom          ! temporary scalars
73
74      ! read namelist for ln_zco
75      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
76
77      !!----------------------------------------------------------------------
78      !!  OPA 9.0 , LOCEAN-IPSL (2005)
79      !! $Id: mppini_2.h90 6413 2016-03-31 16:22:52Z lovato $
80      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
81      !!----------------------------------------------------------------------
82
83      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
84      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901)
85901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
86
87      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
88      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
89902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
90      IF(lwm) WRITE ( numond, namzgr )
91
92      IF(lwp)WRITE(numout,*)
93      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
94      IF(lwp)WRITE(numout,*) '~~~~~~~~'
95      IF(lwp)WRITE(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
188
189      !  2. Index arrays for subdomains
190      ! -------------------------------
191
192      iimppt(:,:) = 1
193      ijmppt(:,:) = 1
194      ipproc(:,:) = -1
195
196      IF( jpni > 1 )THEN
197         DO jj = 1, jpnj
198            DO ji = 2, jpni
199               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
200            END DO
201         END DO
202      ENDIF
203      nfiimpp(:,:) = iimppt(:,:)
204
205      IF( jpnj > 1 )THEN
206         DO jj = 2, jpnj
207            DO ji = 1, jpni
208               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
209            END DO
210         END DO
211      ENDIF
212
213
214      ! 3. Subdomain description in the Regular Case
215      ! --------------------------------------------
216
217      nperio = 0
218      icont = -1
219      DO jarea = 1, jpni*jpnj
220         ii = 1 + MOD(jarea-1,jpni)
221         ij = 1 +    (jarea-1)/jpni
222         ili = ilci(ii,ij)
223         ilj = ilcj(ii,ij)
224         ibondj(ii,ij) = -1
225         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
226         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
227         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
228         ibondi(ii,ij) = 0
229         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
230         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
231         IF( jpni            == 1 )   ibondi(ii,ij) =  2
232
233         ! 2.4 Subdomain neighbors
234
235         iproc = jarea - 1
236         ioso(ii,ij) = iproc - jpni
237         iowe(ii,ij) = iproc - 1
238         ioea(ii,ij) = iproc + 1
239         iono(ii,ij) = iproc + jpni
240         ildi(ii,ij) = 1 + jpreci
241         ilei(ii,ij) = ili -jpreci
242         ionw(ii,ij) = iono(ii,ij) - 1
243         ione(ii,ij) = iono(ii,ij) + 1
244         iosw(ii,ij) = ioso(ii,ij) - 1
245         iose(ii,ij) = ioso(ii,ij) + 1
246         ibsw(ii,ij) = 1
247         ibnw(ii,ij) = 1
248         IF( MOD(iproc,jpni) == 0 ) THEN
249            ibsw(ii,ij) = 0
250            ibnw(ii,ij) = 0
251         ENDIF
252         ibse(ii,ij) = 1
253         ibne(ii,ij) = 1
254         IF( MOD(iproc,jpni) == jpni-1 ) THEN
255            ibse(ii,ij) = 0
256            ibne(ii,ij) = 0
257         ENDIF
258         IF( iproc < jpni ) THEN
259            ibsw(ii,ij) = 0
260            ibse(ii,ij) = 0
261         ENDIF
262         IF( iproc >= (jpnj-1)*jpni ) THEN
263            ibnw(ii,ij) = 0
264            ibne(ii,ij) = 0
265         ENDIF
266         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
267         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
268         ildj(ii,ij) =  1  + jprecj
269         ilej(ii,ij) = ilj - jprecj
270         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
271         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
272
273         ! warning ii*ij (zone) /= nproc (processors)!
274
275         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
276            IF( jpni == 1 )THEN
277               ibondi(ii,ij) = 2
278               nperio = 1
279            ELSE
280               ibondi(ii,ij) = 0
281            ENDIF
282            IF( MOD(jarea,jpni) == 0 ) THEN
283               ioea(ii,ij) = iproc - (jpni-1)
284               ione(ii,ij) = ione(ii,ij) - jpni
285               iose(ii,ij) = iose(ii,ij) - jpni
286            ENDIF
287            IF( MOD(jarea,jpni) == 1 ) THEN
288               iowe(ii,ij) = iproc + jpni - 1
289               ionw(ii,ij) = ionw(ii,ij) + jpni
290               iosw(ii,ij) = iosw(ii,ij) + jpni
291            ENDIF
292            ibsw(ii,ij) = 1
293            ibnw(ii,ij) = 1
294            ibse(ii,ij) = 1
295            ibne(ii,ij) = 1
296            IF( iproc < jpni ) THEN
297               ibsw(ii,ij) = 0
298               ibse(ii,ij) = 0
299            ENDIF
300            IF( iproc >= (jpnj-1)*jpni ) THEN
301               ibnw(ii,ij) = 0
302               ibne(ii,ij) = 0
303            ENDIF
304         ENDIF
305         ipolj(ii,ij) = 0
306         IF( jperio == 3 .OR. jperio == 4 ) THEN
307            ijm1 = jpni*(jpnj-1)
308            imil = ijm1+(jpni+1)/2
309            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
310            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
311            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1   ! MPI rank of northern neighbour
312         ENDIF
313         IF( jperio == 5 .OR. jperio == 6 ) THEN
314            ijm1 = jpni*(jpnj-1)
315            imil = ijm1+(jpni+1)/2
316            IF( jarea > ijm1) ipolj(ii,ij) = 5
317            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
318            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1    ! MPI rank of northern neighbour
319         ENDIF
320
321         ! Check wet points over the entire domain to preserve the MPI communication stencil
322         isurf = 0
323         DO jj = 1, ilj
324            DO  ji = 1, ili
325               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
326            END DO
327         END DO
328
329         IF(isurf /= 0) THEN
330            icont = icont + 1
331            ipproc(ii,ij) = icont
332            iin(icont+1) = ii
333            ijn(icont+1) = ij
334         ENDIF
335      END DO
336
337      nfipproc(:,:) = ipproc(:,:)
338
339      ! Control
340      IF(icont+1 /= jpnij) THEN
341         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
342         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'
343         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
344         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
345      ENDIF
346
347      ! 4. Subdomain print
348      ! ------------------
349
350      IF(lwp) THEN
351         ifreq = 4
352         il1 = 1
353         DO jn = 1,(jpni-1)/ifreq+1
354            il2 = MIN(jpni,il1+ifreq-1)
355            WRITE(numout,*)
356            WRITE(numout,9400) ('***',ji=il1,il2-1)
357            DO jj = jpnj, 1, -1
358               WRITE(numout,9403) ('   ',ji=il1,il2-1)
359               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
360               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
361               WRITE(numout,9403) ('   ',ji=il1,il2-1)
362               WRITE(numout,9400) ('***',ji=il1,il2-1)
363            END DO
364            WRITE(numout,9401) (ji,ji=il1,il2)
365            il1 = il1+ifreq
366         END DO
367 9400     FORMAT('     ***',20('*************',a3))
368 9403     FORMAT('     *     ',20('         *   ',a3))
369 9401     FORMAT('        ',20('   ',i3,'          '))
370 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
371 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
372      ENDIF
373
374
375      ! 5. neighbour treatment
376      ! ----------------------
377
378      DO jarea = 1, jpni*jpnj
379         iproc = jarea-1
380         ii = 1 + MOD(jarea-1,jpni)
381         ij = 1 +    (jarea-1)/jpni
382         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
383            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
384            iino = 1 + MOD(iono(ii,ij),jpni)
385            ijno = 1 +    (iono(ii,ij))/jpni
386              ! Need to reverse the logical direction of communication
387              ! for northern neighbours of northern row processors (north-fold)
388              ! i.e. need to check that the northern neighbour only communicates
389              ! to the SOUTH (or not at all) if this area is land-only (#1057)
390            idir = 1
391            IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1   
392            IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
393            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
394         ENDIF
395         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
396            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
397            iiso = 1 + MOD(ioso(ii,ij),jpni)
398            ijso = 1 +    (ioso(ii,ij))/jpni
399            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
400            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
401         ENDIF
402         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
403            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
404            iiea = 1 + MOD(ioea(ii,ij),jpni)
405            ijea = 1 +    (ioea(ii,ij))/jpni
406            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
407            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
408         ENDIF
409         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
410            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
411            iiwe = 1 + MOD(iowe(ii,ij),jpni)
412            ijwe = 1 +    (iowe(ii,ij))/jpni
413            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
414            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
415         ENDIF
416         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
417            iine = 1 + MOD(ione(ii,ij),jpni)
418            ijne = 1 +    (ione(ii,ij))/jpni
419            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
420         ENDIF
421         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
422            iisw = 1 + MOD(iosw(ii,ij),jpni)
423            ijsw = 1 +    (iosw(ii,ij))/jpni
424            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
425         ENDIF
426         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
427            iinw = 1 + MOD(ionw(ii,ij),jpni)
428            ijnw = 1 +    (ionw(ii,ij))/jpni
429            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
430         ENDIF
431         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
432            iise = 1 + MOD(iose(ii,ij),jpni)
433            ijse = 1 +    (iose(ii,ij))/jpni
434            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
435         ENDIF
436      END DO
437
438
439      ! 6. Change processor name
440      ! ------------------------
441
442      nproc = narea-1
443      ii = iin(narea)
444      ij = ijn(narea)
445
446      ! set default neighbours
447      noso = ioso(ii,ij)
448      nowe = iowe(ii,ij)
449      noea = ioea(ii,ij)
450      nono = iono(ii,ij)
451      npse = iose(ii,ij)
452      npsw = iosw(ii,ij)
453      npne = ione(ii,ij)
454      npnw = ionw(ii,ij)
455
456      ! check neighbours location
457      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
458         iiso = 1 + MOD(ioso(ii,ij),jpni)
459         ijso = 1 +    (ioso(ii,ij))/jpni
460         noso = ipproc(iiso,ijso)
461      ENDIF
462      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
463         iiwe = 1 + MOD(iowe(ii,ij),jpni)
464         ijwe = 1 +    (iowe(ii,ij))/jpni
465         nowe = ipproc(iiwe,ijwe)
466      ENDIF
467      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
468         iiea = 1 + MOD(ioea(ii,ij),jpni)
469         ijea = 1 +    (ioea(ii,ij))/jpni
470         noea = ipproc(iiea,ijea)
471      ENDIF
472      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
473         iino = 1 + MOD(iono(ii,ij),jpni)
474         ijno = 1 +    (iono(ii,ij))/jpni
475         nono = ipproc(iino,ijno)
476      ENDIF
477      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN
478         iise = 1 + MOD(iose(ii,ij),jpni)
479         ijse = 1 +    (iose(ii,ij))/jpni
480         npse = ipproc(iise,ijse)
481      ENDIF
482      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN
483         iisw = 1 + MOD(iosw(ii,ij),jpni)
484         ijsw = 1 +    (iosw(ii,ij))/jpni
485         npsw = ipproc(iisw,ijsw)
486      ENDIF
487      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN
488         iine = 1 + MOD(ione(ii,ij),jpni)
489         ijne = 1 +    (ione(ii,ij))/jpni
490         npne = ipproc(iine,ijne)
491      ENDIF
492      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN
493         iinw = 1 + MOD(ionw(ii,ij),jpni)
494         ijnw = 1 +    (ionw(ii,ij))/jpni
495         npnw = ipproc(iinw,ijnw)
496      ENDIF
497      nbnw = ibnw(ii,ij)
498      nbne = ibne(ii,ij)
499      nbsw = ibsw(ii,ij)
500      nbse = ibse(ii,ij)
501      nlcj = ilcj(ii,ij) 
502      nlci = ilci(ii,ij) 
503      nldi = ildi(ii,ij)
504      nlei = ilei(ii,ij)
505      nldj = ildj(ii,ij)
506      nlej = ilej(ii,ij)
507      nbondi = ibondi(ii,ij)
508      nbondj = ibondj(ii,ij)
509      nimpp = iimppt(ii,ij) 
510      njmpp = ijmppt(ii,ij) 
511      DO jproc = 1, jpnij
512         ii = iin(jproc)
513         ij = ijn(jproc)
514         nimppt(jproc) = iimppt(ii,ij) 
515         njmppt(jproc) = ijmppt(ii,ij) 
516         nlcjt(jproc) = ilcj(ii,ij)
517         nlcit(jproc) = ilci(ii,ij)
518         nldit(jproc) = ildi(ii,ij)
519         nleit(jproc) = ilei(ii,ij)
520         nldjt(jproc) = ildj(ii,ij)
521         nlejt(jproc) = ilej(ii,ij)
522      END DO
523
524      CALL init_dom_xios(iin,ijn,iimppt,ijmppt,ildi,ildj,ilei,ilej)
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      ENDIF
578
579      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init2: error on cyclicity' )
580
581      ! Prepare mpp north fold
582
583      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
584         CALL mpp_ini_north
585         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
586      ENDIF
587
588      ! Prepare NetCDF output file (if necessary)
589      CALL mpp_init_ioipsl
590      !
591      CALL dom_xios_read_coordinates
592      !
593   END SUBROUTINE mpp_init2
Note: See TracBrowser for help on using the repository browser.