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

Last change on this file since 3 was 3, checked in by opalod, 20 years ago

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