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.F90 in branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90 @ 9190

Last change on this file since 9190 was 9190, checked in by gm, 5 years ago

dev_merge_2017: OPA_SRC: style only, results unchanged

  • Property svn:keywords set to Id
File size: 26.3 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      REAL(wp)::   zidom, zjdom               ! local scalars
131      INTEGER, DIMENSION(jpnij)     ::   iin, ii_nono, ii_noea   ! 1D workspace
132      INTEGER, DIMENSION(jpnij)     ::   ijn, ii_noso, ii_nowe   !  -     -
133      INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ilci, ibondi, ipproc   ! 2D workspace
134      INTEGER, DIMENSION(jpni,jpnj) ::   ijmppt, ilcj, ibondj, ipolj    !  -     -
135      INTEGER, DIMENSION(jpni,jpnj) ::   ilei, ildi, iono, ioea         !  -     -
136      INTEGER, DIMENSION(jpni,jpnj) ::   ilej, ildj, ioso, iowe         !  -     -
137      INTEGER, DIMENSION(jpiglo,jpjglo) ::   imask   ! 2D golbal domain workspace
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 .OR. jperio == 7 ) 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,*) '   resulting internal parameters : '
482         WRITE(numout,*) '      nproc  = ', nproc
483         WRITE(numout,*) '      nowe   = ', nowe  , '   noea  =  ', noea
484         WRITE(numout,*) '      nono   = ', nono  , '   noso  =  ', noso
485         WRITE(numout,*) '      nbondi = ', nbondi
486         WRITE(numout,*) '      nbondj = ', nbondj
487         WRITE(numout,*) '      npolj  = ', npolj
488         WRITE(numout,*) '      nperio = ', nperio
489         WRITE(numout,*) '      nlci   = ', nlci
490         WRITE(numout,*) '      nlcj   = ', nlcj
491         WRITE(numout,*) '      nimpp  = ', nimpp
492         WRITE(numout,*) '      njmpp  = ', njmpp
493         WRITE(numout,*) '      nreci  = ', nreci 
494         WRITE(numout,*) '      nrecj  = ', nrecj 
495         WRITE(numout,*) '      nn_hls = ', nn_hls 
496      ENDIF
497 
498      IF( nperio == 1 .AND. jpni /= 1 )   CALL ctl_stop( 'mpp_init: error on cyclicity' )
499
500      IF( jperio == 7 .AND. ( jpni /= 1 .OR. jpnj /= 1 ) )   &
501         &                  CALL ctl_stop( ' mpp_init: error jperio = 7 works only with jpni = jpnj = 1' )
502
503      !                          ! Prepare mpp north fold
504      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
505         CALL mpp_ini_north
506         IF(lwp) WRITE(numout,*)
507         IF(lwp) WRITE(numout,*) '   ==>>>   North fold boundary prepared for jpni >1'
508      ENDIF
509      !
510      CALL mpp_init_ioipsl       ! Prepare NetCDF output file (if necessary)
511      !
512    END SUBROUTINE mpp_init
513
514
515    SUBROUTINE mpp_init_mask( kmask )
516      !!----------------------------------------------------------------------
517      !!                  ***  ROUTINE mpp_init_mask  ***
518      !!
519      !! ** Purpose : Read relevant bathymetric information in a global array
520      !!              in order to provide a land/sea mask used for the elimination
521      !!              of land domains, in an mpp computation.
522      !!
523      !! ** Method  : Read the namelist ln_zco and ln_isfcav in namelist namzgr
524      !!              in order to choose the correct bathymetric information
525      !!              (file and variables) 
526      !!----------------------------------------------------------------------
527      INTEGER, DIMENSION(jpiglo,jpjglo), INTENT(out) ::   kmask   ! global domain
528 
529      INTEGER :: inum   !: logical unit for configuration file
530      INTEGER :: ios    !: iostat error flag
531      INTEGER ::  ijstartrow                   ! temporary integers
532      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zbot, zbdy          ! global workspace
533      REAL(wp) ::   zidom , zjdom          ! local scalars
534      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,           &
535           &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     &
536           &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             & 
537           &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, &
538           &             cn_ice_lim, nn_ice_lim_dta,                             &
539           &             rn_ice_tem, rn_ice_sal, rn_ice_age,                     &
540           &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy
541      !!----------------------------------------------------------------------
542      ! 0. initialisation
543      ! -----------------
544      CALL iom_open( cn_domcfg, inum )
545      !
546      ! ocean bottom level
547      CALL iom_get( inum, jpdom_unknown, 'bottom_level' , zbot , lrowattr=ln_use_jattr )  ! nb of ocean T-points
548      !
549      CALL iom_close( inum )
550      !
551      ! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise)
552      WHERE( zbot(:,:) > 0 )   ;   kmask(:,:) = 1
553      ELSEWHERE                ;   kmask(:,:) = 0
554      END WHERE
555 
556      ! Adjust kmask with bdy_msk if it exists
557 
558      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist : BDY
559      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903)
560903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)', lwp )
561      !
562      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist : BDY
563      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 )
564904   IF( ios >  0 )   CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)', lwp )
565
566      IF( ln_bdy .AND. ln_mask_file ) THEN
567         CALL iom_open( cn_mask_file, inum )
568         CALL iom_get ( inum, jpdom_unknown, 'bdy_msk', zbdy )
569         CALL iom_close( inum )
570         WHERE ( zbdy(:,:) <= 0. ) kmask = 0
571      ENDIF
572      !
573   END SUBROUTINE mpp_init_mask
574
575
576   SUBROUTINE mpp_init_ioipsl
577      !!----------------------------------------------------------------------
578      !!                  ***  ROUTINE mpp_init_ioipsl  ***
579      !!
580      !! ** Purpose :   
581      !!
582      !! ** Method  :   
583      !!
584      !! History :
585      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL
586      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
587      !!----------------------------------------------------------------------
588      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid
589      !!----------------------------------------------------------------------
590
591      ! The domain is split only horizontally along i- or/and j- direction
592      ! So we need at the most only 1D arrays with 2 elements.
593      ! Set idompar values equivalent to the jpdom_local_noextra definition
594      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
595      iglo(1) = jpiglo
596      iglo(2) = jpjglo
597      iloc(1) = nlci
598      iloc(2) = nlcj
599      iabsf(1) = nimppt(narea)
600      iabsf(2) = njmppt(narea)
601      iabsl(:) = iabsf(:) + iloc(:) - 1
602      ihals(1) = nldi - 1
603      ihals(2) = nldj - 1
604      ihale(1) = nlci - nlei
605      ihale(2) = nlcj - nlej
606      idid(1) = 1
607      idid(2) = 2
608
609      IF(lwp) THEN
610          WRITE(numout,*)
611          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
612          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
613          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
614          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
615      ENDIF
616      !
617      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
618      !
619   END SUBROUTINE mpp_init_ioipsl 
620
621#endif
622
623   !!======================================================================
624END MODULE mppini
Note: See TracBrowser for help on using the repository browser.