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

source: trunk/NEMO/OPA_SRC/mppini_2.h90 @ 680

Last change on this file since 680 was 680, checked in by rblod, 17 years ago

nemo_v2_bugfix_049 : SM : Patch to work when jpni*jpnj /= jpnij

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