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

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90 @ 3432

Last change on this file since 3432 was 3432, checked in by trackstand2, 12 years ago

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