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 trunk/NEMO/OPA_SRC – NEMO

source: trunk/NEMO/OPA_SRC/mppini.F90 @ 1556

Last change on this file since 1556 was 1556, checked in by rblod, 15 years ago

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