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_2.h90 in trunk/NEMO/OFF_SRC – NEMO

source: trunk/NEMO/OFF_SRC/mppini_2.h90 @ 1746

Last change on this file since 1746 was 1152, checked in by rblod, 16 years ago

Convert cvs header to svn Id, step II
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 20.3 KB
Line 
1   SUBROUTINE mpp_init2
2      !!----------------------------------------------------------------------
3      !!                  ***  ROUTINE mpp_init2  ***
4      !!
5      !! * Purpose :   Lay out the global domain over processors.
6      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
7      !!     FOR DEFINING BETTER CUTTING OUT.
8      !!       This routine is used with a the bathymetry file.
9      !!       In this version, the land processors are avoided and the adress
10      !!     processor (nproc, narea,noea, ...) are calculated again.
11      !!     The jpnij parameter can be lesser than jpni x jpnj
12      !!     and this jpnij parameter must be calculated before with an
13      !!     algoritmic preprocessing program.
14      !!
15      !! ** Method  :   Global domain is distributed in smaller local domains.
16      !!      Periodic condition is a function of the local domain position
17      !!      (global boundary or neighbouring domain) and of the global
18      !!      periodic
19      !!      Type :         jperio global periodic condition
20      !!                     nperio local  periodic condition
21      !!
22      !! ** Action :        nimpp     : longitudinal index
23      !!                    njmpp     : latitudinal  index
24      !!                    nperio    : lateral condition type
25      !!                    narea     : number for local area
26      !!                    nlci      : first dimension
27      !!                    nlcj      : second dimension
28      !!                    nproc     : number for local processor
29      !!                    noea      : number for local neighboring processor
30      !!                    nowe      : number for local neighboring processor
31      !!                    noso      : number for local neighboring processor
32      !!                    nono      : number for local neighboring processor
33      !!
34      !! History :
35      !!        !  94-11  (M. Guyon)  Original code
36      !!        !  95-04  (J. Escobar, M. Imbard)
37      !!        !  98-02  (M. Guyon)  FETI method
38      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
39      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
40      !!----------------------------------------------------------------------
41      !! * Modules used
42      USE iom
43   
44      !! Local variables
45      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
46      INTEGER ::  inum                        ! temporary logical unit
47      INTEGER ::   &
48         ii, ij, ifreq, il1, il2,          &  ! temporary integers
49         icont, ili, ilj,                  &  !    "          "
50         isurf, ijm1, imil,                &  !    "          "
51         iino, ijno, iiso, ijso,           &  !    "          "
52         iiea, ijea, iiwe, ijwe,           &  !    "          "
53         iinw, ijnw, iine, ijne,           &  !    "          "
54         iisw, ijsw, iise, ijse,           &  !    "          "
55         iresti, irestj, iproc                !    "          "
56      INTEGER, DIMENSION(jpnij) ::   &
57         iin, ijn         
58      INTEGER, DIMENSION(jpni,jpnj) ::   &
59         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace
60         ipproc, ibondj, ibondi, ipolj ,   &  !    "           "
61         ilei  , ilej  , ildi  , ildj  ,   &  !    "           "
62         ioea  , iowe  , ioso  , iono  ,   &  !    "           "
63         ione  , ionw  , iose  , iosw  ,   &  !    "           "
64         ibne  , ibnw  , ibse  , ibsw         !    "           "
65      INTEGER, DIMENSION(jpi,jpj) ::   &
66         imask                                ! temporary global workspace
67      REAL(wp), DIMENSION(jpi,jpj) ::   &
68         zdta                   ! temporary data workspace
69      REAL(wp) ::   zidom , zjdom          ! temporary scalars
70
71      !!----------------------------------------------------------------------
72      !!  OPA 9.0 , LOCEAN-IPSL (2005)
73      !! $Id$
74      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
75      !!----------------------------------------------------------------------
76
77#if defined key_mpp_shmem
78      IF(lwp)WRITE(numout,*)
79      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing PVM T3E + SHMEM'
80      IF(lwp)WRITE(numout,*) '~~~~~~~~'
81      IF(lwp)WRITE(numout,*) ' '
82
83      CALL mppshmem     ! Initialisation of shmem array
84
85#endif
86#if defined key_mpp_mpi
87      IF(lwp)WRITE(numout,*)
88      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
89      IF(lwp)WRITE(numout,*) '~~~~~~~~'
90      IF(lwp)WRITE(numout,*) ' '
91#endif
92
93      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
94
95      ! 0. initialisation
96      ! -----------------
97
98      ! open the file
99      IF ( ln_zps ) THEN
100         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
101         CALL iom_get ( inum, jpdom_data, 'Bathymetry' , zdta )
102      ELSE
103         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
104         CALL iom_get ( inum, jpdom_data, 'Bathy_level', zdta )
105      ENDIF
106      CALL iom_close (inum)
107
108      ! land/sea mask over the global/zoom domain
109
110      imask(:,:)=1
111      WHERE ( zdta(:,:) <= 0. ) imask = 0
112
113      !  1. Dimension arrays for subdomains
114      ! -----------------------------------
115
116      !  Computation of local domain sizes ilci() ilcj()
117      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
118      !  The subdomains are squares leeser than or equal to the global
119      !  dimensions divided by the number of processors minus the overlap
120      !  array.
121
122      nreci=2*jpreci
123      nrecj=2*jprecj
124      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
125      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
126
127      ilci(1:iresti      ,:) = jpi
128      ilci(iresti+1:jpni ,:) = jpi-1
129
130      ilcj(:,      1:irestj) = jpj
131      ilcj(:, irestj+1:jpnj) = jpj-1
132
133      IF(lwp) WRITE(numout,*)
134      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
135      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
136      IF(lwp) WRITE(numout,*)
137      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
138      IF(lwp) WRITE(numout,*)
139      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
140
141      zidom = nreci + sum(ilci(:,1) - nreci )
142      IF(lwp) WRITE(numout,*)
143      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
144
145      zjdom = nrecj + sum(ilcj(1,:) - nrecj )
146      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
147      IF(lwp) WRITE(numout,*)
148
149
150      !  2. Index arrays for subdomains
151      ! -------------------------------
152
153      iimppt(:,:) = 1
154      ijmppt(:,:) = 1
155      ipproc(:,:) = -1
156
157      IF( jpni > 1 )THEN
158         DO jj = 1, jpnj
159            DO ji = 2, jpni
160               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
161            END DO
162         END DO
163      ENDIF
164
165      IF( jpnj > 1 )THEN
166         DO jj = 2, jpnj
167            DO ji = 1, jpni
168               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
169            END DO
170         END DO
171      ENDIF
172
173
174      ! 3. Subdomain description in the Regular Case
175      ! --------------------------------------------
176
177      nperio = 0
178      icont = -1
179      DO jarea = 1, jpni*jpnj
180         ii = 1 + MOD(jarea-1,jpni)
181         ij = 1 +    (jarea-1)/jpni
182         ili = ilci(ii,ij)
183         ilj = ilcj(ii,ij)
184
185         ibondj(ii,ij) = -1
186         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
187         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
188         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
189
190         ibondi(ii,ij) = 0
191         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
192         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
193         IF( jpni            == 1 )   ibondi(ii,ij) =  2
194
195         ! 2.4 Subdomain neighbors
196
197         iproc = jarea - 1
198         ioso(ii,ij) = iproc - jpni
199         iowe(ii,ij) = iproc - 1
200         ioea(ii,ij) = iproc + 1
201         iono(ii,ij) = iproc + jpni
202         ildi(ii,ij) = 1 + jpreci
203         ilei(ii,ij) = ili -jpreci
204         ionw(ii,ij) = iono(ii,ij) - 1
205         ione(ii,ij) = iono(ii,ij) + 1
206         iosw(ii,ij) = ioso(ii,ij) - 1
207         iose(ii,ij) = ioso(ii,ij) + 1
208         ibsw(ii,ij) = 1
209         ibnw(ii,ij) = 1
210         IF( MOD(iproc,jpni) == 0 ) THEN
211            ibsw(ii,ij) = 0
212            ibnw(ii,ij) = 0
213         ENDIF
214         ibse(ii,ij) = 1
215         ibne(ii,ij) = 1
216         IF( MOD(iproc,jpni) == jpni-1 ) THEN
217            ibse(ii,ij) = 0
218            ibne(ii,ij) = 0
219         ENDIF
220         IF( iproc < jpni ) THEN
221            ibsw(ii,ij) = 0
222            ibse(ii,ij) = 0
223         ENDIF
224         IF( iproc >= (jpnj-1)*jpni ) THEN
225            ibnw(ii,ij) = 0
226            ibne(ii,ij) = 0
227         ENDIF
228         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
229         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
230         ildj(ii,ij) =  1  + jprecj
231         ilej(ii,ij) = ilj - jprecj
232         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
233         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
234
235         ! warning ii*ij (zone) /= nproc (processors)!
236
237         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
238            IF( jpni == 1 )THEN
239               ibondi(ii,ij) = 2
240               nperio = 1
241            ELSE
242               ibondi(ii,ij) = 0
243            ENDIF
244            IF( MOD(jarea,jpni) == 0 ) THEN
245               ioea(ii,ij) = iproc - (jpni-1)
246               ione(ii,ij) = ione(ii,ij) - jpni
247               iose(ii,ij) = iose(ii,ij) - jpni
248            ENDIF
249            IF( MOD(jarea,jpni) == 1 ) THEN
250               iowe(ii,ij) = iproc + jpni - 1
251               ionw(ii,ij) = ionw(ii,ij) + jpni
252               iosw(ii,ij) = iosw(ii,ij) + jpni
253            ENDIF
254            ibsw(ii,ij) = 1
255            ibnw(ii,ij) = 1
256            ibse(ii,ij) = 1
257            ibne(ii,ij) = 1
258            IF( iproc < jpni ) THEN
259               ibsw(ii,ij) = 0
260               ibse(ii,ij) = 0
261            ENDIF
262            IF( iproc >= (jpnj-1)*jpni ) THEN
263               ibnw(ii,ij) = 0
264               ibne(ii,ij) = 0
265            ENDIF
266         ENDIF
267         ipolj(ii,ij) = 0
268         IF( jperio == 3 .OR. jperio == 4 ) THEN
269            ijm1 = jpni*(jpnj-1)
270            imil = ijm1+(jpni+1)/2
271            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
272            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
273            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1
274         ENDIF
275         IF( jperio == 5 .OR. jperio == 6 ) THEN
276            ijm1 = jpni*(jpnj-1)
277            imil = ijm1+(jpni+1)/2
278            IF( jarea > ijm1) ipolj(ii,ij) = 5
279            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
280            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1
281         ENDIF
282
283         isurf = 0
284         DO jj = 1+jprecj, ilj-jprecj
285            DO  ji = 1+jpreci, ili-jpreci
286               IF( imask(ji, jj) == 1) isurf = isurf+1
287            END DO
288         END DO
289         IF(isurf /= 0) THEN
290            icont = icont + 1
291            ipproc(ii,ij) = icont
292            iin(icont+1) = ii
293            ijn(icont+1) = ij
294         ENDIF
295      END DO
296
297      ! Control
298      IF(icont+1 /= jpnij) THEN
299         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
300         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'
301         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
302         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
303      ENDIF
304
305      ! 4. Subdomain print
306      ! ------------------
307
308      IF(lwp) THEN
309         ifreq = 4
310         il1 = 1
311         DO jn = 1,(jpni-1)/ifreq+1
312            il2 = MIN(jpni,il1+ifreq-1)
313            WRITE(numout,*)
314            WRITE(numout,9401) (ji,ji=il1,il2)
315            WRITE(numout,9400) ('***',ji=il1,il2-1)
316            DO jj = 1, jpnj
317               ! WRITE(numout,9400)
318               WRITE(numout,9403) ('   ',ji=il1,il2-1)
319               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
320               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
321               WRITE(numout,9403) ('   ',ji=il1,il2-1)
322               WRITE(numout,9400) ('***',ji=il1,il2-1)
323               ! WRITE(numout,9400)
324            END DO
325            il1 = il1+ifreq
326         END DO
327 9400     FORMAT('     ***',20('*************',a3))
328 9403     FORMAT('     *     ',20('         *   ',a3))
329 9401     FORMAT('        ',20('   ',i3,'          '))
330 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
331 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
332      ENDIF
333
334
335      ! 5. neighbour treatment
336      ! ----------------------
337
338      DO jarea = 1, jpni*jpnj
339         iproc = jarea-1
340         ii = 1 + MOD(jarea-1,jpni)
341         ij = 1 +    (jarea-1)/jpni
342         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
343            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
344            iino = 1 + MOD(iono(ii,ij),jpni)
345            ijno = 1 +    (iono(ii,ij))/jpni
346            IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2
347            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1
348         ENDIF
349         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
350            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
351            iiso = 1 + MOD(ioso(ii,ij),jpni)
352            ijso = 1 +    (ioso(ii,ij))/jpni
353            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
354            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
355         ENDIF
356         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
357            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
358            iiea = 1 + MOD(ioea(ii,ij),jpni)
359            ijea = 1 +    (ioea(ii,ij))/jpni
360            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
361            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
362         ENDIF
363         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
364            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
365            iiwe = 1 + MOD(iowe(ii,ij),jpni)
366            ijwe = 1 +    (iowe(ii,ij))/jpni
367            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
368            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
369         ENDIF
370         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
371            iine = 1 + MOD(ione(ii,ij),jpni)
372            ijne = 1 +    (ione(ii,ij))/jpni
373            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
374         ENDIF
375         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
376            iisw = 1 + MOD(iosw(ii,ij),jpni)
377            ijsw = 1 +    (iosw(ii,ij))/jpni
378            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
379         ENDIF
380         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
381            iinw = 1 + MOD(ionw(ii,ij),jpni)
382            ijnw = 1 +    (ionw(ii,ij))/jpni
383            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
384         ENDIF
385         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
386            iise = 1 + MOD(iose(ii,ij),jpni)
387            ijse = 1 +    (iose(ii,ij))/jpni
388            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
389         ENDIF
390      END DO
391
392
393      ! 6. Change processor name
394      ! ------------------------
395
396      nproc = narea-1
397      ii = iin(narea)
398      ij = ijn(narea)
399      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN
400         iiso = 1 + MOD(ioso(ii,ij),jpni)
401         ijso = 1 +    (ioso(ii,ij))/jpni
402         noso = ipproc(iiso,ijso)
403      ENDIF
404      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN
405         iiwe = 1 + MOD(iowe(ii,ij),jpni)
406         ijwe = 1 +    (iowe(ii,ij))/jpni
407         nowe = ipproc(iiwe,ijwe)
408      ENDIF
409      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN
410         iiea = 1 + MOD(ioea(ii,ij),jpni)
411         ijea = 1 +    (ioea(ii,ij))/jpni
412         noea = ipproc(iiea,ijea)
413      ENDIF
414      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN
415         iino = 1 + MOD(iono(ii,ij),jpni)
416         ijno = 1 +    (iono(ii,ij))/jpni
417         nono = ipproc(iino,ijno)
418      ENDIF
419      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN
420         iise = 1 + MOD(iose(ii,ij),jpni)
421         ijse = 1 +    (iose(ii,ij))/jpni
422         npse = ipproc(iise,ijse)
423      ENDIF
424      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN
425         iisw = 1 + MOD(iosw(ii,ij),jpni)
426         ijsw = 1 +    (iosw(ii,ij))/jpni
427         npsw = ipproc(iisw,ijsw)
428      ENDIF
429      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN
430         iine = 1 + MOD(ione(ii,ij),jpni)
431         ijne = 1 +    (ione(ii,ij))/jpni
432         npne = ipproc(iine,ijne)
433      ENDIF
434      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN
435         iinw = 1 + MOD(ionw(ii,ij),jpni)
436         ijnw = 1 +    (ionw(ii,ij))/jpni
437         npnw = ipproc(iinw,ijnw)
438      ENDIF
439      nbnw = ibnw(ii,ij)
440      nbne = ibne(ii,ij)
441      nbsw = ibsw(ii,ij)
442      nbse = ibse(ii,ij)
443      nlcj = ilcj(ii,ij) 
444      nlci = ilci(ii,ij) 
445      nldi = ildi(ii,ij)
446      nlei = ilei(ii,ij)
447      nldj = ildj(ii,ij)
448      nlej = ilej(ii,ij)
449      nbondi = ibondi(ii,ij)
450      nbondj = ibondj(ii,ij)
451      nimpp = iimppt(ii,ij) 
452      njmpp = ijmppt(ii,ij) 
453      DO jproc = 1, jpnij
454         ii = iin(jproc)
455         ij = ijn(jproc)
456         nimppt(jproc) = iimppt(ii,ij) 
457         njmppt(jproc) = ijmppt(ii,ij) 
458         nlcjt(jproc) = ilcj(ii,ij)
459         nlcit(jproc) = ilci(ii,ij)
460         nldit(jproc) = ildi(ii,ij)
461         nleit(jproc) = ilei(ii,ij)
462         nldjt(jproc) = ildj(ii,ij)
463         nlejt(jproc) = ilej(ii,ij)
464      END DO
465
466      ! Save processor layout in ascii file
467      IF (lwp) THEN
468         CALL ctlopn( inum, 'layout.dat', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   &
469            &         1, numout, .FALSE., 1 )
470         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
471         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
472
473        DO  jproc = 1, jpnij
474         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
475                                      nldit(jproc), nldjt(jproc), &
476                                      nleit(jproc), nlejt(jproc), &
477                                      nimppt(jproc), njmppt(jproc)
478        END DO
479        CLOSE(inum)   
480      END IF
481
482
483      ! FETI method
484
485      IF( nperio == 1 .AND. nsolv == 3 ) THEN
486
487         ! general CASE : Earth == infinite tube
488
489         nbnw = 1
490         npnw = narea
491         nbne = 1
492         npne = narea
493         nbsw = 1
494         npsw = (narea-2)
495         nbse = 1
496         npse = (narea-2)
497
498         ! REAL boundary condition
499
500         IF( nbondj == -1 .OR. nbondj == 2 ) THEN
501            nbsw = 0
502            nbse = 0
503         ENDIF
504
505         IF( nbondj == -1 .OR. nbondj == 2 ) THEN
506            nbsw = 0
507            nbse = 0
508         ENDIF
509
510         IF( nbondj ==  1 .OR. nbondj == 2 ) THEN
511            nbnw = 0
512            nbne = 0
513         ENDIF
514      ENDIF
515
516      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' )
517
518      ! Prepare mpp north fold
519
520      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
521         CALL mpp_ini_north
522         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
523      ENDIF
524
525      ! Defined npolj, either 0, 3 , 4 , 5 , 6
526      ! In this case the important thing is that npolj /= 0
527      ! Because if we go through these line it is because jpni >1 and thus
528      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
529
530      npolj = 0
531      ij = ijn(narea)
532
533      IF( jperio == 3 .OR. jperio == 4 ) THEN
534         IF( ij == jpnj ) npolj = 3
535      ENDIF
536
537      IF( jperio == 5 .OR. jperio == 6 ) THEN
538         IF( ij == jpnj ) npolj = 5
539      ENDIF
540
541      ! Prepare NetCDF output file (if necessary)
542      CALL mpp_init_ioipsl
543
544      ! Periodicity : no corner if nbondi = 2 and nperio != 1
545
546      IF(lwp) THEN
547         WRITE(numout,*) ' nproc=  ',nproc
548         WRITE(numout,*) ' nowe=   ',nowe
549         WRITE(numout,*) ' noea=   ',noea
550         WRITE(numout,*) ' nono=   ',nono
551         WRITE(numout,*) ' noso=   ',noso
552         WRITE(numout,*) ' nbondi= ',nbondi
553         WRITE(numout,*) ' nbondj= ',nbondj
554         WRITE(numout,*) ' npolj=  ',npolj
555         WRITE(numout,*) ' nperio= ',nperio
556         WRITE(numout,*) ' nlci=   ',nlci
557         WRITE(numout,*) ' nlcj=   ',nlcj
558         WRITE(numout,*) ' nimpp=  ',nimpp
559         WRITE(numout,*) ' njmpp=  ',njmpp
560         WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse
561         WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw
562         WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne
563         WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw
564      ENDIF
565
566   END SUBROUTINE mpp_init2
Note: See TracBrowser for help on using the repository browser.