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 @ 352

Last change on this file since 352 was 352, checked in by opalod, 18 years ago

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