source: branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90 @ 9012

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

Branch dev_CNRS_2017. Merge in no_ghost changes from dev_r8126_ROBUST08_no_ghost. These changes include lib_mpp refresh and rationalisation of mppini from dev_r8126_ROBUST10_MPPINI

  • Property svn:keywords set to Id
File size: 25.9 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 * nn_hls
156      nrecj = 2 * nn_hls
157      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
158      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
159      !
160      !  Need to use jpimax and jpjmax here since jpi and jpj have already been
161      !  shrunk to local sizes in nemogcm
162#if defined key_nemocice_decomp
163      ! Change padding to be consistent with CICE
164      ilci(1:jpni-1      ,:) = jpimax
165      ilci(jpni          ,:) = jpiglo - (jpni - 1) * (jpimax - nreci)
166      !
167      ilcj(:,      1:jpnj-1) = jpjmax
168      ilcj(:,          jpnj) = jpjglo - (jpnj - 1) * (jpjmax - nrecj)
169#else
170      ilci(1:iresti      ,:) = jpimax
171      ilci(iresti+1:jpni ,:) = jpimax-1
172
173      ilcj(:,      1:irestj) = jpjmax
174      ilcj(:, irestj+1:jpnj) = jpjmax-1
175#endif
176      !
177      nfilcit(:,:) = ilci(:,:)
178      !
179      zidom = nreci + sum(ilci(:,1) - nreci )
180      zjdom = nrecj + sum(ilcj(1,:) - nrecj )
181      !
182      IF(lwp) THEN
183         WRITE(numout,*)
184         WRITE(numout,*) 'mpp_init : MPI Message Passing MPI - domain lay out over processors'
185         WRITE(numout,*) '~~~~~~~~ '
186         WRITE(numout,*) '   defines mpp subdomains'
187         WRITE(numout,*) '      iresti = ', iresti, ' jpni = ', jpni 
188         WRITE(numout,*) '      irestj = ', irestj, ' jpnj = ', jpnj
189         WRITE(numout,*)
190         WRITE(numout,*) '      sum ilci(i,1) = ', zidom, ' jpiglo = ', jpiglo
191         WRITE(numout,*) '      sum ilcj(1,j) = ', zjdom, ' jpjglo = ', jpjglo
192      ENDIF
193
194      !  2. Index arrays for subdomains
195      ! -------------------------------
196      iimppt(:,:) =  1
197      ijmppt(:,:) =  1
198      ipproc(:,:) = -1
199      !
200      IF( jpni > 1 ) THEN
201         DO jj = 1, jpnj
202            DO ji = 2, jpni
203               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
204            END DO
205         END DO
206      ENDIF
207      nfiimpp(:,:) = iimppt(:,:)
208      !
209      IF( jpnj > 1 )THEN
210         DO jj = 2, jpnj
211            DO ji = 1, jpni
212               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
213            END DO
214         END DO
215      ENDIF
216
217      ! 3. Subdomain description in the Regular Case
218      ! --------------------------------------------
219      nperio = 0
220      icont = -1
221      DO jarea = 1, jpni*jpnj
222         ii = 1 + MOD(jarea-1,jpni)
223         ij = 1 +    (jarea-1)/jpni
224         ili = ilci(ii,ij)
225         ilj = ilcj(ii,ij)
226         ibondj(ii,ij) = -1
227         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
228         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
229         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
230         ibondi(ii,ij) = 0
231         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
232         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
233         IF( jpni            == 1 )   ibondi(ii,ij) =  2
234
235         ! Subdomain neighbors
236         iproc = jarea - 1
237         ioso(ii,ij) = iproc - jpni
238         iowe(ii,ij) = iproc - 1
239         ioea(ii,ij) = iproc + 1
240         iono(ii,ij) = iproc + jpni
241         ildi(ii,ij) =  1  + nn_hls
242         ilei(ii,ij) = ili - nn_hls
243
244         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) =  1
245         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
246         ildj(ii,ij) =  1  + nn_hls
247         ilej(ii,ij) = ilj - nn_hls
248         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) =  1
249         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
250
251         ! warning ii*ij (zone) /= nproc (processors)!
252
253         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
254            IF( jpni == 1 )THEN
255               ibondi(ii,ij) = 2
256               nperio = 1
257            ELSE
258               ibondi(ii,ij) = 0
259            ENDIF
260            IF( MOD(jarea,jpni) == 0 ) THEN
261               ioea(ii,ij) = iproc - (jpni-1)
262            ENDIF
263            IF( MOD(jarea,jpni) == 1 ) THEN
264               iowe(ii,ij) = iproc + jpni - 1
265            ENDIF
266         ENDIF
267         ipolj(ii,ij) = 0
268         IF( jperio == 3 .OR. jperio == 4 ) THEN
269            ijm1 = jpni*(jpnj-1)
270            imil = ijm1+(jpni+1)/2
271            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
272            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
273            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1   ! MPI rank of northern neighbour
274         ENDIF
275         IF( jperio == 5 .OR. jperio == 6 ) THEN
276            ijm1 = jpni*(jpnj-1)
277            imil = ijm1+(jpni+1)/2
278            IF( jarea > ijm1) ipolj(ii,ij) = 5
279            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
280            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1    ! MPI rank of northern neighbour
281         ENDIF
282         !
283         ! Check wet points over the entire domain to preserve the MPI communication stencil
284         isurf = 0
285         DO jj = 1, ilj
286            DO  ji = 1, ili
287               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1)   isurf = isurf+1
288            END DO
289         END DO
290         !
291         IF( isurf /= 0 ) THEN
292            icont = icont + 1
293            ipproc(ii,ij) = icont
294            iin(icont+1) = ii
295            ijn(icont+1) = ij
296         ENDIF
297      END DO
298      !
299      nfipproc(:,:) = ipproc(:,:)
300
301      ! Check potential error
302      IF( icont+1 /= jpnij ) THEN
303         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
304         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 
305         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
306         CALL ctl_stop( 'mpp_init: Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
307      ENDIF
308
309      ! 4. Subdomain print
310      ! ------------------
311      IF(lwp) THEN
312         ifreq = 4
313         il1 = 1
314         DO jn = 1, (jpni-1)/ifreq+1
315            il2 = MIN(jpni,il1+ifreq-1)
316            WRITE(numout,*)
317            WRITE(numout,9400) ('***',ji=il1,il2-1)
318            DO jj = jpnj, 1, -1
319               WRITE(numout,9403) ('   ',ji=il1,il2-1)
320               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
321               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
322               WRITE(numout,9403) ('   ',ji=il1,il2-1)
323               WRITE(numout,9400) ('***',ji=il1,il2-1)
324            END DO
325            WRITE(numout,9401) (ji,ji=il1,il2)
326            il1 = il1+ifreq
327         END DO
328 9400    FORMAT('     ***',20('*************',a3))
329 9403    FORMAT('     *     ',20('         *   ',a3))
330 9401    FORMAT('        ',20('   ',i3,'          '))
331 9402    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
332 9404    FORMAT('     *  ',20('      ',i3,'   *   '))
333      ENDIF
334
335      ! 5. neighbour treatment
336      ! ----------------------
337      DO jarea = 1, jpni*jpnj
338         iproc = jarea-1
339         ii = 1 + MOD( jarea-1  , jpni )
340         ij = 1 +     (jarea-1) / jpni
341         IF ( ipproc(ii,ij) == -1 .AND. 0 <= iono(ii,ij) .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
342            iino = 1 + MOD( iono(ii,ij) , jpni )
343            ijno = 1 +      iono(ii,ij) / jpni
344            ! Need to reverse the logical direction of communication
345            ! for northern neighbours of northern row processors (north-fold)
346            ! i.e. need to check that the northern neighbour only communicates
347            ! to the SOUTH (or not at all) if this area is land-only (#1057)
348            idir = 1
349            IF( ij == jpnj .AND. ijno == jpnj )   idir = -1   
350            IF( ibondj(iino,ijno) == idir     )   ibondj(iino,ijno) =   2
351            IF( ibondj(iino,ijno) == 0        )   ibondj(iino,ijno) = -idir
352         ENDIF
353         IF( ipproc(ii,ij) == -1 .AND. 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
354            iiso = 1 + MOD( ioso(ii,ij) , jpni )
355            ijso = 1 +      ioso(ii,ij) / jpni
356            IF( ibondj(iiso,ijso) == -1 )   ibondj(iiso,ijso) = 2
357            IF( ibondj(iiso,ijso) ==  0 )   ibondj(iiso,ijso) = 1
358         ENDIF
359         IF( ipproc(ii,ij) == -1 .AND. 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= jpni*jpnj-1 ) THEN
360            iiea = 1 + MOD( ioea(ii,ij) , jpni )
361            ijea = 1 +      ioea(ii,ij) / jpni
362            IF( ibondi(iiea,ijea) == 1 )   ibondi(iiea,ijea) =  2
363            IF( ibondi(iiea,ijea) == 0 )   ibondi(iiea,ijea) = -1
364         ENDIF
365         IF( ipproc(ii,ij) == -1 .AND. 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
366            iiwe = 1 + MOD( iowe(ii,ij) , jpni )
367            ijwe = 1 +      iowe(ii,ij) / jpni
368            IF( ibondi(iiwe,ijwe) == -1 )   ibondi(iiwe,ijwe) = 2
369            IF( ibondi(iiwe,ijwe) ==  0 )   ibondi(iiwe,ijwe) = 1
370         ENDIF
371      END DO
372
373      ! just to save nono etc for all proc
374      ii_noso(:) = -1
375      ii_nono(:) = -1
376      ii_noea(:) = -1
377      ii_nowe(:) = -1 
378      nproc = narea-1
379      DO jarea = 1, jpnij
380         ii = iin(jarea)
381         ij = ijn(jarea)
382         IF( 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
383            iiso = 1 + MOD( ioso(ii,ij) , jpni )
384            ijso = 1 +      ioso(ii,ij) / jpni
385            noso = ipproc(iiso,ijso)
386            ii_noso(jarea)= noso
387         ENDIF
388         IF( 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
389          iiwe = 1 + MOD( iowe(ii,ij) , jpni )
390          ijwe = 1 +      iowe(ii,ij) / jpni
391          nowe = ipproc(iiwe,ijwe)
392          ii_nowe(jarea)= nowe
393         ENDIF
394         IF( 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
395            iiea = 1 + MOD( ioea(ii,ij) , jpni )
396            ijea = 1 +      ioea(ii,ij) / jpni
397            noea = ipproc(iiea,ijea)
398            ii_noea(jarea)= noea
399         ENDIF
400         IF( 0 <= iono(ii,ij) .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
401            iino = 1 + MOD( iono(ii,ij) , jpni )
402            ijno = 1 +      iono(ii,ij) / jpni
403            nono = ipproc(iino,ijno)
404            ii_nono(jarea)= nono
405         ENDIF
406      END DO
407   
408      ! 6. Change processor name
409      ! ------------------------
410      nproc = narea-1
411      ii = iin(narea)
412      ij = ijn(narea)
413      !
414      ! set default neighbours
415      noso = ii_noso(narea)
416      nowe = ii_nowe(narea)
417      noea = ii_noea(narea)
418      nono = ii_nono(narea)
419      nlcj = ilcj(ii,ij) 
420      nlci = ilci(ii,ij) 
421      nldi = ildi(ii,ij)
422      nlei = ilei(ii,ij)
423      nldj = ildj(ii,ij)
424      nlej = ilej(ii,ij)
425      nbondi = ibondi(ii,ij)
426      nbondj = ibondj(ii,ij)
427      nimpp = iimppt(ii,ij) 
428      njmpp = ijmppt(ii,ij) 
429      DO jproc = 1, jpnij
430         ii = iin(jproc)
431         ij = ijn(jproc)
432         nimppt(jproc) = iimppt(ii,ij) 
433         njmppt(jproc) = ijmppt(ii,ij) 
434         nlcjt(jproc) = ilcj(ii,ij)
435         nlcit(jproc) = ilci(ii,ij)
436         nldit(jproc) = ildi(ii,ij)
437         nleit(jproc) = ilei(ii,ij)
438         nldjt(jproc) = ildj(ii,ij)
439         nlejt(jproc) = ilej(ii,ij)
440      END DO
441
442      ! Save processor layout in ascii file
443      IF (lwp) THEN
444         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
445         WRITE(inum,'(a)') '   jpnij   jpimax  jpjmax    jpk  jpiglo  jpjglo'//&
446   &           ' ( local:    narea     jpi     jpj)'
447         WRITE(inum,'(6i8,a,3i8,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,&
448   &           ' ( local: ',narea,jpi,jpj,' )'
449         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj '
450
451         DO jproc = 1, jpnij
452            ii = iin(jproc)
453            ij = ijn(jproc)
454            WRITE(inum,'(15i5)') jproc-1, nlcit  (jproc), nlcjt  (jproc),   &
455               &                          nldit  (jproc), nldjt  (jproc),   &
456               &                          nleit  (jproc), nlejt  (jproc),   &
457               &                          nimppt (jproc), njmppt (jproc),   & 
458               &                          ii_nono(jproc), ii_noso(jproc),   &
459               &                          ii_nowe(jproc), ii_noea(jproc),   &
460               &                          ibondi (ii,ij), ibondj (ii,ij) 
461         END DO
462         CLOSE(inum)   
463      END IF
464
465      !                          ! north fold parameter
466      ! Defined npolj, either 0, 3 , 4 , 5 , 6
467      ! In this case the important thing is that npolj /= 0
468      ! Because if we go through these line it is because jpni >1 and thus
469      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
470      npolj = 0
471      ij = ijn(narea)
472      IF( jperio == 3 .OR. jperio == 4 ) THEN
473         IF( ij == jpnj )   npolj = 3
474      ENDIF
475      IF( jperio == 5 .OR. jperio == 6 ) THEN
476         IF( ij == jpnj )   npolj = 5
477      ENDIF
478      !
479      IF(lwp) THEN
480         WRITE(numout,*)
481         WRITE(numout,*) ' nproc  = ', nproc
482         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
483         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
484         WRITE(numout,*) ' nbondi = ', nbondi
485         WRITE(numout,*) ' nbondj = ', nbondj
486         WRITE(numout,*) ' npolj  = ', npolj
487         WRITE(numout,*) ' nperio = ', nperio
488         WRITE(numout,*) ' nlci   = ', nlci
489         WRITE(numout,*) ' nlcj   = ', nlcj
490         WRITE(numout,*) ' nimpp  = ', nimpp
491         WRITE(numout,*) ' njmpp  = ', njmpp
492         WRITE(numout,*) ' nreci  = ', nreci 
493         WRITE(numout,*) ' nrecj  = ', nrecj 
494         WRITE(numout,*) ' nn_hls = ', nn_hls 
495      ENDIF
496
497      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( 'mpp_init: error on cyclicity' )
498
499      !                          ! Prepare mpp north fold
500      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
501         CALL mpp_ini_north
502         IF(lwp) WRITE(numout,*) ' mpp_init : North fold boundary prepared for jpni >1'
503      ENDIF
504      !
505      CALL mpp_init_ioipsl       ! Prepare NetCDF output file (if necessary)
506      !
507    END SUBROUTINE mpp_init
508
509
510    SUBROUTINE mpp_init_mask( kmask )
511      !!----------------------------------------------------------------------
512      !!                  ***  ROUTINE mpp_init_mask  ***
513      !!
514      !! ** Purpose : Read relevant bathymetric information in a global array
515      !!              in order to provide a land/sea mask used for the elimination
516      !!              of land domains, in an mpp computation.
517      !!
518      !! ** Method  : Read the namelist ln_zco and ln_isfcav in namelist namzgr
519      !!              in order to choose the correct bathymetric information
520      !!              (file and variables) 
521      !!----------------------------------------------------------------------
522      INTEGER, DIMENSION(jpiglo,jpjglo), INTENT(out) ::   kmask   ! global domain
523 
524      INTEGER :: inum   !: logical unit for configuration file
525      INTEGER :: ios    !: iostat error flag
526      INTEGER ::  ijstartrow                   ! temporary integers
527      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zbot, zbdy          ! global workspace
528      REAL(wp) ::   zidom , zjdom          ! local scalars
529      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,         &
530           &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
531           &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             & 
532           &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
533           &             cn_ice_lim, nn_ice_lim_dta,                           &
534           &             rn_ice_tem, rn_ice_sal, rn_ice_age,                 &
535           &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy
536      !!----------------------------------------------------------------------
537      ! 0. initialisation
538      ! -----------------
539      CALL iom_open( cn_domcfg, inum )
540      !
541      ! ocean bottom level
542      CALL iom_get( inum, jpdom_unknown, 'bottom_level' , zbot , lrowattr=ln_use_jattr )  ! nb of ocean T-points
543      !
544      CALL iom_close( inum )
545      !
546      ! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise)
547      WHERE( zbot(:,:) > 0 )   ;   kmask(:,:) = 1
548      ELSEWHERE                ;   kmask(:,:) = 0
549      END WHERE
550 
551      ! Adjust kmask with bdy_msk if it exists
552 
553      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist : BDY
554      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
555903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)', lwp )
556
557      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist : BDY
558      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
559904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)', lwp )
560
561      IF( ln_bdy .AND. ln_mask_file ) THEN
562         CALL iom_open( cn_mask_file, inum )
563         CALL iom_get ( inum, jpdom_unknown, 'bdy_msk', zbdy )
564         CALL iom_close( inum )
565         WHERE ( zbdy(:,:) <= 0. ) kmask = 0
566      ENDIF
567      !
568   END SUBROUTINE mpp_init_mask
569
570
571   SUBROUTINE mpp_init_ioipsl
572      !!----------------------------------------------------------------------
573      !!                  ***  ROUTINE mpp_init_ioipsl  ***
574      !!
575      !! ** Purpose :   
576      !!
577      !! ** Method  :   
578      !!
579      !! History :
580      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL
581      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
582      !!----------------------------------------------------------------------
583      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid
584      !!----------------------------------------------------------------------
585
586      ! The domain is split only horizontally along i- or/and j- direction
587      ! So we need at the most only 1D arrays with 2 elements.
588      ! Set idompar values equivalent to the jpdom_local_noextra definition
589      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
590      iglo(1) = jpiglo
591      iglo(2) = jpjglo
592      iloc(1) = nlci
593      iloc(2) = nlcj
594      iabsf(1) = nimppt(narea)
595      iabsf(2) = njmppt(narea)
596      iabsl(:) = iabsf(:) + iloc(:) - 1
597      ihals(1) = nldi - 1
598      ihals(2) = nldj - 1
599      ihale(1) = nlci - nlei
600      ihale(2) = nlcj - nlej
601      idid(1) = 1
602      idid(2) = 2
603
604      IF(lwp) THEN
605          WRITE(numout,*)
606          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
607          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
608          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
609          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
610      ENDIF
611      !
612      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
613      !
614   END SUBROUTINE mpp_init_ioipsl 
615
616#endif
617
618   !!======================================================================
619END MODULE mppini
Note: See TracBrowser for help on using the repository browser.