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

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

RB:nemo_v1_update_038: first integration of Agrif :

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