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

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

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