Changeset 8375


Ignore:
Timestamp:
2017-07-26T14:30:01+02:00 (4 years ago)
Author:
acc
Message:

Branch 2017/dev_r8126_ROBUST08_no_ghost. Style changes to mppini.F90 following a review by Gurvan (actually a review of branches/2017/dev_r8126_ROBUST10_MPPINI which this branch now supersedes). Cosmetic changes only; compiled and SETTE tested with ORCA2LIMPISCES.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r8314 r8375  
    11MODULE mppini 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE mppini   *** 
    44   !! Ocean initialization : distributed memory computing initialization 
    5    !!============================================================================== 
    6  
    7    !!---------------------------------------------------------------------- 
    8    !!   mpp_init       : Lay out the global domain over processors  
    9    !!                    with/without land processor elimination 
    10    !!   mpp_init_ioispl: IOIPSL initialization in mpp 
    11    !!---------------------------------------------------------------------- 
    12    USE dom_oce         ! ocean space and time domain  
    13    USE in_out_manager  ! I/O Manager 
    14    USE lib_mpp         ! distribued memory computing library 
    15    USE ioipsl 
    16    USE iom 
     5   !!====================================================================== 
     6   !! History :  6.0  !  1994-11  (M. Guyon)  Original code 
     7   !!  OPA       7.0  !  1995-04  (J. Escobar, M. Imbard) 
     8   !!            8.0  !  1998-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
     9   !!  NEMO      1.0  !  2004-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1 
     10   !!            4.0  !  2016-06  (G. Madec)  use domain configuration file instead of bathymetry file 
     11   !!            4.0  !  2017-06  (J.M. Molines, T. Lovato) merge of mppini and mppini_2 
     12   !!---------------------------------------------------------------------- 
     13 
     14   !!---------------------------------------------------------------------- 
     15   !!  mpp_init       : Lay out the global domain over processors with/without land processor elimination 
     16   !!  mpp_init_mask  :  
     17   !!  mpp_init_ioipsl: IOIPSL initialization in mpp  
     18   !!---------------------------------------------------------------------- 
     19   USE dom_oce        ! ocean space and time domain 
     20   USE bdy_oce        ! open BounDarY   
     21   ! 
     22   USE lib_mpp        ! distribued memory computing library 
     23   USE iom            ! nemo I/O library  
     24   USE ioipsl         ! I/O IPSL library 
     25   USE in_out_manager ! I/O Manager 
    1726 
    1827   IMPLICIT NONE 
     
    4049      !! 
    4150      !! ** Method  :   Shared memory computing, set the local processor 
    42       !!      variables to the value of the global domain 
    43       !! 
    44       !! History : 
    45       !!   9.0  !  04-01  (G. Madec, J.M. Molines)  F90 : free form, north fold jpni >1 
    46       !!---------------------------------------------------------------------- 
    47  
    48       ! No mpp computation 
    49       nimpp  = 1 
     51      !!              variables to the value of the global domain 
     52      !!---------------------------------------------------------------------- 
     53      ! 
     54      nimpp  = 1           !  
    5055      njmpp  = 1 
    5156      nlci   = jpi 
     
    6065      nidom  = FLIO_DOM_NONE 
    6166      npolj = jperio 
    62  
     67      ! 
    6368      IF(lwp) THEN 
    6469         WRITE(numout,*) 
    65          WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing' 
    66          WRITE(numout,*) '~~~~~~~~~~~ ' 
    67          WRITE(numout,*) '         nperio = ', nperio 
    68          WRITE(numout,*) '         npolj  = ', npolj 
    69          WRITE(numout,*) '         nimpp  = ', nimpp 
    70          WRITE(numout,*) '         njmpp  = ', njmpp 
    71       ENDIF 
    72  
    73       IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) & 
    74           CALL ctl_stop( 'equality  jpni = jpnj = jpnij = 1 is not satisfied',   & 
    75           &              'the domain is lay out for distributed memory computing! ' ) 
    76  
    77       IF( jperio == 7 ) CALL ctl_stop( ' jperio = 7 needs distributed memory computing ',   & 
    78           &              ' with 1 process. Add key_mpp_mpi in the list of active cpp keys ' ) 
     70         WRITE(numout,*) 'mpp_init : NO massively parallel processing' 
     71         WRITE(numout,*) '~~~~~~~~ ' 
     72         WRITE(numout,*) '   nperio = ', nperio, '   nimpp  = ', nimpp 
     73         WRITE(numout,*) '   npolj  = ', npolj , '   njmpp  = ', njmpp 
     74      ENDIF 
     75      ! 
     76      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 )                                     & 
     77         CALL ctl_stop( 'mpp_init: equality  jpni = jpnj = jpnij = 1 is not satisfied',   & 
     78            &           'the domain is lay out for distributed memory computing!' ) 
     79         ! 
     80      IF( jperio == 7 ) CALL ctl_stop( 'mpp_init: jperio = 7 needs distributed memory computing ',       & 
     81         &                             'with 1 process. Add key_mpp_mpi in the list of active cpp keys ' ) 
     82         ! 
    7983   END SUBROUTINE mpp_init 
    8084 
    8185#else 
    8286   !!---------------------------------------------------------------------- 
    83    !!   'key_mpp_mpi'          OR         MPI massively parallel processing 
     87   !!   'key_mpp_mpi'                     MPI massively parallel processing 
    8488   !!---------------------------------------------------------------------- 
    8589 
     
    9296      !!      presence of the domain configuration file. Land processors elimination 
    9397      !!      is performed if jpni x jpnj /= jpnij. In this case, using the MPP_PREP 
    94       !!      preprocessing tool, hekp for defining the best cutting out. 
     98      !!      preprocessing tool, help for defining the best cutting out. 
    9599      !! 
    96100      !! ** Method  :   Global domain is distributed in smaller local domains. 
     
    115119      !!                    noso      : number for local neighboring processor 
    116120      !!                    nono      : number for local neighboring processor 
    117       !! 
    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 
    163  
     121      !!---------------------------------------------------------------------- 
     122      INTEGER ::   ji, jj, jn, jproc, jarea   ! dummy loop indices 
     123      INTEGER ::   inum                       ! local logical unit 
     124      INTEGER ::   idir, ifreq, icont, isurf  ! local integers 
     125      INTEGER ::   ii, il1, ili, imil         !   -       - 
     126      INTEGER ::   ij, il2, ilj, ijm1         !   -       - 
     127      INTEGER ::   iino, ijno, iiso, ijso     !   -       - 
     128      INTEGER ::   iiea, ijea, iiwe, ijwe     !   -       - 
     129      INTEGER ::   iresti, irestj, iproc      !   -       - 
     130      INTEGER, DIMENSION(jpnij) ::   iin, ii_nono, ii_noea   ! 1D workspace 
     131      INTEGER, DIMENSION(jpnij) ::   ijn, ii_noso, ii_nowe   !  -     - 
     132      INTEGER, DIMENSION(jpni,jpnj) ::   iimppt, ilci, ibondi, ipproc   ! 2D workspace 
     133      INTEGER, DIMENSION(jpni,jpnj) ::   ijmppt, ilcj, ibondj, ipolj    !  -     - 
     134      INTEGER, DIMENSION(jpni,jpnj) ::   ilei, ildi, iono, ioea         !  -     - 
     135      INTEGER, DIMENSION(jpni,jpnj) ::   ilej, ildj, ioso, iowe         !  -     - 
     136      INTEGER, DIMENSION(jpiglo,jpjglo) ::   imask   ! 2D golbal domain workspace 
     137      REAL(wp) ::   zidom, zjdom   ! local scalars 
     138      !!---------------------------------------------------------------------- 
     139      ! 
     140      IF ( jpni * jpnj == jpnij ) THEN    ! regular domain lay out over processors 
     141         imask(:,:) = 1                
     142      ELSEIF ( jpni*jpnj > jpnij ) THEN   ! remove land-only processor (i.e. where imask(:,:)=0) 
     143         CALL mpp_init_mask( imask )    
     144      ELSE                                ! error 
     145         CALL ctl_stop( 'mpp_init: jpnij > jpni x jpnj. Check namelist setting!' ) 
     146      ENDIF 
     147      ! 
    164148      !  1. Dimension arrays for subdomains 
    165149      ! ----------------------------------- 
    166  
    167150      !  Computation of local domain sizes ilci() ilcj() 
    168151      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo 
    169       !  The subdomains are squares leeser than or equal to the global 
    170       !  dimensions divided by the number of processors minus the overlap 
    171       !  array. 
    172  
    173       nreci=2*jpreci 
    174       nrecj=2*jprecj 
     152      !  The subdomains are squares lesser than or equal to the global 
     153      !  dimensions divided by the number of processors minus the overlap array. 
     154      ! 
     155      nreci = 2 * jpreci 
     156      nrecj = 2 * jprecj 
    175157      iresti = 1 + MOD( jpiglo - nreci -1 , jpni ) 
    176158      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj ) 
    177  
     159      ! 
    178160#if defined key_nemocice_decomp 
    179161      ! Change padding to be consistent with CICE 
    180162      ilci(1:jpni-1      ,:) = jpi 
    181163      ilci(jpni          ,:) = jpiglo - (jpni - 1) * (jpi - nreci) 
    182  
     164      ! 
    183165      ilcj(:,      1:jpnj-1) = jpj 
    184166      ilcj(:,          jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj) 
     
    190172      ilcj(:, irestj+1:jpnj) = jpj-1 
    191173#endif 
    192  
     174      ! 
    193175      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  
     176      ! 
     177      zidom = nreci + sum(ilci(:,1) - nreci ) 
     178      zjdom = nrecj + sum(ilcj(1,:) - nrecj ) 
     179      ! 
     180      IF(lwp) THEN 
     181         WRITE(numout,*) 
     182         WRITE(numout,*) 'mpp_init : MPI Message Passing MPI - domain lay out over processors' 
     183         WRITE(numout,*) '~~~~~~~~ ' 
     184         WRITE(numout,*) '   defines mpp subdomains' 
     185         WRITE(numout,*) '      iresti = ', iresti, ' jpni = ', jpni   
     186         WRITE(numout,*) '      irestj = ', irestj, ' jpnj = ', jpnj 
     187         WRITE(numout,*) 
     188         WRITE(numout,*) '      sum ilci(i,1) = ', zidom, ' jpiglo = ', jpiglo 
     189         WRITE(numout,*) '      sum ilcj(1,j) = ', zjdom, ' jpjglo = ', jpjglo 
     190      ENDIF 
    211191 
    212192      !  2. Index arrays for subdomains 
    213193      ! ------------------------------- 
    214  
    215       iimppt(:,:) = 1 
    216       ijmppt(:,:) = 1 
     194      iimppt(:,:) =  1 
     195      ijmppt(:,:) =  1 
    217196      ipproc(:,:) = -1 
    218  
    219       IF( jpni > 1 )THEN 
     197      ! 
     198      IF( jpni > 1 ) THEN 
    220199         DO jj = 1, jpnj 
    221200            DO ji = 2, jpni 
     
    225204      ENDIF 
    226205      nfiimpp(:,:) = iimppt(:,:) 
    227  
     206      ! 
    228207      IF( jpnj > 1 )THEN 
    229208         DO jj = 2, jpnj 
     
    234213      ENDIF 
    235214 
    236  
    237215      ! 3. Subdomain description in the Regular Case 
    238216      ! -------------------------------------------- 
    239  
    240217      nperio = 0 
    241218      icont = -1 
     
    254231         IF( jpni            == 1 )   ibondi(ii,ij) =  2 
    255232 
    256          ! 2.4 Subdomain neighbors 
    257  
     233         ! Subdomain neighbors 
    258234         iproc = jarea - 1 
    259235         ioso(ii,ij) = iproc - jpni 
     
    261237         ioea(ii,ij) = iproc + 1 
    262238         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 
     239         ildi(ii,ij) =  1 + jpreci 
     240         ilei(ii,ij) = ili - jpreci 
     241 
     242         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) =  1 
    267243         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili 
    268244         ildj(ii,ij) =  1  + jprecj 
    269245         ilej(ii,ij) = ilj - jprecj 
    270          IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1 
     246         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) =  1 
    271247         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj 
    272248 
     
    302278            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1    ! MPI rank of northern neighbour 
    303279         ENDIF 
    304  
     280         ! 
    305281         ! Check wet points over the entire domain to preserve the MPI communication stencil 
    306282         isurf = 0 
     
    310286            END DO 
    311287         END DO 
    312  
    313          IF(isurf /= 0) THEN 
     288         ! 
     289         IF( isurf /= 0 ) THEN 
    314290            icont = icont + 1 
    315291            ipproc(ii,ij) = icont 
     
    318294         ENDIF 
    319295      END DO 
    320  
     296      ! 
    321297      nfipproc(:,:) = ipproc(:,:) 
    322298 
    323       ! Control 
    324       IF(icont+1 /= jpnij) THEN 
     299      ! Check potential error 
     300      IF( icont+1 /= jpnij ) THEN 
    325301         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj 
    326302         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'  
    327303         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1 
    328          CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 ) 
     304         CALL ctl_stop( 'mpp_init: Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 ) 
    329305      ENDIF 
    330306 
    331307      ! 4. Subdomain print 
    332308      ! ------------------ 
    333  
    334309      IF(lwp) THEN 
    335310         ifreq = 4 
    336311         il1 = 1 
    337          DO jn = 1,(jpni-1)/ifreq+1 
     312         DO jn = 1, (jpni-1)/ifreq+1 
    338313            il2 = MIN(jpni,il1+ifreq-1) 
    339314            WRITE(numout,*) 
     
    349324            il1 = il1+ifreq 
    350325         END DO 
    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  
     326 9400    FORMAT('     ***',20('*************',a3)) 
     327 9403    FORMAT('     *     ',20('         *   ',a3)) 
     328 9401    FORMAT('        ',20('   ',i3,'          ')) 
     329 9402    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   ')) 
     330 9404    FORMAT('     *  ',20('      ',i3,'   *   ')) 
     331      ENDIF 
    358332 
    359333      ! 5. neighbour treatment 
    360334      ! ---------------------- 
    361  
    362335      DO jarea = 1, jpni*jpnj 
    363336         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) 
     337         ii = 1 + MOD( jarea-1  , jpni ) 
     338         ij = 1 +     (jarea-1) / jpni 
     339         IF ( ipproc(ii,ij) == -1 .AND. 0 <= iono(ii,ij) .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN 
     340            iino = 1 + MOD( iono(ii,ij) , jpni ) 
     341            ijno = 1 +      iono(ii,ij) / jpni 
     342            ! Need to reverse the logical direction of communication  
     343            ! for northern neighbours of northern row processors (north-fold) 
     344            ! i.e. need to check that the northern neighbour only communicates 
     345            ! to the SOUTH (or not at all) if this area is land-only (#1057) 
    374346            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 
     347            IF( ij == jpnj .AND. ijno == jpnj )   idir = -1     
     348            IF( ibondj(iino,ijno) == idir     )   ibondj(iino,ijno) =   2 
     349            IF( ibondj(iino,ijno) == 0        )   ibondj(iino,ijno) = -idir 
     350         ENDIF 
     351         IF( ipproc(ii,ij) == -1 .AND. 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN 
     352            iiso = 1 + MOD( ioso(ii,ij) , jpni ) 
     353            ijso = 1 +      ioso(ii,ij) / jpni 
     354            IF( ibondj(iiso,ijso) == -1 )   ibondj(iiso,ijso) = 2 
     355            IF( ibondj(iiso,ijso) ==  0 )   ibondj(iiso,ijso) = 1 
     356         ENDIF 
     357         IF( ipproc(ii,ij) == -1 .AND. 0 <= ioea(ii,ij) .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. 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN 
     364            iiwe = 1 + MOD( iowe(ii,ij) , jpni ) 
     365            ijwe = 1 +      iowe(ii,ij) / jpni 
     366            IF( ibondi(iiwe,ijwe) == -1 )   ibondi(iiwe,ijwe) = 2 
     367            IF( ibondi(iiwe,ijwe) ==  0 )   ibondi(iiwe,ijwe) = 1 
    399368         ENDIF 
    400369      END DO 
    401370 
    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 
     371      ! just to save nono etc for all proc 
     372      ii_noso(:) = -1 
     373      ii_nono(:) = -1 
     374      ii_noea(:) = -1 
     375      ii_nowe(:) = -1  
     376      nproc = narea-1 
     377      DO jarea = 1, jpnij 
     378         ii = iin(jarea) 
     379         ij = ijn(jarea) 
     380         IF( 0 <= ioso(ii,ij) .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
     381            iiso = 1 + MOD( ioso(ii,ij) , jpni ) 
     382            ijso = 1 +      ioso(ii,ij) / jpni 
     383            noso = ipproc(iiso,ijso) 
     384            ii_noso(jarea)= noso 
     385         ENDIF 
     386         IF( 0 <= iowe(ii,ij) .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
     387          iiwe = 1 + MOD( iowe(ii,ij) , jpni ) 
     388          ijwe = 1 +      iowe(ii,ij) / jpni 
    421389          nowe = ipproc(iiwe,ijwe) 
    422390          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 
     391         ENDIF 
     392         IF( 0 <= ioea(ii,ij) .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
     393            iiea = 1 + MOD( ioea(ii,ij) , jpni ) 
     394            ijea = 1 +      ioea(ii,ij) / jpni 
     395            noea = ipproc(iiea,ijea) 
     396            ii_noea(jarea)= noea 
     397         ENDIF 
     398         IF( 0 <= iono(ii,ij) .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
     399            iino = 1 + MOD( iono(ii,ij) , jpni ) 
     400            ijno = 1 +      iono(ii,ij) / jpni 
     401            nono = ipproc(iino,ijno) 
     402            ii_nono(jarea)= nono 
     403         ENDIF 
     404      END DO 
     405     
    437406      ! 6. Change processor name 
    438407      ! ------------------------ 
    439  
    440408      nproc = narea-1 
    441409      ii = iin(narea) 
    442410      ij = ijn(narea) 
    443  
     411      ! 
    444412      ! set default neighbours 
    445413      noso = ii_noso(narea) 
     
    477445         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj ' 
    478446 
    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)  
     447         DO jproc = 1, jpnij 
     448            ii = iin(jproc) 
     449            ij = ijn(jproc) 
     450            WRITE(inum,'(15i5)') jproc-1, nlcit  (jproc), nlcjt  (jproc),   & 
     451               &                          nldit  (jproc), nldjt  (jproc),   & 
     452               &                          nleit  (jproc), nlejt  (jproc),   & 
     453               &                          nimppt (jproc), njmppt (jproc),   &  
     454               &                          ii_nono(jproc), ii_noso(jproc),   & 
     455               &                          ii_nowe(jproc), ii_noea(jproc),   & 
     456               &                          ibondi (ii,ij), ibondj (ii,ij)  
    490457         END DO 
    491458         CLOSE(inum)    
    492459      END IF 
    493460 
     461      !                          ! north fold parameter 
    494462      ! Defined npolj, either 0, 3 , 4 , 5 , 6 
    495463      ! In this case the important thing is that npolj /= 0 
    496464      ! Because if we go through these line it is because jpni >1 and thus 
    497465      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0 
    498  
    499466      npolj = 0 
    500467      ij = ijn(narea) 
    501  
    502468      IF( jperio == 3 .OR. jperio == 4 ) THEN 
    503          IF( ij == jpnj ) npolj = 3 
    504       ENDIF 
    505  
     469         IF( ij == jpnj )   npolj = 3 
     470      ENDIF 
    506471      IF( jperio == 5 .OR. jperio == 6 ) THEN 
    507          IF( ij == jpnj ) npolj = 5 
    508       ENDIF 
    509  
    510       ! Periodicity : no corner if nbondi = 2 and nperio != 1 
    511  
     472         IF( ij == jpnj )   npolj = 5 
     473      ENDIF 
     474      ! 
    512475      IF(lwp) THEN 
     476         WRITE(numout,*) 
    513477         WRITE(numout,*) ' nproc  = ', nproc 
    514478         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea 
     
    526490         WRITE(numout,*) ' jpreci = ', jpreci  
    527491         WRITE(numout,*) ' jprecj = ', jprecj  
    528          WRITE(numout,*) 
    529       ENDIF 
    530  
    531       IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' ) 
    532  
    533       ! Prepare mpp north fold 
    534  
     492      ENDIF 
     493 
     494      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( 'mpp_init: error on cyclicity' ) 
     495 
     496      !                          ! Prepare mpp north fold 
    535497      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN 
    536498         CALL mpp_ini_north 
    537499         IF(lwp) WRITE(numout,*) ' mpp_init : North fold boundary prepared for jpni >1' 
    538500      ENDIF 
    539  
    540       ! Prepare NetCDF output file (if necessary) 
    541       CALL mpp_init_ioipsl 
    542  
    543  
     501      ! 
     502      CALL mpp_init_ioipsl       ! Prepare NetCDF output file (if necessary) 
     503      ! 
    544504    END SUBROUTINE mpp_init 
    545505 
    546     SUBROUTINE mpp_init_mask(kmask) 
     506 
     507    SUBROUTINE mpp_init_mask( kmask ) 
    547508      !!---------------------------------------------------------------------- 
    548509      !!                  ***  ROUTINE mpp_init_mask  *** 
     
    555516      !!              in order to choose the correct bathymetric information 
    556517      !!              (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 
     518      !!---------------------------------------------------------------------- 
     519      INTEGER, DIMENSION(jpiglo,jpjglo), INTENT(out) ::   kmask   ! global domain  
    564520   
    565521      INTEGER :: inum   !: logical unit for configuration file 
     
    586542      ! 
    587543      ! 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 
     544      WHERE( zbot(:,:) > 0 )   ;   kmask(:,:) = 1 
     545      ELSEWHERE                ;   kmask(:,:) = 0 
    590546      END WHERE 
    591547   
    592       ! Adjust kmask with bdy_msk if exists 
     548      ! Adjust kmask with bdy_msk if it exists 
    593549   
    594550      REWIND( numnam_ref )              ! Namelist nambdy in reference namelist : BDY 
     
    602558      IF( ln_bdy .AND. ln_mask_file ) THEN 
    603559         CALL iom_open( cn_mask_file, inum ) 
    604          CALL iom_get ( inum, jpdom_unknown, 'bdy_msk', zbdy) 
     560         CALL iom_get ( inum, jpdom_unknown, 'bdy_msk', zbdy ) 
    605561         CALL iom_close( inum ) 
    606562         WHERE ( zbdy(:,:) <= 0. ) kmask = 0 
    607563      ENDIF 
    608  
     564      ! 
    609565   END SUBROUTINE mpp_init_mask 
     566 
    610567 
    611568   SUBROUTINE mpp_init_ioipsl 
Note: See TracChangeset for help on using the changeset viewer.