source: trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90 @ 6412

Last change on this file since 6412 was 6412, checked in by lovato, 5 years ago

Revise domain decomposition with land PEs exclusion (see ticket #1704)

  • Property svn:keywords set to Id
File size: 17.7 KB
Line 
1MODULE mppini
2   !!==============================================================================
3   !!                       ***  MODULE mppini   ***
4   !! Ocean initialization : distributed memory computing initialization
5   !!==============================================================================
6
7   !!----------------------------------------------------------------------
8   !!   mpp_init       : Lay out the global domain over processors
9   !!   mpp_init2      : Lay out the global domain over processors
10   !!                    with land processor elimination
11   !!   mpp_init_ioispl: IOIPSL initialization in mpp
12   !!----------------------------------------------------------------------
13   USE dom_oce         ! ocean space and time domain
14   USE in_out_manager  ! I/O Manager
15   USE lib_mpp         ! distribued memory computing library
16   USE ioipsl
17
18   IMPLICIT NONE
19   PRIVATE
20
21   PUBLIC mpp_init       ! called by opa.F90
22   PUBLIC mpp_init2      ! called by opa.F90
23
24   !!----------------------------------------------------------------------
25   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
26   !! $Id$
27   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
28   !!----------------------------------------------------------------------
29CONTAINS
30
31#if ! defined key_mpp_mpi
32   !!----------------------------------------------------------------------
33   !!   Default option :                            shared memory computing
34   !!----------------------------------------------------------------------
35
36   SUBROUTINE mpp_init
37      !!----------------------------------------------------------------------
38      !!                  ***  ROUTINE mpp_init  ***
39      !!
40      !! ** Purpose :   Lay out the global domain over processors.
41      !!
42      !! ** Method  :   Shared memory computing, set the local processor
43      !!      variables to the value of the global domain
44      !!
45      !! History :
46      !!   9.0  !  04-01  (G. Madec, J.M. Molines)  F90 : free form, north fold jpni >1
47      !!----------------------------------------------------------------------
48
49      ! No mpp computation
50      nimpp  = 1
51      njmpp  = 1
52      nlci   = jpi
53      nlcj   = jpj
54      nldi   = 1
55      nldj   = 1
56      nlei   = jpi
57      nlej   = jpj
58      nperio = jperio
59      nbondi = 2
60      nbondj = 2
61      nidom  = FLIO_DOM_NONE
62      npolj = jperio
63
64      IF(lwp) THEN
65         WRITE(numout,*)
66         WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing'
67         WRITE(numout,*) '~~~~~~~~~~~: '
68         WRITE(numout,*) '         nperio = ', nperio
69         WRITE(numout,*) '         npolj  = ', npolj
70         WRITE(numout,*) '         nimpp  = ', nimpp
71         WRITE(numout,*) '         njmpp  = ', njmpp
72      ENDIF
73
74      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) &
75          CALL ctl_stop( 'equality  jpni = jpnj = jpnij = 1 is not satisfied',   &
76          &              'the domain is lay out for distributed memory computing! ' )
77
78   END SUBROUTINE mpp_init
79
80
81   SUBROUTINE mpp_init2 
82      CALL mpp_init                             ! same routine as mpp_init
83   END SUBROUTINE mpp_init2
84
85#else
86   !!----------------------------------------------------------------------
87   !!   'key_mpp_mpi'          OR         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      !!
96      !! ** Method  :   Global domain is distributed in smaller local domains.
97      !!      Periodic condition is a function of the local domain position
98      !!      (global boundary or neighbouring domain) and of the global
99      !!      periodic
100      !!      Type :         jperio global periodic condition
101      !!                     nperio local  periodic condition
102      !!
103      !! ** Action  : - set domain parameters
104      !!                    nimpp     : longitudinal index
105      !!                    njmpp     : latitudinal  index
106      !!                    nperio    : lateral condition type
107      !!                    narea     : number for local area
108      !!                    nlci      : first dimension
109      !!                    nlcj      : second dimension
110      !!                    nbondi    : mark for "east-west local boundary"
111      !!                    nbondj    : mark for "north-south local boundary"
112      !!                    nproc     : number for local processor
113      !!                    noea      : number for local neighboring processor
114      !!                    nowe      : number for local neighboring processor
115      !!                    noso      : number for local neighboring processor
116      !!                    nono      : number for local neighboring processor
117      !!
118      !! History :
119      !!        !  94-11  (M. Guyon)  Original code
120      !!        !  95-04  (J. Escobar, M. Imbard)
121      !!        !  98-02  (M. Guyon)  FETI method
122      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
123      !!   8.5  !  02-08  (G. Madec)  F90 : free form
124      !!   3.4  !  11-11  (C. Harris) decomposition changes for running with CICE
125      !!----------------------------------------------------------------------
126      INTEGER  ::   ji, jj, jn   ! dummy loop indices
127      INTEGER  ::   ii, ij, ifreq, il1, il2            ! local integers
128      INTEGER  ::   iresti, irestj, ijm1, imil, inum   !   -      -
129      REAL(wp) ::   zidom, zjdom                       ! local scalars
130      INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ijmppt, ilcit, ilcjt   ! local workspace
131      !!----------------------------------------------------------------------
132
133      IF(lwp) WRITE(numout,*)
134      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI'
135      IF(lwp) WRITE(numout,*) '~~~~~~~~'
136
137
138      !  1. Dimension arrays for subdomains
139      ! -----------------------------------
140      !  Computation of local domain sizes ilcit() ilcjt()
141      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
142      !  The subdomains are squares leeser than or equal to the global
143      !  dimensions divided by the number of processors minus the overlap
144      !  array (cf. par_oce.F90).
145     
146      nreci  = 2 * jpreci
147      nrecj  = 2 * jprecj
148      iresti = MOD( jpiglo - nreci , jpni )
149      irestj = MOD( jpjglo - nrecj , jpnj )
150
151      IF(  iresti == 0 )   iresti = jpni
152
153#if defined key_nemocice_decomp
154      ! In order to match CICE the size of domains in NEMO has to be changed
155      ! The last line of blocks (west) will have fewer points
156
157      DO jj = 1, jpnj
158         DO ji=1, jpni-1
159            ilcit(ji,jj) = jpi
160         END DO
161         ilcit(jpni,jj) = jpiglo - (jpni - 1) * (jpi - nreci)
162      END DO
163
164#else
165
166      DO jj = 1, jpnj
167         DO ji = 1, iresti
168            ilcit(ji,jj) = jpi
169         END DO
170         DO ji = iresti+1, jpni
171            ilcit(ji,jj) = jpi -1
172         END DO
173      END DO
174     
175#endif
176      nfilcit(:,:) = ilcit(:,:)
177      IF( irestj == 0 )   irestj = jpnj
178
179#if defined key_nemocice_decomp
180      ! Same change to domains in North-South direction as in East-West.
181      DO ji=1,jpni
182         DO jj=1,jpnj-1
183            ilcjt(ji,jj) = jpj
184         END DO
185         ilcjt(ji,jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj)
186      END DO
187
188#else
189
190      DO ji = 1, jpni
191         DO jj = 1, irestj
192            ilcjt(ji,jj) = jpj
193         END DO
194         DO jj = irestj+1, jpnj
195            ilcjt(ji,jj) = jpj -1
196         END DO
197      END DO
198     
199#endif
200
201      !  2. Index arrays for subdomains
202      ! -------------------------------
203     
204      iimppt(:,:) = 1
205      ijmppt(:,:) = 1
206     
207      IF( jpni > 1 ) THEN
208         DO jj = 1, jpnj
209            DO ji = 2, jpni
210               iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
211            END DO
212         END DO
213      ENDIF
214      nfiimpp(:,:)=iimppt(:,:)
215
216      IF( jpnj > 1 ) THEN
217         DO jj = 2, jpnj
218            DO ji = 1, jpni
219               ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
220            END DO
221         END DO
222      ENDIF
223     
224      ! 3. Subdomain description
225      ! ------------------------
226
227      DO jn = 1, jpnij
228         ii = 1 + MOD( jn-1, jpni )
229         ij = 1 + (jn-1) / jpni
230         nfipproc(ii,ij) = jn - 1
231         nimppt(jn) = iimppt(ii,ij)
232         njmppt(jn) = ijmppt(ii,ij)
233         nlcit (jn) = ilcit (ii,ij)     
234         nlci       = nlcit (jn)     
235         nlcjt (jn) = ilcjt (ii,ij)     
236         nlcj       = nlcjt (jn)
237         nbondj = -1                                   ! general case
238         IF( jn   >  jpni          )   nbondj = 0      ! first row of processor
239         IF( jn   >  (jpnj-1)*jpni )   nbondj = 1      ! last  row of processor
240         IF( jpnj == 1             )   nbondj = 2      ! one processor only in j-direction
241         ibonjt(jn) = nbondj
242         
243         nbondi = 0                                    !
244         IF( MOD( jn, jpni ) == 1 )   nbondi = -1      !
245         IF( MOD( jn, jpni ) == 0 )   nbondi =  1      !
246         IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction
247         ibonit(jn) = nbondi
248         
249         nldi =  1   + jpreci
250         nlei = nlci - jpreci
251         IF( nbondi == -1 .OR. nbondi == 2 )   nldi = 1
252         IF( nbondi ==  1 .OR. nbondi == 2 )   nlei = nlci
253         nldj =  1   + jprecj
254         nlej = nlcj - jprecj
255         IF( nbondj == -1 .OR. nbondj == 2 )   nldj = 1
256         IF( nbondj ==  1 .OR. nbondj == 2 )   nlej = nlcj
257         nldit(jn) = nldi
258         nleit(jn) = nlei
259         nldjt(jn) = nldj
260         nlejt(jn) = nlej
261      END DO
262
263      ! 4. Subdomain print
264      ! ------------------
265     
266      IF(lwp) WRITE(numout,*)
267      IF(lwp) WRITE(numout,*) ' mpp_init: defines mpp subdomains'
268      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
269      IF(lwp) WRITE(numout,*)
270      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
271      IF(lwp) WRITE(numout,*)
272      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
273      zidom = nreci
274      DO ji = 1, jpni
275         zidom = zidom + ilcit(ji,1) - nreci
276      END DO
277      IF(lwp) WRITE(numout,*)
278      IF(lwp) WRITE(numout,*)' sum ilcit(i,1)=', zidom, ' jpiglo=', jpiglo
279
280      zjdom = nrecj
281      DO jj = 1, jpnj
282         zjdom = zjdom + ilcjt(1,jj) - nrecj
283      END DO
284      IF(lwp) WRITE(numout,*)' sum ilcit(1,j)=', zjdom, ' jpjglo=', jpjglo
285      IF(lwp) WRITE(numout,*)
286
287      IF(lwp) THEN
288         ifreq = 4
289         il1   = 1
290         DO jn = 1, (jpni-1)/ifreq+1
291            il2 = MIN( jpni, il1+ifreq-1 )
292            WRITE(numout,*)
293            WRITE(numout,9200) ('***',ji = il1,il2-1)
294            DO jj = jpnj, 1, -1
295               WRITE(numout,9203) ('   ',ji = il1,il2-1)
296               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
297               WRITE(numout,9204) (nfipproc(ji,jj),ji=il1,il2)
298               WRITE(numout,9203) ('   ',ji = il1,il2-1)
299               WRITE(numout,9200) ('***',ji = il1,il2-1)
300            END DO
301            WRITE(numout,9201) (ji,ji = il1,il2)
302            il1 = il1+ifreq
303         END DO
304 9200     FORMAT('     ***',20('*************',a3))
305 9203     FORMAT('     *     ',20('         *   ',a3))
306 9201     FORMAT('        ',20('   ',i3,'          '))
307 9202     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
308 9204     FORMAT('     *  ',20('      ',i3,'   *   '))
309      ENDIF
310
311      ! 5. From global to local
312      ! -----------------------
313
314      nperio = 0
315      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
316
317
318      ! 6. Subdomain neighbours
319      ! ----------------------
320
321      nproc = narea - 1
322      noso  = nproc - jpni
323      nowe  = nproc - 1
324      noea  = nproc + 1
325      nono  = nproc + jpni
326      ! great neighbours
327      npnw = nono - 1
328      npne = nono + 1
329      npsw = noso - 1
330      npse = noso + 1
331      nbsw = 1
332      nbnw = 1
333      IF( MOD( nproc, jpni ) == 0 ) THEN
334         nbsw = 0
335         nbnw = 0
336      ENDIF
337      nbse = 1
338      nbne = 1
339      IF( MOD( nproc, jpni ) == jpni-1 ) THEN
340         nbse = 0
341         nbne = 0
342      ENDIF
343      IF(nproc < jpni) THEN
344         nbsw = 0
345         nbse = 0
346      ENDIF
347      IF( nproc >= (jpnj-1)*jpni ) THEN
348         nbnw = 0
349         nbne = 0
350      ENDIF
351      nlcj = nlcjt(narea) 
352      nlci = nlcit(narea) 
353      nldi = nldit(narea)
354      nlei = nleit(narea)
355      nldj = nldjt(narea)
356      nlej = nlejt(narea)
357      nbondi = ibonit(narea)
358      nbondj = ibonjt(narea)
359      nimpp  = nimppt(narea) 
360      njmpp  = njmppt(narea) 
361
362     ! Save processor layout in layout.dat file
363       IF (lwp) THEN
364        CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
365        WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
366        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
367        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
368
369        DO  jn = 1, jpnij
370         WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
371                                      nldit(jn), nldjt(jn), &
372                                      nleit(jn), nlejt(jn), &
373                                      nimppt(jn), njmppt(jn)
374        END DO
375        CLOSE(inum)   
376      END IF
377
378
379      ! w a r n i n g  narea (zone) /= nproc (processors)!
380
381      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
382         IF( jpni == 1 )THEN
383            nbondi = 2
384            nperio = 1
385         ELSE
386            nbondi = 0
387         ENDIF
388         IF( MOD( narea, jpni ) == 0 ) THEN
389            noea = nproc-(jpni-1)
390            npne = npne-jpni
391            npse = npse-jpni
392         ENDIF
393         IF( MOD( narea, jpni ) == 1 ) THEN
394            nowe = nproc+(jpni-1)
395            npnw = npnw+jpni
396            npsw = npsw+jpni
397         ENDIF
398         nbsw = 1
399         nbnw = 1
400         nbse = 1
401         nbne = 1
402         IF( nproc < jpni ) THEN
403            nbsw = 0
404            nbse = 0
405         ENDIF
406         IF( nproc >= (jpnj-1)*jpni ) THEN
407            nbnw = 0
408            nbne = 0
409         ENDIF
410      ENDIF
411      npolj = 0
412      IF( jperio == 3 .OR. jperio == 4 ) THEN
413         ijm1 = jpni*(jpnj-1)
414         imil = ijm1+(jpni+1)/2
415         IF( narea > ijm1 ) npolj = 3
416         IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
417         IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
418      ENDIF
419      IF( jperio == 5 .OR. jperio == 6 ) THEN
420          ijm1 = jpni*(jpnj-1)
421          imil = ijm1+(jpni+1)/2
422          IF( narea > ijm1) npolj = 5
423          IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
424          IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
425      ENDIF
426
427      ! Periodicity : no corner if nbondi = 2 and nperio != 1
428
429      IF(lwp) THEN
430         WRITE(numout,*) ' nproc  = ', nproc
431         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
432         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
433         WRITE(numout,*) ' nbondi = ', nbondi
434         WRITE(numout,*) ' nbondj = ', nbondj
435         WRITE(numout,*) ' npolj  = ', npolj
436         WRITE(numout,*) ' nperio = ', nperio
437         WRITE(numout,*) ' nlci   = ', nlci
438         WRITE(numout,*) ' nlcj   = ', nlcj
439         WRITE(numout,*) ' nimpp  = ', nimpp
440         WRITE(numout,*) ' njmpp  = ', njmpp
441         WRITE(numout,*) ' nreci  = ', nreci  , ' npse   = ', npse
442         WRITE(numout,*) ' nrecj  = ', nrecj  , ' npsw   = ', npsw
443         WRITE(numout,*) ' jpreci = ', jpreci , ' npne   = ', npne
444         WRITE(numout,*) ' jprecj = ', jprecj , ' npnw   = ', npnw
445         WRITE(numout,*)
446      ENDIF
447
448      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' )
449
450      ! Prepare mpp north fold
451
452      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
453         CALL mpp_ini_north
454         IF(lwp) WRITE(numout,*) ' mpp_init : North fold boundary prepared for jpni >1'
455      ENDIF
456
457      ! Prepare NetCDF output file (if necessary)
458      CALL mpp_init_ioipsl
459
460   END SUBROUTINE mpp_init
461
462#  include "mppini_2.h90"
463
464   SUBROUTINE mpp_init_ioipsl
465      !!----------------------------------------------------------------------
466      !!                  ***  ROUTINE mpp_init_ioipsl  ***
467      !!
468      !! ** Purpose :   
469      !!
470      !! ** Method  :   
471      !!
472      !! History :
473      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL
474      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
475      !!----------------------------------------------------------------------
476      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid
477      !!----------------------------------------------------------------------
478
479      ! The domain is split only horizontally along i- or/and j- direction
480      ! So we need at the most only 1D arrays with 2 elements.
481      ! Set idompar values equivalent to the jpdom_local_noextra definition
482      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
483      iglo(1) = jpiglo
484      iglo(2) = jpjglo
485      iloc(1) = nlci
486      iloc(2) = nlcj
487      iabsf(1) = nimppt(narea)
488      iabsf(2) = njmppt(narea)
489      iabsl(:) = iabsf(:) + iloc(:) - 1
490      ihals(1) = nldi - 1
491      ihals(2) = nldj - 1
492      ihale(1) = nlci - nlei
493      ihale(2) = nlcj - nlej
494      idid(1) = 1
495      idid(2) = 2
496
497      IF(lwp) THEN
498          WRITE(numout,*)
499          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
500          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
501          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
502          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
503      ENDIF
504      !
505      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
506      !
507   END SUBROUTINE mpp_init_ioipsl 
508
509#endif
510
511   !!======================================================================
512END MODULE mppini
Note: See TracBrowser for help on using the repository browser.