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/OFF_SRC – NEMO

source: trunk/NEMO/OFF_SRC/mppini.F90 @ 344

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

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 18.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
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 , LOCEAN-IPSL (2005)
29   !! $Header$
30   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
31   !!----------------------------------------------------------------------
32
33CONTAINS
34
35#if ! defined key_mpp_mpi   &&   ! defined key_mpp_shmem
36   !!----------------------------------------------------------------------
37   !!   Default option :                            shared memory computing
38   !!----------------------------------------------------------------------
39
40   SUBROUTINE mpp_init
41      !!----------------------------------------------------------------------
42      !!                  ***  ROUTINE mpp_init  ***
43      !!
44      !! ** Purpose :   Lay out the global domain over processors.
45      !!
46      !! ** Method  :   Shared memory computing, set the local processor
47      !!      variables to the value of the global domain
48      !!
49      !! History :
50      !!   9.0  !  04-01  (G. Madec, J.M. Molines)  F90 : free form, north fold jpni >1
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,*) '         npolj  = ', npolj
71         WRITE(numout,*) '         nimpp  = ', nimpp
72         WRITE(numout,*) '         njmpp  = ', njmpp
73      ENDIF
74
75      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) THEN
76          IF(lwp)WRITE(numout,cform_err)
77          IF(lwp)WRITE(numout,*) 'equality  jpni = jpnj = jpnij = 1 is not satisfied'
78          IF(lwp)WRITE(numout,*) 'the domain is lay out for distributed memory computing! '
79          nstop = nstop + 1
80      ENDIF
81
82   END SUBROUTINE mpp_init
83
84
85   SUBROUTINE mpp_init2 
86      CALL mpp_init                             ! same routine as mpp_init
87   END SUBROUTINE mpp_init2
88
89#else
90   !!----------------------------------------------------------------------
91   !!   'key_mpp_mpi'          OR         MPI massively parallel processing
92   !!   'key_mpp_shmem'                 SHMEM 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      INTEGER ::   ji, jj, jn               ! dummy loop indices
132      INTEGER ::   &
133         ii, ij, ifreq, il1, il2,        &  ! temporary integers
134         iresti, irestj, ijm1, imil,     &  !    "          "
135         inum                               ! temporary logical unit
136
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_shmem
143      IF(lwp) WRITE(numout,*)
144      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing PVM T3E + SHMEM'
145      IF(lwp) WRITE(numout,*) '~~~~~~~~'
146
147      CALL mppshmem                           ! Initialisation of shmem array
148
149#endif
150#if defined key_mpp_mpi
151      IF(lwp) WRITE(numout,*)
152      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI'
153      IF(lwp) WRITE(numout,*) '~~~~~~~~'
154#endif
155
156
157      !  1. Dimension arrays for subdomains
158      ! -----------------------------------
159      !  Computation of local domain sizes ilcit() ilcjt()
160      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
161      !  The subdomains are squares leeser than or equal to the global
162      !  dimensions divided by the number of processors minus the overlap
163      !  array (cf. par_oce.F90).
164     
165      nreci  = 2 * jpreci
166      nrecj  = 2 * jprecj
167      iresti = MOD( jpiglo - nreci , jpni )
168      irestj = MOD( jpjglo - nrecj , jpnj )
169
170      IF(  iresti == 0 )   iresti = jpni
171      DO jj = 1, jpnj
172         DO ji = 1, iresti
173            ilcit(ji,jj) = jpi
174         END DO
175         DO ji = iresti+1, jpni
176            ilcit(ji,jj) = jpi -1
177         END DO
178      END DO
179     
180      IF( irestj == 0 )   irestj = jpnj
181      DO ji = 1, jpni
182         DO jj = 1, irestj
183            ilcjt(ji,jj) = jpj
184         END DO
185         DO jj = irestj+1, jpnj
186            ilcjt(ji,jj) = jpj -1
187         END DO
188      END DO
189     
190      IF(lwp) THEN
191         WRITE(numout,*)
192         WRITE(numout,*) '           defines mpp subdomains'
193         WRITE(numout,*) '           ----------------------'
194         WRITE(numout,*) '              iresti=',iresti,' irestj=',irestj
195         WRITE(numout,*) '              jpni=',jpni,' jpnj=',jpnj
196         ifreq = 4
197         il1   = 1
198         DO jn = 1, (jpni-1)/ifreq+1
199            il2 = MIN( jpni, il1+ifreq-1 )
200            WRITE(numout,*)
201            WRITE(numout,9201) (ji,ji = il1,il2)
202            WRITE(numout,9200) ('***',ji = il1,il2-1)
203            DO jj = 1, jpnj
204               WRITE(numout,9203) ('   ',ji = il1,il2-1)
205               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
206               WRITE(numout,9203) ('   ',ji = il1,il2-1)
207               WRITE(numout,9200) ('***',ji = il1,il2-1)
208            END DO
209            il1 = il1+ifreq
210         END DO
211 9200    FORMAT('     ***',20('*************',a3))
212 9203    FORMAT('     *     ',20('         *   ',a3))
213 9201    FORMAT('        ',20('   ',i3,'          '))
214 9202    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
215      ENDIF
216
217      zidom = nreci
218      DO ji = 1, jpni
219         zidom = zidom + ilcit(ji,1) - nreci
220      END DO
221      IF(lwp) WRITE(numout,*)
222      IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo
223     
224      zjdom = nrecj
225      DO jj = 1, jpnj
226         zjdom = zjdom + ilcjt(1,jj) - nrecj
227      END DO
228      IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo
229      IF(lwp) WRITE(numout,*)
230     
231
232      !  2. Index arrays for subdomains
233      ! -------------------------------
234     
235      iimppt(:,:) = 1
236      ijmppt(:,:) = 1
237     
238      IF( jpni > 1 ) THEN
239         DO jj = 1, jpnj
240            DO ji = 2, jpni
241               iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
242            END DO
243         END DO
244      ENDIF
245
246      IF( jpnj > 1 ) THEN
247         DO jj = 2, jpnj
248            DO ji = 1, jpni
249               ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
250            END DO
251         END DO
252      ENDIF
253     
254      ! 3. Subdomain description
255      ! ------------------------
256
257      DO jn = 1, jpnij
258         ii = 1 + MOD( jn-1, jpni )
259         ij = 1 + (jn-1) / jpni
260         nimppt(jn) = iimppt(ii,ij)
261         njmppt(jn) = ijmppt(ii,ij)
262         nlcit (jn) = ilcit (ii,ij)     
263         nlci       = nlcit (jn)     
264         nlcjt (jn) = ilcjt (ii,ij)     
265         nlcj       = nlcjt (jn)
266         nbondj = -1                                   ! general case
267         IF( jn   >  jpni          )   nbondj = 0      ! first row of processor
268         IF( jn   >  (jpnj-1)*jpni )   nbondj = 1      ! last  row of processor
269         IF( jpnj == 1             )   nbondj = 2      ! one processor only in j-direction
270         ibonjt(jn) = nbondj
271         
272         nbondi = 0                                    !
273         IF( MOD( jn, jpni ) == 1 )   nbondi = -1      !
274         IF( MOD( jn, jpni ) == 0 )   nbondi =  1      !
275         IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction
276         ibonit(jn) = nbondi
277         
278         nldi =  1   + jpreci
279         nlei = nlci - jpreci
280         IF( nbondi == -1 .OR. nbondi == 2 )   nldi = 1
281         IF( nbondi ==  1 .OR. nbondi == 2 )   nlei = nlci
282         nldj =  1   + jprecj
283         nlej = nlcj - jprecj
284         IF( nbondj == -1 .OR. nbondj == 2 )   nldj = 1
285         IF( nbondj ==  1 .OR. nbondj == 2 )   nlej = nlcj
286         nldit(jn) = nldi
287         nleit(jn) = nlei
288         nldjt(jn) = nldj
289         nlejt(jn) = nlej
290      END DO
291     
292
293      ! 4. From global to local
294      ! -----------------------
295
296      nperio = 0
297      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
298
299
300      ! 5. Subdomain neighbours
301      ! ----------------------
302
303      nproc = narea - 1
304      noso  = nproc - jpni
305      nowe  = nproc - 1
306      noea  = nproc + 1
307      nono  = nproc + jpni
308      ! great neighbours
309      npnw = nono - 1
310      npne = nono + 1
311      npsw = noso - 1
312      npse = noso + 1
313      nbsw = 1
314      nbnw = 1
315      IF( MOD( nproc, jpni ) == 0 ) THEN
316         nbsw = 0
317         nbnw = 0
318      ENDIF
319      nbse = 1
320      nbne = 1
321      IF( MOD( nproc, jpni ) == jpni-1 ) THEN
322         nbse = 0
323         nbne = 0
324      ENDIF
325      IF(nproc < jpni) THEN
326         nbsw = 0
327         nbse = 0
328      ENDIF
329      IF( nproc >= (jpnj-1)*jpni ) THEN
330         nbnw = 0
331         nbne = 0
332      ENDIF
333      nlcj = nlcjt(narea) 
334      nlci = nlcit(narea) 
335      nldi = nldit(narea)
336      nlei = nleit(narea)
337      nldj = nldjt(narea)
338      nlej = nlejt(narea)
339      nbondi = ibonit(narea)
340      nbondj = ibonjt(narea)
341      nimpp  = nimppt(narea) 
342      njmpp  = njmppt(narea) 
343
344     ! Save processor layout in layout.dat file
345       IF (lwp) THEN
346        inum = 11   
347
348        OPEN(inum,FILE='layout.dat')
349        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
350        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
351
352        DO  jn = 1, jpnij
353         WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
354                                      nldit(jn), nldjt(jn), &
355                                      nleit(jn), nlejt(jn), &
356                                      nimppt(jn), njmppt(jn)
357        END DO
358        CLOSE(inum)   
359      END IF
360
361
362      ! w a r n i n g  narea (zone) /= nproc (processors)!
363
364      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
365         IF( jpni == 1 )THEN
366            nbondi = 2
367            nperio = 1
368         ELSE
369            nbondi = 0
370         ENDIF
371         IF( MOD( narea, jpni ) == 0 ) THEN
372            noea = nproc-(jpni-1)
373            npne = npne-jpni
374            npse = npse-jpni
375         ENDIF
376         IF( MOD( narea, jpni ) == 1 ) THEN
377            nowe = nproc+(jpni-1)
378            npnw = npnw+jpni
379            npsw = npsw+jpni
380         ENDIF
381         nbsw = 1
382         nbnw = 1
383         nbse = 1
384         nbne = 1
385         IF( nproc < jpni ) THEN
386            nbsw = 0
387            nbse = 0
388         ENDIF
389         IF( nproc >= (jpnj-1)*jpni ) THEN
390            nbnw = 0
391            nbne = 0
392         ENDIF
393      ENDIF
394      npolj = 0
395      IF( jperio == 3 .OR. jperio == 4 ) THEN
396         ijm1 = jpni*(jpnj-1)
397         imil = ijm1+(jpni+1)/2
398         IF( narea > ijm1 ) npolj = 3
399         IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
400         IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
401      ENDIF
402      IF( jperio == 5 .OR. jperio == 6 ) THEN
403          ijm1 = jpni*(jpnj-1)
404          imil = ijm1+(jpni+1)/2
405          IF( narea > ijm1) npolj = 5
406          IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
407          IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
408      ENDIF
409
410      ! FETI method
411
412      IF( nperio == 1 .AND. nsolv == 3 ) THEN 
413         
414         ! general case : Earth == infinite tube
415         
416         nbnw = 1
417         npnw = narea
418         nbne = 1
419         npne = narea
420         nbsw = 1
421         npsw = (narea-2)
422         nbse = 1
423         npse = (narea-2)
424         
425         ! REAL boundary condition
426         
427         IF( nbondj == -1 .OR. nbondj == 2 ) THEN
428            nbsw = 0
429            nbse = 0
430         ENDIF
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            nbnw = 0
439            nbne = 0
440         ENDIF
441      ENDIF
442
443      ! Periodicity : no corner if nbondi = 2 and nperio != 1
444
445      IF(lwp) THEN
446         WRITE(numout,*) ' nproc  = ', nproc
447         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
448         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
449         WRITE(numout,*) ' nbondi = ', nbondi
450         WRITE(numout,*) ' nbondj = ', nbondj
451         WRITE(numout,*) ' npolj  = ', npolj
452         WRITE(numout,*) ' nperio = ', nperio
453         WRITE(numout,*) ' nlci   = ', nlci
454         WRITE(numout,*) ' nlcj   = ', nlcj
455         WRITE(numout,*) ' nimpp  = ', nimpp
456         WRITE(numout,*) ' njmpp  = ', njmpp
457         WRITE(numout,*) ' nbse   = ', nbse  , ' npse   = ', npse
458         WRITE(numout,*) ' nbsw   = ', nbsw  , ' npsw   = ', npsw
459         WRITE(numout,*) ' nbne   = ', nbne  , ' npne   = ', npne
460         WRITE(numout,*) ' nbnw   = ', nbnw  , ' npnw   = ', npnw
461      ENDIF
462
463      IF( nperio == 1 .AND. jpni /= 1 )THEN
464         IF(lwp) WRITE(numout,cform_err)
465         IF(lwp) WRITE(numout,*) ' mpp_init: error on cyclicity'
466         nstop = nstop + 1
467      ENDIF
468
469      ! Prepare mpp north fold
470
471      IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
472         CALL mpp_ini_north
473      END IF
474
475      ! Prepare NetCDF output file (if necessary)
476      CALL mpp_init_ioipsl
477
478   END SUBROUTINE mpp_init
479
480#  include "mppini_2.h90"
481
482# if defined key_dimgout
483   !!----------------------------------------------------------------------
484   !!   'key_dimgout'                  NO use of NetCDF files
485   !!----------------------------------------------------------------------
486   SUBROUTINE mpp_init_ioipsl       ! Dummy routine
487   END SUBROUTINE mpp_init_ioipsl 
488# else
489   SUBROUTINE mpp_init_ioipsl
490      !!----------------------------------------------------------------------
491      !!                  ***  ROUTINE mpp_init_ioipsl  ***
492      !!
493      !! ** Purpose :   
494      !!
495      !! ** Method  :   
496      !!
497      !! History :
498      !!   9.0  !  04-03  (G. Madec)  MPP-IOIPSL
499      !!----------------------------------------------------------------------
500      USE ioipsl
501      INTEGER, DIMENSION(4) ::   &
502         iglo, iloc, iabsf, iabsl, ihals, ihale   ! ???
503      !!----------------------------------------------------------------------
504      iglo(1) = jpiglo
505      iglo(2) = jpjglo
506      iglo(3) = jpk
507      iglo(4) = 1
508      iloc(1) = nlci
509      iloc(2) = nlcj
510      iloc(3) = jpk
511      iloc(4) = 1
512      iabsf(1) = nimppt(narea)
513      iabsf(2) = njmppt(narea)
514      iabsf(3) = 1
515      iabsf(4) = 1
516      iabsl(:) = iabsf(:) + iloc(:) - 1
517      ihals(1) = jpreci
518      ihals(2) = jprecj
519      ihals(3) = 0
520      ihals(4) = 0
521      ihale(1) = jpreci
522      ihale(2) = jprecj
523      ihale(3) = 0
524      ihale(4) = 0
525      IF( nbondi == -1 .OR. nbondi == 2 )   ihals(1) = 0
526      IF( nbondi ==  1 .OR. nbondi == 2 )   ihale(1) = 0
527      IF( nbondj == -1 .OR. nbondj == 2 )   ihals(2) = 0
528      IF( nbondj ==  1 .OR. nbondj == 2 )   ihale(2) = 0
529      IF(lwp) THEN
530          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2), iloc (3), iloc (4)
531          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2), iabsf(3), iabsf(4)
532          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2), ihals(3), ihals(4)
533          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2), ihale(3), ihale(4)
534      ENDIF
535
536      CALL ioipsl_inimpp( jpnij, nproc, iglo, iloc, iabsf, iabsl, ihals, ihale )
537
538   END SUBROUTINE mpp_init_ioipsl 
539
540# endif
541#endif
542
543   !!======================================================================
544END MODULE mppini
Note: See TracBrowser for help on using the repository browser.