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.
Changeset 8219 – NEMO

Changeset 8219


Ignore:
Timestamp:
2017-06-26T16:29:53+02:00 (7 years ago)
Author:
lovato
Message:

trunk : implementation of unified mppini routines - 2017WP (#1916)

Location:
branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM
Files:
1 deleted
7 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r7761 r8219  
    6666 
    6767   !!---------------------------------------------------------------------- 
    68    !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
     68   !! NEMO/OPA 3.7 , NEMO Consortium (2016) 
    6969   !! $Id$ 
    7070   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    286286 
    287287      !                                      ! Domain decomposition 
    288       IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out 
    289       ELSE                            ;   CALL mpp_init2     ! eliminate land processors 
    290       ENDIF 
     288      CALL mpp_init 
    291289      ! 
    292290      IF( nn_timing == 1 )  CALL timing_init 
  • branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r7914 r8219  
    9090   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in 
    9191   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions 
    92    INTEGER, PUBLIC ::   npne, npnw        !: index of north east and north west processor 
    93    INTEGER, PUBLIC ::   npse, npsw        !: index of south east and south west processor 
    94    INTEGER, PUBLIC ::   nbne, nbnw        !: logical of north east & north west processor 
    95    INTEGER, PUBLIC ::   nbse, nbsw        !: logical of south east & south west processor 
    9692   INTEGER, PUBLIC ::   nidom             !: ??? 
    9793 
  • branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r7646 r8219  
    66 
    77   !!---------------------------------------------------------------------- 
    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 
     8   !!   mpp_init       : Lay out the global domain over processors  
     9   !!                    with/without land processor elimination 
    1110   !!   mpp_init_ioispl: IOIPSL initialization in mpp 
    1211   !!---------------------------------------------------------------------- 
     
    1514   USE lib_mpp         ! distribued memory computing library 
    1615   USE ioipsl 
     16   USE iom 
    1717 
    1818   IMPLICIT NONE 
     
    2020 
    2121   PUBLIC mpp_init       ! called by opa.F90 
    22    PUBLIC mpp_init2      ! called by opa.F90 
    23  
    24    !!---------------------------------------------------------------------- 
    25    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     22 
     23   !!---------------------------------------------------------------------- 
     24   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    2625   !! $Id$  
    2726   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    8079   END SUBROUTINE mpp_init 
    8180 
    82  
    83    SUBROUTINE mpp_init2  
    84       CALL mpp_init                             ! same routine as mpp_init 
    85    END SUBROUTINE mpp_init2 
    86  
    8781#else 
    8882   !!---------------------------------------------------------------------- 
     
    9589      !!                     
    9690      !! ** Purpose :   Lay out the global domain over processors. 
     91      !!      If land processors are to be eliminated, this program requires the 
     92      !!      presence of the domain configuration file. Land processors elimination 
     93      !!      is performed if jpni x jpnj /= jpnij. In this case, using the MPP_PREP 
     94      !!      preprocessing tool, hekp for defining the best cutting out. 
    9795      !! 
    9896      !! ** Method  :   Global domain is distributed in smaller local domains. 
     
    103101      !!                     nperio local  periodic condition 
    104102      !! 
    105       !! ** Action  : - set domain parameters 
     103      !! ** Action : - set domain parameters 
    106104      !!                    nimpp     : longitudinal index  
    107105      !!                    njmpp     : latitudinal  index 
     
    118116      !!                    nono      : number for local neighboring processor 
    119117      !! 
    120       !! History : 
    121       !!        !  94-11  (M. Guyon)  Original code 
    122       !!        !  95-04  (J. Escobar, M. Imbard) 
    123       !!        !  98-02  (M. Guyon)  FETI method 
    124       !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
    125       !!   8.5  !  02-08  (G. Madec)  F90 : free form 
    126       !!   3.4  !  11-11  (C. Harris) decomposition changes for running with CICE 
    127       !!---------------------------------------------------------------------- 
    128       INTEGER  ::   ji, jj, jn   ! dummy loop indices 
    129       INTEGER  ::   ii, ij, ifreq, il1, il2            ! local integers 
    130       INTEGER  ::   iresti, irestj, ijm1, imil, inum   !   -      - 
    131       REAL(wp) ::   zidom, zjdom                       ! local scalars 
    132       INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ijmppt, ilcit, ilcjt   ! local workspace 
    133       !!---------------------------------------------------------------------- 
    134  
    135       IF(lwp) WRITE(numout,*) 
    136       IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI' 
    137       IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    138  
     118      !! History :       !  1994-11  (M. Guyon)  Original code 
     119      !!  OPA            !  1995-04  (J. Escobar, M. Imbard) 
     120      !!                 !  1998-02  (M. Guyon)  FETI method 
     121      !!                 !  1998-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
     122      !!  NEMO      1.0  !  2004-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1 
     123      !!            4.0  !  2016-06  (G. Madec)  use domain configuration file instead of bathymetry file 
     124      !!            4.0  !  2017-06  (J.M. Molines, T. Lovato) merge of mppini and mppini_2 
     125      !!---------------------------------------------------------------------- 
     126      !! 
     127      USE in_out_manager  ! I/O Manager 
     128      !!  
     129      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices 
     130      INTEGER ::  inum                        ! temporary logical unit 
     131      INTEGER ::  idir                        ! temporary integers 
     132      INTEGER ::   & 
     133         ii, ij, ifreq, il1, il2,          &  ! temporary integers 
     134         icont, ili, ilj,                  &  !    "          " 
     135         isurf, ijm1, imil,                &  !    "          " 
     136         iino, ijno, iiso, ijso,           &  !    "          "  
     137         iiea, ijea, iiwe, ijwe,           &  !    "          " 
     138         iresti, irestj, iproc                !    "          " 
     139      INTEGER, DIMENSION(jpnij) ::   & 
     140         iin, ijn           
     141      INTEGER, DIMENSION(jpni,jpnj) ::   & 
     142         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace 
     143         ipproc, ibondj, ibondi, ipolj ,   &  !    "           " 
     144         ilei  , ilej  , ildi  , ildj  ,   &  !    "           " 
     145         ioea  , iowe  , ioso  , iono         !    "           " 
     146      INTEGER,  DIMENSION(jpiglo,jpjglo) ::   imask               ! global workspace 
     147      REAL(wp) ::   zidom , zjdom          ! local scalars 
     148      INTEGER, DIMENSION(jpnij) :: ii_nono, ii_noso, ii_noea, ii_nowe  ! jmm used for printing 
     149      !!---------------------------------------------------------------------- 
     150 
     151      IF(lwp)WRITE(numout,*) 
     152      IF(lwp)WRITE(numout,*) 'mpp_init: Message Passing MPI' 
     153      IF(lwp)WRITE(numout,*) '~~~~~~~~~~' 
     154      IF(lwp)WRITE(numout,*) ' ' 
     155 
     156      IF ( jpni * jpnj == jpnij ) THEN 
     157         imask(:,:) = 1                     ! no land processor elimination 
     158      ELSEIF ( jpni*jpnj > jpnij )   THEN 
     159         CALL mpp_init_mask(imask)          ! land processor elimination requires imask=0 on land 
     160      ELSE 
     161         CALL ctl_stop( ' jpnij > jpni x jpnj. Check namelist setting!'  ) 
     162      ENDIF 
    139163 
    140164      !  1. Dimension arrays for subdomains 
    141165      ! ----------------------------------- 
    142       !  Computation of local domain sizes ilcit() ilcjt() 
     166 
     167      !  Computation of local domain sizes ilci() ilcj() 
    143168      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo 
    144169      !  The subdomains are squares leeser than or equal to the global 
    145170      !  dimensions divided by the number of processors minus the overlap 
    146       !  array (cf. par_oce.F90). 
    147        
    148       nreci  = 2 * jpreci 
    149       nrecj  = 2 * jprecj 
    150       iresti = MOD( jpiglo - nreci , jpni ) 
    151       irestj = MOD( jpjglo - nrecj , jpnj ) 
    152  
    153       IF(  iresti == 0 )   iresti = jpni 
     171      !  array. 
     172 
     173      nreci=2*jpreci 
     174      nrecj=2*jprecj 
     175      iresti = 1 + MOD( jpiglo - nreci -1 , jpni ) 
     176      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj ) 
    154177 
    155178#if defined key_nemocice_decomp 
    156       ! In order to match CICE the size of domains in NEMO has to be changed 
    157       ! The last line of blocks (west) will have fewer points 
    158  
    159       DO jj = 1, jpnj 
    160          DO ji=1, jpni-1 
    161             ilcit(ji,jj) = jpi 
    162          END DO 
    163          ilcit(jpni,jj) = jpiglo - (jpni - 1) * (jpi - nreci) 
    164       END DO 
    165  
     179      ! Change padding to be consistent with CICE 
     180      ilci(1:jpni-1      ,:) = jpi 
     181      ilci(jpni          ,:) = jpiglo - (jpni - 1) * (jpi - nreci) 
     182 
     183      ilcj(:,      1:jpnj-1) = jpj 
     184      ilcj(:,          jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj) 
    166185#else 
    167  
    168       DO jj = 1, jpnj 
    169          DO ji = 1, iresti 
    170             ilcit(ji,jj) = jpi 
    171          END DO 
    172          DO ji = iresti+1, jpni 
    173             ilcit(ji,jj) = jpi -1 
    174          END DO 
    175       END DO 
    176        
     186      ilci(1:iresti      ,:) = jpi 
     187      ilci(iresti+1:jpni ,:) = jpi-1 
     188 
     189      ilcj(:,      1:irestj) = jpj 
     190      ilcj(:, irestj+1:jpnj) = jpj-1 
    177191#endif 
    178       nfilcit(:,:) = ilcit(:,:) 
    179       IF( irestj == 0 )   irestj = jpnj 
    180  
    181 #if defined key_nemocice_decomp 
    182       ! Same change to domains in North-South direction as in East-West.  
    183       DO ji=1,jpni 
    184          DO jj=1,jpnj-1 
    185             ilcjt(ji,jj) = jpj 
    186          END DO 
    187          ilcjt(ji,jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj) 
    188       END DO 
    189  
    190 #else 
    191  
    192       DO ji = 1, jpni 
    193          DO jj = 1, irestj 
    194             ilcjt(ji,jj) = jpj 
    195          END DO 
    196          DO jj = irestj+1, jpnj 
    197             ilcjt(ji,jj) = jpj -1 
    198          END DO 
    199       END DO 
    200        
    201 #endif 
     192 
     193      nfilcit(:,:) = ilci(:,:) 
     194 
     195      IF(lwp) WRITE(numout,*) 
     196      IF(lwp) WRITE(numout,*) ' mpp_init: defines mpp subdomains' 
     197      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------' 
     198      IF(lwp) WRITE(numout,*) 
     199      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj 
     200      IF(lwp) WRITE(numout,*) 
     201      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj 
     202 
     203      zidom = nreci + sum(ilci(:,1) - nreci )  
     204      IF(lwp) WRITE(numout,*) 
     205      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo 
     206 
     207      zjdom = nrecj + sum(ilcj(1,:) - nrecj )  
     208      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo 
     209      IF(lwp) WRITE(numout,*) 
     210 
    202211 
    203212      !  2. Index arrays for subdomains 
    204213      ! ------------------------------- 
    205        
     214 
    206215      iimppt(:,:) = 1 
    207216      ijmppt(:,:) = 1 
    208        
    209       IF( jpni > 1 ) THEN 
     217      ipproc(:,:) = -1 
     218 
     219      IF( jpni > 1 )THEN 
    210220         DO jj = 1, jpnj 
    211221            DO ji = 2, jpni 
    212                iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci 
     222               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci 
    213223            END DO 
    214224         END DO 
    215225      ENDIF 
    216       nfiimpp(:,:)=iimppt(:,:) 
    217  
    218       IF( jpnj > 1 ) THEN 
     226      nfiimpp(:,:) = iimppt(:,:) 
     227 
     228      IF( jpnj > 1 )THEN 
    219229         DO jj = 2, jpnj 
    220230            DO ji = 1, jpni 
    221                ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj 
     231               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj 
    222232            END DO 
    223233         END DO 
    224234      ENDIF 
    225        
    226       ! 3. Subdomain description 
    227       ! ------------------------ 
    228  
    229       DO jn = 1, jpnij 
    230          ii = 1 + MOD( jn-1, jpni ) 
    231          ij = 1 + (jn-1) / jpni 
    232          nfipproc(ii,ij) = jn - 1 
    233          nimppt(jn) = iimppt(ii,ij) 
    234          njmppt(jn) = ijmppt(ii,ij) 
    235          nlcit (jn) = ilcit (ii,ij)      
    236          nlci       = nlcit (jn)      
    237          nlcjt (jn) = ilcjt (ii,ij)      
    238          nlcj       = nlcjt (jn) 
    239          nbondj = -1                                   ! general case 
    240          IF( jn   >  jpni          )   nbondj = 0      ! first row of processor 
    241          IF( jn   >  (jpnj-1)*jpni )   nbondj = 1      ! last  row of processor 
    242          IF( jpnj == 1             )   nbondj = 2      ! one processor only in j-direction 
    243          ibonjt(jn) = nbondj 
    244           
    245          nbondi = 0                                    !  
    246          IF( MOD( jn, jpni ) == 1 )   nbondi = -1      ! 
    247          IF( MOD( jn, jpni ) == 0 )   nbondi =  1      ! 
    248          IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction 
    249          ibonit(jn) = nbondi 
    250           
    251          nldi =  1   + jpreci 
    252          nlei = nlci - jpreci 
    253          IF( nbondi == -1 .OR. nbondi == 2 )   nldi = 1 
    254          IF( nbondi ==  1 .OR. nbondi == 2 )   nlei = nlci 
    255          nldj =  1   + jprecj 
    256          nlej = nlcj - jprecj 
    257          IF( nbondj == -1 .OR. nbondj == 2 )   nldj = 1 
    258          IF( nbondj ==  1 .OR. nbondj == 2 )   nlej = nlcj 
    259          nldit(jn) = nldi 
    260          nleit(jn) = nlei 
    261          nldjt(jn) = nldj 
    262          nlejt(jn) = nlej 
     235 
     236 
     237      ! 3. Subdomain description in the Regular Case 
     238      ! -------------------------------------------- 
     239 
     240      nperio = 0 
     241      icont = -1 
     242      DO jarea = 1, jpni*jpnj 
     243         ii = 1 + MOD(jarea-1,jpni) 
     244         ij = 1 +    (jarea-1)/jpni 
     245         ili = ilci(ii,ij) 
     246         ilj = ilcj(ii,ij) 
     247         ibondj(ii,ij) = -1 
     248         IF( jarea >  jpni          )   ibondj(ii,ij) = 0 
     249         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1 
     250         IF( jpnj  == 1             )   ibondj(ii,ij) = 2 
     251         ibondi(ii,ij) = 0 
     252         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1 
     253         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1 
     254         IF( jpni            == 1 )   ibondi(ii,ij) =  2 
     255 
     256         ! 2.4 Subdomain neighbors 
     257 
     258         iproc = jarea - 1 
     259         ioso(ii,ij) = iproc - jpni 
     260         iowe(ii,ij) = iproc - 1 
     261         ioea(ii,ij) = iproc + 1 
     262         iono(ii,ij) = iproc + jpni 
     263         ildi(ii,ij) = 1 + jpreci 
     264         ilei(ii,ij) = ili -jpreci 
     265 
     266         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1 
     267         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili 
     268         ildj(ii,ij) =  1  + jprecj 
     269         ilej(ii,ij) = ilj - jprecj 
     270         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1 
     271         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj 
     272 
     273         ! warning ii*ij (zone) /= nproc (processors)! 
     274 
     275         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN 
     276            IF( jpni == 1 )THEN 
     277               ibondi(ii,ij) = 2 
     278               nperio = 1 
     279            ELSE 
     280               ibondi(ii,ij) = 0 
     281            ENDIF 
     282            IF( MOD(jarea,jpni) == 0 ) THEN 
     283               ioea(ii,ij) = iproc - (jpni-1) 
     284            ENDIF 
     285            IF( MOD(jarea,jpni) == 1 ) THEN 
     286               iowe(ii,ij) = iproc + jpni - 1 
     287            ENDIF 
     288         ENDIF 
     289         ipolj(ii,ij) = 0 
     290         IF( jperio == 3 .OR. jperio == 4 ) THEN 
     291            ijm1 = jpni*(jpnj-1) 
     292            imil = ijm1+(jpni+1)/2 
     293            IF( jarea > ijm1 ) ipolj(ii,ij) = 3 
     294            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4 
     295            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1   ! MPI rank of northern neighbour 
     296         ENDIF 
     297         IF( jperio == 5 .OR. jperio == 6 ) THEN 
     298            ijm1 = jpni*(jpnj-1) 
     299            imil = ijm1+(jpni+1)/2 
     300            IF( jarea > ijm1) ipolj(ii,ij) = 5 
     301            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6 
     302            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1    ! MPI rank of northern neighbour 
     303         ENDIF 
     304 
     305         ! Check wet points over the entire domain to preserve the MPI communication stencil 
     306         isurf = 0 
     307         DO jj = 1, ilj 
     308            DO  ji = 1, ili 
     309               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1)   isurf = isurf+1 
     310            END DO 
     311         END DO 
     312 
     313         IF(isurf /= 0) THEN 
     314            icont = icont + 1 
     315            ipproc(ii,ij) = icont 
     316            iin(icont+1) = ii 
     317            ijn(icont+1) = ij 
     318         ENDIF 
    263319      END DO 
     320 
     321      nfipproc(:,:) = ipproc(:,:) 
     322 
     323      ! Control 
     324      IF(icont+1 /= jpnij) THEN 
     325         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj 
     326         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'  
     327         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1 
     328         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 ) 
     329      ENDIF 
    264330 
    265331      ! 4. Subdomain print 
    266332      ! ------------------ 
    267        
    268       IF(lwp) WRITE(numout,*) 
    269       IF(lwp) WRITE(numout,*) '   defines mpp subdomains' 
    270       IF(lwp) WRITE(numout,*) '      jpni=', jpni, ' iresti=', iresti 
    271       IF(lwp) WRITE(numout,*) '      jpnj=', jpnj, ' irestj=', irestj 
    272       zidom = nreci 
    273       DO ji = 1, jpni 
    274          zidom = zidom + ilcit(ji,1) - nreci 
    275       END DO 
    276       IF(lwp) WRITE(numout,*) 
    277       IF(lwp) WRITE(numout,*)'      sum ilcit(i,1)=', zidom, ' jpiglo=', jpiglo 
    278  
    279       zjdom = nrecj 
    280       DO jj = 1, jpnj 
    281          zjdom = zjdom + ilcjt(1,jj) - nrecj 
    282       END DO 
    283       IF(lwp) WRITE(numout,*)'      sum ilcit(1,j)=', zjdom, ' jpjglo=', jpjglo 
    284333 
    285334      IF(lwp) THEN 
    286335         ifreq = 4 
    287          il1   = 1 
    288          DO jn = 1, (jpni-1)/ifreq+1 
    289             il2 = MIN( jpni, il1+ifreq-1 ) 
     336         il1 = 1 
     337         DO jn = 1,(jpni-1)/ifreq+1 
     338            il2 = MIN(jpni,il1+ifreq-1) 
    290339            WRITE(numout,*) 
    291             WRITE(numout,9200) ('***',ji = il1,il2-1) 
     340            WRITE(numout,9400) ('***',ji=il1,il2-1) 
    292341            DO jj = jpnj, 1, -1 
    293                WRITE(numout,9203) ('   ',ji = il1,il2-1) 
    294                WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 ) 
    295                WRITE(numout,9204) (nfipproc(ji,jj),ji=il1,il2) 
    296                WRITE(numout,9203) ('   ',ji = il1,il2-1) 
    297                WRITE(numout,9200) ('***',ji = il1,il2-1) 
     342               WRITE(numout,9403) ('   ',ji=il1,il2-1) 
     343               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2) 
     344               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2) 
     345               WRITE(numout,9403) ('   ',ji=il1,il2-1) 
     346               WRITE(numout,9400) ('***',ji=il1,il2-1) 
    298347            END DO 
    299             WRITE(numout,9201) (ji,ji = il1,il2) 
     348            WRITE(numout,9401) (ji,ji=il1,il2) 
    300349            il1 = il1+ifreq 
    301350         END DO 
    302  9200     FORMAT('     ***',20('*************',a3)) 
    303  9203     FORMAT('     *     ',20('         *   ',a3)) 
    304  9201     FORMAT('        ',20('   ',i3,'          ')) 
    305  9202     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   ')) 
    306  9204     FORMAT('     *  ',20('      ',i3,'   *   ')) 
    307       ENDIF 
    308  
    309       ! 5. From global to local 
    310       ! ----------------------- 
    311  
    312       nperio = 0 
    313       IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2 
    314  
    315  
    316       ! 6. Subdomain neighbours 
     351 9400     FORMAT('     ***',20('*************',a3)) 
     352 9403     FORMAT('     *     ',20('         *   ',a3)) 
     353 9401     FORMAT('        ',20('   ',i3,'          ')) 
     354 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   ')) 
     355 9404     FORMAT('     *  ',20('      ',i3,'   *   ')) 
     356      ENDIF 
     357 
     358 
     359      ! 5. neighbour treatment 
    317360      ! ---------------------- 
    318361 
    319       nproc = narea - 1 
    320       noso  = nproc - jpni 
    321       nowe  = nproc - 1 
    322       noea  = nproc + 1 
    323       nono  = nproc + jpni 
    324       ! great neighbours 
    325       npnw = nono - 1 
    326       npne = nono + 1 
    327       npsw = noso - 1 
    328       npse = noso + 1 
    329       nbsw = 1 
    330       nbnw = 1 
    331       IF( MOD( nproc, jpni ) == 0 ) THEN 
    332          nbsw = 0 
    333          nbnw = 0 
    334       ENDIF 
    335       nbse = 1 
    336       nbne = 1 
    337       IF( MOD( nproc, jpni ) == jpni-1 ) THEN 
    338          nbse = 0 
    339          nbne = 0 
    340       ENDIF 
    341       IF(nproc < jpni) THEN 
    342          nbsw = 0 
    343          nbse = 0 
    344       ENDIF 
    345       IF( nproc >= (jpnj-1)*jpni ) THEN 
    346          nbnw = 0 
    347          nbne = 0 
    348       ENDIF 
    349       nlcj = nlcjt(narea)   
    350       nlci = nlcit(narea)   
    351       nldi = nldit(narea) 
    352       nlei = nleit(narea) 
    353       nldj = nldjt(narea) 
    354       nlej = nlejt(narea) 
    355       nbondi = ibonit(narea) 
    356       nbondj = ibonjt(narea) 
    357       nimpp  = nimppt(narea)   
    358       njmpp  = njmppt(narea)   
    359  
    360       ! Save processor layout in layout.dat file  
    361       IF(lwp) THEN 
     362      DO jarea = 1, jpni*jpnj 
     363         iproc = jarea-1 
     364         ii = 1 + MOD(jarea-1,jpni) 
     365         ij = 1 +    (jarea-1)/jpni 
     366         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   & 
     367            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN 
     368            iino = 1 + MOD(iono(ii,ij),jpni) 
     369            ijno = 1 +    (iono(ii,ij))/jpni 
     370              ! Need to reverse the logical direction of communication  
     371              ! for northern neighbours of northern row processors (north-fold) 
     372              ! i.e. need to check that the northern neighbour only communicates 
     373              ! to the SOUTH (or not at all) if this area is land-only (#1057) 
     374            idir = 1 
     375            IF( ij .eq. jpnj .AND. ijno .eq. jpnj ) idir = -1     
     376            IF( ibondj(iino,ijno) == idir ) ibondj(iino,ijno)=2 
     377            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -idir 
     378         ENDIF 
     379         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   & 
     380            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN 
     381            iiso = 1 + MOD(ioso(ii,ij),jpni) 
     382            ijso = 1 +    (ioso(ii,ij))/jpni 
     383            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2 
     384            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1 
     385         ENDIF 
     386         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   & 
     387            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN 
     388            iiea = 1 + MOD(ioea(ii,ij),jpni) 
     389            ijea = 1 +    (ioea(ii,ij))/jpni 
     390            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2 
     391            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1 
     392         ENDIF 
     393         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   & 
     394            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN 
     395            iiwe = 1 + MOD(iowe(ii,ij),jpni) 
     396            ijwe = 1 +    (iowe(ii,ij))/jpni 
     397            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2 
     398            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1 
     399         ENDIF 
     400      END DO 
     401 
     402 
     403    ! just to save nono etc for all proc 
     404    ii_noso(:) = -1 
     405    ii_nono(:) = -1 
     406    ii_noea(:) = -1 
     407    ii_nowe(:) = -1  
     408    nproc = narea-1 
     409    DO jarea = 1, jpnij 
     410       ii = iin(jarea) 
     411       ij = ijn(jarea) 
     412       IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
     413          iiso = 1 + MOD(ioso(ii,ij),jpni) 
     414          ijso = 1 +    (ioso(ii,ij))/jpni 
     415          noso = ipproc(iiso,ijso) 
     416          ii_noso(jarea)= noso 
     417       ENDIF 
     418       IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
     419          iiwe = 1 + MOD(iowe(ii,ij),jpni) 
     420          ijwe = 1 +    (iowe(ii,ij))/jpni 
     421          nowe = ipproc(iiwe,ijwe) 
     422          ii_nowe(jarea)= nowe 
     423       ENDIF 
     424       IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
     425          iiea = 1 + MOD(ioea(ii,ij),jpni) 
     426          ijea = 1 +    (ioea(ii,ij))/jpni 
     427          noea = ipproc(iiea,ijea) 
     428          ii_noea(jarea)= noea 
     429       ENDIF 
     430       IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
     431          iino = 1 + MOD(iono(ii,ij),jpni) 
     432          ijno = 1 +    (iono(ii,ij))/jpni 
     433          nono = ipproc(iino,ijno) 
     434          ii_nono(jarea)= nono 
     435       ENDIF 
     436    END DO 
     437      ! 6. Change processor name 
     438      ! ------------------------ 
     439 
     440      nproc = narea-1 
     441      ii = iin(narea) 
     442      ij = ijn(narea) 
     443 
     444      ! set default neighbours 
     445      noso = ii_noso(narea) 
     446      nowe = ii_nowe(narea) 
     447      noea = ii_noea(narea) 
     448      nono = ii_nono(narea) 
     449      nlcj = ilcj(ii,ij)   
     450      nlci = ilci(ii,ij)   
     451      nldi = ildi(ii,ij) 
     452      nlei = ilei(ii,ij) 
     453      nldj = ildj(ii,ij) 
     454      nlej = ilej(ii,ij) 
     455      nbondi = ibondi(ii,ij) 
     456      nbondj = ibondj(ii,ij) 
     457      nimpp = iimppt(ii,ij)   
     458      njmpp = ijmppt(ii,ij)   
     459      DO jproc = 1, jpnij 
     460         ii = iin(jproc) 
     461         ij = ijn(jproc) 
     462         nimppt(jproc) = iimppt(ii,ij)   
     463         njmppt(jproc) = ijmppt(ii,ij)  
     464         nlcjt(jproc) = ilcj(ii,ij) 
     465         nlcit(jproc) = ilci(ii,ij) 
     466         nldit(jproc) = ildi(ii,ij) 
     467         nleit(jproc) = ilei(ii,ij) 
     468         nldjt(jproc) = ildj(ii,ij) 
     469         nlejt(jproc) = ilej(ii,ij) 
     470      END DO 
     471 
     472      ! Save processor layout in ascii file 
     473      IF (lwp) THEN 
    362474         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
    363475         WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo' 
    364476         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo 
    365          WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp' 
    366          ! 
    367          DO jn = 1, jpnij 
    368             WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), & 
    369                &                    nldit(jn), nldjt(jn), & 
    370                &                    nleit(jn), nlejt(jn), & 
    371                &                    nimppt(jn), njmppt(jn) 
     477         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj ' 
     478 
     479        DO  jproc = 1, jpnij 
     480           ii = iin(jproc) 
     481           ij = ijn(jproc) 
     482 
     483           WRITE(inum,'(15i5)') jproc-1, nlcit(jproc), nlcjt(jproc), & 
     484                 nldit(jproc), nldjt(jproc),     & 
     485                 nleit(jproc), nlejt(jproc),     & 
     486                 nimppt(jproc), njmppt(jproc),   &  
     487                 ii_nono(jproc), ii_noso(jproc), & 
     488                 ii_nowe(jproc), ii_noea(jproc), & 
     489                 ibondi(ii,ij),  ibondj(ii,ij)  
    372490         END DO 
    373491         CLOSE(inum)    
    374492      END IF 
    375493 
    376       ! w a r n i n g  narea (zone) /= nproc (processors)! 
    377  
    378       IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN 
    379          IF( jpni == 1 )THEN 
    380             nbondi = 2 
    381             nperio = 1 
    382          ELSE 
    383             nbondi = 0 
    384          ENDIF 
    385          IF( MOD( narea, jpni ) == 0 ) THEN 
    386             noea = nproc-(jpni-1) 
    387             npne = npne-jpni 
    388             npse = npse-jpni 
    389          ENDIF 
    390          IF( MOD( narea, jpni ) == 1 ) THEN 
    391             nowe = nproc+(jpni-1) 
    392             npnw = npnw+jpni 
    393             npsw = npsw+jpni 
    394          ENDIF 
    395          nbsw = 1 
    396          nbnw = 1 
    397          nbse = 1 
    398          nbne = 1 
    399          IF( nproc < jpni ) THEN 
    400             nbsw = 0 
    401             nbse = 0 
    402          ENDIF 
    403          IF( nproc >= (jpnj-1)*jpni ) THEN 
    404             nbnw = 0 
    405             nbne = 0 
    406          ENDIF 
    407       ENDIF 
     494      ! Defined npolj, either 0, 3 , 4 , 5 , 6 
     495      ! In this case the important thing is that npolj /= 0 
     496      ! Because if we go through these line it is because jpni >1 and thus 
     497      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0 
     498 
    408499      npolj = 0 
     500      ij = ijn(narea) 
     501 
    409502      IF( jperio == 3 .OR. jperio == 4 ) THEN 
    410          ijm1 = jpni*(jpnj-1) 
    411          imil = ijm1+(jpni+1)/2 
    412          IF( narea > ijm1 ) npolj = 3 
    413          IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4 
    414          IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1 
    415       ENDIF 
     503         IF( ij == jpnj ) npolj = 3 
     504      ENDIF 
     505 
    416506      IF( jperio == 5 .OR. jperio == 6 ) THEN 
    417           ijm1 = jpni*(jpnj-1) 
    418           imil = ijm1+(jpni+1)/2 
    419           IF( narea > ijm1) npolj = 5 
    420           IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6 
    421           IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1 
     507         IF( ij == jpnj ) npolj = 5 
    422508      ENDIF 
    423509 
     
    425511 
    426512      IF(lwp) THEN 
    427          WRITE(numout,*) '      nproc  = ', nproc 
    428          WRITE(numout,*) '      nowe   = ', nowe  , '      noea   =  ', noea 
    429          WRITE(numout,*) '      nono   = ', nono  , '      noso   =  ', noso 
    430          WRITE(numout,*) '      nbondi = ', nbondi, '      nbondj = ', nbondj 
    431          WRITE(numout,*) '      npolj  = ', npolj 
    432          WRITE(numout,*) '      nperio = ', nperio 
    433          WRITE(numout,*) '      nlci   = ', nlci  , '      nlcj   = ', nlcj 
    434          WRITE(numout,*) '      nimpp  = ', nimpp , '      njmpp  = ', njmpp 
    435          WRITE(numout,*) '      nreci  = ', nreci , '      npse   = ', npse 
    436          WRITE(numout,*) '      nrecj  = ', nrecj , '      npsw   = ', npsw 
    437          WRITE(numout,*) '      jpreci = ', jpreci, '      npne   = ', npne 
    438          WRITE(numout,*) '      jprecj = ', jprecj, '      npnw   = ', npnw 
     513         WRITE(numout,*) ' nproc  = ', nproc 
     514         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea 
     515         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso 
     516         WRITE(numout,*) ' nbondi = ', nbondi 
     517         WRITE(numout,*) ' nbondj = ', nbondj 
     518         WRITE(numout,*) ' npolj  = ', npolj 
     519         WRITE(numout,*) ' nperio = ', nperio 
     520         WRITE(numout,*) ' nlci   = ', nlci 
     521         WRITE(numout,*) ' nlcj   = ', nlcj 
     522         WRITE(numout,*) ' nimpp  = ', nimpp 
     523         WRITE(numout,*) ' njmpp  = ', njmpp 
     524         WRITE(numout,*) ' nreci  = ', nreci   
     525         WRITE(numout,*) ' nrecj  = ', nrecj   
     526         WRITE(numout,*) ' jpreci = ', jpreci  
     527         WRITE(numout,*) ' jprecj = ', jprecj  
    439528         WRITE(numout,*) 
    440529      ENDIF 
    441530 
    442       IF( jperio == 7 .AND. ( jpni /= 1 .OR. jpnj /= 1 ) ) & 
    443          &                  CALL ctl_stop( ' mpp_init: error jperio = 7 works only with jpni = jpnj = 1' ) 
    444531      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' ) 
    445532 
     
    454541      CALL mpp_init_ioipsl 
    455542 
    456    END SUBROUTINE mpp_init 
    457  
    458 #  include "mppini_2.h90" 
     543 
     544    END SUBROUTINE mpp_init 
     545 
     546    SUBROUTINE mpp_init_mask(kmask) 
     547      !!---------------------------------------------------------------------- 
     548      !!                  ***  ROUTINE mpp_init_mask  *** 
     549      !! 
     550      !! ** Purpose : Read relevant bathymetric information in a global array 
     551      !!              in order to provide a land/sea mask used for the elimination 
     552      !!              of land domains, in an mpp computation. 
     553      !! 
     554      !! ** Method  : Read the namelist ln_zco and ln_isfcav in namelist namzgr 
     555      !!              in order to choose the correct bathymetric information 
     556      !!              (file and variables)   
     557      !! 
     558      !! History : 
     559      !!   4.0   !  17-06  (J.M. Molines) from mpp_init_2 to unified mppini 
     560      !!---------------------------------------------------------------------- 
     561      USE bdy_oce 
     562      !! 
     563      INTEGER, DIMENSION(jpiglo,jpjglo), INTENT(out) :: kmask 
     564   
     565      INTEGER :: inum   !: logical unit for configuration file 
     566      INTEGER :: ios    !: iostat error flag 
     567      INTEGER ::  ijstartrow                   ! temporary integers 
     568      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zbot, zbdy          ! global workspace 
     569      REAL(wp) ::   zidom , zjdom          ! local scalars 
     570      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,         & 
     571           &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,     & 
     572           &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &   
     573           &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 
     574           &             cn_ice_lim, nn_ice_lim_dta,                           & 
     575           &             rn_ice_tem, rn_ice_sal, rn_ice_age,                 & 
     576           &             ln_vol, nn_volctl, nn_rimwidth, nb_jpk_bdy 
     577      !!---------------------------------------------------------------------- 
     578      ! 0. initialisation 
     579      ! ----------------- 
     580      CALL iom_open( cn_domcfg, inum ) 
     581      ! 
     582      ! ocean bottom level 
     583      CALL iom_get( inum, jpdom_unknown, 'bottom_level' , zbot , lrowattr=ln_use_jattr )  ! nb of ocean T-points 
     584      ! 
     585      CALL iom_close( inum ) 
     586      ! 
     587      ! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise) 
     588      WHERE( zbot(:,:) > 0 )                   ;   kmask(:,:) = 1 
     589      ELSEWHERE                                ;   kmask(:,:) = 0 
     590      END WHERE 
     591   
     592      ! Adjust kmask with bdy_msk if exists 
     593   
     594      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist : BDY 
     595      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 
     596903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in reference namelist (mppini)', lwp ) 
     597 
     598      REWIND( numnam_cfg )              ! Namelist nambdy in configuration namelist : BDY 
     599      READ  ( numnam_cfg, nambdy, IOSTAT = ios, ERR = 904 ) 
     600904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy in configuration namelist (mppini)', lwp ) 
     601 
     602      IF( ln_bdy .AND. ln_mask_file ) THEN 
     603         CALL iom_open( cn_mask_file, inum ) 
     604         CALL iom_get ( inum, jpdom_unknown, 'bdy_msk', zbdy) 
     605         CALL iom_close( inum ) 
     606         WHERE ( zbdy(:,:) <= 0. ) kmask = 0 
     607      ENDIF 
     608 
     609   END SUBROUTINE mpp_init_mask 
    459610 
    460611   SUBROUTINE mpp_init_ioipsl 
  • branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r7761 r8219  
    413413 
    414414      !                                      ! Domain decomposition 
    415       IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out 
    416       ELSE                            ;   CALL mpp_init2     ! eliminate land processors 
    417       ENDIF 
     415      CALL mpp_init 
    418416      ! 
    419417      IF( nn_timing == 1 )  CALL timing_init 
  • branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90

    r7646 r8219  
    262262 
    263263      !                                      ! Domain decomposition 
    264       IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out 
    265       ELSE                            ;   CALL mpp_init2     ! eliminate land processors 
    266       ENDIF 
     264      CALL mpp_init 
    267265      ! 
    268266      IF( nn_timing == 1 )  CALL timing_init 
  • branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r7761 r8219  
    349349 
    350350      !                                      ! Domain decomposition 
    351       IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out 
    352       ELSE                            ;   CALL mpp_init2     ! eliminate land processors 
    353       ENDIF 
     351      CALL mpp_init 
    354352      ! 
    355353      IF( nn_timing == 1 )  CALL timing_init 
  • branches/2017/dev_r8126_ROBUST10_MPPINI/NEMOGCM/SETTE/sette.sh

    r7756 r8219  
    661661    export TEST_NAME="LONG" 
    662662    cd ${CONFIG_DIR0} 
    663     . ./makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 add_key "key_tide" del_key ${DEL_KEYS} 
     663    . ./makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 del_key ${DEL_KEYS} 
    664664    cd ${SETTE_DIR} 
    665665    . ./param.cfg 
Note: See TracChangeset for help on using the changeset viewer.