source: branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90 @ 8375

Last change on this file since 8375 was 8375, checked in by acc, 3 years ago

Branch 2017/dev_r8126_ROBUST08_no_ghost. Style changes to mppini.F90 following a review by Gurvan (actually a review of branches/2017/dev_r8126_ROBUST10_MPPINI which this branch now supersedes). Cosmetic changes only; compiled and SETTE tested with ORCA2LIMPISCES.

  • Property svn:keywords set to Id
File size: 25.7 KB
Line 
1MODULE mppini
2   !!======================================================================
3   !!                       ***  MODULE mppini   ***
4   !! Ocean initialization : distributed memory computing initialization
5   !!======================================================================
6   !! History :  6.0  !  1994-11  (M. Guyon)  Original code
7   !!  OPA       7.0  !  1995-04  (J. Escobar, M. Imbard)
8   !!            8.0  !  1998-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
9   !!  NEMO      1.0  !  2004-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
10   !!            4.0  !  2016-06  (G. Madec)  use domain configuration file instead of bathymetry file
11   !!            4.0  !  2017-06  (J.M. Molines, T. Lovato) merge of mppini and mppini_2
12   !!----------------------------------------------------------------------
13
14   !!----------------------------------------------------------------------
15   !!  mpp_init       : Lay out the global domain over processors with/without land processor elimination
16   !!  mpp_init_mask  :
17   !!  mpp_init_ioipsl: IOIPSL initialization in mpp
18   !!----------------------------------------------------------------------
19   USE dom_oce        ! ocean space and time domain
20   USE bdy_oce        ! open BounDarY 
21   !
22   USE lib_mpp        ! distribued memory computing library
23   USE iom            ! nemo I/O library
24   USE ioipsl         ! I/O IPSL library
25   USE in_out_manager ! I/O Manager
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC mpp_init       ! called by opa.F90
31
32   !!----------------------------------------------------------------------
33   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
34   !! $Id$
35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
36   !!----------------------------------------------------------------------
37CONTAINS
38
39#if ! defined key_mpp_mpi
40   !!----------------------------------------------------------------------
41   !!   Default option :                            shared memory computing
42   !!----------------------------------------------------------------------
43
44   SUBROUTINE mpp_init
45      !!----------------------------------------------------------------------
46      !!                  ***  ROUTINE mpp_init  ***
47      !!
48      !! ** Purpose :   Lay out the global domain over processors.
49      !!
50      !! ** Method  :   Shared memory computing, set the local processor
51      !!              variables to the value of the global domain
52      !!----------------------------------------------------------------------
53      !
54      nimpp  = 1           !
55      njmpp  = 1
56      nlci   = jpi
57      nlcj   = jpj
58      nldi   = 1
59      nldj   = 1
60      nlei   = jpi
61      nlej   = jpj
62      nperio = jperio
63      nbondi = 2
64      nbondj = 2
65      nidom  = FLIO_DOM_NONE
66      npolj = jperio
67      !
68      IF(lwp) THEN
69         WRITE(numout,*)
70         WRITE(numout,*) 'mpp_init : NO massively parallel processing'
71         WRITE(numout,*) '~~~~~~~~ '
72         WRITE(numout,*) '   nperio = ', nperio, '   nimpp  = ', nimpp
73         WRITE(numout,*) '   npolj  = ', npolj , '   njmpp  = ', njmpp
74      ENDIF
75      !
76      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 )                                     &
77         CALL ctl_stop( 'mpp_init: equality  jpni = jpnj = jpnij = 1 is not satisfied',   &
78            &           'the domain is lay out for distributed memory computing!' )
79         !
80      IF( jperio == 7 ) CALL ctl_stop( 'mpp_init: jperio = 7 needs distributed memory computing ',       &
81         &                             'with 1 process. Add key_mpp_mpi in the list of active cpp keys ' )
82         !
83   END SUBROUTINE mpp_init
84
85#else
86   !!----------------------------------------------------------------------
87   !!   'key_mpp_mpi'                     MPI massively parallel processing
88   !!----------------------------------------------------------------------
89
90   SUBROUTINE mpp_init
91      !!----------------------------------------------------------------------
92      !!                  ***  ROUTINE mpp_init  ***
93      !!                   
94      !! ** Purpose :   Lay out the global domain over processors.
95      !!      If land processors are to be eliminated, this program requires the
96      !!      presence of the domain configuration file. Land processors elimination
97      !!      is performed if jpni x jpnj /= jpnij. In this case, using the MPP_PREP
98      !!      preprocessing tool, help for defining the best cutting out.
99      !!
100      !! ** Method  :   Global domain is distributed in smaller local domains.
101      !!      Periodic condition is a function of the local domain position
102      !!      (global boundary or neighbouring domain) and of the global
103      !!      periodic
104      !!      Type :         jperio global periodic condition
105      !!                     nperio local  periodic condition
106      !!
107      !! ** Action : - set domain parameters
108      !!                    nimpp     : longitudinal index
109      !!                    njmpp     : latitudinal  index
110      !!                    nperio    : lateral condition type
111      !!                    narea     : number for local area
112      !!                    nlci      : first dimension
113      !!                    nlcj      : second dimension
114      !!                    nbondi    : mark for "east-west local boundary"
115      !!                    nbondj    : mark for "north-south local boundary"
116      !!                    nproc     : number for local processor
117      !!                    noea      : number for local neighboring processor
118      !!                    nowe      : number for local neighboring processor
119      !!                    noso      : number for local neighboring processor
120      !!                    nono      : number for local neighboring processor
121      !!----------------------------------------------------------------------
122      INTEGER ::   ji, jj, jn, jproc, jarea   ! dummy loop indices
123      INTEGER ::   inum                       ! local logical unit
124      INTEGER ::   idir, ifreq, icont, isurf  ! local integers
125      INTEGER ::   ii, il1, ili, imil         !   -       -
126      INTEGER ::   ij, il2, ilj, ijm1         !   -       -
127      INTEGER ::   iino, ijno, iiso, ijso     !   -       -
128      INTEGER ::   iiea, ijea, iiwe, ijwe     !   -       -
129      INTEGER ::   iresti, irestj, iproc      !   -       -
130      INTEGER, DIMENSION(jpnij) ::   iin, ii_nono, ii_noea   ! 1D workspace
131      INTEGER, DIMENSION(jpnij) ::   ijn, ii_noso, ii_nowe   !  -     -
132      INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ilci, ibondi, ipproc   ! 2D workspace
133      INTEGER, DIMENSION(jpni,jpnj) ::   ijmppt, ilcj, ibondj, ipolj    !  -     -
134      INTEGER, DIMENSION(jpni,jpnj) ::   ilei, ildi, iono, ioea         !  -     -
135      INTEGER, DIMENSION(jpni,jpnj) ::   ilej, ildj, ioso, iowe         !  -     -
136      INTEGER, DIMENSION(jpiglo,jpjglo) ::   imask   ! 2D golbal domain workspace
137      REAL(wp) ::   zidom, zjdom   ! local scalars
138      !!----------------------------------------------------------------------
139      !
140      IF ( jpni * jpnj == jpnij ) THEN    ! regular domain lay out over processors
141         imask(:,:) = 1               
142      ELSEIF ( jpni*jpnj > jpnij ) THEN   ! remove land-only processor (i.e. where imask(:,:)=0)
143         CALL mpp_init_mask( imask )   
144      ELSE                                ! error
145         CALL ctl_stop( 'mpp_init: jpnij > jpni x jpnj. Check namelist setting!' )
146      ENDIF
147      !
148      !  1. Dimension arrays for subdomains
149      ! -----------------------------------
150      !  Computation of local domain sizes ilci() ilcj()
151      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
152      !  The subdomains are squares lesser than or equal to the global
153      !  dimensions divided by the number of processors minus the overlap array.
154      !
155      nreci = 2 * jpreci
156      nrecj = 2 * jprecj
157      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
158      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
159      !
160#if defined key_nemocice_decomp
161      ! Change padding to be consistent with CICE
162      ilci(1:jpni-1      ,:) = jpi
163      ilci(jpni          ,:) = jpiglo - (jpni - 1) * (jpi - nreci)
164      !
165      ilcj(:,      1:jpnj-1) = jpj
166      ilcj(:,          jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj)
167#else
168      ilci(1:iresti      ,:) = jpi
169      ilci(iresti+1:jpni ,:) = jpi-1
170
171      ilcj(:,      1:irestj) = jpj
172      ilcj(:, irestj+1:jpnj) = jpj-1
173#endif
174      !
175      nfilcit(:,:) = ilci(:,:)
176      !
177      zidom = nreci + sum(ilci(:,1) - nreci )
178      zjdom = nrecj + sum(ilcj(1,:) - nrecj )
179      !
180      IF(lwp) THEN
181         WRITE(numout,*)
182         WRITE(numout,*) 'mpp_init : MPI Message Passing MPI - domain lay out over processors'
183         WRITE(numout,*) '~~~~~~~~ '
184         WRITE(numout,*) '   defines mpp subdomains'
185         WRITE(numout,*) '      iresti = ', iresti, ' jpni = ', jpni 
186         WRITE(numout,*) '      irestj = ', irestj, ' jpnj = ', jpnj
187         WRITE(numout,*)
188         WRITE(numout,*) '      sum ilci(i,1) = ', zidom, ' jpiglo = ', jpiglo
189         WRITE(numout,*) '      sum ilcj(1,j) = ', zjdom, ' jpjglo = ', jpjglo
190      ENDIF
191
192      !  2. Index arrays for subdomains
193      ! -------------------------------
194      iimppt(:,:) =  1
195      ijmppt(:,:) =  1
196      ipproc(:,:) = -1
197      !
198      IF( jpni > 1 ) THEN
199         DO jj = 1, jpnj
200            DO ji = 2, jpni
201               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
202            END DO
203         END DO
204      ENDIF
205      nfiimpp(:,:) = iimppt(:,:)
206      !
207      IF( jpnj > 1 )THEN
208         DO jj = 2, jpnj
209            DO ji = 1, jpni
210               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
211            END DO
212         END DO
213      ENDIF
214
215      ! 3. Subdomain description in the Regular Case
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         ! Subdomain neighbors
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
242         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) =  1
243         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
244         ildj(ii,ij) =  1  + jprecj
245         ilej(ii,ij) = ilj - jprecj
246         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) =  1
247         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
248
249         ! warning ii*ij (zone) /= nproc (processors)!
250
251         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
252            IF( jpni == 1 )THEN
253               ibondi(ii,ij) = 2
254               nperio = 1
255            ELSE
256               ibondi(ii,ij) = 0
257            ENDIF
258            IF( MOD(jarea,jpni) == 0 ) THEN
259               ioea(ii,ij) = iproc - (jpni-1)
260            ENDIF
261            IF( MOD(jarea,jpni) == 1 ) THEN
262               iowe(ii,ij) = iproc + jpni - 1
263            ENDIF
264         ENDIF
265         ipolj(ii,ij) = 0
266         IF( jperio == 3 .OR. jperio == 4 ) THEN
267            ijm1 = jpni*(jpnj-1)
268            imil = ijm1+(jpni+1)/2
269            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
270            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
271            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1   ! MPI rank of northern neighbour
272         ENDIF
273         IF( jperio == 5 .OR. jperio == 6 ) THEN
274            ijm1 = jpni*(jpnj-1)
275            imil = ijm1+(jpni+1)/2
276            IF( jarea > ijm1) ipolj(ii,ij) = 5
277            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
278            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1    ! MPI rank of northern neighbour
279         ENDIF
280         !
281         ! Check wet points over the entire domain to preserve the MPI communication stencil
282         isurf = 0
283         DO jj = 1, ilj
284            DO  ji = 1, ili
285               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1)   isurf = isurf+1
286            END DO
287         END DO
288         !
289         IF( isurf /= 0 ) THEN
290            icont = icont + 1
291            ipproc(ii,ij) = icont
292            iin(icont+1) = ii
293            ijn(icont+1) = ij
294         ENDIF
295      END DO
296      !
297      nfipproc(:,:) = ipproc(:,:)
298
299      ! Check potential error
300      IF( icont+1 /= jpnij ) THEN
301         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
302         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 
303         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
304         CALL ctl_stop( 'mpp_init: Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
305      ENDIF
306
307      ! 4. Subdomain print
308      ! ------------------
309      IF(lwp) THEN
310         ifreq = 4
311         il1 = 1
312         DO jn = 1, (jpni-1)/ifreq+1
313            il2 = MIN(jpni,il1+ifreq-1)
314            WRITE(numout,*)
315            WRITE(numout,9400) ('***',ji=il1,il2-1)
316            DO jj = jpnj, 1, -1
317               WRITE(numout,9403) ('   ',ji=il1,il2-1)
318               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
319               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
320               WRITE(numout,9403) ('   ',ji=il1,il2-1)
321               WRITE(numout,9400) ('***',ji=il1,il2-1)
322            END DO
323            WRITE(numout,9401) (ji,ji=il1,il2)
324            il1 = il1+ifreq
325         END DO
326 9400    FORMAT('     ***',20('*************',a3))
327 9403    FORMAT('     *     ',20('         *   ',a3))
328 9401    FORMAT('        ',20('   ',i3,'          '))
329 9402    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
330 9404    FORMAT('     *  ',20('      ',i3,'   *   '))
331      ENDIF
332
333      ! 5. neighbour treatment
334      ! ----------------------
335      DO jarea = 1, jpni*jpnj
336         iproc = jarea-1
337         ii = 1 + MOD( jarea-1  , jpni )
338         ij = 1 +     (jarea-1) / jpni
339         IF ( ipproc(ii,ij) == -1 .AND. 0 <= iono(ii,ij) .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
340            iino = 1 + MOD( iono(ii,ij) , jpni )
341            ijno = 1 +      iono(ii,ij) / jpni
342            ! Need to reverse the logical direction of communication
343            ! for northern neighbours of northern row processors (north-fold)
344            ! i.e. need to check that the northern neighbour only communicates
345            ! to the SOUTH (or not at all) if this area is land-only (#1057)
346            idir = 1
347            IF( ij == jpnj .AND. ijno == jpnj )   idir = -1   
348            IF( ibondj(iino,ijno) == idir     )   ibondj(iino,ijno) =   2
349            IF( ibondj(iino,ijno) == 0        )   ibondj(iino,ijno) = -idir
350         ENDIF
351         IF( ipproc(ii,ij) == -1 .AND. 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
352            iiso = 1 + MOD( ioso(ii,ij) , jpni )
353            ijso = 1 +      ioso(ii,ij) / jpni
354            IF( ibondj(iiso,ijso) == -1 )   ibondj(iiso,ijso) = 2
355            IF( ibondj(iiso,ijso) ==  0 )   ibondj(iiso,ijso) = 1
356         ENDIF
357         IF( ipproc(ii,ij) == -1 .AND. 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= jpni*jpnj-1 ) THEN
358            iiea = 1 + MOD( ioea(ii,ij) , jpni )
359            ijea = 1 +      ioea(ii,ij) / jpni
360            IF( ibondi(iiea,ijea) == 1 )   ibondi(iiea,ijea) =  2
361            IF( ibondi(iiea,ijea) == 0 )   ibondi(iiea,ijea) = -1
362         ENDIF
363         IF( ipproc(ii,ij) == -1 .AND. 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
364            iiwe = 1 + MOD( iowe(ii,ij) , jpni )
365            ijwe = 1 +      iowe(ii,ij) / jpni
366            IF( ibondi(iiwe,ijwe) == -1 )   ibondi(iiwe,ijwe) = 2
367            IF( ibondi(iiwe,ijwe) ==  0 )   ibondi(iiwe,ijwe) = 1
368         ENDIF
369      END DO
370
371      ! just to save nono etc for all proc
372      ii_noso(:) = -1
373      ii_nono(:) = -1
374      ii_noea(:) = -1
375      ii_nowe(:) = -1 
376      nproc = narea-1
377      DO jarea = 1, jpnij
378         ii = iin(jarea)
379         ij = ijn(jarea)
380         IF( 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
381            iiso = 1 + MOD( ioso(ii,ij) , jpni )
382            ijso = 1 +      ioso(ii,ij) / jpni
383            noso = ipproc(iiso,ijso)
384            ii_noso(jarea)= noso
385         ENDIF
386         IF( 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
387          iiwe = 1 + MOD( iowe(ii,ij) , jpni )
388          ijwe = 1 +      iowe(ii,ij) / jpni
389          nowe = ipproc(iiwe,ijwe)
390          ii_nowe(jarea)= nowe
391         ENDIF
392         IF( 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
393            iiea = 1 + MOD( ioea(ii,ij) , jpni )
394            ijea = 1 +      ioea(ii,ij) / jpni
395            noea = ipproc(iiea,ijea)
396            ii_noea(jarea)= noea
397         ENDIF
398         IF( 0 <= iono(ii,ij) .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
399            iino = 1 + MOD( iono(ii,ij) , jpni )
400            ijno = 1 +      iono(ii,ij) / jpni
401            nono = ipproc(iino,ijno)
402            ii_nono(jarea)= nono
403         ENDIF
404      END DO
405   
406      ! 6. Change processor name
407      ! ------------------------
408      nproc = narea-1
409      ii = iin(narea)
410      ij = ijn(narea)
411      !
412      ! set default neighbours
413      noso = ii_noso(narea)
414      nowe = ii_nowe(narea)
415      noea = ii_noea(narea)
416      nono = ii_nono(narea)
417      nlcj = ilcj(ii,ij) 
418      nlci = ilci(ii,ij) 
419      nldi = ildi(ii,ij)
420      nlei = ilei(ii,ij)
421      nldj = ildj(ii,ij)
422      nlej = ilej(ii,ij)
423      nbondi = ibondi(ii,ij)
424      nbondj = ibondj(ii,ij)
425      nimpp = iimppt(ii,ij) 
426      njmpp = ijmppt(ii,ij) 
427      DO jproc = 1, jpnij
428         ii = iin(jproc)
429         ij = ijn(jproc)
430         nimppt(jproc) = iimppt(ii,ij) 
431         njmppt(jproc) = ijmppt(ii,ij) 
432         nlcjt(jproc) = ilcj(ii,ij)
433         nlcit(jproc) = ilci(ii,ij)
434         nldit(jproc) = ildi(ii,ij)
435         nleit(jproc) = ilei(ii,ij)
436         nldjt(jproc) = ildj(ii,ij)
437         nlejt(jproc) = ilej(ii,ij)
438      END DO
439
440      ! Save processor layout in ascii file
441      IF (lwp) THEN
442         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
443         WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
444         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
445         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj '
446
447         DO jproc = 1, jpnij
448            ii = iin(jproc)
449            ij = ijn(jproc)
450            WRITE(inum,'(15i5)') jproc-1, nlcit  (jproc), nlcjt  (jproc),   &
451               &                          nldit  (jproc), nldjt  (jproc),   &
452               &                          nleit  (jproc), nlejt  (jproc),   &
453               &                          nimppt (jproc), njmppt (jproc),   & 
454               &                          ii_nono(jproc), ii_noso(jproc),   &
455               &                          ii_nowe(jproc), ii_noea(jproc),   &
456               &                          ibondi (ii,ij), ibondj (ii,ij) 
457         END DO
458         CLOSE(inum)   
459      END IF
460
461      !                          ! north fold parameter
462      ! Defined npolj, either 0, 3 , 4 , 5 , 6
463      ! In this case the important thing is that npolj /= 0
464      ! Because if we go through these line it is because jpni >1 and thus
465      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
466      npolj = 0
467      ij = ijn(narea)
468      IF( jperio == 3 .OR. jperio == 4 ) THEN
469         IF( ij == jpnj )   npolj = 3
470      ENDIF
471      IF( jperio == 5 .OR. jperio == 6 ) THEN
472         IF( ij == jpnj )   npolj = 5
473      ENDIF
474      !
475      IF(lwp) THEN
476         WRITE(numout,*)
477         WRITE(numout,*) ' nproc  = ', nproc
478         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
479         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
480         WRITE(numout,*) ' nbondi = ', nbondi
481         WRITE(numout,*) ' nbondj = ', nbondj
482         WRITE(numout,*) ' npolj  = ', npolj
483         WRITE(numout,*) ' nperio = ', nperio
484         WRITE(numout,*) ' nlci   = ', nlci
485         WRITE(numout,*) ' nlcj   = ', nlcj
486         WRITE(numout,*) ' nimpp  = ', nimpp
487         WRITE(numout,*) ' njmpp  = ', njmpp
488         WRITE(numout,*) ' nreci  = ', nreci 
489         WRITE(numout,*) ' nrecj  = ', nrecj 
490         WRITE(numout,*) ' jpreci = ', jpreci 
491         WRITE(numout,*) ' jprecj = ', jprecj 
492      ENDIF
493
494      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( 'mpp_init: error on cyclicity' )
495
496      !                          ! Prepare mpp north fold
497      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
498         CALL mpp_ini_north
499         IF(lwp) WRITE(numout,*) ' mpp_init : North fold boundary prepared for jpni >1'
500      ENDIF
501      !
502      CALL mpp_init_ioipsl       ! Prepare NetCDF output file (if necessary)
503      !
504    END SUBROUTINE mpp_init
505
506
507    SUBROUTINE mpp_init_mask( kmask )
508      !!----------------------------------------------------------------------
509      !!                  ***  ROUTINE mpp_init_mask  ***
510      !!
511      !! ** Purpose : Read relevant bathymetric information in a global array
512      !!              in order to provide a land/sea mask used for the elimination
513      !!              of land domains, in an mpp computation.
514      !!
515      !! ** Method  : Read the namelist ln_zco and ln_isfcav in namelist namzgr
516      !!              in order to choose the correct bathymetric information
517      !!              (file and variables) 
518      !!----------------------------------------------------------------------
519      INTEGER, DIMENSION(jpiglo,jpjglo), INTENT(out) ::   kmask   ! global domain
520 
521      INTEGER :: inum   !: logical unit for configuration file
522      INTEGER :: ios    !: iostat error flag
523      INTEGER ::  ijstartrow                   ! temporary integers
524      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zbot, zbdy          ! global workspace
525      REAL(wp) ::   zidom , zjdom          ! local scalars
526      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,         &
527           &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
528           &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             & 
529           &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
530           &             cn_ice_lim, nn_ice_lim_dta,                           &
531           &             rn_ice_tem, rn_ice_sal, rn_ice_age,                 &
532           &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy
533      !!----------------------------------------------------------------------
534      ! 0. initialisation
535      ! -----------------
536      CALL iom_open( cn_domcfg, inum )
537      !
538      ! ocean bottom level
539      CALL iom_get( inum, jpdom_unknown, 'bottom_level' , zbot , lrowattr=ln_use_jattr )  ! nb of ocean T-points
540      !
541      CALL iom_close( inum )
542      !
543      ! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise)
544      WHERE( zbot(:,:) > 0 )   ;   kmask(:,:) = 1
545      ELSEWHERE                ;   kmask(:,:) = 0
546      END WHERE
547 
548      ! Adjust kmask with bdy_msk if it exists
549 
550      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist : BDY
551      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
552903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)', lwp )
553
554      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist : BDY
555      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
556904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)', lwp )
557
558      IF( ln_bdy .AND. ln_mask_file ) THEN
559         CALL iom_open( cn_mask_file, inum )
560         CALL iom_get ( inum, jpdom_unknown, 'bdy_msk', zbdy )
561         CALL iom_close( inum )
562         WHERE ( zbdy(:,:) <= 0. ) kmask = 0
563      ENDIF
564      !
565   END SUBROUTINE mpp_init_mask
566
567
568   SUBROUTINE mpp_init_ioipsl
569      !!----------------------------------------------------------------------
570      !!                  ***  ROUTINE mpp_init_ioipsl  ***
571      !!
572      !! ** Purpose :   
573      !!
574      !! ** Method  :   
575      !!
576      !! History :
577      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL
578      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
579      !!----------------------------------------------------------------------
580      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid
581      !!----------------------------------------------------------------------
582
583      ! The domain is split only horizontally along i- or/and j- direction
584      ! So we need at the most only 1D arrays with 2 elements.
585      ! Set idompar values equivalent to the jpdom_local_noextra definition
586      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
587      iglo(1) = jpiglo
588      iglo(2) = jpjglo
589      iloc(1) = nlci
590      iloc(2) = nlcj
591      iabsf(1) = nimppt(narea)
592      iabsf(2) = njmppt(narea)
593      iabsl(:) = iabsf(:) + iloc(:) - 1
594      ihals(1) = nldi - 1
595      ihals(2) = nldj - 1
596      ihale(1) = nlci - nlei
597      ihale(2) = nlcj - nlej
598      idid(1) = 1
599      idid(2) = 2
600
601      IF(lwp) THEN
602          WRITE(numout,*)
603          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
604          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
605          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
606          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
607      ENDIF
608      !
609      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
610      !
611   END SUBROUTINE mpp_init_ioipsl 
612
613#endif
614
615   !!======================================================================
616END MODULE mppini
Note: See TracBrowser for help on using the repository browser.