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

source: branches/UKMO/r6232_tracer_advection/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90 @ 9295

Last change on this file since 9295 was 9295, checked in by jcastill, 6 years ago

Remove svn keywords

File size: 22.8 KB
RevLine 
[3]1   SUBROUTINE mpp_init2
2      !!----------------------------------------------------------------------
3      !!                  ***  ROUTINE mpp_init2  ***
4      !!
5      !! * Purpose :   Lay out the global domain over processors.
6      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
7      !!     FOR DEFINING BETTER CUTTING OUT.
8      !!       This routine is used with a the bathymetry file.
9      !!       In this version, the land processors are avoided and the adress
10      !!     processor (nproc, narea,noea, ...) are calculated again.
11      !!     The jpnij parameter can be lesser than jpni x jpnj
12      !!     and this jpnij parameter must be calculated before with an
13      !!     algoritmic preprocessing program.
14      !!
15      !! ** Method  :   Global domain is distributed in smaller local domains.
16      !!      Periodic condition is a function of the local domain position
17      !!      (global boundary or neighbouring domain) and of the global
18      !!      periodic
19      !!      Type :         jperio global periodic condition
20      !!                     nperio local  periodic condition
21      !!
22      !! ** Action :        nimpp     : longitudinal index
23      !!                    njmpp     : latitudinal  index
24      !!                    nperio    : lateral condition type
25      !!                    narea     : number for local area
26      !!                    nlci      : first dimension
27      !!                    nlcj      : second dimension
28      !!                    nproc     : number for local processor
29      !!                    noea      : number for local neighboring processor
30      !!                    nowe      : number for local neighboring processor
31      !!                    noso      : number for local neighboring processor
32      !!                    nono      : number for local neighboring processor
33      !!
34      !! History :
35      !!        !  94-11  (M. Guyon)  Original code
36      !!        !  95-04  (J. Escobar, M. Imbard)
37      !!        !  98-02  (M. Guyon)  FETI method
38      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
39      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
40      !!----------------------------------------------------------------------
[1581]41      USE in_out_manager  ! I/O Manager
[473]42      USE iom
[1601]43      !!
[3]44      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
[473]45      INTEGER ::  inum                        ! temporary logical unit
[3818]46      INTEGER ::  idir                        ! temporary integers
[5118]47      INTEGER ::  jstartrow                   ! temporary integers
[4147]48      INTEGER ::   ios                        ! Local integer output status for namelist read
[3]49      INTEGER ::   &
50         ii, ij, ifreq, il1, il2,          &  ! temporary integers
[169]51         icont, ili, ilj,                  &  !    "          "
[3]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         !    "           "
[680]67      INTEGER,  DIMENSION(jpiglo,jpjglo) ::   &
[3]68         imask                                ! temporary global workspace
[680]69      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
[4990]70         zdta, zdtaisf                     ! temporary data workspace
[473]71      REAL(wp) ::   zidom , zjdom          ! temporary scalars
[128]72
[680]73      ! read namelist for ln_zco
[4990]74      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
[680]75
[3]76      !!----------------------------------------------------------------------
[247]77      !!  OPA 9.0 , LOCEAN-IPSL (2005)
[1152]78      !! $Id$
[247]79      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
[3]80      !!----------------------------------------------------------------------
81
[4147]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 )
[4624]89      IF(lwm) WRITE ( numond, namzgr )
[4147]90
[3]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
[473]96      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
[3]97
98      ! 0. initialisation
99      ! -----------------
100
101      ! open the file
[680]102      ! Remember that at this level in the code, mpp is not yet initialized, so
[5118]103      ! the file must be open with jpdom_unknown, and kstart and kcount forced
104      jstartrow = 1
[473]105      IF ( ln_zco ) THEN
106         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
[5118]107          ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
108          ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
109         CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
110         jstartrow = MAX(1,jstartrow)
111         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/), kcount=(/jpiglo,jpjglo/) )
[69]112      ELSE
[473]113         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
[5118]114         IF ( ln_isfcav ) THEN
115             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
116         ELSE
117             ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file
118             ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry
119             CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
120             jstartrow = MAX(1,jstartrow)
[5130]121             CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom+jstartrow-1/)   &
122                &                                                   , kcount=(/jpiglo,jpjglo/) )
[5118]123         ENDIF
[69]124      ENDIF
[473]125      CALL iom_close (inum)
[4990]126     
127      ! used to compute the land processor in case of not masked bathy file.
128      zdtaisf(:,:) = 0.0_wp
129      IF ( ln_isfcav ) THEN
130         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
131         CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
132      END IF
133      CALL iom_close (inum)
[69]134
[3]135      ! land/sea mask over the global/zoom domain
[128]136
[473]137      imask(:,:)=1
[4990]138      WHERE ( zdta(:,:) - zdtaisf(:,:) <= 0. ) imask = 0
[128]139
[3]140      !  1. Dimension arrays for subdomains
141      ! -----------------------------------
142
143      !  Computation of local domain sizes ilci() ilcj()
144      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
145      !  The subdomains are squares leeser than or equal to the global
146      !  dimensions divided by the number of processors minus the overlap
147      !  array.
[169]148
[3]149      nreci=2*jpreci
150      nrecj=2*jprecj
[128]151      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
152      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
[3]153
[4153]154#if defined key_nemocice_decomp
155      ! Change padding to be consistent with CICE
156      ilci(1:jpni-1      ,:) = jpi
157      ilci(jpni          ,:) = jpiglo - (jpni - 1) * (jpi - nreci)
158
159      ilcj(:,      1:jpnj-1) = jpj
160      ilcj(:,          jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj)
161#else
[128]162      ilci(1:iresti      ,:) = jpi
163      ilci(iresti+1:jpni ,:) = jpi-1
164
[169]165      ilcj(:,      1:irestj) = jpj
166      ilcj(:, irestj+1:jpnj) = jpj-1
[4153]167#endif
[128]168
[4671]169      nfilcit(:,:) = ilci(:,:)
170
[3]171      IF(lwp) WRITE(numout,*)
172      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
173      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
174      IF(lwp) WRITE(numout,*)
175      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
176      IF(lwp) WRITE(numout,*)
177      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
178
[128]179      zidom = nreci + sum(ilci(:,1) - nreci )
[3]180      IF(lwp) WRITE(numout,*)
181      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
182
[128]183      zjdom = nrecj + sum(ilcj(1,:) - nrecj )
184      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
[3]185      IF(lwp) WRITE(numout,*)
186
187
188      !  2. Index arrays for subdomains
189      ! -------------------------------
190
[128]191      iimppt(:,:) = 1
192      ijmppt(:,:) = 1
193      ipproc(:,:) = -1
[169]194
[3]195      IF( jpni > 1 )THEN
196         DO jj = 1, jpnj
197            DO ji = 2, jpni
198               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
199            END DO
200         END DO
201      ENDIF
[4671]202      nfiimpp(:,:) = iimppt(:,:)
[3]203
204      IF( jpnj > 1 )THEN
205         DO jj = 2, jpnj
206            DO ji = 1, jpni
207               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
208            END DO
209         END DO
210      ENDIF
[169]211
212
[3]213      ! 3. Subdomain description in the Regular Case
214      ! --------------------------------------------
[169]215
[3]216      nperio = 0
217      icont = -1
218      DO jarea = 1, jpni*jpnj
219         ii = 1 + MOD(jarea-1,jpni)
220         ij = 1 +    (jarea-1)/jpni
221         ili = ilci(ii,ij)
222         ilj = ilcj(ii,ij)
223         ibondj(ii,ij) = -1
224         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
225         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
226         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
227         ibondi(ii,ij) = 0
228         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
229         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
230         IF( jpni            == 1 )   ibondi(ii,ij) =  2
[169]231
[3]232         ! 2.4 Subdomain neighbors
[169]233
[3]234         iproc = jarea - 1
235         ioso(ii,ij) = iproc - jpni
236         iowe(ii,ij) = iproc - 1
237         ioea(ii,ij) = iproc + 1
238         iono(ii,ij) = iproc + jpni
239         ildi(ii,ij) = 1 + jpreci
240         ilei(ii,ij) = ili -jpreci
241         ionw(ii,ij) = iono(ii,ij) - 1
242         ione(ii,ij) = iono(ii,ij) + 1
243         iosw(ii,ij) = ioso(ii,ij) - 1
244         iose(ii,ij) = ioso(ii,ij) + 1
245         ibsw(ii,ij) = 1
246         ibnw(ii,ij) = 1
247         IF( MOD(iproc,jpni) == 0 ) THEN
248            ibsw(ii,ij) = 0
249            ibnw(ii,ij) = 0
250         ENDIF
251         ibse(ii,ij) = 1
252         ibne(ii,ij) = 1
253         IF( MOD(iproc,jpni) == jpni-1 ) THEN
254            ibse(ii,ij) = 0
255            ibne(ii,ij) = 0
256         ENDIF
257         IF( iproc < jpni ) THEN
258            ibsw(ii,ij) = 0
259            ibse(ii,ij) = 0
260         ENDIF
261         IF( iproc >= (jpnj-1)*jpni ) THEN
262            ibnw(ii,ij) = 0
263            ibne(ii,ij) = 0
264         ENDIF
265         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
266         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
267         ildj(ii,ij) =  1  + jprecj
268         ilej(ii,ij) = ilj - jprecj
269         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
270         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
[169]271
[3]272         ! warning ii*ij (zone) /= nproc (processors)!
[169]273
[3]274         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
275            IF( jpni == 1 )THEN
276               ibondi(ii,ij) = 2
277               nperio = 1
278            ELSE
279               ibondi(ii,ij) = 0
280            ENDIF
281            IF( MOD(jarea,jpni) == 0 ) THEN
282               ioea(ii,ij) = iproc - (jpni-1)
283               ione(ii,ij) = ione(ii,ij) - jpni
284               iose(ii,ij) = iose(ii,ij) - jpni
285            ENDIF
286            IF( MOD(jarea,jpni) == 1 ) THEN
287               iowe(ii,ij) = iproc + jpni - 1
288               ionw(ii,ij) = ionw(ii,ij) + jpni
289               iosw(ii,ij) = iosw(ii,ij) + jpni
290            ENDIF
291            ibsw(ii,ij) = 1
292            ibnw(ii,ij) = 1
293            ibse(ii,ij) = 1
294            ibne(ii,ij) = 1
295            IF( iproc < jpni ) THEN
296               ibsw(ii,ij) = 0
297               ibse(ii,ij) = 0
298            ENDIF
299            IF( iproc >= (jpnj-1)*jpni ) THEN
300               ibnw(ii,ij) = 0
301               ibne(ii,ij) = 0
302            ENDIF
303         ENDIF
[169]304         ipolj(ii,ij) = 0
[3]305         IF( jperio == 3 .OR. jperio == 4 ) THEN
306            ijm1 = jpni*(jpnj-1)
307            imil = ijm1+(jpni+1)/2
308            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
309            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
[4647]310            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1   ! MPI rank of northern neighbour
[3]311         ENDIF
312         IF( jperio == 5 .OR. jperio == 6 ) THEN
313            ijm1 = jpni*(jpnj-1)
314            imil = ijm1+(jpni+1)/2
315            IF( jarea > ijm1) ipolj(ii,ij) = 5
316            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
[4647]317            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1    ! MPI rank of northern neighbour
[3]318         ENDIF
[169]319
[3]320         isurf = 0
[290]321         DO jj = 1+jprecj, ilj-jprecj
322            DO  ji = 1+jpreci, ili-jpreci
[680]323               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
[3]324            END DO
325         END DO
326         IF(isurf /= 0) THEN
327            icont = icont + 1
328            ipproc(ii,ij) = icont
329            iin(icont+1) = ii
330            ijn(icont+1) = ij
331         ENDIF
332      END DO
[169]333
[4671]334      nfipproc(:,:) = ipproc(:,:)
335
336
[3]337      ! Control
338      IF(icont+1 /= jpnij) THEN
[473]339         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
340         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'
341         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
342         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
[3]343      ENDIF
[169]344
[3]345      ! 4. Subdomain print
346      ! ------------------
[169]347
[3]348      IF(lwp) THEN
349         ifreq = 4
350         il1 = 1
351         DO jn = 1,(jpni-1)/ifreq+1
352            il2 = MIN(jpni,il1+ifreq-1)
353            WRITE(numout,*)
354            WRITE(numout,9400) ('***',ji=il1,il2-1)
[689]355            DO jj = jpnj, 1, -1
[3]356               WRITE(numout,9403) ('   ',ji=il1,il2-1)
357               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
358               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
359               WRITE(numout,9403) ('   ',ji=il1,il2-1)
360               WRITE(numout,9400) ('***',ji=il1,il2-1)
361            END DO
[689]362            WRITE(numout,9401) (ji,ji=il1,il2)
[3]363            il1 = il1+ifreq
364         END DO
365 9400     FORMAT('     ***',20('*************',a3))
366 9403     FORMAT('     *     ',20('         *   ',a3))
367 9401     FORMAT('        ',20('   ',i3,'          '))
368 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
369 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
370      ENDIF
371
372
373      ! 5. neighbour treatment
374      ! ----------------------
[169]375
[3]376      DO jarea = 1, jpni*jpnj
377         iproc = jarea-1
378         ii = 1 + MOD(jarea-1,jpni)
379         ij = 1 +    (jarea-1)/jpni
380         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
381            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
382            iino = 1 + MOD(iono(ii,ij),jpni)
383            ijno = 1 +    (iono(ii,ij))/jpni
[3818]384              ! Need to reverse the logical direction of communication
385              ! for northern neighbours of northern row processors (north-fold)
386              ! i.e. need to check that the northern neighbour only communicates
387              ! to the SOUTH (or not at all) if this area is land-only (#1057)
388            idir = 1
389            IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1   
390            IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2
391            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir
[3]392         ENDIF
393         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
394            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
395            iiso = 1 + MOD(ioso(ii,ij),jpni)
396            ijso = 1 +    (ioso(ii,ij))/jpni
397            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
398            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
399         ENDIF
400         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
401            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
402            iiea = 1 + MOD(ioea(ii,ij),jpni)
403            ijea = 1 +    (ioea(ii,ij))/jpni
404            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
405            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
406         ENDIF
407         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
408            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
409            iiwe = 1 + MOD(iowe(ii,ij),jpni)
410            ijwe = 1 +    (iowe(ii,ij))/jpni
411            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
412            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
413         ENDIF
414         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
415            iine = 1 + MOD(ione(ii,ij),jpni)
416            ijne = 1 +    (ione(ii,ij))/jpni
417            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
418         ENDIF
419         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
420            iisw = 1 + MOD(iosw(ii,ij),jpni)
421            ijsw = 1 +    (iosw(ii,ij))/jpni
422            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
423         ENDIF
424         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
425            iinw = 1 + MOD(ionw(ii,ij),jpni)
426            ijnw = 1 +    (ionw(ii,ij))/jpni
427            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
428         ENDIF
429         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
430            iise = 1 + MOD(iose(ii,ij),jpni)
431            ijse = 1 +    (iose(ii,ij))/jpni
432            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
433         ENDIF
434      END DO
[169]435
436
[3]437      ! 6. Change processor name
438      ! ------------------------
[169]439
[3]440      nproc = narea-1
441      ii = iin(narea)
442      ij = ijn(narea)
443      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
444         iiso = 1 + MOD(ioso(ii,ij),jpni)
445         ijso = 1 +    (ioso(ii,ij))/jpni
446         noso = ipproc(iiso,ijso)
447      ENDIF
448      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
449         iiwe = 1 + MOD(iowe(ii,ij),jpni)
450         ijwe = 1 +    (iowe(ii,ij))/jpni
451         nowe = ipproc(iiwe,ijwe)
452      ENDIF
453      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
454         iiea = 1 + MOD(ioea(ii,ij),jpni)
455         ijea = 1 +    (ioea(ii,ij))/jpni
456         noea = ipproc(iiea,ijea)
457      ENDIF
458      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
459         iino = 1 + MOD(iono(ii,ij),jpni)
460         ijno = 1 +    (iono(ii,ij))/jpni
461         nono = ipproc(iino,ijno)
462      ENDIF
463      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN
464         iise = 1 + MOD(iose(ii,ij),jpni)
465         ijse = 1 +    (iose(ii,ij))/jpni
466         npse = ipproc(iise,ijse)
467      ENDIF
468      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN
469         iisw = 1 + MOD(iosw(ii,ij),jpni)
470         ijsw = 1 +    (iosw(ii,ij))/jpni
471         npsw = ipproc(iisw,ijsw)
472      ENDIF
473      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN
474         iine = 1 + MOD(ione(ii,ij),jpni)
475         ijne = 1 +    (ione(ii,ij))/jpni
476         npne = ipproc(iine,ijne)
477      ENDIF
478      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN
479         iinw = 1 + MOD(ionw(ii,ij),jpni)
480         ijnw = 1 +    (ionw(ii,ij))/jpni
481         npnw = ipproc(iinw,ijnw)
482      ENDIF
483      nbnw = ibnw(ii,ij)
484      nbne = ibne(ii,ij)
485      nbsw = ibsw(ii,ij)
486      nbse = ibse(ii,ij)
487      nlcj = ilcj(ii,ij) 
488      nlci = ilci(ii,ij) 
489      nldi = ildi(ii,ij)
490      nlei = ilei(ii,ij)
491      nldj = ildj(ii,ij)
492      nlej = ilej(ii,ij)
493      nbondi = ibondi(ii,ij)
494      nbondj = ibondj(ii,ij)
495      nimpp = iimppt(ii,ij) 
496      njmpp = ijmppt(ii,ij) 
497      DO jproc = 1, jpnij
498         ii = iin(jproc)
499         ij = ijn(jproc)
500         nimppt(jproc) = iimppt(ii,ij) 
501         njmppt(jproc) = ijmppt(ii,ij) 
502         nlcjt(jproc) = ilcj(ii,ij)
503         nlcit(jproc) = ilci(ii,ij)
504         nldit(jproc) = ildi(ii,ij)
505         nleit(jproc) = ilei(ii,ij)
506         nldjt(jproc) = ildj(ii,ij)
507         nlejt(jproc) = ilej(ii,ij)
508      END DO
509
510      ! Save processor layout in ascii file
511      IF (lwp) THEN
[1581]512         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
[473]513         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
514         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
[3]515
516        DO  jproc = 1, jpnij
517         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
518                                      nldit(jproc), nldjt(jproc), &
519                                      nleit(jproc), nlejt(jproc), &
520                                      nimppt(jproc), njmppt(jproc)
521        END DO
522        CLOSE(inum)   
523      END IF
524
[473]525      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' )
[3]526
527      ! Prepare mpp north fold
528
[290]529      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
[3]530         CALL mpp_ini_north
531         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
[290]532      ENDIF
[3]533
534      ! Defined npolj, either 0, 3 , 4 , 5 , 6
535      ! In this case the important thing is that npolj /= 0
536      ! Because if we go through these line it is because jpni >1 and thus
537      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
538
539      npolj = 0
540      ij = ijn(narea)
541
[290]542      IF( jperio == 3 .OR. jperio == 4 ) THEN
543         IF( ij == jpnj ) npolj = 3
[3]544      ENDIF
545
546      IF( jperio == 5 .OR. jperio == 6 ) THEN
[290]547         IF( ij == jpnj ) npolj = 5
[3]548      ENDIF
[389]549
[290]550      ! Prepare NetCDF output file (if necessary)
551      CALL mpp_init_ioipsl
[3]552
[290]553      ! Periodicity : no corner if nbondi = 2 and nperio != 1
[3]554
[290]555      IF(lwp) THEN
556         WRITE(numout,*) ' nproc=  ',nproc
557         WRITE(numout,*) ' nowe=   ',nowe
558         WRITE(numout,*) ' noea=   ',noea
559         WRITE(numout,*) ' nono=   ',nono
560         WRITE(numout,*) ' noso=   ',noso
561         WRITE(numout,*) ' nbondi= ',nbondi
562         WRITE(numout,*) ' nbondj= ',nbondj
563         WRITE(numout,*) ' npolj=  ',npolj
564         WRITE(numout,*) ' nperio= ',nperio
565         WRITE(numout,*) ' nlci=   ',nlci
566         WRITE(numout,*) ' nlcj=   ',nlcj
567         WRITE(numout,*) ' nimpp=  ',nimpp
568         WRITE(numout,*) ' njmpp=  ',njmpp
569         WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse
570         WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw
571         WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne
572         WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw
573      ENDIF
574
[3]575   END SUBROUTINE mpp_init2
Note: See TracBrowser for help on using the repository browser.