Index: /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 2442)
+++ /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 2442)
@@ -0,0 +1,556 @@
+MODULE istate
+   !!======================================================================
+   !!                     ***  MODULE  istate  ***
+   !! Ocean state   :  initial state setting
+   !!=====================================================================
+   !! History :  OPA  !  1989-12  (P. Andrich)  Original code
+   !!            5.0  !  1991-11  (G. Madec)  rewritting
+   !!            6.0  !  1996-01  (G. Madec)  terrain following coordinates
+   !!            8.0  !  2001-09  (M. Levy, M. Ben Jelloul)  istate_eel
+   !!            8.0  !  2001-09  (M. Levy, M. Ben Jelloul)  istate_uvg
+   !!   NEMO     1.0  !  2003-08  (G. Madec, C. Talandier)  F90: Free form, modules + EEL R5
+   !!             -   !  2004-05  (A. Koch-Larrouy)  istate_gyre 
+   !!            2.0  !  2006-07  (S. Masson)  distributed restart using iom
+   !!            3.3  !  2010-10  (C. Ethe) merge TRC-TRA
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   istate_init   : initial state setting
+   !!   istate_tem    : analytical profile for initial Temperature
+   !!   istate_sal    : analytical profile for initial Salinity
+   !!   istate_eel    : initial state setting of EEL R5 configuration
+   !!   istate_gyre   : initial state setting of GYRE configuration
+   !!   istate_uvg    : initial velocity in geostropic balance
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers 
+   USE dom_oce         ! ocean space and time domain 
+   USE daymod          ! calendar
+   USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine)
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE phycst          ! physical constants
+   USE dtatem          ! temperature data                 (dta_tem routine)
+   USE dtasal          ! salinity data                    (dta_sal routine)
+   USE restart         ! ocean restart                   (rst_read routine)
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+   USE zpshde          ! partial step: hor. derivative (zps_hde routine)
+   USE eosbn2          ! equation of state            (eos bn2 routine)
+   USE domvvl          ! varying vertical mesh
+   USE dynspg_oce      ! pressure gradient schemes
+   USE dynspg_flt      ! pressure gradient schemes
+   USE dynspg_exp      ! pressure gradient schemes
+   USE dynspg_ts       ! pressure gradient schemes
+   USE traswp          ! Swap arrays                      (tra_swp routine)
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   istate_init   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE istate_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_init  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracer fields.
+      !!----------------------------------------------------------------------
+      ! - ML - needed for initialization of e3t_b
+      INTEGER  ::  jk     ! dummy loop indice
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+      rhd  (:,:,:) = 0.e0
+      rhop (:,:,:) = 0.e0
+      rn2  (:,:,:) = 0.e0 
+      ta   (:,:,:) = 0.e0    
+      sa   (:,:,:) = 0.e0
+
+      IF( ln_rstart ) THEN                    ! Restart from a file
+         !                                    ! -------------------
+         neuler = 1                              ! Set time-step indicator at nit000 (leap-frog)
+         CALL rst_read                           ! Read the restart file
+         CALL tra_swap                           ! swap 3D arrays (t,s)  in a 4D array (ts)
+         CALL day_init                           ! model calendar (using both namelist and restart infos)
+      ELSE
+         !                                    ! Start from rest
+         !                                    ! ---------------
+         numror = 0                              ! define numror = 0 -> no restart file to read
+         neuler = 0                              ! Set time-step indicator at nit000 (euler forward)
+         CALL day_init                           ! model calendar (using both namelist and restart infos)
+         !                                       ! Initialization of ocean to zero
+         !   before fields     !       now fields     
+         sshb (:,:)   = 0.e0   ;   sshn (:,:)   = 0.e0
+         ub   (:,:,:) = 0.e0   ;   un   (:,:,:) = 0.e0
+         vb   (:,:,:) = 0.e0   ;   vn   (:,:,:) = 0.e0  
+         rotb (:,:,:) = 0.e0   ;   rotn (:,:,:) = 0.e0
+         hdivb(:,:,:) = 0.e0   ;   hdivn(:,:,:) = 0.e0
+         !
+         IF( cp_cfg == 'eel' ) THEN
+            CALL istate_eel                      ! EEL   configuration : start from pre-defined U,V T-S fields
+         ELSEIF( cp_cfg == 'gyre' ) THEN         
+            CALL istate_gyre                     ! GYRE  configuration : start from pre-defined T-S fields
+         ELSE
+            !                                    ! Other configurations: Initial T-S fields
+#if defined key_dtatem
+            CALL dta_tem( nit000 )                  ! read 3D temperature data
+            tb(:,:,:) = t_dta(:,:,:)   ;   tn(:,:,:) = t_dta(:,:,:)
+            
+#else
+            IF(lwp) WRITE(numout,*)                 ! analytical temperature profile
+            IF(lwp) WRITE(numout,*)'             Temperature initialization using an analytic profile'
+            CALL istate_tem
+#endif
+#if defined key_dtasal
+            CALL dta_sal( nit000 )                  ! read 3D salinity data
+            sb(:,:,:) = s_dta(:,:,:)   ;   sn(:,:,:) = s_dta(:,:,:)
+#else
+            ! No salinity data
+            IF(lwp)WRITE(numout,*)                  ! analytical salinity profile
+            IF(lwp)WRITE(numout,*)'             Salinity initialisation using a constant value'
+            CALL istate_sal
+#endif
+         ENDIF
+         !
+         CALL tra_swap                     ! swap 3D arrays (tb,sb,tn,sn)  in a 4D array
+         CALL eos( tsb, rhd, rhop )        ! before potential and in situ densities
+#if ! defined key_c1d
+         IF( ln_zps )   CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv,  & ! zps: before hor. gradient
+            &                                       rhd, gru , grv  )   ! of t,s,rd at ocean bottom
+#endif
+         !   
+         ! - ML - sshn could be modified by istate_eel, so that initialization of fse3t_b is done here
+         IF( lk_vvl ) THEN
+            DO jk = 1, jpk
+               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
+            ENDDO
+         ENDIF
+         ! 
+      ENDIF
+      !
+      IF( lk_agrif ) THEN                  ! read free surface arrays in restart file
+         IF( ln_rstart ) THEN
+            IF( lk_dynspg_flt )   CALL flt_rst( nit000, 'READ' )      ! read or initialize the following fields
+            !                                                         ! gcx, gcxb for agrif_opa_init
+         ENDIF                                                        ! explicit case not coded yet with AGRIF
+      ENDIF
+      !
+   END SUBROUTINE istate_init
+
+
+   SUBROUTINE istate_tem
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE istate_tem  ***
+      !!   
+      !! ** Purpose :   Intialization of the temperature field with an 
+      !!      analytical profile or a file (i.e. in EEL configuration)
+      !!
+      !! ** Method  :   Use Philander analytic profile of temperature
+      !!
+      !! References :  Philander ???
+      !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, jk
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'istate_tem : initial temperature profile'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+      !
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               tn(ji,jj,jk) = (  ( ( 7.5 - 0.*ABS(gphit(ji,jj))/30. )   &
+                  &               *( 1.-TANH((fsdept(ji,jj,jk)-80.)/30.) )   &
+                  &            + 10.*(5000.-fsdept(ji,jj,jk))/5000.)  ) * tmask(ji,jj,jk)
+               tb(ji,jj,jk) = tn(ji,jj,jk)
+          END DO
+        END DO
+      END DO
+      !
+      IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
+         &                 1     , jpi   , 5     , 1     , jpk   ,   &
+         &                 1     , 1.    , numout                  )
+      !
+   END SUBROUTINE istate_tem
+
+
+   SUBROUTINE istate_sal
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE istate_sal  ***
+      !!
+      !! ** Purpose :   Intialize the salinity field with an analytic profile
+      !!
+      !! ** Method  :   Use to a constant value 35.5
+      !!              
+      !! ** Action  :   Initialize sn and sb
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   zsal = 35.50_wp
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'istate_sal : initial salinity : ', zsal
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+      !
+      sn(:,:,:) = zsal * tmask(:,:,:)
+      sb(:,:,:) = sn(:,:,:)
+      !
+   END SUBROUTINE istate_sal
+
+
+   SUBROUTINE istate_eel
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_eel  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers for EEL R5
+      !!      configuration (channel with or without a topographic bump)
+      !!
+      !! ** Method  : - set temprature field
+      !!              - set salinity field
+      !!              - set velocity field including horizontal divergence
+      !!                and relative vorticity fields
+      !!----------------------------------------------------------------------
+      USE divcur     ! hor. divergence & rel. vorticity      (div_cur routine)
+      USE iom
+ 
+      INTEGER  ::   inum              ! temporary logical unit
+      INTEGER  ::   ji, jj, jk        ! dummy loop indices
+      INTEGER  ::   ijloc
+      REAL(wp) ::   zh1, zh2, zslope, zcst, zfcor   ! temporary scalars
+      REAL(wp) ::   zt1  = 15._wp                   ! surface temperature value (EEL R5)
+      REAL(wp) ::   zt2  =  5._wp                   ! bottom  temperature value (EEL R5)
+      REAL(wp) ::   zsal = 35.0_wp                  ! constant salinity (EEL R2, R5 and R6)
+      REAL(wp) ::   zueel = 0.1_wp                  ! constant uniform zonal velocity (EEL R5)
+      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zssh  ! initial ssh over the global domain
+      !!----------------------------------------------------------------------
+
+      SELECT CASE ( jp_cfg ) 
+         !                                              ! ====================
+         CASE ( 5 )                                     ! EEL R5 configuration
+            !                                           ! ====================
+            !
+            ! set temperature field with a linear profile
+            ! -------------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: linear temperature profile'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            zh1 = gdept_0(  1  )
+            zh2 = gdept_0(jpkm1)
+            !
+            zslope = ( zt1 - zt2 ) / ( zh1 - zh2 )
+            zcst   = ( zt1 * ( zh1 - zh2) - ( zt1 - zt2 ) * zh1 ) / ( zh1 - zh2 )
+            !
+            DO jk = 1, jpk
+               tn(:,:,jk) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk)
+               tb(:,:,jk) = tn(:,:,jk)
+            END DO
+            !
+            IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
+               &                 1     , jpi   , 5     , 1     , jpk   ,   &
+               &                 1     , 1.    , numout                  )
+            !
+            ! set salinity field to a constant value
+            ! --------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            sn(:,:,:) = zsal * tmask(:,:,:)
+            sb(:,:,:) = sn(:,:,:)
+            !
+            ! set the dynamics: U,V, hdiv, rot (and ssh if necessary)
+            ! ----------------
+            ! Start EEL5 configuration with barotropic geostrophic velocities 
+            ! according the sshb and sshn SSH imposed.
+            ! we assume a uniform grid (hence the use of e1t(1,1) for delta_y)
+            ! we use the Coriolis frequency at mid-channel.   
+            ub(:,:,:) = zueel * umask(:,:,:)
+            un(:,:,:) = ub(:,:,:)
+            ijloc = mj0(INT(jpjglo-1)/2)
+            zfcor = ff(1,ijloc)
+            !
+            DO jj = 1, jpjglo
+               zssh(:,jj) = - (FLOAT(jj)- FLOAT(jpjglo-1)/2.)*zueel*e1t(1,1)*zfcor/grav 
+            END DO
+            !
+            IF(lwp) THEN
+               WRITE(numout,*) ' Uniform zonal velocity for EEL R5:',zueel
+               WRITE(numout,*) ' Geostrophic SSH profile as a function of y:'
+               WRITE(numout,'(12(1x,f6.2))') zssh(1,:)
+            ENDIF
+            !
+            DO jj = 1, nlcj
+               DO ji = 1, nlci
+                  sshb(ji,jj) = zssh( mig(ji) , mjg(jj) ) * tmask(ji,jj,1)
+               END DO
+            END DO
+            sshb(nlci+1:jpi,      :   ) = 0.e0      ! set to zero extra mpp columns
+            sshb(      :   ,nlcj+1:jpj) = 0.e0      ! set to zero extra mpp rows
+            !
+            sshn(:,:) = sshb(:,:)                   ! set now ssh to the before value
+            !
+            IF( nn_rstssh /= 0 ) THEN  
+               nn_rstssh = 0                        ! hand-made initilization of ssh 
+               CALL ctl_warn( 'istate_eel: force nn_rstssh = 0' )
+            ENDIF
+            !
+            CALL div_cur( nit000 )                  ! horizontal divergence and relative vorticity (curl)
+            ! N.B. the vertical velocity will be computed from the horizontal divergence field
+            ! in istate by a call to wzv routine
+
+
+            !                                     ! ==========================
+         CASE ( 2 , 6 )                           ! EEL R2 or R6 configuration
+            !                                     ! ==========================
+            !
+            ! set temperature field with a NetCDF file
+            ! ----------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R2 or R6: read initial temperature in a NetCDF file'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            CALL iom_open ( 'eel.initemp', inum )
+            CALL iom_get ( inum, jpdom_data, 'initemp', tb ) ! read before temprature (tb)
+            CALL iom_close( inum )
+            !
+            tn(:,:,:) = tb(:,:,:)                            ! set nox temperature to tb
+            !
+            IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
+               &                 1     , jpi   , 5     , 1     , jpk   ,   &
+               &                 1     , 1.    , numout                  )
+            !
+            ! set salinity field to a constant value
+            ! --------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            sn(:,:,:) = zsal * tmask(:,:,:)
+            sb(:,:,:) = sn(:,:,:)
+            !
+            !                                    ! ===========================
+         CASE DEFAULT                            ! NONE existing configuration
+            !                                    ! ===========================
+            WRITE(ctmp1,*) 'EEL with a ', jp_cfg,' km resolution is not coded'
+            CALL ctl_stop( ctmp1 )
+            !
+      END SELECT
+      !
+   END SUBROUTINE istate_eel
+
+
+   SUBROUTINE istate_gyre
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_gyre  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers for GYRE
+      !!      configuration (double gyre with rotated domain)
+      !!
+      !! ** Method  : - set temprature field
+      !!              - set salinity field
+      !!----------------------------------------------------------------------
+      INTEGER :: ji, jj, jk  ! dummy loop indices
+      INTEGER            ::   inum          ! temporary logical unit
+      INTEGER, PARAMETER ::   ntsinit = 0   ! (0/1) (analytical/input data files) T&S initialization
+      !!----------------------------------------------------------------------
+
+      SELECT CASE ( ntsinit)
+
+      CASE ( 0 )                  ! analytical T/S profil deduced from LEVITUS
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'istate_gyre : initial analytical T and S profil deduced from LEVITUS '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  tn(ji,jj,jk) = (  16. - 12. * TANH( (fsdept(ji,jj,jk) - 400) / 700 )         )   &
+                       &           * (-TANH( (500-fsdept(ji,jj,jk)) / 150 ) + 1) / 2               &
+                       &       + (      15. * ( 1. - TANH( (fsdept(ji,jj,jk)-50.) / 1500.) )       &
+                       &                - 1.4 * TANH((fsdept(ji,jj,jk)-100.) / 100.)               &    
+                       &                + 7.  * (1500. - fsdept(ji,jj,jk)) / 1500.             )   & 
+                       &           * (-TANH( (fsdept(ji,jj,jk) - 500) / 150) + 1) / 2
+                  tn(ji,jj,jk) = tn(ji,jj,jk) * tmask(ji,jj,jk)
+                  tb(ji,jj,jk) = tn(ji,jj,jk)
+
+                  sn(ji,jj,jk) =  (  36.25 - 1.13 * TANH( (fsdept(ji,jj,jk) - 305) / 460 )  )  &
+                     &              * (-TANH((500 - fsdept(ji,jj,jk)) / 150) + 1) / 2          &
+                     &          + (  35.55 + 1.25 * (5000. - fsdept(ji,jj,jk)) / 5000.         &
+                     &                - 1.62 * TANH( (fsdept(ji,jj,jk) - 60.  ) / 650. )       &
+                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 35.  ) / 100. )       &
+                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 1000.) / 5000.)    )  &
+                     &              * (-TANH((fsdept(ji,jj,jk) - 500) / 150) + 1) / 2 
+                  sn(ji,jj,jk) = sn(ji,jj,jk) * tmask(ji,jj,jk)
+                  sb(ji,jj,jk) = sn(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+      CASE ( 1 )                  ! T/S data fields read in dta_tem.nc/data_sal.nc files
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'istate_gyre : initial T and S read from dta_tem.nc/data_sal.nc files'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         IF(lwp) WRITE(numout,*) '              NetCDF FORMAT'
+
+         ! Read temperature field
+         ! ----------------------
+         CALL iom_open ( 'data_tem', inum )
+         CALL iom_get ( inum, jpdom_data, 'votemper', tn ) 
+         CALL iom_close( inum )
+
+         tn(:,:,:) = tn(:,:,:) * tmask(:,:,:) 
+         tb(:,:,:) = tn(:,:,:)
+
+         ! Read salinity field
+         ! -------------------
+         CALL iom_open ( 'data_sal', inum )
+         CALL iom_get ( inum, jpdom_data, 'vosaline', sn ) 
+         CALL iom_close( inum )
+
+         sn(:,:,:)  = sn(:,:,:) * tmask(:,:,:) 
+         sb(:,:,:)  = sn(:,:,:)
+
+      END SELECT
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '              Initial temperature and salinity profiles:'
+         WRITE(numout, "(9x,' level   gdept_0   temperature   salinity   ')" )
+         WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_0(jk), tn(2,2,jk), sn(2,2,jk), jk = 1, jpk )
+      ENDIF
+
+   END SUBROUTINE istate_gyre
+
+
+   SUBROUTINE istate_uvg
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE istate_uvg  ***
+      !!
+      !! ** Purpose :   Compute the geostrophic velocities from (tn,sn) fields
+      !!
+      !! ** Method  :   Using the hydrostatic hypothesis the now hydrostatic 
+      !!      pressure is computed by integrating the in-situ density from the
+      !!      surface to the bottom.
+      !!                 p=integral [ rau*g dz ]
+      !!----------------------------------------------------------------------
+      USE dynspg          ! surface pressure gradient             (dyn_spg routine)
+      USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine)
+      USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+
+      INTEGER ::   ji, jj, jk        ! dummy loop indices
+      INTEGER ::   indic             ! ???
+      REAL(wp) ::   zmsv, zphv, zmsu, zphu, zalfg     ! temporary scalars
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zprn     ! workspace
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*) 
+      IF(lwp) WRITE(numout,*) 'istate_uvg : Start from Geostrophy'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+      ! Compute the now hydrostatic pressure
+      ! ------------------------------------
+
+      zalfg = 0.5 * grav * rau0
+      
+      zprn(:,:,1) = zalfg * fse3w(:,:,1) * ( 1 + rhd(:,:,1) )       ! Surface value
+
+      DO jk = 2, jpkm1                                              ! Vertical integration from the surface
+         zprn(:,:,jk) = zprn(:,:,jk-1)   &
+            &         + zalfg * fse3w(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) )
+      END DO  
+
+      ! Compute geostrophic balance
+      ! ---------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vertor opt.
+               zmsv = 1. / MAX(  umask(ji-1,jj+1,jk) + umask(ji  ,jj+1,jk)   &
+                               + umask(ji-1,jj  ,jk) + umask(ji  ,jj  ,jk) , 1.  )
+               zphv = ( zprn(ji  ,jj+1,jk) - zprn(ji-1,jj+1,jk) ) * umask(ji-1,jj+1,jk) / e1u(ji-1,jj+1)   &
+                    + ( zprn(ji+1,jj+1,jk) - zprn(ji  ,jj+1,jk) ) * umask(ji  ,jj+1,jk) / e1u(ji  ,jj+1)   &
+                    + ( zprn(ji  ,jj  ,jk) - zprn(ji-1,jj  ,jk) ) * umask(ji-1,jj  ,jk) / e1u(ji-1,jj  )   &
+                    + ( zprn(ji+1,jj  ,jk) - zprn(ji  ,jj  ,jk) ) * umask(ji  ,jj  ,jk) / e1u(ji  ,jj  )
+               zphv = 1. / rau0 * zphv * zmsv * vmask(ji,jj,jk)
+
+               zmsu = 1. / MAX(  vmask(ji+1,jj  ,jk) + vmask(ji  ,jj  ,jk)   &
+                               + vmask(ji+1,jj-1,jk) + vmask(ji  ,jj-1,jk) , 1.  )
+               zphu = ( zprn(ji+1,jj+1,jk) - zprn(ji+1,jj  ,jk) ) * vmask(ji+1,jj  ,jk) / e2v(ji+1,jj  )   &
+                    + ( zprn(ji  ,jj+1,jk) - zprn(ji  ,jj  ,jk) ) * vmask(ji  ,jj  ,jk) / e2v(ji  ,jj  )   &
+                    + ( zprn(ji+1,jj  ,jk) - zprn(ji+1,jj-1,jk) ) * vmask(ji+1,jj-1,jk) / e2v(ji+1,jj-1)   &
+                    + ( zprn(ji  ,jj  ,jk) - zprn(ji  ,jj-1,jk) ) * vmask(ji  ,jj-1,jk) / e2v(ji  ,jj-1)
+               zphu = 1. / rau0 * zphu * zmsu * umask(ji,jj,jk)
+
+               ! Compute the geostrophic velocities
+               un(ji,jj,jk) = -2. * zphu / ( ff(ji,jj) + ff(ji  ,jj-1) )
+               vn(ji,jj,jk) =  2. * zphv / ( ff(ji,jj) + ff(ji-1,jj  ) )
+            END DO
+         END DO
+      END DO
+
+      IF(lwp) WRITE(numout,*) '         we force to zero bottom velocity'
+
+      ! Susbtract the bottom velocity (level jpk-1 for flat bottom case)
+      ! to have a zero bottom velocity
+
+      DO jk = 1, jpkm1
+         un(:,:,jk) = ( un(:,:,jk) - un(:,:,jpkm1) ) * umask(:,:,jk)
+         vn(:,:,jk) = ( vn(:,:,jk) - vn(:,:,jpkm1) ) * vmask(:,:,jk)
+      END DO
+
+      CALL lbc_lnk( un, 'U', -1. )
+      CALL lbc_lnk( vn, 'V', -1. )
+      
+      ub(:,:,:) = un(:,:,:)
+      vb(:,:,:) = vn(:,:,:)
+      
+      ! WARNING !!!!!
+      ! after initializing u and v, we need to calculate the initial streamfunction bsf.
+      ! Otherwise, only the trend will be computed and the model will blow up (inconsistency).
+      ! to do that, we call dyn_spg with a special trick:
+      ! we fill ua and va with the velocities divided by dt, and the streamfunction will be brought to the
+      ! right value assuming the velocities have been set up in one time step.
+      ! we then set bsfd to zero (first guess for next step is d(psi)/dt = 0.)
+      !  sets up s false trend to calculate the barotropic streamfunction.
+
+      ua(:,:,:) = ub(:,:,:) / rdt
+      va(:,:,:) = vb(:,:,:) / rdt
+
+      ! calls dyn_spg. we assume euler time step, starting from rest.
+      indic = 0
+      CALL dyn_spg( nit000, indic )       ! surface pressure gradient
+
+      ! the new velocity is ua*rdt
+
+      CALL lbc_lnk( ua, 'U', -1. )
+      CALL lbc_lnk( va, 'V', -1. )
+
+      ub(:,:,:) = ua(:,:,:) * rdt
+      vb(:,:,:) = va(:,:,:) * rdt
+      ua(:,:,:) = 0.e0
+      va(:,:,:) = 0.e0
+      un(:,:,:) = ub(:,:,:)
+      vn(:,:,:) = vb(:,:,:)
+       
+      ! Compute the divergence and curl
+
+      CALL div_cur( nit000 )            ! now horizontal divergence and curl
+
+      hdivb(:,:,:) = hdivn(:,:,:)       ! set the before to the now value
+      rotb (:,:,:) = rotn (:,:,:)       ! set the before to the now value
+      !
+   END SUBROUTINE istate_uvg
+
+   !!=====================================================================
+END MODULE istate
Index: /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90	(revision 2442)
+++ /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90	(revision 2442)
@@ -0,0 +1,742 @@
+MODULE cla
+   !!======================================================================
+   !!                    ***  MODULE  cla  ***
+   !! Cross Land Advection : specific update of the horizontal divergence,
+   !!                        tracer trends and after velocity
+   !!
+   !!                 ---   Specific to ORCA_R2   ---
+   !!
+   !!======================================================================
+   !! History :  1.0  ! 2002-11 (A. Bozec)  Original code
+   !!            3.2  ! 2009-07 (G. Madec)  merge cla, cla_div, tra_cla, cla_dynspg
+   !!                 !                     and correct a mpp bug reported by A.R. Porter
+   !!----------------------------------------------------------------------
+#if defined key_orca_r2
+   !!----------------------------------------------------------------------
+   !!   'key_orca_r2'                                 global ocean model R2
+   !!----------------------------------------------------------------------
+   !!   cla_div           : update of horizontal divergence at cla straits
+   !!   tra_cla           : update of tracers at cla straits
+   !!   cla_dynspg        : update of after horizontal velocities at cla straits
+   !!   cla_init          : initialisation - control check
+   !!   cla_bab_el_mandeb : cross land advection for Bab-el-mandeb strait
+   !!   cla_gibraltar     : cross land advection for Gibraltar strait
+   !!   cla_hormuz        : cross land advection for Hormuz strait
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE dynspg_oce     ! ocean dynamics: surface pressure gradient variables
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distributed memory computing library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   cla_init     ! routine called by opa.F90
+   PUBLIC   cla_div      ! routine called by divcur.F90
+   PUBLIC   cla_traadv   ! routine called by traadv.F90
+   PUBLIC   cla_dynspg   ! routine called by dynspg_flt.F90
+
+   INTEGER  ::   nbab, ngib, nhor   ! presence or not of required grid-point on local domain
+   !                                ! for Bab-el-Mandeb, Gibraltar, and Hormuz straits
+   
+   !                                                              !!! profile of hdiv for some straits
+   REAL(wp), DIMENSION (jpk) ::   hdiv_139_101, hdiv_139_101_kt    ! Gibraltar     strait, fixed & time evolving part (i,j)=(172,101)
+   REAL(wp), DIMENSION (jpk) ::   hdiv_139_102                     ! Gibraltar     strait, fixed part only            (i,j)=(139,102)
+   REAL(wp), DIMENSION (jpk) ::   hdiv_141_102, hdiv_141_102_kt    ! Gibraltar     strait, fixed & time evolving part (i,j)=(141,102)
+   REAL(wp), DIMENSION (jpk) ::   hdiv_161_88 , hdiv_161_88_kt     ! Bab-el-Mandeb strait, fixed & time evolving part (i,j)=(161,88)
+   REAL(wp), DIMENSION (jpk) ::   hdiv_161_87                      ! Bab-el-Mandeb strait, fixed part only            (i,j)=(161,87)
+   REAL(wp), DIMENSION (jpk) ::   hdiv_160_89 , hdiv_160_89_kt     ! Bab-el-Mandeb strait, fixed & time evolving part (i,j)=(160,89)
+   REAL(wp), DIMENSION (jpk) ::   hdiv_172_94                      ! Hormuz        strait, fixed part only            (i,j)=(172, 94)
+
+   REAL(wp), DIMENSION (jpk) ::   t_171_94_hor, s_171_94_hor       ! Temperature, salinity in the Hormuz strait
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE cla_div( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE div_cla  ***
+      !!
+      !! ** Purpose :   update the horizontal divergence of the velocity field
+      !!              at some straits ( Gibraltar, Bab el Mandeb and Hormuz ).
+      !!
+      !! ** Method  : - first time-step: initialisation of cla
+      !!              - all   time-step: using imposed transport at each strait, 
+      !!              the now horizontal divergence is updated
+      !!
+      !! ** Action  :   phdivn   updted now horizontal divergence at cla straits
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!----------------------------------------------------------------------
+      !     
+      IF( kt == nit000 ) THEN
+         !
+         CALL cla_init                                        ! control check 
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'div_cla : cross land advection on hdiv '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~'
+         !
+         IF( nbab == 1 )   CALL cla_bab_el_mandeb('ini')    ! Bab el Mandeb ( Red Sea - Indian ocean )
+         IF( ngib == 1 )   CALL cla_gibraltar    ('ini')    ! Gibraltar strait (Med Sea - Atlantic ocean)
+         IF( nhor == 1 )   CALL cla_hormuz       ('ini')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
+         !
+      ENDIF                           
+      !
+      IF( nbab == 1    )   CALL cla_bab_el_mandeb('div')    ! Bab el Mandeb ( Red Sea - Indian ocean )
+      IF( ngib == 1    )   CALL cla_gibraltar    ('div')    ! Gibraltar strait (Med Sea - Atlantic ocean)
+      IF( nhor == 1    )   CALL cla_hormuz       ('div')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
+      !
+!!gm  lbc useless here, no?
+!!gm      CALL lbc_lnk( hdivn, 'T', 1. )                    ! Lateral boundary conditions on hdivn
+      !
+   END SUBROUTINE cla_div
+   
+   
+   SUBROUTINE cla_traadv( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tra_cla  ***
+      !!                   
+      !! ** Purpose :   Update the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations
+      !!      at some straits ( Bab el Mandeb, Gibraltar, Hormuz ).
+      !!
+      !! ** Method  :   using both imposed transport at each strait and T & S
+      !!              budget, the now tracer trends is updated
+      !!
+      !! ** Action  :   (ta,sa)   updated now tracer trends at cla straits
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_cla : cross land advection on tracers '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+      !
+      IF( nbab == 1    )   CALL cla_bab_el_mandeb('tra')      ! Bab el Mandeb strait
+      IF( ngib == 1    )   CALL cla_gibraltar    ('tra')      ! Gibraltar strait
+      IF( nhor == 1    )   CALL cla_hormuz       ('tra')      ! Hormuz Strait ( Persian Gulf)
+      !
+   END SUBROUTINE cla_traadv
+
+   
+   SUBROUTINE cla_dynspg( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE cla_dynspg  ***
+      !!                   
+      !! ** Purpose :   Update the after velocity at some straits 
+      !!              (Bab el Mandeb, Gibraltar, Hormuz).
+      !!
+      !! ** Method  :   required to compute the filtered surface pressure gradient 
+      !!
+      !! ** Action  :   (ua,va)   after velocity at the cla straits
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'cla_dynspg : cross land advection on (ua,va) '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+      ENDIF
+      !
+      IF( nbab == 1    )   CALL cla_bab_el_mandeb('spg')      ! Bab el Mandeb strait
+      IF( ngib == 1    )   CALL cla_gibraltar    ('spg')      ! Gibraltar strait
+      IF( nhor == 1    )   CALL cla_hormuz       ('spg')      ! Hormuz Strait ( Persian Gulf)
+      !
+!!gm lbc is needed here, not?
+!!gm      CALL lbc_lnk( hdivn, 'U', -1. )   ;   CALL lbc_lnk( hdivn, 'V', -1. )      ! Lateral boundary conditions 
+      !
+   END SUBROUTINE cla_dynspg
+
+
+   SUBROUTINE cla_init
+      !! -------------------------------------------------------------------
+      !!                   ***  ROUTINE cla_init  ***
+      !!           
+      !! ** Purpose :   control check for mpp computation  
+      !!
+      !! ** Method  : - All the strait grid-points must be inside one of the 
+      !!              local domain interior for the cla advection to work
+      !!              properly in mpp (i.e. inside (2:jpim1,2:jpjm1) ).
+      !!              Define the corresponding indicators (nbab, ngib, nhor)
+      !!              - The profiles of cross-land fluxes are currently hard
+      !!              coded for L31 levels. Stop if jpk/=31
+      !!
+      !! ** Action  :   nbab, ngib, nhor   strait inside the local domain or not
+      !!---------------------------------------------------------------------
+      REAL(wp) ::   ztemp
+      !!---------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cla_init : cross land advection initialisation '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+      !
+      IF( .NOT.lk_dynspg_flt )   CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' )
+      !
+      IF( lk_vvl    )   CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' )
+      !
+      IF( jpk /= 31 )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' )
+      !
+      !                                        _|_______|_______|_
+      !                                     89  |       |///////|  
+      !                                        _|_______|_______|_
+      ! ------------------------ !          88  |///////|       | 
+      !   Bab el Mandeb strait   !             _|_______|_______|_
+      ! ------------------------ !          87  |///////|       | 
+      !                                        _|_______|_______|_
+      !                                         |  160  |  161  |  
+      !
+      ! The 6 Bab el Mandeb grid-points must be inside one of the interior of the
+      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
+      nbab = 0
+      IF(  ( 1 <= mj0( 88) .AND. mj1( 89) <= jpj ) .AND.    &  !* (161,89), (161,88) and (161,88) on the local pocessor
+         & ( 1 <= mi0(160) .AND. mi1(161) <= jpi )       )    nbab = 1 
+      !
+      ! test if there is no local domain that includes all required grid-points
+      ztemp = REAL( nbab )
+      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
+      IF( ztemp == 0 ) THEN                     ! Only 2 points in each direction, this should never be a problem
+         CALL ctl_stop( ' cross land advection at Bab-el_Mandeb does not work with your processor cutting: change it' )
+      ENDIF
+      !                                        ___________________________
+      ! ------------------------ !         102  |       |///////|       |
+      !     Gibraltar strait     !             _|_______|_______|_______|_
+      ! ------------------------ !         101  |       |///////|       |
+      !                                        _|_______|_______|_______|_ 
+      !                                         |  139  |  140  |  141  |
+      !
+      ! The 6 Gibraltar grid-points must be inside one of the interior of the
+      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
+      ngib = 0
+      IF(  ( 2 <= mj0(101) .AND. mj1(102) <= jpjm1 ) .AND.    &  !* (139:141,101:102) on the local pocessor
+         & ( 2 <= mi0(139) .AND. mi1(141) <= jpim1 )       )    ngib = 1 
+      !
+      ! test if there is no local domain that includes all required grid-points
+      ztemp = REAL( ngib )
+      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
+      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
+           CALL ctl_stop( ' cross land advection at Gibraltar does not work with your processor cutting: change it' )
+      ENDIF
+      !                                        _______________
+      ! ------------------------ !          94  |/////|     | 
+      !       Hormuz strait      !             _|_____|_____|_
+      ! ------------------------ !                171   172     
+      !           
+      ! The 2 Hormuz grid-points must be inside one of the interior of the
+      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
+      nhor = 0
+      IF(    2 <= mj0( 94) .AND. mj1( 94) <= jpjm1  .AND.  & 
+         &   2 <= mi0(171) .AND. mi1(172) <= jpim1         )   nhor = 1 
+      !
+      ! test if there is no local domain that includes all required grid-points
+      ztemp = REAL( nhor )
+      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
+      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
+           CALL ctl_stop( ' cross land advection at Hormuz does not work with your processor cutting: change it' )
+      ENDIF
+      !
+   END SUBROUTINE cla_init
+
+
+   SUBROUTINE cla_bab_el_mandeb( cd_td )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE cla_bab_el_mandeb  ***
+      !!       
+      !! ** Purpose :   update the now horizontal divergence, the tracer tendancy
+      !!              and the after velocity in vicinity of Bab el Mandeb ( Red Sea - Indian ocean).
+      !!
+      !! ** Method  :   compute the exchanges at each side of the strait :
+      !!
+      !!       surf. zio_flow
+      !! (+ balance of emp) /\  |\\\\\\\\\\\|
+      !!                    ||  |\\\\\\\\\\\|  
+      !!    deep zio_flow   ||  |\\\\\\\\\\\|  
+      !!            |  ||   ||  |\\\\\\\\\\\|  
+      !!        89  |  ||   ||  |\\\\\\\\\\\|  
+      !!            |__\/_v_||__|____________ 
+      !!            !\\\\\\\\\\\|          surf. zio_flow
+      !!            |\\\\\\\\\\\|<===    (+ balance of emp)
+      !!            |\\\\\\\\\\\u
+      !!        88  |\\\\\\\\\\\|<---      deep  zrecirc (upper+deep at 2 different levels)
+      !!            |___________|__________   
+      !!            !\\\\\\\\\\\|         
+      !!            |\\\\\\\\\\\| ---\     deep  zrecirc (upper+deep) 
+      !!        87  !\\\\\\\\\\\u ===/   + deep  zio_flow   (all at the same level)
+      !!            !\\\\\\\\\\\|  
+      !!            !___________|__________ 
+      !!                160         161
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
+      !                                         ! ='tra' update the tracers
+      !                                         ! ='spg' update after velocity
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zemp_red     ! temporary scalar
+      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
+      !!---------------------------------------------------------------------
+      !
+      SELECT CASE( cd_td ) 
+      !                     ! ---------------- !
+      CASE( 'ini' )         !  initialisation  ! 
+         !                  ! ---------------- ! 
+         !                                   
+         zio_flow    = 0.4e6                       ! imposed in/out flow
+         zrecirc_upp = 0.2e6                       ! imposed upper recirculation water
+         zrecirc_bot = 0.5e6                       ! imposed bottom  recirculation water
+
+         hdiv_161_88(:) = 0.e0                     ! (161,88) Gulf of Aden side, north point
+         hdiv_161_87(:) = 0.e0                     ! (161,87) Gulf of Aden side, south point
+         hdiv_160_89(:) = 0.e0                     ! (160,89) Red sea side
+
+         DO jj = mj0(88), mj1(88)              !** profile of hdiv at (161,88)   (Gulf of Aden side, north point)
+            DO ji = mi0(161), mi1(161)         !------------------------------
+               DO jk = 1, 8                        ! surface in/out flow   (Ind -> Red)   (div >0)
+                  hdiv_161_88(jk) = + zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                   ! recirculation water   (Ind -> Red)   (div >0)
+               hdiv_161_88(20) =                 + zrecirc_upp   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,20) )
+               hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
+            END DO
+         END DO
+         !
+         DO jj = mj0(87), mj1(87)              !** profile of hdiv at (161,88)   (Gulf of Aden side, south point)
+            DO ji = mi0(161), mi1(161)         !------------------------------
+               !                                   ! deep out flow + recirculation   (Red -> Ind)   (div <0)
+               hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
+            END DO
+         END DO
+         !
+         DO jj = mj0(89), mj1(89)              !** profile of hdiv at (161,88)   (Red sea side)
+            DO ji = mi0(160), mi1(160)         !------------------------------
+               DO jk = 1, 8                        ! surface inflow    (Ind -> Red)   (div <0)
+                  hdiv_160_89(jk) = - zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                   ! deep    outflow   (Red -> Ind)   (div >0)
+               hdiv_160_89(16)    = + zio_flow / (      e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,16) )
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
+         !                  ! ---------=====-- ! 
+         !                                     !** emp on the Red Sea   (div >0) 
+         zemp_red = 0.e0                       !---------------------
+         DO jj = mj0(87), mj1(96)                  ! sum over the Red sea
+            DO ji = mi0(148), mi1(160) 
+               zemp_red = zemp_red + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( zemp_red )   ! sum with other processors value
+         zemp_red = zemp_red * 1.e-3               ! convert in m3
+         !
+         !                                     !** Correct hdivn (including emp adjustment)
+         !                                     !-------------------------------------------
+         DO jj = mj0(88), mj1(88)                  !* profile of hdiv at (161,88)   (Gulf of Aden side, north point)
+            DO ji = mi0(161), mi1(161) 
+               hdiv_161_88_kt(:) = hdiv_161_88(:)
+               DO jk = 1, 8                              ! increase the inflow from the Indian   (div >0) 
+                  hdiv_161_88_kt(jk) = hdiv_161_88(jk) + zemp_red / (8. * e2u(ji,jj) * fse3u(ji,jj,jk) )
+               END DO
+               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_88_kt(:)
+            END DO
+         END DO
+         DO jj = mj0(87), mj1(87)                  !* profile of divergence at (161,87)   (Gulf of Aden side, south point)
+            DO ji = mi0(161), mi1(161) 
+               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_87(:)
+            END DO
+         END DO
+         DO jj = mj0(89), mj1(89)                  !* profile of divergence at (160,89)   (Red sea side)
+            DO ji = mi0(160), mi1(160) 
+               hdiv_160_89_kt(:) = hdiv_160_89(:)
+               DO jk = 1, 18                              ! increase the inflow from the Indian   (div <0) 
+                  hdiv_160_89_kt(jk) = hdiv_160_89(jk) - zemp_red / (10. * e1v(ji,jj) * fse3v(ji,jj,jk) )
+               END DO
+               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_160_89_kt(:)
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
+         !                  ! --------=======- !
+         !
+         DO jj = mj0(88), mj1(88)              !** (161,88)   (Gulf of Aden side, north point)
+            DO ji = mi0(161), mi1(161) 
+               DO jk = 1, jpkm1                         ! surf inflow + reciculation (from Gulf of Aden)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_161_88_kt(jk) * tn(ji,jj,jk)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_161_88_kt(jk) * sn(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         DO jj = mj0(87), mj1(87)              !** (161,87)   (Gulf of Aden side, south point)
+            DO ji = mi0(161), mi1(161) 
+               jk =  21                                 ! deep outflow + recirulation (combined flux)
+               ta(ji,jj,jk) = ta(ji,jj,jk) + hdiv_161_88(20) * tn(ji  ,jj+1,20)   &  ! upper recirculation from Gulf of Aden
+                  &                        + hdiv_161_88(21) * tn(ji  ,jj+1,21)   &  ! deep  recirculation from Gulf of Aden
+                  &                        + hdiv_160_89(16) * tn(ji-1,jj+2,16)      ! deep inflow from Red sea
+               sa(ji,jj,jk) = sa(ji,jj,jk) + hdiv_161_88(20) * sn(ji  ,jj+1,20)   &
+                  &                        + hdiv_161_88(21) * sn(ji  ,jj+1,21)   &
+                  &                        + hdiv_160_89(16) * sn(ji-1,jj+2,16)   
+            END DO
+         END DO
+         DO jj = mj0(89), mj1(89)              !** (161,88)   (Red sea side)
+            DO ji = mi0(160), mi1(160)
+               DO jk = 1, 14                            ! surface inflow (from Gulf of Aden)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_160_89_kt(jk) * tn(ji+1,jj-1,jk)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_160_89_kt(jk) * sn(ji+1,jj-1,jk)
+               END DO
+               !                                        ! deep    outflow (from Red sea)
+               ta(ji,jj,16) = ta(ji,jj,16) - hdiv_160_89(jk) * tn(ji,jj,jk)
+               sa(ji,jj,16) = sa(ji,jj,16) - hdiv_160_89(jk) * sn(ji,jj,jk)
+            END DO
+         END DO
+         !
+         !                  ! ---------------- !
+      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
+         !                  ! --------=======- !
+         ! at this stage, (ua,va) are the after velocity, not the tendancy
+         ! compute the velocity from the divergence at T-point
+         !
+         DO jj = mj0(88), mj1(88)              !** (160,88)   (Gulf of Aden side, north point)
+            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point) 
+               ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
+                  &                              * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         DO jj = mj0(87), mj1(87)              !** (160,87)   (Gulf of Aden side, south point)
+            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point) 
+               ua(ji,jj,:) = - hdiv_161_87(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
+                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         DO jj = mj0(88), mj1(88)              !** profile of divergence at (160,89)   (Red sea side)
+            DO ji = mi0(160), mi1(160)                   ! 88, not 89 as it is a V-point)
+               va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1t(ji,jj+1) * e2t(ji,jj+1) * fse3t(ji,jj+1,:) )   &
+                  &                              * e1v(ji,jj) * fse3v(ji,jj,:)
+            END DO
+         END DO
+      END SELECT
+      !
+   END SUBROUTINE cla_bab_el_mandeb
+   
+
+   SUBROUTINE cla_gibraltar( cd_td )
+      !! -------------------------------------------------------------------
+      !!                 ***  ROUTINE cla_gibraltar  ***
+      !!        
+      !! ** Purpose :   update the now horizontal divergence, the tracer 
+      !!              tendancyand the after velocity in vicinity of Gibraltar 
+      !!              strait ( Persian Gulf - Indian ocean ).
+      !!
+      !! ** Method :
+      !!                     _______________________            
+      !!      deep  zio_flow /====|///////|====> surf. zio_flow
+      !!    + deep  zrecirc  \----|///////|     (+balance of emp)
+      !! 102                      u///////u
+      !!      mid.  recicul    <--|///////|<==== deep  zio_flow
+      !!                     _____|_______|_____  
+      !!      surf. zio_flow ====>|///////|       
+      !!    (+balance of emp)     |///////|
+      !! 101                      u///////|             
+      !!      mid.  recicul    -->|///////|               Caution: zrecirc split into 
+      !!      deep  zrecirc  ---->|///////|                  upper & bottom recirculation
+      !!                   _______|_______|_______ 
+      !!                     139     140     141  
+      !!
+      !!---------------------------------------------------------------------
+      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
+      !                                         ! ='tra' update the tracers
+      !                                         ! ='spg' update after velocity
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zemp_med     ! temporary scalar
+      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
+      !!---------------------------------------------------------------------
+      !
+      SELECT CASE( cd_td ) 
+      !                     ! ---------------- !
+      CASE( 'ini' )         !  initialisation  ! 
+         !                  ! ---------------- ! 
+         !                                     !** initialization of the velocity
+         hdiv_139_101(:) = 0.e0                     !  139,101 (Atlantic side, south point)
+         hdiv_139_102(:) = 0.e0                     !  139,102 (Atlantic side, north point)
+         hdiv_141_102(:) = 0.e0                     !  141,102 (Med sea  side)
+            
+         !                                     !** imposed transport
+         zio_flow    = 0.8e6                        ! inflow surface  water
+         zrecirc_mid = 0.7e6                        ! middle recirculation water
+         zrecirc_upp = 2.5e6                        ! upper  recirculation water
+         zrecirc_bot = 3.5e6                        ! bottom recirculation water
+         !
+         DO jj = mj0(101), mj1(101)            !** profile of hdiv at 139,101 (Atlantic side, south point)
+            DO ji = mi0(139), mi1(139)         !-----------------------------
+               DO jk = 1, 14                        ! surface in/out flow (Atl -> Med)   (div >0)
+                  hdiv_139_101(jk) = + zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               DO jk = 15, 20                       ! middle  reciculation (Atl 101 -> Atl 102)   (div >0)   
+                  hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                    ! upper reciculation (Atl 101 -> Atl 101)   (div >0)
+               hdiv_139_101(21) =               + zrecirc_upp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               !
+               !                                    ! upper & bottom reciculation (Atl 101 -> Atl 101 & 102)   (div >0)
+               hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)            !** profile of hdiv at 139,102 (Atlantic side, north point)
+            DO ji = mi0(139), mi1(139)         !-----------------------------
+               DO jk = 15, 20                       ! middle reciculation (Atl 101 -> Atl 102)   (div <0)                
+                  hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                    ! outflow of Mediterranean sea + deep recirculation   (div <0) 
+               hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)            !** velocity profile at 141,102  (Med sea side)
+            DO ji = mi0(141), mi1(141)         !------------------------------
+               DO  jk = 1, 14                       ! surface inflow in the Med     (div <0)
+                  hdiv_141_102(jk) = - zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                    ! deep    outflow toward the Atlantic    (div >0) 
+               hdiv_141_102(21)    = + zio_flow / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
+         !                  ! ---------=====-- ! 
+         !                                     !** emp on the Mediterranean Sea  (div >0) 
+         zemp_med = 0.e0                       !-------------------------------
+         DO jj = mj0(96), mj1(110)                  ! sum over the Med sea
+            DO ji = mi0(141),mi1(181)
+               zemp_med = zemp_med + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 
+            END DO
+         END DO
+         DO jj = mj0(96), mj1(96)                   ! minus 2 points in Red Sea 
+            DO ji = mi0(148),mi1(148)
+               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
+            END DO
+            DO ji = mi0(149),mi1(149)
+               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( zemp_med )    ! sum with other processors value
+         zemp_med = zemp_med * 1.e-3                ! convert in m3
+         !
+         !                                     !** Correct hdivn (including emp adjustment)
+         !                                     !-------------------------------------------
+         DO jj = mj0(101), mj1(101)                 !* 139,101 (Atlantic side, south point)
+            DO ji = mi0(139), mi1(139) 
+               hdiv_139_101_kt(:) = hdiv_139_101(:)      
+               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div >0) 
+                  hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_139_101_kt(:)
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)                 !* 139,102 (Atlantic side, north point)
+            DO ji = mi0(139), mi1(139) 
+               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_139_102(:)
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)
+            DO ji = mi0(141), mi1(141) 
+               hdiv_141_102(:) = hdiv_141_102(:)
+               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div <0)
+                  hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_141_102_kt(:)
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
+         !                  ! --------=======- !
+         !
+         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)   (div >0)
+            DO ji = mi0(139), mi1(139) 
+               DO jk = 1, jpkm1                         ! surf inflow + mid. & bottom reciculation (from Atlantic)	
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_101_kt(jk) * tn(ji,jj,jk)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_101_kt(jk) * sn(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)   (div <0)
+            DO ji = mi0(139), mi1(139) 
+               DO jk = 15, 20                            ! middle  reciculation (Atl 101 -> Atl 102)   (div <0)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_102(jk) * tn(ji,jj-1,jk)  ! middle Atlantic recirculation
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_102(jk) * sn(ji,jj-1,jk)
+               END DO
+               !                                         ! upper & bottom Atl. reciculation (Atl 101 -> Atl 102) - (div <0)
+               !                                         ! deep Med flow                    (Med 102 -> Atl 102) - (div <0)
+               ta(ji,jj,22) = ta(ji,jj,22) + hdiv_141_102(21) * tn(ji+2,jj  ,21)   &  ! deep Med flow  
+                  &                        + hdiv_139_101(21) * tn(ji  ,jj-1,21)   &  ! upper  Atlantic recirculation  
+                  &                        + hdiv_139_101(22) * tn(ji  ,jj-1,22)      ! bottom Atlantic recirculation  
+               sa(ji,jj,22) = sa(ji,jj,22) + hdiv_141_102(21) * sn(ji+2,jj  ,21)   &
+                  &                        + hdiv_139_101(21) * sn(ji  ,jj-1,21)   &
+                  &                        + hdiv_139_101(22) * sn(ji  ,jj-1,22) 
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)   (div <0)
+            DO ji = mi0(141), mi1(141) 
+               DO jk = 1, 14                             ! surface flow from Atlantic to Med sea
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_141_102_kt(jk) * tn(ji-2,jj-1,jk)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_141_102_kt(jk) * sn(ji-2,jj-1,jk)
+               END DO
+               !                                         ! deeper flow from Med sea to Atlantic
+               ta(ji,jj,21) = ta(ji,jj,21) - hdiv_141_102(21) * tn(ji,jj,21)
+               sa(ji,jj,21) = sa(ji,jj,21) - hdiv_141_102(21) * sn(ji,jj,21)
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
+         !                  ! --------=======- !
+         ! at this stage, (ua,va) are the after velocity, not the tendancy
+         ! compute the velocity from the divergence at T-point
+         !
+         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)
+            DO ji = mi0(139), mi1(139)                    ! div >0 => ua >0, same sign
+               ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
+                  &                             * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)
+            DO ji = mi0(139), mi1(139)                    ! div <0 => ua <0, same sign
+               ua(ji,jj,:) = hdiv_139_102(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
+                  &                          * e2u(ji,jj) * fse3u(ji,jj,:)   
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)            !** 140,102 (Med side) (140 not 141 as it is a U-point)
+            DO ji = mi0(140), mi1(140)                    ! div >0 => ua <0, opposite sign
+               ua(ji,jj,:) = - hdiv_141_102(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
+                  &                            * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+   END SUBROUTINE cla_gibraltar
+
+
+   SUBROUTINE cla_hormuz( cd_td )
+      !! -------------------------------------------------------------------
+      !!                   ***  ROUTINE div_hormuz  ***
+      !!              
+      !! ** Purpose :   update the now horizontal divergence, the tracer 
+      !!              tendancyand the after velocity in vicinity of Hormuz 
+      !!              strait ( Persian Gulf - Indian ocean ).
+      !!
+      !! ** Method  :   Hormuz strait
+      !!            ______________   
+      !!            |/////|<==      surface inflow
+      !!        94  |/////|     
+      !!            |/////|==>      deep    outflow
+      !!            |_____|_______
+      !!              171    172     
+      !!---------------------------------------------------------------------
+      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='ini' initialisation
+      !!                                        ! ='div' update the divergence
+      !!                                        ! ='tra' update the tracers
+      !!                                        ! ='spg' update after velocity
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zio_flow     ! temporary scalar
+      !!---------------------------------------------------------------------
+      !
+      SELECT CASE( cd_td ) 
+      !                     ! ---------------- !
+      CASE( 'ini' )         !  initialisation  ! 
+         !                  ! ---------------- ! 
+         !                                     !** profile of horizontal divergence due to cross-land advection
+         zio_flow  = 1.e6                          ! imposed in/out flow
+         !
+         hdiv_172_94(:) = 0.e0         
+         !
+         DO jj = mj0(94), mj1(94)                  ! in/out flow at (i,j) = (172,94)
+            DO ji = mi0(172), mi1(172) 
+               DO jk = 1, 8                            ! surface inflow  (Indian ocean to Persian Gulf) (div<0)
+                  hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               DO jk = 16, 18                          ! deep    outflow (Persian Gulf to Indian ocean) (div>0)
+                  hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         !                                     !** T & S profile in the Hormuz strait (use in deep outflow)
+         !      Temperature       and         Salinity
+         t_171_94_hor(:)  = 0.e0   ;   s_171_94_hor(:)  = 0.e0
+         t_171_94_hor(16) = 18.4   ;   s_171_94_hor(16) = 36.27
+         t_171_94_hor(17) = 17.8   ;   s_171_94_hor(17) = 36.4
+         t_171_94_hor(18) = 16.    ;   s_171_94_hor(18) = 36.27
+         !
+         !                  ! ---------------- !
+      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
+         !                  ! ---------=====-- ! 
+         !                                   
+         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
+            DO ji = mi0(172), mi1(172) 
+               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_172_94(:)
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
+         !                  ! --------=======- !
+         !                          
+         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
+            DO ji = mi0(172), mi1(172) 
+               DO jk = 1, 8                          ! surface inflow   (Indian ocean to Persian Gulf) (div<0)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * tn(ji,jj,jk) 
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * sn(ji,jj,jk) 
+               END DO
+               DO jk = 16, 18                        ! deep outflow     (Persian Gulf to Indian ocean) (div>0)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * t_171_94_hor(jk)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * s_171_94_hor(jk)
+               END DO
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
+         !                  ! --------=======- !
+         ! No barotropic flow through Hormuz strait
+         ! at this stage, (ua,va) are the after velocity, not the tendancy
+         ! compute the velocity from the divergence at T-point
+         DO jj = mj0(94), mj1(94)              !** 171,94 (Indian ocean side) (171 not 172 as it is the western U-point)
+            DO ji = mi0(171), mi1(171)                ! div >0 => ua >0, opposite sign
+               ua(ji,jj,:) = - hdiv_172_94(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
+                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+   END SUBROUTINE cla_hormuz
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                            Dummy module
+   !!----------------------------------------------------------------------
+   USE in_out_manager ! I/O manager
+CONTAINS
+   SUBROUTINE cla_init
+      CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2 with 31 levels' )
+   END SUBROUTINE cla_init
+   SUBROUTINE cla_div( kt )
+      WRITE(*,*) 'cla_div: You should have not see this print! error?', kt
+   END SUBROUTINE cla_div
+   SUBROUTINE cla_traadv( kt ) 
+      WRITE(*,*) 'cla_traadv: You should have not see this print! error?', kt
+   END SUBROUTINE cla_traadv
+   SUBROUTINE cla_dynspg( kt ) 
+      WRITE(*,*) 'dyn_spg_cla: You should have not see this print! error?', kt
+   END SUBROUTINE cla_dynspg
+#endif
+   
+   !!======================================================================
+END MODULE cla
Index: /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 2442)
+++ /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 2442)
@@ -0,0 +1,275 @@
+MODULE lbclnk
+   !!======================================================================
+   !!                       ***  MODULE  lbclnk  ***
+   !! Ocean        : lateral boundary conditions
+   !!=====================================================================
+   !! History :  OPA  ! 1997-06  (G. Madec)     Original code
+   !!   NEMO     1.0  ! 2002-09  (G. Madec)     F90: Free form and module
+   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment  
+   !!----------------------------------------------------------------------
+#if   defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'             MPI massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
+   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
+   !!----------------------------------------------------------------------
+   USE lib_mpp          ! distributed memory computing library
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc_lnk_e
+      MODULE PROCEDURE mpp_lnk_2d_e
+   END INTERFACE
+
+   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
+   PUBLIC lbc_lnk_e
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                              shared memory computing
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
+   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh
+   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers   
+   USE dom_oce         ! ocean space and time domain 
+   USE in_out_manager  ! I/O manager
+   USE lbcnfd          ! north fold
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc_lnk_e
+      MODULE PROCEDURE lbc_lnk_2d
+   END INTERFACE
+
+   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
+   PUBLIC   lbc_lnk_e 
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case)
+      !!
+      !! ** Method  :   psign = -1 :    change the sign across the north fold
+      !!                      =  1 : no change of the sign across the north fold
+      !!                      =  0 : no change of the sign across the north fold and
+      !!                             strict positivity preserved: use inner row/column
+      !!                             for closed boundaries.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign 
+      !!----------------------------------------------------------------------
+      !
+      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
+      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
+      !
+   END SUBROUTINE lbc_lnk_3d_gather
+
+
+   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_lnk_3d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
+      !!
+      !! ** Method  :   psign = -1 :    change the sign across the north fold
+      !!                      =  1 : no change of the sign across the north fold
+      !!                      =  0 : no change of the sign across the north fold and
+      !!                             strict positivity preserved: use inner row/column
+      !!                             for closed boundaries.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign 
+      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
+      !!
+      REAL(wp) ::   zland
+      !!----------------------------------------------------------------------
+
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
+      ELSE                         ;   zland = 0.e0
+      ENDIF
+
+
+      IF( PRESENT( cd_mpp ) ) THEN
+         ! only fill the overlap area and extra allows 
+         ! this is in mpp case. In this module, just do nothing
+      ELSE
+         !
+         !                                     !  East-West boundaries
+         !                                     ! ======================
+         SELECT CASE ( nperio )
+         !
+         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
+            pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points
+            pt3d(jpi,:,:) = pt3d(  2  ,:,:)
+            !
+         CASE DEFAULT                             !**  East closed  --  West closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt3d( 1 ,:,:) = zland
+               pt3d(jpi,:,:) = zland
+            CASE ( 'F' )                               ! F-point
+               pt3d(jpi,:,:) = zland
+            END SELECT
+            !
+         END SELECT
+         !
+         !                                     ! North-South boundaries
+         !                                     ! ======================
+         SELECT CASE ( nperio )
+         !
+         CASE ( 2 )                               !**  South symmetric  --  North closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+               pt3d(:, 1 ,:) = pt3d(:,3,:)
+               pt3d(:,jpj,:) = zland
+            CASE ( 'V' , 'F' )                         ! V-, F-points
+               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
+               pt3d(:,jpj,:) = zland
+            END SELECT
+            !
+         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
+            SELECT CASE ( cd_type )                    ! South : closed
+            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
+               pt3d(:, 1 ,:) = zland
+            END SELECT
+            !                                          ! North fold
+            pt3d( 1 ,jpj,:) = zland
+            pt3d(jpi,jpj,:) = zland
+            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
+            !
+         CASE DEFAULT                             !**  North closed  --  South closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt3d(:, 1 ,:) = zland
+               pt3d(:,jpj,:) = zland
+            CASE ( 'F' )                               ! F-point
+               pt3d(:,jpj,:) = zland
+            END SELECT
+            !
+         END SELECT
+         !
+      ENDIF
+      !
+   END SUBROUTINE lbc_lnk_3d
+
+
+   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE lbc_lnk_2d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
+      !!
+      !! ** Method  :   psign = -1 :    change the sign across the north fold
+      !!                      =  1 : no change of the sign across the north fold
+      !!                      =  0 : no change of the sign across the north fold and
+      !!                             strict positivity preserved: use inner row/column
+      !!                             for closed boundaries.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
+      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign 
+      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
+      !!
+      REAL(wp) ::   zland
+      !!----------------------------------------------------------------------
+
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
+      ELSE                         ;   zland = 0.e0
+      ENDIF
+
+      IF (PRESENT(cd_mpp)) THEN
+         ! only fill the overlap area and extra allows 
+         ! this is in mpp case. In this module, just do nothing
+      ELSE      
+         !
+         !                                     ! East-West boundaries
+         !                                     ! ====================
+         SELECT CASE ( nperio )
+         !
+         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
+            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
+            pt2d(jpi,:) = pt2d(  2  ,:)
+            !
+         CASE DEFAULT                             !** East closed  --  West closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
+               pt2d( 1 ,:) = zland
+               pt2d(jpi,:) = zland
+            CASE ( 'F' )                              ! F-point
+               pt2d(jpi,:) = zland
+            END SELECT
+            !
+         END SELECT
+         !
+         !                                     ! North-South boundaries
+         !                                     ! ======================
+         SELECT CASE ( nperio )
+         !
+         CASE ( 2 )                               !**  South symmetric  --  North closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+               pt2d(:, 1 ) = pt2d(:,3)
+               pt2d(:,jpj) = zland
+            CASE ( 'V' , 'F' )                         ! V-, F-points
+               pt2d(:, 1 ) = psgn * pt2d(:,2)
+               pt2d(:,jpj) = zland
+            END SELECT
+            !
+         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
+            SELECT CASE ( cd_type )                    ! South : closed
+            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
+               pt2d(:, 1 ) = zland
+            END SELECT
+            !                                          ! North fold
+            pt2d( 1 ,1  ) = zland 
+            pt2d( 1 ,jpj) = zland 
+            pt2d(jpi,jpj) = zland
+            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
+            !
+         CASE DEFAULT                             !**  North closed  --  South closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt2d(:, 1 ) = zland
+               pt2d(:,jpj) = zland
+            CASE ( 'F' )                               ! F-point
+               pt2d(:,jpj) = zland
+            END SELECT
+            !
+         END SELECT
+         !
+      ENDIF
+      !    
+   END SUBROUTINE lbc_lnk_2d
+
+#endif
+
+   !!======================================================================
+END MODULE lbclnk
Index: /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 2442)
+++ /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 2442)
@@ -0,0 +1,308 @@
+MODULE lbcnfd
+   !!======================================================================
+   !!                       ***  MODULE  lbcnfd  ***
+   !! Ocean        : north fold  boundary conditions
+   !!======================================================================
+   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   lbc_nfd       : generic interface for lbc_nfd_3d and lbc_nfd_2d routines
+   !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd)
+   !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd)
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers   
+   USE dom_oce        ! ocean space and time domain 
+   USE in_out_manager ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE lbc_nfd
+      MODULE PROCEDURE   lbc_nfd_3d, lbc_nfd_2d
+   END INTERFACE
+
+   PUBLIC   lbc_nfd   ! north fold conditions
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine lbc_nfd_3d  ***
+      !!
+      !! ** Purpose :   3D lateral boundary condition : North fold treatment
+      !!              without processor exchanges. 
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  :   pt3d with updated values along the north fold
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
+      !                                                        !   = T , U , V , F , W points
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
+      !                                                        !   = -1. , the sign is changed if north fold boundary
+      !                                                        !   =  1. , the sign is kept  if north fold boundary
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the boundary condition is applied
+      !
+      INTEGER  ::   ji, jk
+      INTEGER  ::   ijt, iju, ijpj, ijpjm1
+      !!----------------------------------------------------------------------
+
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
+      END SELECT
+      ijpjm1 = ijpj-1
+
+      DO jk = 1, jpk
+         !
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+2
+                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
+               END DO
+               DO ji = jpiglo/2, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
+                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
+               END DO
+            END SELECT
+            !
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
+               END DO
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            SELECT CASE ( cd_type)
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt3d(:, 1  ,jk) = 0.e0
+               pt3d(:,ijpj,jk) = 0.e0
+            CASE ( 'F' )                               ! F-point
+               pt3d(:,ijpj,jk) = 0.e0
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+      END DO
+      !
+   END SUBROUTINE lbc_nfd_3d
+
+
+   SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine lbc_nfd_2d  ***
+      !!
+      !! ** Purpose :   2D lateral boundary condition : North fold treatment
+      !!       without processor exchanges. 
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  :   pt2d with updated values along the north fold
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
+      !                                                      ! = T , U , V , F , W points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
+      !                                                      !   = -1. , the sign is changed if north fold boundary
+      !                                                      !   =  1. , the sign is kept  if north fold boundary
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the boundary condition is applied
+      INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos
+      !
+      INTEGER  ::   ji, jl, ipr2dj
+      INTEGER  ::   ijt, iju, ijpj, ijpjm1
+      !!----------------------------------------------------------------------
+
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
+      END SELECT
+      !
+      IF( PRESENT(pr2dj) ) THEN           ! use of additional halos
+         ipr2dj = pr2dj
+         IF( jpni > 1 )   ijpj = ijpj + ipr2dj
+      ELSE
+         ipr2dj = 0 
+      ENDIF
+      !
+      ijpjm1 = ijpj-1
+
+
+      SELECT CASE ( npolj )
+      !
+      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+         !
+         SELECT CASE ( cd_type )
+         !
+         CASE ( 'T' , 'W' )                               ! T- , W-points
+            DO jl = 0, ipr2dj
+               DO ji = 2, jpiglo
+                  ijt=jpiglo-ji+2
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
+               END DO
+            END DO
+            DO ji = jpiglo/2+1, jpiglo
+               ijt=jpiglo-ji+2
+               pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1)
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
+               END DO
+            END DO
+            DO ji = jpiglo/2, jpiglo-1
+               iju = jpiglo-ji+1
+               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
+            END DO
+         CASE ( 'V' )                                     ! V-point
+            DO jl = -1, ipr2dj
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-3-jl)
+               END DO
+            END DO
+         CASE ( 'F' )                                     ! F-point
+            DO jl = -1, ipr2dj
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl)
+               END DO
+            END DO
+         CASE ( 'I' )                                     ! ice U-V point (I-point)
+            DO jl = 0, ipr2dj
+               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
+               DO ji = 3, jpiglo
+                  iju = jpiglo - ji + 3
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
+               END DO
+            END DO
+         END SELECT
+         !
+      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+         !
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' )                               ! T-, W-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-1-jl)
+               END DO
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
+               END DO
+            END DO
+         CASE ( 'V' )                                     ! V-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
+               END DO
+            END DO
+            DO ji = jpiglo/2+1, jpiglo
+               ijt = jpiglo-ji+1
+               pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)
+            END DO
+         CASE ( 'F' )                               ! F-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
+               END DO
+            END DO
+            DO ji = jpiglo/2+1, jpiglo-1
+               iju = jpiglo-ji
+               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
+            END DO
+         CASE ( 'I' )                                  ! ice U-V point (I-point)
+            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
+            DO jl = 0, ipr2dj
+               DO ji = 2 , jpiglo-1
+                  ijt = jpiglo - ji + 2
+                  pt2d(ji,ijpj+jl)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) )
+               END DO
+            END DO
+         END SELECT
+         !
+      CASE DEFAULT                           ! *  closed : the code probably never go through
+         !
+         SELECT CASE ( cd_type)
+         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
+            pt2d(:, 1:1-ipr2dj     ) = 0.e0
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+         CASE ( 'F' )                                   ! F-point
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+         CASE ( 'I' )                                   ! ice U-V point
+            pt2d(:, 1:1-ipr2dj     ) = 0.e0
+            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
+         END SELECT
+         !
+      END SELECT
+      !
+   END SUBROUTINE lbc_nfd_2d
+
+   !!======================================================================
+END MODULE lbcnfd
Index: /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 2442)
+++ /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 2442)
@@ -0,0 +1,2586 @@
+MODULE lib_mpp
+   !!======================================================================
+   !!                       ***  MODULE  lib_mpp  ***
+   !! Ocean numerics:  massively parallel processing library
+   !!=====================================================================
+   !! History :  OPA  !  1994  (M. Guyon, J. Escobar, M. Imbard)  Original code
+   !!            7.0  !  1997  (A.M. Treguier)  SHMEM additions
+   !!            8.0  !  1998  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
+   !!                 !  1998  (J.M. Molines) Open boundary conditions
+   !!   NEMO     1.0  !  2003  (J.-M. Molines, G. Madec)  F90, free form
+   !!                 !  2003  (J.M. Molines) add mpp_ini_north(_3d,_2d)
+   !!             -   !  2004  (R. Bourdalle Badie)  isend option in mpi
+   !!                 !  2004  (J.M. Molines) minloc, maxloc
+   !!             -   !  2005  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
+   !!             -   !  2005  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
+   !!             -   !  2005  (R. Benshila, G. Madec)  add extra halo case
+   !!             -   !  2008  (R. Benshila) add mpp_ini_ice
+   !!            3.2  !  2009  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
+   !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl 
+   !!----------------------------------------------------------------------
+#if   defined key_mpp_mpi  
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'             MPI massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!   mynode      : indentify the processor unit
+   !!   mpp_lnk     : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d)
+   !!   mpp_lnk_3d_gather :  Message passing manadgement for two 3D arrays
+   !!   mpp_lnk_e   : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e)
+   !!   mpprecv     :
+   !!   mppsend     :   SUBROUTINE mpp_ini_znl
+   !!   mppscatter  :
+   !!   mppgather   :
+   !!   mpp_min     : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
+   !!   mpp_max     : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real
+   !!   mpp_sum     : generic interface for mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
+   !!   mpp_minloc  :
+   !!   mpp_maxloc  :
+   !!   mppsync     :
+   !!   mppstop     :
+   !!   mppobc      : variant of mpp_lnk for open boundary condition
+   !!   mpp_ini_north : initialisation of north fold
+   !!   mpp_lbc_north : north fold processors gathering
+   !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo
+   !!----------------------------------------------------------------------
+   !! History :
+   !!        !  94 (M. Guyon, J. Escobar, M. Imbard)  Original code
+   !!        !  97  (A.M. Treguier)  SHMEM additions
+   !!        !  98  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
+   !!   9.0  !  03  (J.-M. Molines, G. Madec)  F90, free form
+   !!        !  04  (R. Bourdalle Badie)  isend option in mpi
+   !!        !  05  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
+   !!        !  05  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
+   !!        !  09  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce                    ! ocean space and time domain 
+   USE in_out_manager             ! I/O manager
+   USE lbcnfd                     ! north fold treatment
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free
+   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e
+   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc
+   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
+   PUBLIC   mpprecv, mppsend, mppscatter, mppgather
+   PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl
+   PUBLIC   mppsize, mpprank
+
+   !! * Interfaces
+   !! define generic interface for these routine as they are called sometimes
+   !! with scalar arguments instead of array arguments, which causes problems
+   !! for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ
+   INTERFACE mpp_min
+      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
+   END INTERFACE
+   INTERFACE mpp_max
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
+   END INTERFACE
+   INTERFACE mpp_sum
+# if defined key_mpp_rep
+      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, &
+                       mppsum_realdd, mppsum_a_realdd
+# else
+      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real
+# endif
+   END INTERFACE
+   INTERFACE mpp_lbc_north
+      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 
+   END INTERFACE
+   INTERFACE mpp_minloc
+      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+   END INTERFACE
+   INTERFACE mpp_maxloc
+      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+   END INTERFACE
+   
+   !! ========================= !!
+   !!  MPI  variable definition !!
+   !! ========================= !!
+!$AGRIF_DO_NOT_TREAT
+   INCLUDE 'mpif.h'
+!$AGRIF_END_DO_NOT_TREAT
+   
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag
+
+   INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2)
+   
+   INTEGER ::   mppsize        ! number of process
+   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ]
+!$AGRIF_DO_NOT_TREAT
+   INTEGER, PUBLIC ::   mpi_comm_opa   ! opa local communicator
+!$AGRIF_END_DO_NOT_TREAT
+
+   INTEGER, PUBLIC :: MPI_SUMDD
+
+   ! variables used in case of sea-ice
+   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice
+   INTEGER ::   ngrp_ice        !  group ID for the ice processors (for rheology)
+   INTEGER ::   ndim_rank_ice   !  number of 'ice' processors
+   INTEGER ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm
+   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_ice     ! dimension ndim_rank_ice
+
+   ! variables used for zonal integration
+   INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average
+   LOGICAL, PUBLIC ::   l_znl_root      ! True on the 'left'most processor on the same row
+   INTEGER ::   ngrp_znl        ! group ID for the znl processors
+   INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average
+   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
+   
+   ! North fold condition in mpp_mpi with jpni > 1
+   INTEGER ::   ngrp_world        ! group ID for the world processors
+   INTEGER ::   ngrp_opa          ! group ID for the opa processors
+   INTEGER ::   ngrp_north        ! group ID for the northern processors (to be fold)
+   INTEGER ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north
+   INTEGER ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !)
+   INTEGER ::   njmppmax          ! value of njmpp for the processors of the northern line
+   INTEGER ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm
+   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_north   ! dimension ndim_rank_north
+
+   ! Type of send : standard, buffered, immediate
+   CHARACTER(len=1) ::   cn_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend)
+   LOGICAL          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I')
+   INTEGER          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend 
+      
+   REAL(wp), ALLOCATABLE, DIMENSION(:) :: tampon  ! buffer in case of bsend
+
+   ! message passing arrays
+   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   t4ns, t4sn   ! 2 x 3d for north-south & south-north
+   REAL(wp), DIMENSION(jpj,jpreci,jpk,2,2) ::   t4ew, t4we   ! 2 x 3d for east-west & west-east
+   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   t4p1, t4p2   ! 2 x 3d for north fold
+   REAL(wp), DIMENSION(jpi,jprecj,jpk,2)   ::   t3ns, t3sn   ! 3d for north-south & south-north
+   REAL(wp), DIMENSION(jpj,jpreci,jpk,2)   ::   t3ew, t3we   ! 3d for east-west & west-east
+   REAL(wp), DIMENSION(jpi,jprecj,jpk,2)   ::   t3p1, t3p2   ! 3d for north fold
+   REAL(wp), DIMENSION(jpi,jprecj,2)       ::   t2ns, t2sn   ! 2d for north-south & south-north
+   REAL(wp), DIMENSION(jpj,jpreci,2)       ::   t2ew, t2we   ! 2d for east-west & west-east
+   REAL(wp), DIMENSION(jpi,jprecj,2)       ::   t2p1, t2p2   ! 2d for north fold
+   REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ::   tr2ns, tr2sn  ! 2d for north-south & south-north + extra outer halo
+   REAL(wp), DIMENSION(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ::   tr2ew, tr2we  ! 2d for east-west   & west-east   + extra outer halo
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   FUNCTION mynode(ldtxt, localComm)
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mynode  ***
+      !!                    
+      !! ** Purpose :   Find processor unit
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
+      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      INTEGER ::   mynode, ierr, code
+      LOGICAL ::   mpi_was_called
+      
+      NAMELIST/nammpp/ cn_mpi_send, nn_buffer
+      !!----------------------------------------------------------------------
+      !
+      WRITE(ldtxt(1),*)
+      WRITE(ldtxt(2),*) 'mynode : mpi initialisation'
+      WRITE(ldtxt(3),*) '~~~~~~ '
+      !
+      REWIND( numnam )               ! Namelist namrun : parameters of the run
+      READ  ( numnam, nammpp )
+      !                              ! control print
+      WRITE(ldtxt(4),*) '   Namelist nammpp'
+      WRITE(ldtxt(5),*) '      mpi send type                      cn_mpi_send = ', cn_mpi_send
+      WRITE(ldtxt(6),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer
+
+#if defined key_agrif
+      IF( Agrif_Root() ) THEN
+#endif
+         !!bug RB : should be clean to use Agrif in coupled mode
+#if ! defined key_agrif
+         CALL mpi_initialized ( mpi_was_called, code )
+         IF( code /= MPI_SUCCESS ) THEN
+            WRITE(*, cform_err)
+            WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+
+         IF( PRESENT(localComm) .and. mpi_was_called ) THEN
+            mpi_comm_opa = localComm
+            SELECT CASE ( cn_mpi_send )
+            CASE ( 'S' )                ! Standard mpi send (blocking)
+               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)'
+            CASE ( 'B' )                ! Buffer mpi send (blocking)
+               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
+               CALL mpi_init_opa( ierr ) 
+            CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+               WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
+               l_isend = .TRUE.
+            CASE DEFAULT
+               WRITE(ldtxt(7),cform_err)
+               WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send
+               nstop = nstop + 1
+            END SELECT
+         ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
+            WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator '
+            WRITE(ldtxt(8),*) '          without calling MPI_Init before ! '
+            nstop = nstop + 1
+         ELSE
+#endif
+            SELECT CASE ( cn_mpi_send )
+            CASE ( 'S' )                ! Standard mpi send (blocking)
+               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)'
+               CALL mpi_init( ierr )
+            CASE ( 'B' )                ! Buffer mpi send (blocking)
+               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
+               CALL mpi_init_opa( ierr )
+            CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+               WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
+               l_isend = .TRUE.
+               CALL mpi_init( ierr )
+            CASE DEFAULT
+               WRITE(ldtxt(7),cform_err)
+               WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send
+               nstop = nstop + 1
+            END SELECT
+
+#if ! defined key_agrif
+            CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code)
+            IF( code /= MPI_SUCCESS ) THEN
+               WRITE(*, cform_err)
+               WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
+               CALL mpi_abort( mpi_comm_world, code, ierr )
+            ENDIF
+            !
+         ENDIF
+#endif
+#if defined key_agrif
+      ELSE
+         SELECT CASE ( cn_mpi_send )
+         CASE ( 'S' )                ! Standard mpi send (blocking)
+            WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)'
+         CASE ( 'B' )                ! Buffer mpi send (blocking)
+            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
+         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
+            l_isend = .TRUE.
+         CASE DEFAULT
+            WRITE(ldtxt(7),cform_err)
+            WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send
+            nstop = nstop + 1
+         END SELECT
+      ENDIF
+
+      mpi_comm_opa = mpi_comm_world
+#endif
+      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
+      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )
+      mynode = mpprank
+      !
+#if defined key_mpp_rep
+      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr)
+#endif
+      !
+   END FUNCTION mynode
+
+
+   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_3d  ***
+      !!
+      !! ** Purpose :   Message passing manadgement
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !! ** Action  :   ptab with update value at its periphery
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                             ! = T , U , V , F , W points
+      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                             ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
+      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!----------------------------------------------------------------------
+
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+         !
+         ! WARNING ptab is defined only between nld and nle
+         DO jk = 1, jpk
+            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)   
+               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk)
+               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk)
+            END DO
+            DO ji = nlci+1, jpi                 ! added column(s) (full)
+               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk)
+               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk)
+               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk)
+            END DO
+         END DO
+         !
+      ELSE                              ! standard close or cyclic treatment 
+         !
+         !                                   ! East-West boundaries
+         !                                        !* Cyclic east-west
+         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+            ptab( 1 ,:,:) = ptab(jpim1,:,:)
+            ptab(jpi,:,:) = ptab(  2  ,:,:)
+         ELSE                                     !* closed
+            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
+                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
+         ENDIF
+         !                                   ! North-South boundaries (always closed)
+         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
+                                      ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
+         !
+      ENDIF
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+         END DO
+      END SELECT  
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk
+      !
+      SELECT CASE ( nbondi ) 
+      CASE ( -1 )
+         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
+         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci-jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = t3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = t3we(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk
+      !
+      SELECT CASE ( nbondj )     
+      CASE ( -1 )
+         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
+         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 ) 
+         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj-jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jprecj
+            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jl,:) = t3sn(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+   END SUBROUTINE mpp_lnk_3d
+
+
+   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d  ***
+      !!                  
+      !! ** Purpose :   Message passing manadgement for 2d array
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W and I points
+      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                         ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!----------------------------------------------------------------------
+
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !
+      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+         !
+         ! WARNING pt2d is defined only between nld and nle
+         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)   
+            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej)
+            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej)
+         END DO
+         DO ji = nlci+1, jpi                 ! added column(s) (full)
+            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej)
+            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     )
+            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej)
+         END DO
+         !
+      ELSE                              ! standard close or cyclic treatment 
+         !
+         !                                   ! East-West boundaries
+         IF( nbondi == 2 .AND.   &                ! Cyclic east-west
+            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west
+            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east
+         ELSE                                     ! closed
+            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
+                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
+         ENDIF
+         !                                   ! North-South boundaries (always closed)
+            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
+                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north
+         !
+      ENDIF
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            t2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            t2we(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t2ew(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t2ew(1,1,2), imigr )
+         CALL mpprecv( 2, t2we(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t2we(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci - jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            pt2d(iihom+jl,:) = t2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = t2we(:,jl,2)
+            pt2d(iihom+jl,:) = t2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = t2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            t2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            t2ns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t2ns(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t2ns(1,1,2), imigr )
+         CALL mpprecv( 4, t2sn(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t2sn(1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj - jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = t2sn(:,jl,2)
+            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+         END DO
+      CASE ( 1 ) 
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = t2sn(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+   END SUBROUTINE mpp_lnk_2d
+
+
+   SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_3d_gather  ***
+      !!
+      !! ** Purpose :   Message passing manadgement for two 3D arrays
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !! ** Action  :   ptab1 and ptab2  with update value at its periphery
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays 
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points
+      REAL(wp)                        , INTENT(in   ) ::   psgn      ! =-1 the sign change across the north fold boundary
+      !!                                                             ! =  1. , the sign is kept
+      INTEGER  ::   jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!----------------------------------------------------------------------
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         ptab1( 1 ,:,:) = ptab1(jpim1,:,:)
+         ptab1(jpi,:,:) = ptab1(  2  ,:,:)
+         ptab2( 1 ,:,:) = ptab2(jpim1,:,:)
+         ptab2(jpi,:,:) = ptab2(  2  ,:,:)
+      ELSE                                        !* closed
+         IF( .NOT. cd_type1 == 'F' )   ptab1(     1       :jpreci,:,:) = 0.e0    ! south except at F-point
+         IF( .NOT. cd_type2 == 'F' )   ptab2(     1       :jpreci,:,:) = 0.e0
+                                       ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0    ! north
+                                       ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0
+      ENDIF
+
+      
+      !                                      ! North-South boundaries
+      IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0.e0    ! south except at F-point
+      IF( .NOT. cd_type2 == 'F' )   ptab2(:,     1       :jprecj,:) = 0.e0
+                                    ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0    ! north
+                                    ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
+
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            t4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
+            t4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
+            t4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
+            t4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk *2
+      !
+      SELECT CASE ( nbondi ) 
+      CASE ( -1 )
+         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
+         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci - jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, jpreci
+            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
+            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jpreci
+            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
+            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
+            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj - nrecj
+         DO jl = 1, jprecj
+            t4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)
+            t4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)
+            t4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)
+            t4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk * 2
+      !
+      SELECT CASE ( nbondj )     
+      CASE ( -1 )
+         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )
+         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
+      CASE ( 1 ) 
+         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj - jprecj
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, jprecj
+            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)
+            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jprecj
+            ptab1(:,jl      ,:) = t4sn(:,jl,:,1,2)
+            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)
+            ptab2(:,jl      ,:) = t4sn(:,jl,:,2,2)
+            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab1(:,jl,:) = t4sn(:,jl,:,1,2)
+            ptab2(:,jl,:) = t4sn(:,jl,:,2,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      IF( npolj /= 0 ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )                                           
+            CALL lbc_nfd      ( ptab1, cd_type1, psgn )   ! only for northern procs.
+            CALL lbc_nfd      ( ptab2, cd_type2, psgn )
+         CASE DEFAULT
+            CALL mpp_lbc_north( ptab1, cd_type1, psgn )   ! for all northern procs.
+            CALL mpp_lbc_north (ptab2, cd_type2, psgn)
+         END SELECT 
+         !
+      ENDIF
+      !
+   END SUBROUTINE mpp_lnk_3d_gather
+
+
+   SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_e  ***
+      !!                  
+      !! ** Purpose :   Message passing manadgement for 2d array (with halo)
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    jpr2di : number of rows for extra outer halo
+      !!                    jpr2dj : number of columns for extra outer halo
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
+      !                                                                                         ! = T , U , V , F , W and I points
+      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the
+      !!                                                                                        ! north boundary, =  1. otherwise
+      INTEGER  ::   jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ipreci, iprecj             ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!----------------------------------------------------------------------
+
+      ipreci = jpreci + jpr2di      ! take into account outer extra 2D overlap area
+      iprecj = jprecj + jpr2dj
+
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! Order matters Here !!!!
+      !
+      !                                      !* North-South boundaries (always colsed)
+      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jpr2dj   :  jprecj  ) = 0.e0    ! south except at F-point
+                                   pt2d(:,nlcj-jprecj+1:jpj+jpr2dj) = 0.e0    ! north
+                                
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         pt2d(1-jpr2di:     1    ,:) = pt2d(jpim1-jpr2di:  jpim1 ,:)       ! east
+         pt2d(   jpi  :jpi+jpr2di,:) = pt2d(     2      :2+jpr2di,:)       ! west
+         !
+      ELSE                                        !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpr2di   :jpreci    ,:) = 0.e0    ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpr2di,:) = 0.e0    ! north
+      ENDIF
+      !
+
+      ! north fold treatment
+      ! -----------------------
+      IF( npolj /= 0 ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jpr2dj), cd_type, psgn, pr2dj=jpr2dj )
+         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               )
+         END SELECT 
+         !
+      ENDIF
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci-jpr2di
+         DO jl = 1, ipreci
+            tr2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            tr2we(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = ipreci * ( jpj + 2*jpr2dj)
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      iihom = nlci - jpreci
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         DO jl = 1, ipreci
+            pt2d(iihom+jl,:) = tr2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
+            pt2d( iihom+jl,:) = tr2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj-jpr2dj
+         DO jl = 1, iprecj
+            tr2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            tr2ns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = iprecj * ( jpi + 2*jpr2di )
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
+      CASE ( 1 )
+         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      END SELECT
+      !
+      !                           ! Write Dirichlet lateral conditions
+      ijhom = nlcj - jprecj  
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         DO jl = 1, iprecj
+            pt2d(:,ijhom+jl) = tr2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
+            pt2d(:,ijhom+jl ) = tr2ns(:,jl,2)
+         END DO
+      CASE ( 1 ) 
+         DO jl = 1, iprecj
+            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
+         END DO
+      END SELECT
+
+   END SUBROUTINE mpp_lnk_2d_e
+
+
+   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsend  ***
+      !!                   
+      !! ** Purpose :   Send messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
+      INTEGER , INTENT(in   ) ::   kbytes     ! size of the array pmess
+      INTEGER , INTENT(in   ) ::   kdest      ! receive process number
+      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message
+      INTEGER , INTENT(in   ) ::   md_req     ! argument for isend
+      !!
+      INTEGER ::   iflag
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( cn_mpi_send )
+      CASE ( 'S' )                ! Standard mpi send (blocking)
+         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag )
+      CASE ( 'B' )                ! Buffer mpi send (blocking)
+         CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag )
+      CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+         ! be carefull, one more argument here : the mpi request identifier..
+         CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa, md_req, iflag )
+      END SELECT
+      !
+   END SUBROUTINE mppsend
+
+
+   SUBROUTINE mpprecv( ktyp, pmess, kbytes )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpprecv  ***
+      !!
+      !! ** Purpose :   Receive messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
+      INTEGER , INTENT(in   ) ::   kbytes     ! suze of the array pmess
+      INTEGER , INTENT(in   ) ::   ktyp       ! Tag of the recevied message
+      !!
+      INTEGER :: istatus(mpi_status_size)
+      INTEGER :: iflag
+      !!----------------------------------------------------------------------
+      !
+      CALL mpi_recv( pmess, kbytes, mpi_double_precision, mpi_any_source, ktyp, mpi_comm_opa, istatus, iflag )
+      !
+   END SUBROUTINE mpprecv
+
+
+   SUBROUTINE mppgather( ptab, kp, pio )
+      !!----------------------------------------------------------------------
+      !!                   ***  routine mppgather  ***
+      !!                   
+      !! ** Purpose :   Transfert between a local subdomain array and a work 
+      !!     array which is distributed following the vertical level.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj),       INTENT(in   ) ::   ptab   ! subdomain input array
+      INTEGER ,                           INTENT(in   ) ::   kp     ! record length
+      REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT(  out) ::   pio    ! subdomain input array
+      !!
+      INTEGER :: itaille, ierror   ! temporary integer
+      !!---------------------------------------------------------------------
+      !
+      itaille = jpi * jpj
+      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   &
+         &                            mpi_double_precision, kp , mpi_comm_opa, ierror ) 
+      !
+   END SUBROUTINE mppgather
+
+
+   SUBROUTINE mppscatter( pio, kp, ptab )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppscatter  ***
+      !!
+      !! ** Purpose :   Transfert between awork array which is distributed 
+      !!      following the vertical level and the local subdomain array.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::  pio        ! output array
+      INTEGER                             ::   kp        ! Tag (not used with MPI
+      REAL(wp), DIMENSION(jpi,jpj)        ::  ptab       ! subdomain array input
+      !!
+      INTEGER :: itaille, ierror   ! temporary integer
+      !!---------------------------------------------------------------------
+      !
+      itaille=jpi*jpj
+      !
+      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   &
+         &                            mpi_double_precision, kp  , mpi_comm_opa, ierror )
+      !
+   END SUBROUTINE mppscatter
+
+
+   SUBROUTINE mppmax_a_int( ktab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_a_int  ***
+      !! 
+      !! ** Purpose :   Find maximum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                  ::   kdim   ! size of array
+      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array
+      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   ! 
+      !!
+      INTEGER :: ierror, localcomm   ! temporary integer
+      INTEGER, DIMENSION(kdim) ::   iwork
+      !!----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, localcomm, ierror )
+      !
+      ktab(:) = iwork(:)
+      !
+   END SUBROUTINE mppmax_a_int
+
+
+   SUBROUTINE mppmax_int( ktab, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_int  ***
+      !!
+      !! ** Purpose :   Find maximum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(inout)           ::   ktab      ! ???
+      INTEGER, INTENT(in   ), OPTIONAL ::   kcom      ! ???
+      !! 
+      INTEGER ::   ierror, iwork, localcomm   ! temporary integer
+      !!----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa 
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror)
+      !
+      ktab = iwork
+      !
+   END SUBROUTINE mppmax_int
+
+
+   SUBROUTINE mppmin_a_int( ktab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmin_a_int  ***
+      !! 
+      !! ** Purpose :   Find minimum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT( in  )                  ::   kdim        ! size of array
+      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array
+      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
+      !!
+      INTEGER ::   ierror, localcomm   ! temporary integer
+      INTEGER, DIMENSION(kdim) ::   iwork
+      !!----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_min, localcomm, ierror )
+      !
+      ktab(:) = iwork(:)
+      !
+   END SUBROUTINE mppmin_a_int
+
+
+   SUBROUTINE mppmin_int( ktab, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmin_int  ***
+      !!
+      !! ** Purpose :   Find minimum value in an integer layout array
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(inout) ::   ktab      ! ???
+      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
+      !!
+      INTEGER ::  ierror, iwork, localcomm
+      !!----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+     CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror )
+      !
+      ktab = iwork
+      !
+   END SUBROUTINE mppmin_int
+
+
+   SUBROUTINE mppsum_a_int( ktab, kdim )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsum_a_int  ***
+      !!                    
+      !! ** Purpose :   Global integer sum, 1D array case
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   )                   ::   kdim      ! ???
+      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab      ! ???
+      !!
+      INTEGER :: ierror
+      INTEGER, DIMENSION (kdim) ::  iwork
+      !!----------------------------------------------------------------------
+      !
+      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
+      !
+      ktab(:) = iwork(:)
+      !
+   END SUBROUTINE mppsum_a_int
+
+
+   SUBROUTINE mppsum_int( ktab )
+      !!----------------------------------------------------------------------
+      !!                 ***  routine mppsum_int  ***
+      !!                  
+      !! ** Purpose :   Global integer sum
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(inout) ::   ktab
+      !! 
+      INTEGER :: ierror, iwork
+      !!----------------------------------------------------------------------
+      !
+      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
+      !
+      ktab = iwork
+      !
+   END SUBROUTINE mppsum_int
+
+
+   SUBROUTINE mppmax_a_real( ptab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                 ***  routine mppmax_a_real  ***
+      !!                  
+      !! ** Purpose :   Maximum
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                  ::   kdim
+      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
+      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
+      !!
+      INTEGER :: ierror, localcomm
+      REAL(wp), DIMENSION(kdim) ::  zwork
+      !!----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) ) localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror )
+      ptab(:) = zwork(:)
+      !
+   END SUBROUTINE mppmax_a_real
+
+
+   SUBROUTINE mppmax_real( ptab, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmax_real  ***
+      !!                    
+      !! ** Purpose :   Maximum
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout)           ::   ptab   ! ???
+      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
+      !!
+      INTEGER  ::   ierror, localcomm
+      REAL(wp) ::   zwork
+      !!----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa 
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_max, localcomm, ierror )
+      ptab = zwork
+      !
+   END SUBROUTINE mppmax_real
+
+
+   SUBROUTINE mppmin_a_real( ptab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                 ***  routine mppmin_a_real  ***
+      !!                  
+      !! ** Purpose :   Minimum of REAL, array case
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                  ::   kdim
+      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
+      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
+      !!
+      INTEGER :: ierror, localcomm
+      REAL(wp), DIMENSION(kdim) ::   zwork
+      !!-----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa 
+      IF( PRESENT(kcom) ) localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_min, localcomm, ierror )
+      ptab(:) = zwork(:)
+      !
+   END SUBROUTINE mppmin_a_real
+
+
+   SUBROUTINE mppmin_real( ptab, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppmin_real  ***
+      !! 
+      !! ** Purpose :   minimum of REAL, scalar case
+      !!
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(inout)           ::   ptab        ! 
+      INTEGER , INTENT(in   ), OPTIONAL :: kcom
+      !!
+      INTEGER  ::   ierror
+      REAL(wp) ::   zwork
+      INTEGER :: localcomm
+      !!-----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa 
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_min, localcomm, ierror )
+      ptab = zwork
+      !
+   END SUBROUTINE mppmin_real
+
+
+   SUBROUTINE mppsum_a_real( ptab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsum_a_real  ***
+      !! 
+      !! ** Purpose :   global sum, REAL ARRAY argument case
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT( in )                     ::   kdim      ! size of ptab
+      REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array
+      INTEGER , INTENT( in ), OPTIONAL           :: kcom
+      !!
+      INTEGER                   ::   ierror    ! temporary integer
+      INTEGER                   ::   localcomm 
+      REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace 
+      !!-----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa 
+      IF( PRESENT(kcom) )   localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_sum, localcomm, ierror )
+      ptab(:) = zwork(:)
+      !
+   END SUBROUTINE mppsum_a_real
+
+
+   SUBROUTINE mppsum_real( ptab, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsum_real  ***
+      !!              
+      !! ** Purpose :   global sum, SCALAR argument case
+      !!
+      !!-----------------------------------------------------------------------
+      REAL(wp), INTENT(inout)           ::   ptab   ! input scalar
+      INTEGER , INTENT(in   ), OPTIONAL ::   kcom
+      !!
+      INTEGER  ::   ierror, localcomm 
+      REAL(wp) ::   zwork
+      !!-----------------------------------------------------------------------
+      !
+      localcomm = mpi_comm_opa 
+      IF( PRESENT(kcom) ) localcomm = kcom
+      !
+      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_sum, localcomm, ierror )
+      ptab = zwork
+      !
+   END SUBROUTINE mppsum_real
+
+# if defined key_mpp_rep
+   SUBROUTINE mppsum_realdd( ytab, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsum_realdd ***
+      !!
+      !! ** Purpose :   global sum in Massively Parallel Processing
+      !!                SCALAR argument case for double-double precision
+      !!
+      !!-----------------------------------------------------------------------
+      COMPLEX(wp), INTENT(inout)         :: ytab    ! input scalar
+      INTEGER , INTENT( in  ), OPTIONAL :: kcom
+
+      !! * Local variables   (MPI version)
+      INTEGER  ::    ierror
+      INTEGER  ::   localcomm
+      COMPLEX(wp) :: zwork
+
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) ) localcomm = kcom
+
+      ! reduce local sums into global sum
+      CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, &
+                       MPI_SUMDD,localcomm,ierror)
+      ytab = zwork
+
+   END SUBROUTINE mppsum_realdd
+  
+  
+   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsum_a_realdd  ***
+      !!
+      !! ** Purpose :   global sum in Massively Parallel Processing
+      !!                COMPLEX ARRAY case for double-double precision
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT( in )                        ::   kdim      ! size of ytab
+      COMPLEX(wp), DIMENSION(kdim), INTENT( inout ) ::   ytab      ! input array
+      INTEGER , INTENT( in  ), OPTIONAL :: kcom
+
+      !! * Local variables   (MPI version)
+      INTEGER                      :: ierror    ! temporary integer
+      INTEGER                      ::   localcomm
+      COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace
+
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) ) localcomm = kcom
+
+      CALL MPI_ALLREDUCE (ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, &
+                       MPI_SUMDD,localcomm,ierror)
+      ytab(:) = zwork(:)
+
+   END SUBROUTINE mppsum_a_realdd
+# endif   
+   
+   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj )
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_minloc  ***
+      !!
+      !! ** Purpose :   Compute the global minimum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab    ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask   ! Local mask
+      REAL(wp)                     , INTENT(  out) ::   pmin    ! Global minimum of ptab
+      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of minimum in global frame
+      !!
+      INTEGER , DIMENSION(2)   ::   ilocs
+      INTEGER :: ierror
+      REAL(wp) ::   zmin   ! local minimum
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      zmin  = MINVAL( ptab(:,:) , mask= pmask == 1.e0 )
+      ilocs = MINLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      !
+      zain(1,:)=zmin
+      zain(2,:)=ki+10000.*kj
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
+      !
+      pmin = zaout(1,1)
+      kj = INT(zaout(2,1)/10000.)
+      ki = INT(zaout(2,1) - 10000.*kj )
+      !
+   END SUBROUTINE mpp_minloc2d
+
+
+   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj ,kk)
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_minloc  ***
+      !!
+      !! ** Purpose :   Compute the global minimum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
+      REAL(wp)                         , INTENT(  out) ::   pmin         ! Global minimum of ptab
+      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame
+      !!
+      INTEGER  ::   ierror
+      REAL(wp) ::   zmin     ! local minimum
+      INTEGER , DIMENSION(3)   ::   ilocs
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
+      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      kk = ilocs(3)
+      !
+      zain(1,:)=zmin
+      zain(2,:)=ki+10000.*kj+100000000.*kk
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
+      !
+      pmin = zaout(1,1)
+      kk   = INT( zaout(2,1) / 100000000. )
+      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
+      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
+      !
+   END SUBROUTINE mpp_minloc3d
+
+
+   SUBROUTINE mpp_maxloc2d( ptab, pmask, pmax, ki, kj )
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_maxloc  ***
+      !!
+      !! ** Purpose :   Compute the global maximum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab     ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask    ! Local mask
+      REAL(wp)                     , INTENT(  out) ::   pmax     ! Global maximum of ptab
+      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of maximum in global frame
+      !!  
+      INTEGER  :: ierror
+      INTEGER, DIMENSION (2)   ::   ilocs
+      REAL(wp) :: zmax   ! local maximum
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1.e0 )
+      ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      !
+      zain(1,:) = zmax
+      zain(2,:) = ki + 10000. * kj
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
+      !
+      pmax = zaout(1,1)
+      kj   = INT( zaout(2,1) / 10000.     )
+      ki   = INT( zaout(2,1) - 10000.* kj )
+      !
+   END SUBROUTINE mpp_maxloc2d
+
+
+   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_maxloc  ***
+      !!
+      !! ** Purpose :  Compute the global maximum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
+      REAL(wp)                         , INTENT(  out) ::   pmax         ! Global maximum of ptab
+      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame
+      !!   
+      REAL(wp) :: zmax   ! local maximum
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      INTEGER , DIMENSION(3)   ::   ilocs
+      INTEGER :: ierror
+      !!-----------------------------------------------------------------------
+      !
+      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
+      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      kk = ilocs(3)
+      !
+      zain(1,:)=zmax
+      zain(2,:)=ki+10000.*kj+100000000.*kk
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
+      !
+      pmax = zaout(1,1)
+      kk   = INT( zaout(2,1) / 100000000. )
+      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
+      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
+      !
+   END SUBROUTINE mpp_maxloc3d
+
+
+   SUBROUTINE mppsync()
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsync  ***
+      !!                   
+      !! ** Purpose :   Massively parallel processors, synchroneous
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER :: ierror
+      !!-----------------------------------------------------------------------
+      !
+      CALL mpi_barrier( mpi_comm_opa, ierror )
+      !
+   END SUBROUTINE mppsync
+
+
+   SUBROUTINE mppstop
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppstop  ***
+      !!                   
+      !! ** purpose :   Stop massilively parallel processors method
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ::   info
+      !!----------------------------------------------------------------------
+      !
+      CALL mppsync
+      CALL mpi_finalize( info )
+      !
+   END SUBROUTINE mppstop
+
+
+   SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppobc  ***
+      !! 
+      !! ** Purpose :   Message passing manadgement for open boundary
+      !!     conditions array
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!       between processors following neighboring subdomains.
+      !!       domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices
+      INTEGER , INTENT(in   )                     ::   kl         ! index of open boundary
+      INTEGER , INTENT(in   )                     ::   kk         ! vertical dimension
+      INTEGER , INTENT(in   )                     ::   ktype      ! define north/south or east/west cdt
+      !                                                           !  = 1  north/south  ;  = 2  east/west
+      INTEGER , INTENT(in   )                     ::   kij        ! horizontal dimension
+      REAL(wp), INTENT(inout), DIMENSION(kij,kk)  ::   ptab       ! variable array
+      !! 
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      INTEGER  ::   iipt0, iipt1, ilpt1   ! temporary integers
+      INTEGER  ::   ijpt0, ijpt1          !    -          -
+      INTEGER  ::   imigr, iihom, ijhom   !    -          -
+      INTEGER ::   ml_req1, ml_req2, ml_err    ! for key_mpi_isend
+      INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztab   ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      ! boundary condition initialization
+      ! ---------------------------------
+      ztab(:,:) = 0.e0
+      !
+      IF( ktype==1 ) THEN                                  ! north/south boundaries
+         iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci     ) )
+         iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) )
+         ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci     ) )
+         ijpt0 = MAX( 1, MIN(kl  - njmpp+1, nlcj     ) )
+         ijpt1 = MAX( 0, MIN(kl  - njmpp+1, nlcj - 1 ) )
+      ELSEIF( ktype==2 ) THEN                              ! east/west boundaries
+         iipt0 = MAX( 1, MIN(kl  - nimpp+1, nlci     ) )
+         iipt1 = MAX( 0, MIN(kl  - nimpp+1, nlci - 1 ) )
+         ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj     ) )
+         ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) )
+         ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) )
+      ELSE
+         CALL ctl_stop( 'mppobc: bad ktype' )
+      ENDIF
+      
+      ! Communication level by level
+      ! ----------------------------
+!!gm Remark : this is very time consumming!!!
+      !                                         ! ------------------------ !
+      DO jk = 1, kk                             !   Loop over the levels   !
+         !                                      ! ------------------------ !
+         !
+         IF( ktype == 1 ) THEN                               ! north/south boundaries
+            DO jj = ijpt0, ijpt1
+               DO ji = iipt0, iipt1
+                  ztab(ji,jj) = ptab(ji,jk)
+               END DO
+            END DO
+         ELSEIF( ktype == 2 ) THEN                           ! east/west boundaries
+            DO jj = ijpt0, ijpt1
+               DO ji = iipt0, iipt1
+                  ztab(ji,jj) = ptab(jj,jk)
+               END DO
+            END DO
+         ENDIF
+
+
+         ! 1. East and west directions
+         ! ---------------------------
+         !
+         IF( nbondi /= 2 ) THEN         ! Read Dirichlet lateral conditions
+            iihom = nlci-nreci
+            DO jl = 1, jpreci
+               t2ew(:,jl,1) = ztab(jpreci+jl,:)
+               t2we(:,jl,1) = ztab(iihom +jl,:)
+            END DO
+         ENDIF
+         !
+         !                              ! Migrations
+         imigr=jpreci*jpj
+         !
+         IF( nbondi == -1 ) THEN
+            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
+            CALL mpprecv( 1, t2ew(1,1,2), imigr )
+            IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ELSEIF( nbondi == 0 ) THEN
+            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
+            CALL mpprecv( 1, t2ew(1,1,2), imigr )
+            CALL mpprecv( 2, t2we(1,1,2), imigr )
+            IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err )
+            IF(l_isend)   CALL mpi_wait( ml_req2, ml_stat, ml_err )
+         ELSEIF( nbondi == 1 ) THEN
+            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+            CALL mpprecv( 2, t2we(1,1,2), imigr )
+            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ENDIF
+         !
+         !                              ! Write Dirichlet lateral conditions
+         iihom = nlci-jpreci
+         !
+         IF( nbondi == 0 .OR. nbondi == 1 ) THEN
+            DO jl = 1, jpreci
+               ztab(jl,:) = t2we(:,jl,2)
+            END DO
+         ENDIF
+         IF( nbondi == -1 .OR. nbondi == 0 ) THEN
+            DO jl = 1, jpreci
+               ztab(iihom+jl,:) = t2ew(:,jl,2)
+            END DO
+         ENDIF
+
+
+         ! 2. North and south directions
+         ! -----------------------------
+         !
+         IF( nbondj /= 2 ) THEN         ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, jprecj
+               t2sn(:,jl,1) = ztab(:,ijhom +jl)
+               t2ns(:,jl,1) = ztab(:,jprecj+jl)
+            END DO
+         ENDIF
+         !
+         !                              ! Migrations
+         imigr = jprecj * jpi
+         !
+         IF( nbondj == -1 ) THEN
+            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
+            CALL mpprecv( 3, t2ns(1,1,2), imigr )
+            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ELSEIF( nbondj == 0 ) THEN
+            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
+            CALL mpprecv( 3, t2ns(1,1,2), imigr )
+            CALL mpprecv( 4, t2sn(1,1,2), imigr )
+            IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err )
+            IF( l_isend )   CALL mpi_wait( ml_req2, ml_stat, ml_err )
+         ELSEIF( nbondj == 1 ) THEN
+            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+            CALL mpprecv( 4, t2sn(1,1,2), imigr)
+            IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ENDIF
+         !
+         !                              ! Write Dirichlet lateral conditions
+         ijhom = nlcj - jprecj
+         IF( nbondj == 0 .OR. nbondj == 1 ) THEN
+            DO jl = 1, jprecj
+               ztab(:,jl) = t2sn(:,jl,2)
+            END DO
+         ENDIF
+         IF( nbondj == 0 .OR. nbondj == -1 ) THEN
+            DO jl = 1, jprecj
+               ztab(:,ijhom+jl) = t2ns(:,jl,2)
+            END DO
+         ENDIF
+         IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN
+            DO jj = ijpt0, ijpt1            ! north/south boundaries
+               DO ji = iipt0,ilpt1
+                  ptab(ji,jk) = ztab(ji,jj)  
+               END DO
+            END DO
+         ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN
+            DO jj = ijpt0, ilpt1            ! east/west boundaries
+               DO ji = iipt0,iipt1
+                  ptab(jj,jk) = ztab(ji,jj) 
+               END DO
+            END DO
+         ENDIF
+         !
+      END DO
+      !
+   END SUBROUTINE mppobc
+   
+
+   SUBROUTINE mpp_comm_free( kcom )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kcom
+      !!
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      CALL MPI_COMM_FREE(kcom, ierr)
+      !
+   END SUBROUTINE mpp_comm_free
+
+
+   SUBROUTINE mpp_ini_ice( pindic )
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_ice  ***
+      !!
+      !! ** Purpose :   Initialize special communicator for ice areas
+      !!      condition together with global variables needed in the ddmpp folding
+      !!
+      !! ** Method  : - Look for ice processors in ice routines
+      !!              - Put their number in nrank_ice
+      !!              - Create groups for the world processors and the ice processors
+      !!              - Create a communicator for ice processors
+      !!
+      !! ** output
+      !!      njmppmax = njmpp for northern procs
+      !!      ndim_rank_ice = number of processors with ice
+      !!      nrank_ice (ndim_rank_ice) = ice processors
+      !!      ngrp_world = group ID for the world processors
+      !!      ngrp_ice = group ID for the ice processors
+      !!      ncomm_ice = communicator for the ice procs.
+      !!      n_ice_root = number (in the world) of proc 0 in the ice comm.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: pindic
+      !!
+      INTEGER :: ierr
+      INTEGER :: jjproc
+      INTEGER :: ii
+      INTEGER, DIMENSION(jpnij) :: kice
+      INTEGER, DIMENSION(jpnij) :: zwork
+      !!----------------------------------------------------------------------
+      !
+      ! Look for how many procs with sea-ice
+      !
+      kice = 0
+      DO jjproc = 1, jpnij
+         IF( jjproc == narea .AND. pindic .GT. 0 )   kice(jjproc) = 1    
+      END DO
+      !
+      zwork = 0
+      CALL MPI_ALLREDUCE( kice, zwork, jpnij, mpi_integer, mpi_sum, mpi_comm_opa, ierr )
+      ndim_rank_ice = SUM( zwork )          
+
+      ! Allocate the right size to nrank_north
+#if ! defined key_agrif
+      IF( ALLOCATED ( nrank_ice ) )   DEALLOCATE( nrank_ice )
+#else
+      IF( ASSOCIATED( nrank_ice ) )   DEALLOCATE( nrank_ice )
+#endif
+      ALLOCATE( nrank_ice(ndim_rank_ice) )
+      !
+      ii = 0     
+      nrank_ice = 0
+      DO jjproc = 1, jpnij
+         IF( zwork(jjproc) == 1) THEN
+            ii = ii + 1
+            nrank_ice(ii) = jjproc -1 
+         ENDIF
+      END DO
+
+      ! Create the world group
+      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr )
+
+      ! Create the ice group from the world group
+      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_ice, nrank_ice, ngrp_ice, ierr )
+
+      ! Create the ice communicator , ie the pool of procs with sea-ice
+      CALL MPI_COMM_CREATE( mpi_comm_opa, ngrp_ice, ncomm_ice, ierr )
+
+      ! Find proc number in the world of proc 0 in the north
+      ! The following line seems to be useless, we just comment & keep it as reminder
+      ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr)
+      !
+   END SUBROUTINE mpp_ini_ice
+
+
+   SUBROUTINE mpp_ini_znl
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_znl  ***
+      !!
+      !! ** Purpose :   Initialize special communicator for computing zonal sum
+      !!
+      !! ** Method  : - Look for processors in the same row
+      !!              - Put their number in nrank_znl
+      !!              - Create group for the znl processors
+      !!              - Create a communicator for znl processors
+      !!              - Determine if processor should write znl files
+      !!
+      !! ** output
+      !!      ndim_rank_znl = number of processors on the same row
+      !!      ngrp_znl = group ID for the znl processors
+      !!      ncomm_znl = communicator for the ice procs.
+      !!      n_znl_root = number (in the world) of proc 0 in the ice comm.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr
+      INTEGER :: jproc
+      INTEGER :: ii
+      INTEGER, DIMENSION(jpnij) :: kwork
+      !
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world
+      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_opa   : ', mpi_comm_opa
+      !
+      IF ( jpnj == 1 ) THEN
+         ngrp_znl  = ngrp_world
+         ncomm_znl = mpi_comm_opa
+      ELSE
+         !
+         CALL MPI_ALLGATHER ( njmpp, 1, mpi_integer, kwork, 1, mpi_integer, mpi_comm_opa, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - kwork pour njmpp : ', kwork
+         !-$$        CALL flush(numout)
+         !
+         ! Count number of processors on the same row
+         ndim_rank_znl = 0
+         DO jproc=1,jpnij
+            IF ( kwork(jproc) == njmpp ) THEN
+               ndim_rank_znl = ndim_rank_znl + 1
+            ENDIF
+         END DO
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ndim_rank_znl : ', ndim_rank_znl
+         !-$$        CALL flush(numout)
+         ! Allocate the right size to nrank_znl
+#if ! defined key_agrif
+         IF (ALLOCATED (nrank_znl)) DEALLOCATE(nrank_znl)
+#else
+         IF (ASSOCIATED(nrank_znl)) DEALLOCATE(nrank_znl)
+#endif
+         ALLOCATE(nrank_znl(ndim_rank_znl))
+         ii = 0     
+         nrank_znl (:) = 0
+         DO jproc=1,jpnij
+            IF ( kwork(jproc) == njmpp) THEN
+               ii = ii + 1
+               nrank_znl(ii) = jproc -1 
+            ENDIF
+         END DO
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - nrank_znl : ', nrank_znl
+         !-$$        CALL flush(numout)
+
+         ! Create the opa group
+         CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_opa,ierr)
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_opa : ', ngrp_opa
+         !-$$        CALL flush(numout)
+
+         ! Create the znl group from the opa group
+         CALL MPI_GROUP_INCL  ( ngrp_opa, ndim_rank_znl, nrank_znl, ngrp_znl, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_znl ', ngrp_znl
+         !-$$        CALL flush(numout)
+
+         ! Create the znl communicator from the opa communicator, ie the pool of procs in the same row
+         CALL MPI_COMM_CREATE ( mpi_comm_opa, ngrp_znl, ncomm_znl, ierr )
+         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ncomm_znl ', ncomm_znl
+         !-$$        CALL flush(numout)
+         !
+      END IF
+
+      ! Determines if processor if the first (starting from i=1) on the row
+      IF ( jpni == 1 ) THEN 
+         l_znl_root = .TRUE.
+      ELSE
+         l_znl_root = .FALSE.
+         kwork (1) = nimpp
+         CALL mpp_min ( kwork(1), kcom = ncomm_znl)
+         IF ( nimpp == kwork(1)) l_znl_root = .TRUE.
+      END IF
+
+   END SUBROUTINE mpp_ini_znl
+
+
+   SUBROUTINE mpp_ini_north
+      !!----------------------------------------------------------------------
+      !!               ***  routine mpp_ini_north  ***
+      !!
+      !! ** Purpose :   Initialize special communicator for north folding 
+      !!      condition together with global variables needed in the mpp folding
+      !!
+      !! ** Method  : - Look for northern processors
+      !!              - Put their number in nrank_north
+      !!              - Create groups for the world processors and the north processors
+      !!              - Create a communicator for northern processors
+      !!
+      !! ** output
+      !!      njmppmax = njmpp for northern procs
+      !!      ndim_rank_north = number of processors in the northern line
+      !!      nrank_north (ndim_rank_north) = number  of the northern procs.
+      !!      ngrp_world = group ID for the world processors
+      !!      ngrp_north = group ID for the northern processors
+      !!      ncomm_north = communicator for the northern procs.
+      !!      north_root = number (in the world) of proc 0 in the northern comm.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ::   ierr
+      INTEGER ::   jjproc
+      INTEGER ::   ii, ji
+      !!----------------------------------------------------------------------
+      !
+      njmppmax = MAXVAL( njmppt )
+      !
+      ! Look for how many procs on the northern boundary
+      ndim_rank_north = 0
+      DO jjproc = 1, jpnij
+         IF( njmppt(jjproc) == njmppmax )   ndim_rank_north = ndim_rank_north + 1
+      END DO
+      !
+      ! Allocate the right size to nrank_north
+#if ! defined key_agrif
+      IF (ALLOCATED (nrank_north)) DEALLOCATE(nrank_north)
+#else
+      IF (ASSOCIATED(nrank_north)) DEALLOCATE(nrank_north)
+#endif
+      ALLOCATE( nrank_north(ndim_rank_north) )
+
+      ! Fill the nrank_north array with proc. number of northern procs.
+      ! Note : the rank start at 0 in MPI
+      ii = 0
+      DO ji = 1, jpnij
+         IF ( njmppt(ji) == njmppmax   ) THEN
+            ii=ii+1
+            nrank_north(ii)=ji-1
+         END IF
+      END DO
+      !
+      ! create the world group
+      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr )
+      !
+      ! Create the North group from the world group
+      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_north, nrank_north, ngrp_north, ierr )
+      !
+      ! Create the North communicator , ie the pool of procs in the north group
+      CALL MPI_COMM_CREATE( mpi_comm_opa, ngrp_north, ncomm_north, ierr )
+      !
+   END SUBROUTINE mpp_ini_north
+
+
+   SUBROUTINE mpp_lbc_north_3d( pt3d, cd_type, psgn )
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_3d  ***
+      !!
+      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
+      !!              in mpp configuration in case of jpn1 > 1
+      !!
+      !! ** Method  :   North fold condition and mpp with more than one proc
+      !!              in i-direction require a specific treatment. We gather 
+      !!              the 4 northern lines of the global domain on 1 processor
+      !!              and apply lbc north-fold on this sub array. Then we
+      !!              scatter the north fold array back to the processors.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the b.c. is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      !                                                              !   = T ,  U , V , F or W  gridpoints
+      REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
+      !!                                                             ! =  1. , the sign is kept
+      INTEGER ::   ji, jj, jr
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ijpjm1, ij, iproc
+      REAL(wp), DIMENSION(jpiglo,4,jpk)      ::   ztab
+      REAL(wp), DIMENSION(jpi   ,4,jpk)      ::   znorthloc
+      REAL(wp), DIMENSION(jpi   ,4,jpk,jpni) ::   znorthgloio
+      !!----------------------------------------------------------------------
+      !   
+      ijpj   = 4
+      ijpjm1 = 3
+      !
+      DO jj = nlcj - ijpj +1, nlcj          ! put in znorthloc the last 4 jlines of pt3d
+         ij = jj - nlcj + ijpj
+         znorthloc(:,ij,:) = pt3d(:,jj,:)
+      END DO
+      !
+      !                                     ! Build in procs of ncomm_north the znorthgloio
+      itaille = jpi * jpk * ijpj
+      CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
+         &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+      !
+      !                                     ! recover the global north array
+      DO jr = 1, ndim_rank_north
+         iproc = nrank_north(jr) + 1
+         ildi  = nldit (iproc)
+         ilei  = nleit (iproc)
+         iilb  = nimppt(iproc)
+         DO jj = 1, 4
+            DO ji = ildi, ilei
+               ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr)
+            END DO
+         END DO
+      END DO
+      !
+      CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
+      !
+      DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
+         ij = jj - nlcj + ijpj
+         DO ji= 1, nlci
+            pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:)
+         END DO
+      END DO
+      !
+   END SUBROUTINE mpp_lbc_north_3d
+
+
+   SUBROUTINE mpp_lbc_north_2d( pt2d, cd_type, psgn)
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_2d  ***
+      !!
+      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
+      !!              in mpp configuration in case of jpn1 > 1 (for 2d array )
+      !!
+      !! ** Method  :   North fold condition and mpp with more than one proc
+      !!              in i-direction require a specific treatment. We gather 
+      !!              the 4 northern lines of the global domain on 1 processor
+      !!              and apply lbc north-fold on this sub array. Then we
+      !!              scatter the north fold array back to the processors.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the b.c. is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      !                                                          !   = T ,  U , V , F or W  gridpoints
+      REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
+      !!                                                             ! =  1. , the sign is kept
+      INTEGER ::   ji, jj, jr
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ijpjm1, ij, iproc
+      REAL(wp), DIMENSION(jpiglo,4)      ::   ztab
+      REAL(wp), DIMENSION(jpi   ,4)      ::   znorthloc
+      REAL(wp), DIMENSION(jpi   ,4,jpni) ::   znorthgloio
+      !!----------------------------------------------------------------------
+      !
+      ijpj   = 4
+      ijpjm1 = 3
+      !
+      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d
+         ij = jj - nlcj + ijpj
+         znorthloc(:,ij) = pt2d(:,jj)
+      END DO
+
+      !                                     ! Build in procs of ncomm_north the znorthgloio
+      itaille = jpi * ijpj
+      CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,        &
+         &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+      !
+      DO jr = 1, ndim_rank_north            ! recover the global north array
+         iproc = nrank_north(jr) + 1
+         ildi=nldit (iproc)
+         ilei=nleit (iproc)
+         iilb=nimppt(iproc)
+         DO jj = 1, 4
+            DO ji = ildi, ilei
+               ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
+            END DO
+         END DO
+      END DO
+      !
+      CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
+      !
+      !
+      DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
+         ij = jj - nlcj + ijpj
+         DO ji = 1, nlci
+            pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
+         END DO
+      END DO
+      !
+   END SUBROUTINE mpp_lbc_north_2d
+
+
+   SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn)
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_2d  ***
+      !!
+      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
+      !!              in mpp configuration in case of jpn1 > 1 and for 2d 
+      !!              array with outer extra halo
+      !!
+      !! ** Method  :   North fold condition and mpp with more than one proc
+      !!              in i-direction require a specific treatment. We gather 
+      !!              the 4+2*jpr2dj northern lines of the global domain on 1 
+      !!              processor and apply lbc north-fold on this sub array. 
+      !!              Then we scatter the north fold array back to the processors.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points
+      !                                                                                         !   = T ,  U , V , F or W -points
+      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! = -1. the sign change across the  
+      !!                                                                                        ! north fold, =  1. otherwise
+      INTEGER ::   ji, jj, jr
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ij, iproc
+      REAL(wp), DIMENSION(jpiglo,4+2*jpr2dj)      ::   ztab
+      REAL(wp), DIMENSION(jpi   ,4+2*jpr2dj)      ::   znorthloc
+      REAL(wp), DIMENSION(jpi   ,4+2*jpr2dj,jpni) ::   znorthgloio
+      !!----------------------------------------------------------------------
+      !
+      ijpj=4
+
+      ij=0
+      ! put in znorthloc the last 4 jlines of pt2d
+      DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
+         ij = ij + 1
+         DO ji = 1, jpi
+            znorthloc(ji,ij)=pt2d(ji,jj)
+         END DO
+      END DO
+      !
+      itaille = jpi * ( ijpj + 2 * jpr2dj )
+      CALL MPI_ALLGATHER( znorthloc(1,1)    , itaille, MPI_DOUBLE_PRECISION,    &
+         &                znorthgloio(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+      !
+      DO jr = 1, ndim_rank_north            ! recover the global north array
+         iproc = nrank_north(jr) + 1
+         ildi = nldit (iproc)
+         ilei = nleit (iproc)
+         iilb = nimppt(iproc)
+         DO jj = 1, ijpj+2*jpr2dj
+            DO ji = ildi, ilei
+               ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
+            END DO
+         END DO
+      END DO
+
+
+      ! 2. North-Fold boundary conditions
+      ! ----------------------------------
+      CALL lbc_nfd( ztab(:,:), cd_type, psgn, pr2dj = jpr2dj )
+
+      ij = jpr2dj
+      !! Scatter back to pt2d
+      DO jj = nlcj - ijpj + 1 , nlcj +jpr2dj
+      ij  = ij +1 
+         DO ji= 1, nlci
+            pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
+         END DO
+      END DO
+      !
+   END SUBROUTINE mpp_lbc_north_e
+
+
+   SUBROUTINE mpi_init_opa( code )
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_init.opa  ***
+      !!
+      !! ** Purpose :: export and attach a MPI buffer for bsend
+      !!
+      !! ** Method  :: define buffer size in namelist, if 0 no buffer attachment
+      !!            but classical mpi_init
+      !! 
+      !! History :: 01/11 :: IDRIS initial version for IBM only  
+      !!            08/04 :: R. Benshila, generalisation
+      !!---------------------------------------------------------------------
+      INTEGER                                 :: code, ierr
+      LOGICAL                                 :: mpi_was_called
+      !!---------------------------------------------------------------------
+      !
+      CALL mpi_initialized( mpi_was_called, code )      ! MPI initialization
+      IF ( code /= MPI_SUCCESS ) THEN
+         CALL ctl_stop( ' lib_mpp: Error in routine mpi_initialized' )
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+      !
+      IF( .NOT. mpi_was_called ) THEN
+         CALL mpi_init( code )
+         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code )
+         IF ( code /= MPI_SUCCESS ) THEN
+            CALL ctl_stop( ' lib_mpp: Error in routine mpi_comm_dup' )
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF
+      !
+      IF( nn_buffer > 0 ) THEN
+         IF ( lwp ) WRITE(numout,*) 'mpi_bsend, buffer allocation of  : ', nn_buffer
+         ! Buffer allocation and attachment
+         ALLOCATE( tampon(nn_buffer) )
+         CALL mpi_buffer_attach( tampon, nn_buffer,code )
+      ENDIF
+      !
+   END SUBROUTINE mpi_init_opa
+
+#if defined key_mpp_rep
+   SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype)
+      !!---------------------------------------------------------------------
+      !!   Routine DDPDD_MPI: used by reduction operator MPI_SUMDD
+      !!
+      !!   Modification of original codes written by David H. Bailey
+      !!   This subroutine computes yddb(i) = ydda(i)+yddb(i)
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in)                         :: ilen, itype
+      COMPLEX(wp), DIMENSION(ilen), INTENT(in)     :: ydda
+      COMPLEX(wp), DIMENSION(ilen), INTENT(inout)  :: yddb
+      !
+      REAL(wp) :: zerr, zt1, zt2    ! local work variables
+      INTEGER :: ji, ztmp           ! local scalar
+
+      ztmp = itype   ! avoid compilation warning
+
+      DO ji=1,ilen
+      ! Compute ydda + yddb using Knuth's trick.
+         zt1  = real(ydda(ji)) + real(yddb(ji))
+         zerr = zt1 - real(ydda(ji))
+         zt2  = ((real(yddb(ji)) - zerr) + (real(ydda(ji)) - (zt1 - zerr))) &
+                + aimag(ydda(ji)) + aimag(yddb(ji))
+
+         ! The result is zt1 + zt2, after normalization.
+         yddb(ji) = cmplx ( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1),wp )
+      END DO
+
+   END SUBROUTINE DDPDD_MPI
+#endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case:            Dummy module        share memory computing
+   !!----------------------------------------------------------------------
+
+   INTERFACE mpp_sum
+      MODULE PROCEDURE mpp_sum_a2s, mpp_sum_as, mpp_sum_ai, mpp_sum_s, mpp_sum_i,  &
+             &         mpp_sum_c, mpp_sum_ac 
+   END INTERFACE
+   INTERFACE mpp_max
+      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
+   END INTERFACE
+   INTERFACE mpp_min
+      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
+   END INTERFACE
+   INTERFACE mppobc
+      MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d
+   END INTERFACE
+   INTERFACE mpp_minloc
+      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+   END INTERFACE
+   INTERFACE mpp_maxloc
+      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+   END INTERFACE
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
+   INTEGER :: ncomm_ice
+
+CONTAINS
+
+   FUNCTION mynode( ldtxt, localComm ) RESULT (function_value)
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
+      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0
+      IF( .FALSE. )   ldtxt(:) = 'never done'
+   END FUNCTION mynode
+
+   SUBROUTINE mppsync                       ! Dummy routine
+   END SUBROUTINE mppsync
+
+   SUBROUTINE mpp_sum_as( parr, kdim, kcom )      ! Dummy routine
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1), kcom
+   END SUBROUTINE mpp_sum_as
+
+   SUBROUTINE mpp_sum_a2s( parr, kdim, kcom )      ! Dummy routine
+      REAL   , DIMENSION(:,:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1), kcom
+   END SUBROUTINE mpp_sum_a2s
+
+   SUBROUTINE mpp_sum_ai( karr, kdim, kcom )      ! Dummy routine
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1), kcom
+   END SUBROUTINE mpp_sum_ai
+
+   SUBROUTINE mpp_sum_ac( yarr, kdim, kcom )      ! Dummy routine
+      COMPLEX, DIMENSION(:) :: yarr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_ac: You should not have seen this print! error?', kdim, yarr(1), kcom
+   END SUBROUTINE mpp_sum_ac
+
+   SUBROUTINE mpp_sum_s( psca, kcom )            ! Dummy routine
+      REAL                  :: psca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca, kcom
+   END SUBROUTINE mpp_sum_s
+ 
+   SUBROUTINE mpp_sum_i( kint, kcom )            ! Dummy routine
+      integer               :: kint
+      INTEGER, OPTIONAL     :: kcom
+      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint, kcom
+   END SUBROUTINE mpp_sum_i
+
+   SUBROUTINE mpp_sum_c( ysca, kcom )            ! Dummy routine
+      COMPLEX               :: ysca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_c: You should not have seen this print! error?', ysca, kcom
+   END SUBROUTINE mpp_sum_c
+
+   SUBROUTINE mppmax_a_real( parr, kdim, kcom )
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
+   END SUBROUTINE mppmax_a_real
+
+   SUBROUTINE mppmax_real( psca, kcom )
+      REAL                  :: psca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_real: You should not have seen this print! error?', psca, kcom
+   END SUBROUTINE mppmax_real
+
+   SUBROUTINE mppmin_a_real( parr, kdim, kcom )
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
+   END SUBROUTINE mppmin_a_real
+
+   SUBROUTINE mppmin_real( psca, kcom )
+      REAL                  :: psca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_real: You should not have seen this print! error?', psca, kcom
+   END SUBROUTINE mppmin_real
+
+   SUBROUTINE mppmax_a_int( karr, kdim ,kcom)
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
+   END SUBROUTINE mppmax_a_int
+
+   SUBROUTINE mppmax_int( kint, kcom)
+      INTEGER               :: kint
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmax_int: You should not have seen this print! error?', kint, kcom
+   END SUBROUTINE mppmax_int
+
+   SUBROUTINE mppmin_a_int( karr, kdim, kcom )
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
+   END SUBROUTINE mppmin_a_int
+
+   SUBROUTINE mppmin_int( kint, kcom )
+      INTEGER               :: kint
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom
+   END SUBROUTINE mppmin_int
+
+   SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+      REAL, DIMENSION(:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij
+   END SUBROUTINE mppobc_1d
+
+   SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+      REAL, DIMENSION(:,:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij
+   END SUBROUTINE mppobc_2d
+
+   SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+      REAL, DIMENSION(:,:,:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij
+   END SUBROUTINE mppobc_3d
+
+   SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
+      REAL, DIMENSION(:,:,:,:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij
+   END SUBROUTINE mppobc_4d
+
+   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj )
+      REAL                   :: pmin
+      REAL , DIMENSION (:,:) :: ptab, pmask
+      INTEGER :: ki, kj
+      WRITE(*,*) 'mpp_minloc2d: You should not have seen this print! error?', pmin, ki, kj, ptab(1,1), pmask(1,1)
+   END SUBROUTINE mpp_minloc2d
+
+   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj, kk )
+      REAL                     :: pmin
+      REAL , DIMENSION (:,:,:) :: ptab, pmask
+      INTEGER :: ki, kj, kk
+      WRITE(*,*) 'mpp_minloc3d: You should not have seen this print! error?', pmin, ki, kj, kk, ptab(1,1,1), pmask(1,1,1)
+   END SUBROUTINE mpp_minloc3d
+
+   SUBROUTINE mpp_maxloc2d( ptab, pmask, pmax, ki, kj )
+      REAL                   :: pmax
+      REAL , DIMENSION (:,:) :: ptab, pmask
+      INTEGER :: ki, kj
+      WRITE(*,*) 'mpp_maxloc2d: You should not have seen this print! error?', pmax, ki, kj, ptab(1,1), pmask(1,1)
+   END SUBROUTINE mpp_maxloc2d
+
+   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
+      REAL                     :: pmax
+      REAL , DIMENSION (:,:,:) :: ptab, pmask
+      INTEGER :: ki, kj, kk
+      WRITE(*,*) 'mpp_maxloc3d: You should not have seen this print! error?', pmax, ki, kj, kk, ptab(1,1,1), pmask(1,1,1)
+   END SUBROUTINE mpp_maxloc3d
+
+   SUBROUTINE mppstop
+      WRITE(*,*) 'mppstop: You should not have seen this print! error?'
+   END SUBROUTINE mppstop
+
+   SUBROUTINE mpp_ini_ice( kcom )
+      INTEGER :: kcom
+      WRITE(*,*) 'mpp_ini_ice: You should not have seen this print! error?', kcom
+   END SUBROUTINE mpp_ini_ice
+
+   SUBROUTINE mpp_ini_znl
+      WRITE(*,*) 'mpp_ini_znl: You should not have seen this print! error?'
+   END SUBROUTINE mpp_ini_znl
+
+   SUBROUTINE mpp_comm_free( kcom )
+      INTEGER :: kcom
+      WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom
+   END SUBROUTINE mpp_comm_free
+#endif
+   !!----------------------------------------------------------------------
+END MODULE lib_mpp
Index: /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 2442)
+++ /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 2442)
@@ -0,0 +1,493 @@
+MODULE mppini
+   !!==============================================================================
+   !!                       ***  MODULE mppini   ***
+   !! Ocean initialization : distributed memory computing initialization
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   mpp_init       : Lay out the global domain over processors
+   !!   mpp_init2      : Lay out the global domain over processors 
+   !!                    with land processor elimination
+   !!   mpp_init_ioispl: IOIPSL initialization in mpp
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain 
+   USE in_out_manager  ! I/O Manager
+   USE lib_mpp         ! distribued memory computing library
+   USE ioipsl
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC mpp_init       ! called by opa.F90
+   PUBLIC mpp_init2      ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if ! defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   Default option :                            shared memory computing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Shared memory computing, set the local processor
+      !!      variables to the value of the global domain
+      !!
+      !! History :
+      !!   9.0  !  04-01  (G. Madec, J.M. Molines)  F90 : free form, north fold jpni >1
+      !!----------------------------------------------------------------------
+
+      ! No mpp computation
+      nimpp  = 1
+      njmpp  = 1
+      nlci   = jpi
+      nlcj   = jpj
+      nldi   = 1
+      nldj   = 1
+      nlei   = jpi
+      nlej   = jpj
+      nperio = jperio
+      nbondi = 2
+      nbondj = 2
+      nidom  = FLIO_DOM_NONE
+      npolj = jperio
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing'
+         WRITE(numout,*) '~~~~~~~~~~~: '
+         WRITE(numout,*) '         nperio = ', nperio
+         WRITE(numout,*) '         npolj  = ', npolj
+         WRITE(numout,*) '         nimpp  = ', nimpp
+         WRITE(numout,*) '         njmpp  = ', njmpp
+      ENDIF
+
+      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) &
+          CALL ctl_stop( 'equality  jpni = jpnj = jpnij = 1 is not satisfied',   &
+          &              'the domain is lay out for distributed memory computing! ' )
+
+   END SUBROUTINE mpp_init
+
+
+   SUBROUTINE mpp_init2 
+      CALL mpp_init                             ! same routine as mpp_init
+   END SUBROUTINE mpp_init2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'          OR         MPI massively parallel processing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!                    
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!      Periodic condition is a function of the local domain position
+      !!      (global boundary or neighbouring domain) and of the global
+      !!      periodic
+      !!      Type :         jperio global periodic condition
+      !!                     nperio local  periodic condition
+      !!
+      !! ** Action  : - set domain parameters
+      !!                    nimpp     : longitudinal index 
+      !!                    njmpp     : latitudinal  index
+      !!                    nperio    : lateral condition type 
+      !!                    narea     : number for local area
+      !!                    nlci      : first dimension
+      !!                    nlcj      : second dimension
+      !!                    nbondi    : mark for "east-west local boundary"
+      !!                    nbondj    : mark for "north-south local boundary"
+      !!                    nproc     : number for local processor
+      !!                    noea      : number for local neighboring processor
+      !!                    nowe      : number for local neighboring processor
+      !!                    noso      : number for local neighboring processor
+      !!                    nono      : number for local neighboring processor
+      !!
+      !! History :
+      !!        !  94-11  (M. Guyon)  Original code
+      !!        !  95-04  (J. Escobar, M. Imbard)
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+      !!   8.5  !  02-08  (G. Madec)  F90 : free form
+      !!----------------------------------------------------------------------
+      !! * Local variables
+      INTEGER ::   ji, jj, jn               ! dummy loop indices
+      INTEGER ::   &
+         ii, ij, ifreq, il1, il2,        &  ! temporary integers
+         iresti, irestj, ijm1, imil,     &  !    "          "
+         inum                               ! temporary logical unit
+
+      INTEGER, DIMENSION(jpni,jpnj) ::   &
+         iimppt, ijmppt, ilcit, ilcjt       ! temporary workspace
+      REAL(wp) ::   zidom, zjdom            ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+
+
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+      !  Computation of local domain sizes ilcit() ilcjt()
+      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
+      !  The subdomains are squares leeser than or equal to the global
+      !  dimensions divided by the number of processors minus the overlap
+      !  array (cf. par_oce.F90).
+      
+      nreci  = 2 * jpreci
+      nrecj  = 2 * jprecj
+      iresti = MOD( jpiglo - nreci , jpni )
+      irestj = MOD( jpjglo - nrecj , jpnj )
+
+      IF(  iresti == 0 )   iresti = jpni
+      DO jj = 1, jpnj
+         DO ji = 1, iresti
+            ilcit(ji,jj) = jpi
+         END DO
+         DO ji = iresti+1, jpni
+            ilcit(ji,jj) = jpi -1
+         END DO
+      END DO
+      
+      IF( irestj == 0 )   irestj = jpnj
+      DO ji = 1, jpni
+         DO jj = 1, irestj
+            ilcjt(ji,jj) = jpj
+         END DO
+         DO jj = irestj+1, jpnj
+            ilcjt(ji,jj) = jpj -1
+         END DO
+      END DO
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '           defines mpp subdomains'
+         WRITE(numout,*) '           ----------------------'
+         WRITE(numout,*) '           iresti=',iresti,' irestj=',irestj
+         WRITE(numout,*) '           jpni  =',jpni  ,' jpnj  =',jpnj
+         ifreq = 4
+         il1   = 1
+         DO jn = 1, (jpni-1)/ifreq+1
+            il2 = MIN( jpni, il1+ifreq-1 )
+            WRITE(numout,*)
+            WRITE(numout,9200) ('***',ji = il1,il2-1)
+            DO jj = jpnj, 1, -1
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9200) ('***',ji = il1,il2-1)
+            END DO
+            WRITE(numout,9201) (ji,ji = il1,il2)
+            il1 = il1+ifreq
+         END DO
+ 9200    FORMAT('     ***',20('*************',a3))
+ 9203    FORMAT('     *     ',20('         *   ',a3))
+ 9201    FORMAT('        ',20('   ',i3,'          '))
+ 9202    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+      ENDIF
+
+      zidom = nreci
+      DO ji = 1, jpni
+         zidom = zidom + ilcit(ji,1) - nreci
+      END DO
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo
+      
+      zjdom = nrecj
+      DO jj = 1, jpnj
+         zjdom = zjdom + ilcjt(1,jj) - nrecj
+      END DO
+      IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo
+      IF(lwp) WRITE(numout,*)
+      
+
+      !  2. Index arrays for subdomains
+      ! -------------------------------
+      
+      iimppt(:,:) = 1
+      ijmppt(:,:) = 1
+      
+      IF( jpni > 1 ) THEN
+         DO jj = 1, jpnj
+            DO ji = 2, jpni
+               iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
+            END DO
+         END DO
+      ENDIF
+
+      IF( jpnj > 1 ) THEN
+         DO jj = 2, jpnj
+            DO ji = 1, jpni
+               ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
+            END DO
+         END DO
+      ENDIF
+      
+      ! 3. Subdomain description
+      ! ------------------------
+
+      DO jn = 1, jpnij
+         ii = 1 + MOD( jn-1, jpni )
+         ij = 1 + (jn-1) / jpni
+         nimppt(jn) = iimppt(ii,ij)
+         njmppt(jn) = ijmppt(ii,ij)
+         nlcit (jn) = ilcit (ii,ij)     
+         nlci       = nlcit (jn)     
+         nlcjt (jn) = ilcjt (ii,ij)     
+         nlcj       = nlcjt (jn)
+         nbondj = -1                                   ! general case
+         IF( jn   >  jpni          )   nbondj = 0      ! first row of processor
+         IF( jn   >  (jpnj-1)*jpni )   nbondj = 1      ! last  row of processor
+         IF( jpnj == 1             )   nbondj = 2      ! one processor only in j-direction
+         ibonjt(jn) = nbondj
+         
+         nbondi = 0                                    ! 
+         IF( MOD( jn, jpni ) == 1 )   nbondi = -1      !
+         IF( MOD( jn, jpni ) == 0 )   nbondi =  1      !
+         IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction
+         ibonit(jn) = nbondi
+         
+         nldi =  1   + jpreci
+         nlei = nlci - jpreci
+         IF( nbondi == -1 .OR. nbondi == 2 )   nldi = 1
+         IF( nbondi ==  1 .OR. nbondi == 2 )   nlei = nlci
+         nldj =  1   + jprecj
+         nlej = nlcj - jprecj
+         IF( nbondj == -1 .OR. nbondj == 2 )   nldj = 1
+         IF( nbondj ==  1 .OR. nbondj == 2 )   nlej = nlcj
+         nldit(jn) = nldi
+         nleit(jn) = nlei
+         nldjt(jn) = nldj
+         nlejt(jn) = nlej
+      END DO
+      
+
+      ! 4. From global to local
+      ! -----------------------
+
+      nperio = 0
+      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
+
+
+      ! 5. Subdomain neighbours
+      ! ----------------------
+
+      nproc = narea - 1
+      noso  = nproc - jpni
+      nowe  = nproc - 1
+      noea  = nproc + 1
+      nono  = nproc + jpni
+      ! great neighbours
+      npnw = nono - 1
+      npne = nono + 1
+      npsw = noso - 1
+      npse = noso + 1
+      nbsw = 1
+      nbnw = 1
+      IF( MOD( nproc, jpni ) == 0 ) THEN
+         nbsw = 0
+         nbnw = 0
+      ENDIF
+      nbse = 1
+      nbne = 1
+      IF( MOD( nproc, jpni ) == jpni-1 ) THEN
+         nbse = 0
+         nbne = 0
+      ENDIF
+      IF(nproc < jpni) THEN
+         nbsw = 0
+         nbse = 0
+      ENDIF
+      IF( nproc >= (jpnj-1)*jpni ) THEN
+         nbnw = 0
+         nbne = 0
+      ENDIF
+      nlcj = nlcjt(narea)  
+      nlci = nlcit(narea)  
+      nldi = nldit(narea)
+      nlei = nleit(narea)
+      nldj = nldjt(narea)
+      nlej = nlejt(narea)
+      nbondi = ibonit(narea)
+      nbondj = ibonjt(narea)
+      nimpp  = nimppt(narea)  
+      njmpp  = njmppt(narea)  
+
+     ! Save processor layout in layout.dat file 
+       IF (lwp) THEN
+        CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+        WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
+        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
+        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
+
+        DO  jn = 1, jpnij
+         WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
+                                      nldit(jn), nldjt(jn), &
+                                      nleit(jn), nlejt(jn), &
+                                      nimppt(jn), njmppt(jn)
+        END DO
+        CLOSE(inum)   
+      END IF
+
+
+      ! w a r n i n g  narea (zone) /= nproc (processors)!
+
+      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+         IF( jpni == 1 )THEN
+            nbondi = 2
+            nperio = 1
+         ELSE
+            nbondi = 0
+         ENDIF
+         IF( MOD( narea, jpni ) == 0 ) THEN
+            noea = nproc-(jpni-1)
+            npne = npne-jpni
+            npse = npse-jpni
+         ENDIF
+         IF( MOD( narea, jpni ) == 1 ) THEN
+            nowe = nproc+(jpni-1)
+            npnw = npnw+jpni
+            npsw = npsw+jpni
+         ENDIF
+         nbsw = 1
+         nbnw = 1
+         nbse = 1
+         nbne = 1
+         IF( nproc < jpni ) THEN
+            nbsw = 0
+            nbse = 0
+         ENDIF
+         IF( nproc >= (jpnj-1)*jpni ) THEN
+            nbnw = 0
+            nbne = 0
+         ENDIF
+      ENDIF
+      npolj = 0
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         ijm1 = jpni*(jpnj-1)
+         imil = ijm1+(jpni+1)/2
+         IF( narea > ijm1 ) npolj = 3
+         IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
+         IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
+      ENDIF
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+          ijm1 = jpni*(jpnj-1)
+          imil = ijm1+(jpni+1)/2
+          IF( narea > ijm1) npolj = 5
+          IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
+          IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
+      ENDIF
+
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc  = ', nproc
+         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
+         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
+         WRITE(numout,*) ' nbondi = ', nbondi
+         WRITE(numout,*) ' nbondj = ', nbondj
+         WRITE(numout,*) ' npolj  = ', npolj
+         WRITE(numout,*) ' nperio = ', nperio
+         WRITE(numout,*) ' nlci   = ', nlci
+         WRITE(numout,*) ' nlcj   = ', nlcj
+         WRITE(numout,*) ' nimpp  = ', nimpp
+         WRITE(numout,*) ' njmpp  = ', njmpp
+         WRITE(numout,*) ' nbse   = ', nbse  , ' npse   = ', npse
+         WRITE(numout,*) ' nbsw   = ', nbsw  , ' npsw   = ', npsw
+         WRITE(numout,*) ' nbne   = ', nbne  , ' npne   = ', npne
+         WRITE(numout,*) ' nbnw   = ', nbnw  , ' npnw   = ', npnw
+      ENDIF
+
+      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' )
+
+      ! Prepare mpp north fold
+
+      IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+      END IF
+
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+   END SUBROUTINE mpp_init
+
+#  include "mppini_2.h90"
+
+# if defined key_dimgout
+   !!----------------------------------------------------------------------
+   !!   'key_dimgout'                  NO use of NetCDF files
+   !!----------------------------------------------------------------------
+   SUBROUTINE mpp_init_ioipsl       ! Dummy routine
+   END SUBROUTINE mpp_init_ioipsl  
+# else
+   SUBROUTINE mpp_init_ioipsl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init_ioipsl  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !! ** Method  :   
+      !!
+      !! History :
+      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL 
+      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
+      !!----------------------------------------------------------------------
+      !! Local declarations
+
+      INTEGER, DIMENSION(2) ::   &
+         iglo, iloc, iabsf, iabsl, ihals, ihale, idid
+      !!----------------------------------------------------------------------
+
+      ! The domain is split only horizontally along i- or/and j- direction
+      ! So we need at the most only 1D arrays with 2 elements.
+      ! Set idompar values equivalent to the jpdom_local_noextra definition
+      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
+      iglo(1) = jpiglo
+      iglo(2) = jpjglo
+      iloc(1) = nlci
+      iloc(2) = nlcj
+      iabsf(1) = nimppt(narea)
+      iabsf(2) = njmppt(narea)
+      iabsl(:) = iabsf(:) + iloc(:) - 1
+      ihals(1) = nldi - 1
+      ihals(2) = nldj - 1
+      ihale(1) = nlci - nlei
+      ihale(2) = nlcj - nlej
+      idid(1) = 1
+      idid(2) = 2
+
+      IF(lwp) THEN
+          WRITE(numout,*)
+          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
+          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
+          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
+          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
+      ENDIF
+
+      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
+
+   END SUBROUTINE mpp_init_ioipsl  
+
+# endif
+#endif
+
+   !!======================================================================
+END MODULE mppini
Index: /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 2442)
+++ /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 2442)
@@ -0,0 +1,525 @@
+   SUBROUTINE mpp_init2
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init2  ***
+      !!
+      !! * Purpose :   Lay out the global domain over processors.
+      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
+      !!     FOR DEFINING BETTER CUTTING OUT.
+      !!       This routine is used with a the bathymetry file.
+      !!       In this version, the land processors are avoided and the adress
+      !!     processor (nproc, narea,noea, ...) are calculated again.
+      !!     The jpnij parameter can be lesser than jpni x jpnj
+      !!     and this jpnij parameter must be calculated before with an
+      !!     algoritmic preprocessing program.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!      Periodic condition is a function of the local domain position
+      !!      (global boundary or neighbouring domain) and of the global
+      !!      periodic
+      !!      Type :         jperio global periodic condition
+      !!                     nperio local  periodic condition
+      !!
+      !! ** Action :        nimpp     : longitudinal index 
+      !!                    njmpp     : latitudinal  index
+      !!                    nperio    : lateral condition type 
+      !!                    narea     : number for local area
+      !!                    nlci      : first dimension
+      !!                    nlcj      : second dimension
+      !!                    nproc     : number for local processor
+      !!                    noea      : number for local neighboring processor
+      !!                    nowe      : number for local neighboring processor
+      !!                    noso      : number for local neighboring processor
+      !!                    nono      : number for local neighboring processor
+      !!
+      !! History :
+      !!        !  94-11  (M. Guyon)  Original code
+      !!        !  95-04  (J. Escobar, M. Imbard)
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
+      !!----------------------------------------------------------------------
+      USE in_out_manager  ! I/O Manager
+      USE iom
+      !! 
+      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
+      INTEGER ::  inum                        ! temporary logical unit
+      INTEGER ::   &
+         ii, ij, ifreq, il1, il2,          &  ! temporary integers
+         icont, ili, ilj,                  &  !    "          "
+         isurf, ijm1, imil,                &  !    "          "
+         iino, ijno, iiso, ijso,           &  !    "          " 
+         iiea, ijea, iiwe, ijwe,           &  !    "          "
+         iinw, ijnw, iine, ijne,           &  !    "          "
+         iisw, ijsw, iise, ijse,           &  !    "          "
+         iresti, irestj, iproc                !    "          "
+      INTEGER, DIMENSION(jpnij) ::   &
+         iin, ijn          
+      INTEGER, DIMENSION(jpni,jpnj) ::   &
+         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace
+         ipproc, ibondj, ibondi, ipolj ,   &  !    "           "
+         ilei  , ilej  , ildi  , ildj  ,   &  !    "           "
+         ioea  , iowe  , ioso  , iono  ,   &  !    "           "
+         ione  , ionw  , iose  , iosw  ,   &  !    "           "
+         ibne  , ibnw  , ibse  , ibsw         !    "           "
+      INTEGER,  DIMENSION(jpiglo,jpjglo) ::   &
+         imask                                ! temporary global workspace
+      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
+         zdta                   ! temporary data workspace
+      REAL(wp) ::   zidom , zjdom          ! temporary scalars
+
+      ! read namelist for ln_zco
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
+
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+      !! $Id$
+      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+      !!----------------------------------------------------------------------
+      
+      REWIND ( numnam )              ! Read Namelist namzgr : vertical coordinate'
+      READ   ( numnam, namzgr )
+
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~'
+      IF(lwp)WRITE(numout,*) ' '
+
+      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
+
+      ! 0. initialisation
+      ! -----------------
+
+      ! open the file
+      ! Remember that at this level in the code, mpp is not yet initialized, so
+      ! the file must be open with jpdom_unknown, and kstart amd kcount forced 
+      IF ( ln_zco ) THEN 
+         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
+         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+      ELSE
+         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
+         CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+      ENDIF
+      CALL iom_close (inum)
+
+      ! land/sea mask over the global/zoom domain
+
+      imask(:,:)=1
+      WHERE ( zdta(:,:) <= 0. ) imask = 0
+
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+
+      !  Computation of local domain sizes ilci() ilcj()
+      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
+      !  The subdomains are squares leeser than or equal to the global
+      !  dimensions divided by the number of processors minus the overlap
+      !  array.
+
+      nreci=2*jpreci
+      nrecj=2*jprecj
+      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
+      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
+
+      ilci(1:iresti      ,:) = jpi
+      ilci(iresti+1:jpni ,:) = jpi-1
+
+      ilcj(:,      1:irestj) = jpj
+      ilcj(:, irestj+1:jpnj) = jpj-1
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
+
+      zidom = nreci + sum(ilci(:,1) - nreci ) 
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
+
+      zjdom = nrecj + sum(ilcj(1,:) - nrecj ) 
+      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
+      IF(lwp) WRITE(numout,*)
+
+
+      !  2. Index arrays for subdomains
+      ! -------------------------------
+
+      iimppt(:,:) = 1
+      ijmppt(:,:) = 1
+      ipproc(:,:) = -1
+
+      IF( jpni > 1 )THEN
+         DO jj = 1, jpnj
+            DO ji = 2, jpni
+               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
+            END DO
+         END DO
+      ENDIF
+
+      IF( jpnj > 1 )THEN
+         DO jj = 2, jpnj
+            DO ji = 1, jpni
+               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
+            END DO
+         END DO
+      ENDIF
+
+
+      ! 3. Subdomain description in the Regular Case
+      ! --------------------------------------------
+
+      nperio = 0
+      icont = -1
+      DO jarea = 1, jpni*jpnj
+         ii = 1 + MOD(jarea-1,jpni)
+         ij = 1 +    (jarea-1)/jpni
+         ili = ilci(ii,ij)
+         ilj = ilcj(ii,ij)
+
+         ibondj(ii,ij) = -1
+         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
+         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
+         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
+
+         ibondi(ii,ij) = 0
+         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
+         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
+         IF( jpni            == 1 )   ibondi(ii,ij) =  2
+
+         ! 2.4 Subdomain neighbors
+
+         iproc = jarea - 1
+         ioso(ii,ij) = iproc - jpni
+         iowe(ii,ij) = iproc - 1
+         ioea(ii,ij) = iproc + 1
+         iono(ii,ij) = iproc + jpni
+         ildi(ii,ij) = 1 + jpreci
+         ilei(ii,ij) = ili -jpreci
+         ionw(ii,ij) = iono(ii,ij) - 1
+         ione(ii,ij) = iono(ii,ij) + 1
+         iosw(ii,ij) = ioso(ii,ij) - 1
+         iose(ii,ij) = ioso(ii,ij) + 1
+         ibsw(ii,ij) = 1
+         ibnw(ii,ij) = 1
+         IF( MOD(iproc,jpni) == 0 ) THEN
+            ibsw(ii,ij) = 0
+            ibnw(ii,ij) = 0
+         ENDIF
+         ibse(ii,ij) = 1
+         ibne(ii,ij) = 1
+         IF( MOD(iproc,jpni) == jpni-1 ) THEN
+            ibse(ii,ij) = 0
+            ibne(ii,ij) = 0
+         ENDIF
+         IF( iproc < jpni ) THEN
+            ibsw(ii,ij) = 0
+            ibse(ii,ij) = 0
+         ENDIF
+         IF( iproc >= (jpnj-1)*jpni ) THEN
+            ibnw(ii,ij) = 0
+            ibne(ii,ij) = 0
+         ENDIF
+         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
+         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
+         ildj(ii,ij) =  1  + jprecj
+         ilej(ii,ij) = ilj - jprecj
+         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
+         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
+
+         ! warning ii*ij (zone) /= nproc (processors)!
+
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+            IF( jpni == 1 )THEN
+               ibondi(ii,ij) = 2
+               nperio = 1
+            ELSE
+               ibondi(ii,ij) = 0
+            ENDIF
+            IF( MOD(jarea,jpni) == 0 ) THEN
+               ioea(ii,ij) = iproc - (jpni-1)
+               ione(ii,ij) = ione(ii,ij) - jpni
+               iose(ii,ij) = iose(ii,ij) - jpni
+            ENDIF
+            IF( MOD(jarea,jpni) == 1 ) THEN
+               iowe(ii,ij) = iproc + jpni - 1
+               ionw(ii,ij) = ionw(ii,ij) + jpni
+               iosw(ii,ij) = iosw(ii,ij) + jpni 
+            ENDIF
+            ibsw(ii,ij) = 1
+            ibnw(ii,ij) = 1
+            ibse(ii,ij) = 1
+            ibne(ii,ij) = 1
+            IF( iproc < jpni ) THEN
+               ibsw(ii,ij) = 0
+               ibse(ii,ij) = 0
+            ENDIF
+            IF( iproc >= (jpnj-1)*jpni ) THEN
+               ibnw(ii,ij) = 0
+               ibne(ii,ij) = 0
+            ENDIF
+         ENDIF
+         ipolj(ii,ij) = 0
+         IF( jperio == 3 .OR. jperio == 4 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
+            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1
+         ENDIF
+         IF( jperio == 5 .OR. jperio == 6 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1) ipolj(ii,ij) = 5
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
+            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1
+         ENDIF
+
+         isurf = 0
+         DO jj = 1+jprecj, ilj-jprecj
+            DO  ji = 1+jpreci, ili-jpreci
+               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
+            END DO
+         END DO
+         IF(isurf /= 0) THEN
+            icont = icont + 1
+            ipproc(ii,ij) = icont
+            iin(icont+1) = ii
+            ijn(icont+1) = ij
+         ENDIF
+      END DO
+
+      ! Control
+      IF(icont+1 /= jpnij) THEN
+         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
+         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 
+         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
+         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
+      ENDIF
+
+      ! 4. Subdomain print
+      ! ------------------
+
+      IF(lwp) THEN
+         ifreq = 4
+         il1 = 1
+         DO jn = 1,(jpni-1)/ifreq+1
+            il2 = MIN(jpni,il1+ifreq-1)
+            WRITE(numout,*)
+            WRITE(numout,9400) ('***',ji=il1,il2-1)
+            DO jj = jpnj, 1, -1
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
+               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9400) ('***',ji=il1,il2-1)
+            END DO
+            WRITE(numout,9401) (ji,ji=il1,il2)
+            il1 = il1+ifreq
+         END DO
+ 9400     FORMAT('     ***',20('*************',a3))
+ 9403     FORMAT('     *     ',20('         *   ',a3))
+ 9401     FORMAT('        ',20('   ',i3,'          '))
+ 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+ 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
+      ENDIF
+
+
+      ! 5. neighbour treatment
+      ! ----------------------
+
+      DO jarea = 1, jpni*jpnj
+         iproc = jarea-1
+         ii = 1 + MOD(jarea-1,jpni)
+         ij = 1 +    (jarea-1)/jpni
+         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
+            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
+            iino = 1 + MOD(iono(ii,ij),jpni)
+            ijno = 1 +    (iono(ii,ij))/jpni
+            IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2
+            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
+            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
+            iiso = 1 + MOD(ioso(ii,ij),jpni)
+            ijso = 1 +    (ioso(ii,ij))/jpni
+            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
+            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
+            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
+            iiea = 1 + MOD(ioea(ii,ij),jpni)
+            ijea = 1 +    (ioea(ii,ij))/jpni
+            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
+            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
+            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
+            iiwe = 1 + MOD(iowe(ii,ij),jpni)
+            ijwe = 1 +    (iowe(ii,ij))/jpni
+            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
+            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
+            iine = 1 + MOD(ione(ii,ij),jpni)
+            ijne = 1 +    (ione(ii,ij))/jpni
+            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
+            iisw = 1 + MOD(iosw(ii,ij),jpni)
+            ijsw = 1 +    (iosw(ii,ij))/jpni
+            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
+            iinw = 1 + MOD(ionw(ii,ij),jpni)
+            ijnw = 1 +    (ionw(ii,ij))/jpni
+            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
+            iise = 1 + MOD(iose(ii,ij),jpni)
+            ijse = 1 +    (iose(ii,ij))/jpni
+            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
+         ENDIF
+      END DO
+
+
+      ! 6. Change processor name
+      ! ------------------------
+
+      nproc = narea-1
+      ii = iin(narea)
+      ij = ijn(narea)
+      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiso = 1 + MOD(ioso(ii,ij),jpni)
+         ijso = 1 +    (ioso(ii,ij))/jpni
+         noso = ipproc(iiso,ijso)
+      ENDIF
+      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiwe = 1 + MOD(iowe(ii,ij),jpni)
+         ijwe = 1 +    (iowe(ii,ij))/jpni
+         nowe = ipproc(iiwe,ijwe)
+      ENDIF
+      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiea = 1 + MOD(ioea(ii,ij),jpni)
+         ijea = 1 +    (ioea(ii,ij))/jpni
+         noea = ipproc(iiea,ijea)
+      ENDIF
+      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iino = 1 + MOD(iono(ii,ij),jpni)
+         ijno = 1 +    (iono(ii,ij))/jpni
+         nono = ipproc(iino,ijno)
+      ENDIF
+      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iise = 1 + MOD(iose(ii,ij),jpni)
+         ijse = 1 +    (iose(ii,ij))/jpni
+         npse = ipproc(iise,ijse)
+      ENDIF
+      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iisw = 1 + MOD(iosw(ii,ij),jpni)
+         ijsw = 1 +    (iosw(ii,ij))/jpni
+         npsw = ipproc(iisw,ijsw)
+      ENDIF
+      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iine = 1 + MOD(ione(ii,ij),jpni)
+         ijne = 1 +    (ione(ii,ij))/jpni
+         npne = ipproc(iine,ijne)
+      ENDIF
+      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iinw = 1 + MOD(ionw(ii,ij),jpni)
+         ijnw = 1 +    (ionw(ii,ij))/jpni
+         npnw = ipproc(iinw,ijnw)
+      ENDIF
+      nbnw = ibnw(ii,ij)
+      nbne = ibne(ii,ij)
+      nbsw = ibsw(ii,ij)
+      nbse = ibse(ii,ij)
+      nlcj = ilcj(ii,ij)  
+      nlci = ilci(ii,ij)  
+      nldi = ildi(ii,ij)
+      nlei = ilei(ii,ij)
+      nldj = ildj(ii,ij)
+      nlej = ilej(ii,ij)
+      nbondi = ibondi(ii,ij)
+      nbondj = ibondj(ii,ij)
+      nimpp = iimppt(ii,ij)  
+      njmpp = ijmppt(ii,ij)  
+      DO jproc = 1, jpnij
+         ii = iin(jproc)
+         ij = ijn(jproc)
+         nimppt(jproc) = iimppt(ii,ij)  
+         njmppt(jproc) = ijmppt(ii,ij)  
+         nlcjt(jproc) = ilcj(ii,ij)
+         nlcit(jproc) = ilci(ii,ij)
+         nldit(jproc) = ildi(ii,ij)
+         nleit(jproc) = ilei(ii,ij)
+         nldjt(jproc) = ildj(ii,ij)
+         nlejt(jproc) = ilej(ii,ij)
+      END DO
+
+      ! Save processor layout in ascii file
+      IF (lwp) THEN
+         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
+         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
+
+        DO  jproc = 1, jpnij
+         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
+                                      nldit(jproc), nldjt(jproc), &
+                                      nleit(jproc), nlejt(jproc), &
+                                      nimppt(jproc), njmppt(jproc)
+        END DO
+        CLOSE(inum)   
+      END IF
+
+      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' )
+
+      ! Prepare mpp north fold
+
+      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
+      ENDIF
+
+      ! Defined npolj, either 0, 3 , 4 , 5 , 6
+      ! In this case the important thing is that npolj /= 0
+      ! Because if we go through these line it is because jpni >1 and thus
+      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
+
+      npolj = 0
+      ij = ijn(narea)
+
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         IF( ij == jpnj ) npolj = 3
+      ENDIF
+
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+         IF( ij == jpnj ) npolj = 5
+      ENDIF
+
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc=  ',nproc
+         WRITE(numout,*) ' nowe=   ',nowe
+         WRITE(numout,*) ' noea=   ',noea
+         WRITE(numout,*) ' nono=   ',nono
+         WRITE(numout,*) ' noso=   ',noso
+         WRITE(numout,*) ' nbondi= ',nbondi
+         WRITE(numout,*) ' nbondj= ',nbondj
+         WRITE(numout,*) ' npolj=  ',npolj
+         WRITE(numout,*) ' nperio= ',nperio
+         WRITE(numout,*) ' nlci=   ',nlci
+         WRITE(numout,*) ' nlcj=   ',nlcj
+         WRITE(numout,*) ' nimpp=  ',nimpp
+         WRITE(numout,*) ' njmpp=  ',njmpp
+         WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse
+         WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw
+         WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne
+         WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw
+      ENDIF
+
+   END SUBROUTINE mpp_init2
Index: anches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/cla.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/cla.F90	(revision 2441)
+++ 	(revision )
@@ -1,742 +1,0 @@
-MODULE cla
-   !!======================================================================
-   !!                    ***  MODULE  cla  ***
-   !! Cross Land Advection : specific update of the horizontal divergence,
-   !!                        tracer trends and after velocity
-   !!
-   !!                 ---   Specific to ORCA_R2   ---
-   !!
-   !!======================================================================
-   !! History :  1.0  ! 2002-11 (A. Bozec)  Original code
-   !!            3.2  ! 2009-07 (G. Madec)  merge cla, cla_div, tra_cla, cla_dynspg
-   !!                 !                     and correct a mpp bug reported by A.R. Porter
-   !!----------------------------------------------------------------------
-#if defined key_orca_r2
-   !!----------------------------------------------------------------------
-   !!   'key_orca_r2'                                 global ocean model R2
-   !!----------------------------------------------------------------------
-   !!   cla_div           : update of horizontal divergence at cla straits
-   !!   tra_cla           : update of tracers at cla straits
-   !!   cla_dynspg        : update of after horizontal velocities at cla straits
-   !!   cla_init          : initialisation - control check
-   !!   cla_bab_el_mandeb : cross land advection for Bab-el-mandeb strait
-   !!   cla_gibraltar     : cross land advection for Gibraltar strait
-   !!   cla_hormuz        : cross land advection for Hormuz strait
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers
-   USE dom_oce        ! ocean space and time domain
-   USE sbc_oce        ! surface boundary condition: ocean
-   USE dynspg_oce     ! ocean dynamics: surface pressure gradient variables
-   USE in_out_manager ! I/O manager
-   USE lib_mpp        ! distributed memory computing library
-   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   cla_init     ! routine called by opa.F90
-   PUBLIC   cla_div      ! routine called by divcur.F90
-   PUBLIC   cla_traadv   ! routine called by traadv.F90
-   PUBLIC   cla_dynspg   ! routine called by dynspg_flt.F90
-
-   INTEGER  ::   nbab, ngib, nhor   ! presence or not of required grid-point on local domain
-   !                                ! for Bab-el-Mandeb, Gibraltar, and Hormuz straits
-   
-   !                                                              !!! profile of hdiv for some straits
-   REAL(wp), DIMENSION (jpk) ::   hdiv_139_101, hdiv_139_101_kt    ! Gibraltar     strait, fixed & time evolving part (i,j)=(172,101)
-   REAL(wp), DIMENSION (jpk) ::   hdiv_139_102                     ! Gibraltar     strait, fixed part only            (i,j)=(139,102)
-   REAL(wp), DIMENSION (jpk) ::   hdiv_141_102, hdiv_141_102_kt    ! Gibraltar     strait, fixed & time evolving part (i,j)=(141,102)
-   REAL(wp), DIMENSION (jpk) ::   hdiv_161_88 , hdiv_161_88_kt     ! Bab-el-Mandeb strait, fixed & time evolving part (i,j)=(161,88)
-   REAL(wp), DIMENSION (jpk) ::   hdiv_161_87                      ! Bab-el-Mandeb strait, fixed part only            (i,j)=(161,87)
-   REAL(wp), DIMENSION (jpk) ::   hdiv_160_89 , hdiv_160_89_kt     ! Bab-el-Mandeb strait, fixed & time evolving part (i,j)=(160,89)
-   REAL(wp), DIMENSION (jpk) ::   hdiv_172_94                      ! Hormuz        strait, fixed part only            (i,j)=(172, 94)
-
-   REAL(wp), DIMENSION (jpk) ::   t_171_94_hor, s_171_94_hor       ! Temperature, salinity in the Hormuz strait
-   
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE cla_div( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE div_cla  ***
-      !!
-      !! ** Purpose :   update the horizontal divergence of the velocity field
-      !!              at some straits ( Gibraltar, Bab el Mandeb and Hormuz ).
-      !!
-      !! ** Method  : - first time-step: initialisation of cla
-      !!              - all   time-step: using imposed transport at each strait, 
-      !!              the now horizontal divergence is updated
-      !!
-      !! ** Action  :   phdivn   updted now horizontal divergence at cla straits
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
-      !!----------------------------------------------------------------------
-      !     
-      IF( kt == nit000 ) THEN
-         !
-         CALL cla_init                                        ! control check 
-         !
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'div_cla : cross land advection on hdiv '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~'
-         !
-         IF( nbab == 1 )   CALL cla_bab_el_mandeb('ini')    ! Bab el Mandeb ( Red Sea - Indian ocean )
-         IF( ngib == 1 )   CALL cla_gibraltar    ('ini')    ! Gibraltar strait (Med Sea - Atlantic ocean)
-         IF( nhor == 1 )   CALL cla_hormuz       ('ini')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
-         !
-      ENDIF                           
-      !
-      IF( nbab == 1    )   CALL cla_bab_el_mandeb('div')    ! Bab el Mandeb ( Red Sea - Indian ocean )
-      IF( ngib == 1    )   CALL cla_gibraltar    ('div')    ! Gibraltar strait (Med Sea - Atlantic ocean)
-      IF( nhor == 1    )   CALL cla_hormuz       ('div')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
-      !
-!!gm  lbc useless here, no?
-!!gm      CALL lbc_lnk( hdivn, 'T', 1. )                    ! Lateral boundary conditions on hdivn
-      !
-   END SUBROUTINE cla_div
-   
-   
-   SUBROUTINE cla_traadv( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE tra_cla  ***
-      !!                   
-      !! ** Purpose :   Update the now trend due to the advection of tracers
-      !!      and add it to the general trend of passive tracer equations
-      !!      at some straits ( Bab el Mandeb, Gibraltar, Hormuz ).
-      !!
-      !! ** Method  :   using both imposed transport at each strait and T & S
-      !!              budget, the now tracer trends is updated
-      !!
-      !! ** Action  :   (ta,sa)   updated now tracer trends at cla straits
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == nit000 ) THEN 
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'tra_cla : cross land advection on tracers '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~'
-      ENDIF
-      !
-      IF( nbab == 1    )   CALL cla_bab_el_mandeb('tra')      ! Bab el Mandeb strait
-      IF( ngib == 1    )   CALL cla_gibraltar    ('tra')      ! Gibraltar strait
-      IF( nhor == 1    )   CALL cla_hormuz       ('tra')      ! Hormuz Strait ( Persian Gulf)
-      !
-   END SUBROUTINE cla_traadv
-
-   
-   SUBROUTINE cla_dynspg( kt )
-      !!----------------------------------------------------------------------
-      !!                 ***  ROUTINE cla_dynspg  ***
-      !!                   
-      !! ** Purpose :   Update the after velocity at some straits 
-      !!              (Bab el Mandeb, Gibraltar, Hormuz).
-      !!
-      !! ** Method  :   required to compute the filtered surface pressure gradient 
-      !!
-      !! ** Action  :   (ua,va)   after velocity at the cla straits
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
-      !!----------------------------------------------------------------------
-      !
-      IF( kt == nit000 ) THEN 
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'cla_dynspg : cross land advection on (ua,va) '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-      ENDIF
-      !
-      IF( nbab == 1    )   CALL cla_bab_el_mandeb('spg')      ! Bab el Mandeb strait
-      IF( ngib == 1    )   CALL cla_gibraltar    ('spg')      ! Gibraltar strait
-      IF( nhor == 1    )   CALL cla_hormuz       ('spg')      ! Hormuz Strait ( Persian Gulf)
-      !
-!!gm lbc is needed here, not?
-!!gm      CALL lbc_lnk( hdivn, 'U', -1. )   ;   CALL lbc_lnk( hdivn, 'V', -1. )      ! Lateral boundary conditions 
-      !
-   END SUBROUTINE cla_dynspg
-
-
-   SUBROUTINE cla_init
-      !! -------------------------------------------------------------------
-      !!                   ***  ROUTINE cla_init  ***
-      !!           
-      !! ** Purpose :   control check for mpp computation  
-      !!
-      !! ** Method  : - All the strait grid-points must be inside one of the 
-      !!              local domain interior for the cla advection to work
-      !!              properly in mpp (i.e. inside (2:jpim1,2:jpjm1) ).
-      !!              Define the corresponding indicators (nbab, ngib, nhor)
-      !!              - The profiles of cross-land fluxes are currently hard
-      !!              coded for L31 levels. Stop if jpk/=31
-      !!
-      !! ** Action  :   nbab, ngib, nhor   strait inside the local domain or not
-      !!---------------------------------------------------------------------
-      REAL(wp) ::   ztemp
-      !!---------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'cla_init : cross land advection initialisation '
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
-      !
-      IF( .NOT.lk_dynspg_flt )   CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' )
-      !
-      IF( lk_vvl    )   CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' )
-      !
-      IF( jpk /= 31 )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' )
-      !
-      !                                        _|_______|_______|_
-      !                                     89  |       |///////|  
-      !                                        _|_______|_______|_
-      ! ------------------------ !          88  |///////|       | 
-      !   Bab el Mandeb strait   !             _|_______|_______|_
-      ! ------------------------ !          87  |///////|       | 
-      !                                        _|_______|_______|_
-      !                                         |  160  |  161  |  
-      !
-      ! The 6 Bab el Mandeb grid-points must be inside one of the interior of the
-      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
-      nbab = 0
-      IF(  ( 1 <= mj0( 88) .AND. mj1( 89) <= jpj ) .AND.    &  !* (161,89), (161,88) and (161,88) on the local pocessor
-         & ( 1 <= mi0(160) .AND. mi1(161) <= jpi )       )    nbab = 1 
-      !
-      ! test if there is no local domain that includes all required grid-points
-      ztemp = REAL( nbab )
-      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
-      IF( ztemp == 0 ) THEN                     ! Only 2 points in each direction, this should never be a problem
-         CALL ctl_stop( ' cross land advection at Bab-el_Mandeb does not work with your processor cutting: change it' )
-      ENDIF
-      !                                        ___________________________
-      ! ------------------------ !         102  |       |///////|       |
-      !     Gibraltar strait     !             _|_______|_______|_______|_
-      ! ------------------------ !         101  |       |///////|       |
-      !                                        _|_______|_______|_______|_ 
-      !                                         |  139  |  140  |  141  |
-      !
-      ! The 6 Gibraltar grid-points must be inside one of the interior of the
-      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
-      ngib = 0
-      IF(  ( 2 <= mj0(101) .AND. mj1(102) <= jpjm1 ) .AND.    &  !* (139:141,101:102) on the local pocessor
-         & ( 2 <= mi0(139) .AND. mi1(141) <= jpim1 )       )    ngib = 1 
-      !
-      ! test if there is no local domain that includes all required grid-points
-      ztemp = REAL( ngib )
-      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
-      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
-           CALL ctl_stop( ' cross land advection at Gibraltar does not work with your processor cutting: change it' )
-      ENDIF
-      !                                        _______________
-      ! ------------------------ !          94  |/////|     | 
-      !       Hormuz strait      !             _|_____|_____|_
-      ! ------------------------ !                171   172     
-      !           
-      ! The 2 Hormuz grid-points must be inside one of the interior of the
-      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
-      nhor = 0
-      IF(    2 <= mj0( 94) .AND. mj1( 94) <= jpjm1  .AND.  & 
-         &   2 <= mi0(171) .AND. mi1(172) <= jpim1         )   nhor = 1 
-      !
-      ! test if there is no local domain that includes all required grid-points
-      ztemp = REAL( nhor )
-      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
-      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
-           CALL ctl_stop( ' cross land advection at Hormuz does not work with your processor cutting: change it' )
-      ENDIF
-      !
-   END SUBROUTINE cla_init
-
-
-   SUBROUTINE cla_bab_el_mandeb( cd_td )
-      !!----------------------------------------------------------------------
-      !!                ***  ROUTINE cla_bab_el_mandeb  ***
-      !!       
-      !! ** Purpose :   update the now horizontal divergence, the tracer tendancy
-      !!              and the after velocity in vicinity of Bab el Mandeb ( Red Sea - Indian ocean).
-      !!
-      !! ** Method  :   compute the exchanges at each side of the strait :
-      !!
-      !!       surf. zio_flow
-      !! (+ balance of emp) /\  |\\\\\\\\\\\|
-      !!                    ||  |\\\\\\\\\\\|  
-      !!    deep zio_flow   ||  |\\\\\\\\\\\|  
-      !!            |  ||   ||  |\\\\\\\\\\\|  
-      !!        89  |  ||   ||  |\\\\\\\\\\\|  
-      !!            |__\/_v_||__|____________ 
-      !!            !\\\\\\\\\\\|          surf. zio_flow
-      !!            |\\\\\\\\\\\|<===    (+ balance of emp)
-      !!            |\\\\\\\\\\\u
-      !!        88  |\\\\\\\\\\\|<---      deep  zrecirc (upper+deep at 2 different levels)
-      !!            |___________|__________   
-      !!            !\\\\\\\\\\\|         
-      !!            |\\\\\\\\\\\| ---\     deep  zrecirc (upper+deep) 
-      !!        87  !\\\\\\\\\\\u ===/   + deep  zio_flow   (all at the same level)
-      !!            !\\\\\\\\\\\|  
-      !!            !___________|__________ 
-      !!                160         161
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
-      !                                         ! ='tra' update the tracers
-      !                                         ! ='spg' update after velocity
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zemp_red     ! temporary scalar
-      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
-      !!---------------------------------------------------------------------
-      !
-      SELECT CASE( cd_td ) 
-      !                     ! ---------------- !
-      CASE( 'ini' )         !  initialisation  ! 
-         !                  ! ---------------- ! 
-         !                                   
-         zio_flow    = 0.4e6                       ! imposed in/out flow
-         zrecirc_upp = 0.2e6                       ! imposed upper recirculation water
-         zrecirc_bot = 0.5e6                       ! imposed bottom  recirculation water
-
-         hdiv_161_88(:) = 0.e0                     ! (161,88) Gulf of Aden side, north point
-         hdiv_161_87(:) = 0.e0                     ! (161,87) Gulf of Aden side, south point
-         hdiv_160_89(:) = 0.e0                     ! (160,89) Red sea side
-
-         DO jj = mj0(88), mj1(88)              !** profile of hdiv at (161,88)   (Gulf of Aden side, north point)
-            DO ji = mi0(161), mi1(161)         !------------------------------
-               DO jk = 1, 8                        ! surface in/out flow   (Ind -> Red)   (div >0)
-                  hdiv_161_88(jk) = + zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                   ! recirculation water   (Ind -> Red)   (div >0)
-               hdiv_161_88(20) =                 + zrecirc_upp   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,20) )
-               hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
-            END DO
-         END DO
-         !
-         DO jj = mj0(87), mj1(87)              !** profile of hdiv at (161,88)   (Gulf of Aden side, south point)
-            DO ji = mi0(161), mi1(161)         !------------------------------
-               !                                   ! deep out flow + recirculation   (Red -> Ind)   (div <0)
-               hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
-            END DO
-         END DO
-         !
-         DO jj = mj0(89), mj1(89)              !** profile of hdiv at (161,88)   (Red sea side)
-            DO ji = mi0(160), mi1(160)         !------------------------------
-               DO jk = 1, 8                        ! surface inflow    (Ind -> Red)   (div <0)
-                  hdiv_160_89(jk) = - zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                   ! deep    outflow   (Red -> Ind)   (div >0)
-               hdiv_160_89(16)    = + zio_flow / (      e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,16) )
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
-         !                  ! ---------=====-- ! 
-         !                                     !** emp on the Red Sea   (div >0) 
-         zemp_red = 0.e0                       !---------------------
-         DO jj = mj0(87), mj1(96)                  ! sum over the Red sea
-            DO ji = mi0(148), mi1(160) 
-               zemp_red = zemp_red + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_sum( zemp_red )   ! sum with other processors value
-         zemp_red = zemp_red * 1.e-3               ! convert in m3
-         !
-         !                                     !** Correct hdivn (including emp adjustment)
-         !                                     !-------------------------------------------
-         DO jj = mj0(88), mj1(88)                  !* profile of hdiv at (161,88)   (Gulf of Aden side, north point)
-            DO ji = mi0(161), mi1(161) 
-               hdiv_161_88_kt(:) = hdiv_161_88(:)
-               DO jk = 1, 8                              ! increase the inflow from the Indian   (div >0) 
-                  hdiv_161_88_kt(jk) = hdiv_161_88(jk) + zemp_red / (8. * e2u(ji,jj) * fse3u(ji,jj,jk) )
-               END DO
-               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_88_kt(:)
-            END DO
-         END DO
-         DO jj = mj0(87), mj1(87)                  !* profile of divergence at (161,87)   (Gulf of Aden side, south point)
-            DO ji = mi0(161), mi1(161) 
-               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_87(:)
-            END DO
-         END DO
-         DO jj = mj0(89), mj1(89)                  !* profile of divergence at (160,89)   (Red sea side)
-            DO ji = mi0(160), mi1(160) 
-               hdiv_160_89_kt(:) = hdiv_160_89(:)
-               DO jk = 1, 18                              ! increase the inflow from the Indian   (div <0) 
-                  hdiv_160_89_kt(jk) = hdiv_160_89(jk) - zemp_red / (10. * e1v(ji,jj) * fse3v(ji,jj,jk) )
-               END DO
-               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_160_89_kt(:)
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
-         !                  ! --------=======- !
-         !
-         DO jj = mj0(88), mj1(88)              !** (161,88)   (Gulf of Aden side, north point)
-            DO ji = mi0(161), mi1(161) 
-               DO jk = 1, jpkm1                         ! surf inflow + reciculation (from Gulf of Aden)
-                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_161_88_kt(jk) * tn(ji,jj,jk)
-                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_161_88_kt(jk) * sn(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         DO jj = mj0(87), mj1(87)              !** (161,87)   (Gulf of Aden side, south point)
-            DO ji = mi0(161), mi1(161) 
-               jk =  21                                 ! deep outflow + recirulation (combined flux)
-               ta(ji,jj,jk) = ta(ji,jj,jk) + hdiv_161_88(20) * tn(ji  ,jj+1,20)   &  ! upper recirculation from Gulf of Aden
-                  &                        + hdiv_161_88(21) * tn(ji  ,jj+1,21)   &  ! deep  recirculation from Gulf of Aden
-                  &                        + hdiv_160_89(16) * tn(ji-1,jj+2,16)      ! deep inflow from Red sea
-               sa(ji,jj,jk) = sa(ji,jj,jk) + hdiv_161_88(20) * sn(ji  ,jj+1,20)   &
-                  &                        + hdiv_161_88(21) * sn(ji  ,jj+1,21)   &
-                  &                        + hdiv_160_89(16) * sn(ji-1,jj+2,16)   
-            END DO
-         END DO
-         DO jj = mj0(89), mj1(89)              !** (161,88)   (Red sea side)
-            DO ji = mi0(160), mi1(160)
-               DO jk = 1, 14                            ! surface inflow (from Gulf of Aden)
-                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_160_89_kt(jk) * tn(ji+1,jj-1,jk)
-                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_160_89_kt(jk) * sn(ji+1,jj-1,jk)
-               END DO
-               !                                        ! deep    outflow (from Red sea)
-               ta(ji,jj,16) = ta(ji,jj,16) - hdiv_160_89(jk) * tn(ji,jj,jk)
-               sa(ji,jj,16) = sa(ji,jj,16) - hdiv_160_89(jk) * sn(ji,jj,jk)
-            END DO
-         END DO
-         !
-         !                  ! ---------------- !
-      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
-         !                  ! --------=======- !
-         ! at this stage, (ua,va) are the after velocity, not the tendancy
-         ! compute the velocity from the divergence at T-point
-         !
-         DO jj = mj0(88), mj1(88)              !** (160,88)   (Gulf of Aden side, north point)
-            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point) 
-               ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
-                  &                              * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         DO jj = mj0(87), mj1(87)              !** (160,87)   (Gulf of Aden side, south point)
-            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point) 
-               ua(ji,jj,:) = - hdiv_161_87(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
-                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         DO jj = mj0(88), mj1(88)              !** profile of divergence at (160,89)   (Red sea side)
-            DO ji = mi0(160), mi1(160)                   ! 88, not 89 as it is a V-point)
-               va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1t(ji,jj+1) * e2t(ji,jj+1) * fse3t(ji,jj+1,:) )   &
-                  &                              * e1v(ji,jj) * fse3v(ji,jj,:)
-            END DO
-         END DO
-      END SELECT
-      !
-   END SUBROUTINE cla_bab_el_mandeb
-   
-
-   SUBROUTINE cla_gibraltar( cd_td )
-      !! -------------------------------------------------------------------
-      !!                 ***  ROUTINE cla_gibraltar  ***
-      !!        
-      !! ** Purpose :   update the now horizontal divergence, the tracer 
-      !!              tendancyand the after velocity in vicinity of Gibraltar 
-      !!              strait ( Persian Gulf - Indian ocean ).
-      !!
-      !! ** Method :
-      !!                     _______________________            
-      !!      deep  zio_flow /====|///////|====> surf. zio_flow
-      !!    + deep  zrecirc  \----|///////|     (+balance of emp)
-      !! 102                      u///////u
-      !!      mid.  recicul    <--|///////|<==== deep  zio_flow
-      !!                     _____|_______|_____  
-      !!      surf. zio_flow ====>|///////|       
-      !!    (+balance of emp)     |///////|
-      !! 101                      u///////|             
-      !!      mid.  recicul    -->|///////|               Caution: zrecirc split into 
-      !!      deep  zrecirc  ---->|///////|                  upper & bottom recirculation
-      !!                   _______|_______|_______ 
-      !!                     139     140     141  
-      !!
-      !!---------------------------------------------------------------------
-      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
-      !                                         ! ='tra' update the tracers
-      !                                         ! ='spg' update after velocity
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zemp_med     ! temporary scalar
-      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
-      !!---------------------------------------------------------------------
-      !
-      SELECT CASE( cd_td ) 
-      !                     ! ---------------- !
-      CASE( 'ini' )         !  initialisation  ! 
-         !                  ! ---------------- ! 
-         !                                     !** initialization of the velocity
-         hdiv_139_101(:) = 0.e0                     !  139,101 (Atlantic side, south point)
-         hdiv_139_102(:) = 0.e0                     !  139,102 (Atlantic side, north point)
-         hdiv_141_102(:) = 0.e0                     !  141,102 (Med sea  side)
-            
-         !                                     !** imposed transport
-         zio_flow    = 0.8e6                        ! inflow surface  water
-         zrecirc_mid = 0.7e6                        ! middle recirculation water
-         zrecirc_upp = 2.5e6                        ! upper  recirculation water
-         zrecirc_bot = 3.5e6                        ! bottom recirculation water
-         !
-         DO jj = mj0(101), mj1(101)            !** profile of hdiv at 139,101 (Atlantic side, south point)
-            DO ji = mi0(139), mi1(139)         !-----------------------------
-               DO jk = 1, 14                        ! surface in/out flow (Atl -> Med)   (div >0)
-                  hdiv_139_101(jk) = + zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               DO jk = 15, 20                       ! middle  reciculation (Atl 101 -> Atl 102)   (div >0)   
-                  hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                    ! upper reciculation (Atl 101 -> Atl 101)   (div >0)
-               hdiv_139_101(21) =               + zrecirc_upp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               !
-               !                                    ! upper & bottom reciculation (Atl 101 -> Atl 101 & 102)   (div >0)
-               hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)            !** profile of hdiv at 139,102 (Atlantic side, north point)
-            DO ji = mi0(139), mi1(139)         !-----------------------------
-               DO jk = 15, 20                       ! middle reciculation (Atl 101 -> Atl 102)   (div <0)                
-                  hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                    ! outflow of Mediterranean sea + deep recirculation   (div <0) 
-               hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)            !** velocity profile at 141,102  (Med sea side)
-            DO ji = mi0(141), mi1(141)         !------------------------------
-               DO  jk = 1, 14                       ! surface inflow in the Med     (div <0)
-                  hdiv_141_102(jk) = - zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               !                                    ! deep    outflow toward the Atlantic    (div >0) 
-               hdiv_141_102(21)    = + zio_flow / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
-         !                  ! ---------=====-- ! 
-         !                                     !** emp on the Mediterranean Sea  (div >0) 
-         zemp_med = 0.e0                       !-------------------------------
-         DO jj = mj0(96), mj1(110)                  ! sum over the Med sea
-            DO ji = mi0(141),mi1(181)
-               zemp_med = zemp_med + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 
-            END DO
-         END DO
-         DO jj = mj0(96), mj1(96)                   ! minus 2 points in Red Sea 
-            DO ji = mi0(148),mi1(148)
-               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
-            END DO
-            DO ji = mi0(149),mi1(149)
-               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
-            END DO
-         END DO
-         IF( lk_mpp )   CALL mpp_sum( zemp_med )    ! sum with other processors value
-         zemp_med = zemp_med * 1.e-3                ! convert in m3
-         !
-         !                                     !** Correct hdivn (including emp adjustment)
-         !                                     !-------------------------------------------
-         DO jj = mj0(101), mj1(101)                 !* 139,101 (Atlantic side, south point)
-            DO ji = mi0(139), mi1(139) 
-               hdiv_139_101_kt(:) = hdiv_139_101(:)      
-               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div >0) 
-                  hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_139_101_kt(:)
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)                 !* 139,102 (Atlantic side, north point)
-            DO ji = mi0(139), mi1(139) 
-               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_139_102(:)
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)
-            DO ji = mi0(141), mi1(141) 
-               hdiv_141_102(:) = hdiv_141_102(:)
-               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div <0)
-                  hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_141_102_kt(:)
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
-         !                  ! --------=======- !
-         !
-         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)   (div >0)
-            DO ji = mi0(139), mi1(139) 
-               DO jk = 1, jpkm1                         ! surf inflow + mid. & bottom reciculation (from Atlantic)	
-                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_101_kt(jk) * tn(ji,jj,jk)
-                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_101_kt(jk) * sn(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-         !
-         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)   (div <0)
-            DO ji = mi0(139), mi1(139) 
-               DO jk = 15, 20                            ! middle  reciculation (Atl 101 -> Atl 102)   (div <0)
-                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_102(jk) * tn(ji,jj-1,jk)  ! middle Atlantic recirculation
-                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_102(jk) * sn(ji,jj-1,jk)
-               END DO
-               !                                         ! upper & bottom Atl. reciculation (Atl 101 -> Atl 102) - (div <0)
-               !                                         ! deep Med flow                    (Med 102 -> Atl 102) - (div <0)
-               ta(ji,jj,22) = ta(ji,jj,22) + hdiv_141_102(21) * tn(ji+2,jj  ,21)   &  ! deep Med flow  
-                  &                        + hdiv_139_101(21) * tn(ji  ,jj-1,21)   &  ! upper  Atlantic recirculation  
-                  &                        + hdiv_139_101(22) * tn(ji  ,jj-1,22)      ! bottom Atlantic recirculation  
-               sa(ji,jj,22) = sa(ji,jj,22) + hdiv_141_102(21) * sn(ji+2,jj  ,21)   &
-                  &                        + hdiv_139_101(21) * sn(ji  ,jj-1,21)   &
-                  &                        + hdiv_139_101(22) * sn(ji  ,jj-1,22) 
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)   (div <0)
-            DO ji = mi0(141), mi1(141) 
-               DO jk = 1, 14                             ! surface flow from Atlantic to Med sea
-                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_141_102_kt(jk) * tn(ji-2,jj-1,jk)
-                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_141_102_kt(jk) * sn(ji-2,jj-1,jk)
-               END DO
-               !                                         ! deeper flow from Med sea to Atlantic
-               ta(ji,jj,21) = ta(ji,jj,21) - hdiv_141_102(21) * tn(ji,jj,21)
-               sa(ji,jj,21) = sa(ji,jj,21) - hdiv_141_102(21) * sn(ji,jj,21)
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
-         !                  ! --------=======- !
-         ! at this stage, (ua,va) are the after velocity, not the tendancy
-         ! compute the velocity from the divergence at T-point
-         !
-         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)
-            DO ji = mi0(139), mi1(139)                    ! div >0 => ua >0, same sign
-               ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
-                  &                             * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)
-            DO ji = mi0(139), mi1(139)                    ! div <0 => ua <0, same sign
-               ua(ji,jj,:) = hdiv_139_102(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
-                  &                          * e2u(ji,jj) * fse3u(ji,jj,:)   
-            END DO
-         END DO
-         DO jj = mj0(102), mj1(102)            !** 140,102 (Med side) (140 not 141 as it is a U-point)
-            DO ji = mi0(140), mi1(140)                    ! div >0 => ua <0, opposite sign
-               ua(ji,jj,:) = - hdiv_141_102(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
-                  &                            * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-   END SUBROUTINE cla_gibraltar
-
-
-   SUBROUTINE cla_hormuz( cd_td )
-      !! -------------------------------------------------------------------
-      !!                   ***  ROUTINE div_hormuz  ***
-      !!              
-      !! ** Purpose :   update the now horizontal divergence, the tracer 
-      !!              tendancyand the after velocity in vicinity of Hormuz 
-      !!              strait ( Persian Gulf - Indian ocean ).
-      !!
-      !! ** Method  :   Hormuz strait
-      !!            ______________   
-      !!            |/////|<==      surface inflow
-      !!        94  |/////|     
-      !!            |/////|==>      deep    outflow
-      !!            |_____|_______
-      !!              171    172     
-      !!---------------------------------------------------------------------
-      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='ini' initialisation
-      !!                                        ! ='div' update the divergence
-      !!                                        ! ='tra' update the tracers
-      !!                                        ! ='spg' update after velocity
-      !!
-      INTEGER  ::   ji, jj, jk   ! dummy loop indices
-      REAL(wp) ::   zio_flow     ! temporary scalar
-      !!---------------------------------------------------------------------
-      !
-      SELECT CASE( cd_td ) 
-      !                     ! ---------------- !
-      CASE( 'ini' )         !  initialisation  ! 
-         !                  ! ---------------- ! 
-         !                                     !** profile of horizontal divergence due to cross-land advection
-         zio_flow  = 1.e6                          ! imposed in/out flow
-         !
-         hdiv_172_94(:) = 0.e0         
-         !
-         DO jj = mj0(94), mj1(94)                  ! in/out flow at (i,j) = (172,94)
-            DO ji = mi0(172), mi1(172) 
-               DO jk = 1, 8                            ! surface inflow  (Indian ocean to Persian Gulf) (div<0)
-                  hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-               DO jk = 16, 18                          ! deep    outflow (Persian Gulf to Indian ocean) (div>0)
-                  hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
-               END DO
-            END DO
-         END DO
-         !                                     !** T & S profile in the Hormuz strait (use in deep outflow)
-         !      Temperature       and         Salinity
-         t_171_94_hor(:)  = 0.e0   ;   s_171_94_hor(:)  = 0.e0
-         t_171_94_hor(16) = 18.4   ;   s_171_94_hor(16) = 36.27
-         t_171_94_hor(17) = 17.8   ;   s_171_94_hor(17) = 36.4
-         t_171_94_hor(18) = 16.    ;   s_171_94_hor(18) = 36.27
-         !
-         !                  ! ---------------- !
-      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
-         !                  ! ---------=====-- ! 
-         !                                   
-         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
-            DO ji = mi0(172), mi1(172) 
-               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_172_94(:)
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
-         !                  ! --------=======- !
-         !                          
-         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
-            DO ji = mi0(172), mi1(172) 
-               DO jk = 1, 8                          ! surface inflow   (Indian ocean to Persian Gulf) (div<0)
-                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * tn(ji,jj,jk) 
-                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * sn(ji,jj,jk) 
-               END DO
-               DO jk = 16, 18                        ! deep outflow     (Persian Gulf to Indian ocean) (div>0)
-                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * t_171_94_hor(jk)
-                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * s_171_94_hor(jk)
-               END DO
-            END DO
-         END DO
-         !                  ! ---------------- !
-      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
-         !                  ! --------=======- !
-         ! No barotropic flow through Hormuz strait
-         ! at this stage, (ua,va) are the after velocity, not the tendancy
-         ! compute the velocity from the divergence at T-point
-         DO jj = mj0(94), mj1(94)              !** 171,94 (Indian ocean side) (171 not 172 as it is the western U-point)
-            DO ji = mi0(171), mi1(171)                ! div >0 => ua >0, opposite sign
-               ua(ji,jj,:) = - hdiv_172_94(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
-                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
-            END DO
-         END DO
-         !
-      END SELECT
-      !
-   END SUBROUTINE cla_hormuz
-   
-#else
-   !!----------------------------------------------------------------------
-   !!   Default key                                            Dummy module
-   !!----------------------------------------------------------------------
-   USE in_out_manager ! I/O manager
-CONTAINS
-   SUBROUTINE cla_init
-      CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2 with 31 levels' )
-   END SUBROUTINE cla_init
-   SUBROUTINE cla_div( kt )
-      WRITE(*,*) 'cla_div: You should have not see this print! error?', kt
-   END SUBROUTINE cla_div
-   SUBROUTINE cla_traadv( kt ) 
-      WRITE(*,*) 'cla_traadv: You should have not see this print! error?', kt
-   END SUBROUTINE cla_traadv
-   SUBROUTINE cla_dynspg( kt ) 
-      WRITE(*,*) 'dyn_spg_cla: You should have not see this print! error?', kt
-   END SUBROUTINE cla_dynspg
-#endif
-   
-   !!======================================================================
-END MODULE cla
Index: anches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/istate.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/istate.F90	(revision 2441)
+++ 	(revision )
@@ -1,556 +1,0 @@
-MODULE istate
-   !!======================================================================
-   !!                     ***  MODULE  istate  ***
-   !! Ocean state   :  initial state setting
-   !!=====================================================================
-   !! History :  OPA  !  1989-12  (P. Andrich)  Original code
-   !!            5.0  !  1991-11  (G. Madec)  rewritting
-   !!            6.0  !  1996-01  (G. Madec)  terrain following coordinates
-   !!            8.0  !  2001-09  (M. Levy, M. Ben Jelloul)  istate_eel
-   !!            8.0  !  2001-09  (M. Levy, M. Ben Jelloul)  istate_uvg
-   !!   NEMO     1.0  !  2003-08  (G. Madec, C. Talandier)  F90: Free form, modules + EEL R5
-   !!             -   !  2004-05  (A. Koch-Larrouy)  istate_gyre 
-   !!            2.0  !  2006-07  (S. Masson)  distributed restart using iom
-   !!            3.3  !  2010-10  (C. Ethe) merge TRC-TRA
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   istate_init   : initial state setting
-   !!   istate_tem    : analytical profile for initial Temperature
-   !!   istate_sal    : analytical profile for initial Salinity
-   !!   istate_eel    : initial state setting of EEL R5 configuration
-   !!   istate_gyre   : initial state setting of GYRE configuration
-   !!   istate_uvg    : initial velocity in geostropic balance
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and active tracers 
-   USE dom_oce         ! ocean space and time domain 
-   USE daymod          ! calendar
-   USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine)
-   USE ldftra_oce      ! ocean active tracers: lateral physics
-   USE zdf_oce         ! ocean vertical physics
-   USE phycst          ! physical constants
-   USE dtatem          ! temperature data                 (dta_tem routine)
-   USE dtasal          ! salinity data                    (dta_sal routine)
-   USE restart         ! ocean restart                   (rst_read routine)
-   USE in_out_manager  ! I/O manager
-   USE iom             ! I/O library
-   USE zpshde          ! partial step: hor. derivative (zps_hde routine)
-   USE eosbn2          ! equation of state            (eos bn2 routine)
-   USE domvvl          ! varying vertical mesh
-   USE dynspg_oce      ! pressure gradient schemes
-   USE dynspg_flt      ! pressure gradient schemes
-   USE dynspg_exp      ! pressure gradient schemes
-   USE dynspg_ts       ! pressure gradient schemes
-   USE traswp          ! Swap arrays                      (tra_swp routine)
-   
-   IMPLICIT NONE
-   PRIVATE
-
-   PUBLIC   istate_init   ! routine called by step.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-#  include "vectopt_loop_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   SUBROUTINE istate_init
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE istate_init  ***
-      !! 
-      !! ** Purpose :   Initialization of the dynamics and tracer fields.
-      !!----------------------------------------------------------------------
-      ! - ML - needed for initialization of e3t_b
-      INTEGER  ::  jk     ! dummy loop indice
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-
-      rhd  (:,:,:) = 0.e0
-      rhop (:,:,:) = 0.e0
-      rn2  (:,:,:) = 0.e0 
-      ta   (:,:,:) = 0.e0    
-      sa   (:,:,:) = 0.e0
-
-      IF( ln_rstart ) THEN                    ! Restart from a file
-         !                                    ! -------------------
-         neuler = 1                              ! Set time-step indicator at nit000 (leap-frog)
-         CALL rst_read                           ! Read the restart file
-         CALL tra_swap                           ! swap 3D arrays (t,s)  in a 4D array (ts)
-         CALL day_init                           ! model calendar (using both namelist and restart infos)
-      ELSE
-         !                                    ! Start from rest
-         !                                    ! ---------------
-         numror = 0                              ! define numror = 0 -> no restart file to read
-         neuler = 0                              ! Set time-step indicator at nit000 (euler forward)
-         CALL day_init                           ! model calendar (using both namelist and restart infos)
-         !                                       ! Initialization of ocean to zero
-         !   before fields     !       now fields     
-         sshb (:,:)   = 0.e0   ;   sshn (:,:)   = 0.e0
-         ub   (:,:,:) = 0.e0   ;   un   (:,:,:) = 0.e0
-         vb   (:,:,:) = 0.e0   ;   vn   (:,:,:) = 0.e0  
-         rotb (:,:,:) = 0.e0   ;   rotn (:,:,:) = 0.e0
-         hdivb(:,:,:) = 0.e0   ;   hdivn(:,:,:) = 0.e0
-         !
-         IF( cp_cfg == 'eel' ) THEN
-            CALL istate_eel                      ! EEL   configuration : start from pre-defined U,V T-S fields
-         ELSEIF( cp_cfg == 'gyre' ) THEN         
-            CALL istate_gyre                     ! GYRE  configuration : start from pre-defined T-S fields
-         ELSE
-            !                                    ! Other configurations: Initial T-S fields
-#if defined key_dtatem
-            CALL dta_tem( nit000 )                  ! read 3D temperature data
-            tb(:,:,:) = t_dta(:,:,:)   ;   tn(:,:,:) = t_dta(:,:,:)
-            
-#else
-            IF(lwp) WRITE(numout,*)                 ! analytical temperature profile
-            IF(lwp) WRITE(numout,*)'             Temperature initialization using an analytic profile'
-            CALL istate_tem
-#endif
-#if defined key_dtasal
-            CALL dta_sal( nit000 )                  ! read 3D salinity data
-            sb(:,:,:) = s_dta(:,:,:)   ;   sn(:,:,:) = s_dta(:,:,:)
-#else
-            ! No salinity data
-            IF(lwp)WRITE(numout,*)                  ! analytical salinity profile
-            IF(lwp)WRITE(numout,*)'             Salinity initialisation using a constant value'
-            CALL istate_sal
-#endif
-         ENDIF
-         !
-         CALL tra_swap                     ! swap 3D arrays (tb,sb,tn,sn)  in a 4D array
-         CALL eos( tsb, rhd, rhop )        ! before potential and in situ densities
-#if ! defined key_c1d
-         IF( ln_zps )   CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv,  & ! zps: before hor. gradient
-            &                                       rhd, gru , grv  )   ! of t,s,rd at ocean bottom
-#endif
-         !   
-         ! - ML - sshn could be modified by istate_eel, so that initialization of fse3t_b is done here
-         IF( lk_vvl ) THEN
-            DO jk = 1, jpk
-               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
-            ENDDO
-         ENDIF
-         ! 
-      ENDIF
-      !
-      IF( lk_agrif ) THEN                  ! read free surface arrays in restart file
-         IF( ln_rstart ) THEN
-            IF( lk_dynspg_flt )   CALL flt_rst( nit000, 'READ' )      ! read or initialize the following fields
-            !                                                         ! gcx, gcxb for agrif_opa_init
-         ENDIF                                                        ! explicit case not coded yet with AGRIF
-      ENDIF
-      !
-   END SUBROUTINE istate_init
-
-
-   SUBROUTINE istate_tem
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE istate_tem  ***
-      !!   
-      !! ** Purpose :   Intialization of the temperature field with an 
-      !!      analytical profile or a file (i.e. in EEL configuration)
-      !!
-      !! ** Method  :   Use Philander analytic profile of temperature
-      !!
-      !! References :  Philander ???
-      !!----------------------------------------------------------------------
-      INTEGER :: ji, jj, jk
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'istate_tem : initial temperature profile'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-      !
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               tn(ji,jj,jk) = (  ( ( 7.5 - 0.*ABS(gphit(ji,jj))/30. )   &
-                  &               *( 1.-TANH((fsdept(ji,jj,jk)-80.)/30.) )   &
-                  &            + 10.*(5000.-fsdept(ji,jj,jk))/5000.)  ) * tmask(ji,jj,jk)
-               tb(ji,jj,jk) = tn(ji,jj,jk)
-          END DO
-        END DO
-      END DO
-      !
-      IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
-         &                 1     , jpi   , 5     , 1     , jpk   ,   &
-         &                 1     , 1.    , numout                  )
-      !
-   END SUBROUTINE istate_tem
-
-
-   SUBROUTINE istate_sal
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE istate_sal  ***
-      !!
-      !! ** Purpose :   Intialize the salinity field with an analytic profile
-      !!
-      !! ** Method  :   Use to a constant value 35.5
-      !!              
-      !! ** Action  :   Initialize sn and sb
-      !!----------------------------------------------------------------------
-      REAL(wp) ::   zsal = 35.50_wp
-      !!----------------------------------------------------------------------
-      !
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'istate_sal : initial salinity : ', zsal
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-      !
-      sn(:,:,:) = zsal * tmask(:,:,:)
-      sb(:,:,:) = sn(:,:,:)
-      !
-   END SUBROUTINE istate_sal
-
-
-   SUBROUTINE istate_eel
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE istate_eel  ***
-      !! 
-      !! ** Purpose :   Initialization of the dynamics and tracers for EEL R5
-      !!      configuration (channel with or without a topographic bump)
-      !!
-      !! ** Method  : - set temprature field
-      !!              - set salinity field
-      !!              - set velocity field including horizontal divergence
-      !!                and relative vorticity fields
-      !!----------------------------------------------------------------------
-      USE divcur     ! hor. divergence & rel. vorticity      (div_cur routine)
-      USE iom
- 
-      INTEGER  ::   inum              ! temporary logical unit
-      INTEGER  ::   ji, jj, jk        ! dummy loop indices
-      INTEGER  ::   ijloc
-      REAL(wp) ::   zh1, zh2, zslope, zcst, zfcor   ! temporary scalars
-      REAL(wp) ::   zt1  = 15._wp                   ! surface temperature value (EEL R5)
-      REAL(wp) ::   zt2  =  5._wp                   ! bottom  temperature value (EEL R5)
-      REAL(wp) ::   zsal = 35.0_wp                  ! constant salinity (EEL R2, R5 and R6)
-      REAL(wp) ::   zueel = 0.1_wp                  ! constant uniform zonal velocity (EEL R5)
-      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zssh  ! initial ssh over the global domain
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( jp_cfg ) 
-         !                                              ! ====================
-         CASE ( 5 )                                     ! EEL R5 configuration
-            !                                           ! ====================
-            !
-            ! set temperature field with a linear profile
-            ! -------------------------------------------
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: linear temperature profile'
-            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-            !
-            zh1 = gdept_0(  1  )
-            zh2 = gdept_0(jpkm1)
-            !
-            zslope = ( zt1 - zt2 ) / ( zh1 - zh2 )
-            zcst   = ( zt1 * ( zh1 - zh2) - ( zt1 - zt2 ) * zh1 ) / ( zh1 - zh2 )
-            !
-            DO jk = 1, jpk
-               tn(:,:,jk) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk)
-               tb(:,:,jk) = tn(:,:,jk)
-            END DO
-            !
-            IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
-               &                 1     , jpi   , 5     , 1     , jpk   ,   &
-               &                 1     , 1.    , numout                  )
-            !
-            ! set salinity field to a constant value
-            ! --------------------------------------
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
-            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-            !
-            sn(:,:,:) = zsal * tmask(:,:,:)
-            sb(:,:,:) = sn(:,:,:)
-            !
-            ! set the dynamics: U,V, hdiv, rot (and ssh if necessary)
-            ! ----------------
-            ! Start EEL5 configuration with barotropic geostrophic velocities 
-            ! according the sshb and sshn SSH imposed.
-            ! we assume a uniform grid (hence the use of e1t(1,1) for delta_y)
-            ! we use the Coriolis frequency at mid-channel.   
-            ub(:,:,:) = zueel * umask(:,:,:)
-            un(:,:,:) = ub(:,:,:)
-            ijloc = mj0(INT(jpjglo-1)/2)
-            zfcor = ff(1,ijloc)
-            !
-            DO jj = 1, jpjglo
-               zssh(:,jj) = - (FLOAT(jj)- FLOAT(jpjglo-1)/2.)*zueel*e1t(1,1)*zfcor/grav 
-            END DO
-            !
-            IF(lwp) THEN
-               WRITE(numout,*) ' Uniform zonal velocity for EEL R5:',zueel
-               WRITE(numout,*) ' Geostrophic SSH profile as a function of y:'
-               WRITE(numout,'(12(1x,f6.2))') zssh(1,:)
-            ENDIF
-            !
-            DO jj = 1, nlcj
-               DO ji = 1, nlci
-                  sshb(ji,jj) = zssh( mig(ji) , mjg(jj) ) * tmask(ji,jj,1)
-               END DO
-            END DO
-            sshb(nlci+1:jpi,      :   ) = 0.e0      ! set to zero extra mpp columns
-            sshb(      :   ,nlcj+1:jpj) = 0.e0      ! set to zero extra mpp rows
-            !
-            sshn(:,:) = sshb(:,:)                   ! set now ssh to the before value
-            !
-            IF( nn_rstssh /= 0 ) THEN  
-               nn_rstssh = 0                        ! hand-made initilization of ssh 
-               CALL ctl_warn( 'istate_eel: force nn_rstssh = 0' )
-            ENDIF
-            !
-            CALL div_cur( nit000 )                  ! horizontal divergence and relative vorticity (curl)
-            ! N.B. the vertical velocity will be computed from the horizontal divergence field
-            ! in istate by a call to wzv routine
-
-
-            !                                     ! ==========================
-         CASE ( 2 , 6 )                           ! EEL R2 or R6 configuration
-            !                                     ! ==========================
-            !
-            ! set temperature field with a NetCDF file
-            ! ----------------------------------------
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R2 or R6: read initial temperature in a NetCDF file'
-            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-            !
-            CALL iom_open ( 'eel.initemp', inum )
-            CALL iom_get ( inum, jpdom_data, 'initemp', tb ) ! read before temprature (tb)
-            CALL iom_close( inum )
-            !
-            tn(:,:,:) = tb(:,:,:)                            ! set nox temperature to tb
-            !
-            IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
-               &                 1     , jpi   , 5     , 1     , jpk   ,   &
-               &                 1     , 1.    , numout                  )
-            !
-            ! set salinity field to a constant value
-            ! --------------------------------------
-            IF(lwp) WRITE(numout,*)
-            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
-            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-            !
-            sn(:,:,:) = zsal * tmask(:,:,:)
-            sb(:,:,:) = sn(:,:,:)
-            !
-            !                                    ! ===========================
-         CASE DEFAULT                            ! NONE existing configuration
-            !                                    ! ===========================
-            WRITE(ctmp1,*) 'EEL with a ', jp_cfg,' km resolution is not coded'
-            CALL ctl_stop( ctmp1 )
-            !
-      END SELECT
-      !
-   END SUBROUTINE istate_eel
-
-
-   SUBROUTINE istate_gyre
-      !!----------------------------------------------------------------------
-      !!                   ***  ROUTINE istate_gyre  ***
-      !! 
-      !! ** Purpose :   Initialization of the dynamics and tracers for GYRE
-      !!      configuration (double gyre with rotated domain)
-      !!
-      !! ** Method  : - set temprature field
-      !!              - set salinity field
-      !!----------------------------------------------------------------------
-      INTEGER :: ji, jj, jk  ! dummy loop indices
-      INTEGER            ::   inum          ! temporary logical unit
-      INTEGER, PARAMETER ::   ntsinit = 0   ! (0/1) (analytical/input data files) T&S initialization
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( ntsinit)
-
-      CASE ( 0 )                  ! analytical T/S profil deduced from LEVITUS
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'istate_gyre : initial analytical T and S profil deduced from LEVITUS '
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-
-         DO jk = 1, jpk
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  tn(ji,jj,jk) = (  16. - 12. * TANH( (fsdept(ji,jj,jk) - 400) / 700 )         )   &
-                       &           * (-TANH( (500-fsdept(ji,jj,jk)) / 150 ) + 1) / 2               &
-                       &       + (      15. * ( 1. - TANH( (fsdept(ji,jj,jk)-50.) / 1500.) )       &
-                       &                - 1.4 * TANH((fsdept(ji,jj,jk)-100.) / 100.)               &    
-                       &                + 7.  * (1500. - fsdept(ji,jj,jk)) / 1500.             )   & 
-                       &           * (-TANH( (fsdept(ji,jj,jk) - 500) / 150) + 1) / 2
-                  tn(ji,jj,jk) = tn(ji,jj,jk) * tmask(ji,jj,jk)
-                  tb(ji,jj,jk) = tn(ji,jj,jk)
-
-                  sn(ji,jj,jk) =  (  36.25 - 1.13 * TANH( (fsdept(ji,jj,jk) - 305) / 460 )  )  &
-                     &              * (-TANH((500 - fsdept(ji,jj,jk)) / 150) + 1) / 2          &
-                     &          + (  35.55 + 1.25 * (5000. - fsdept(ji,jj,jk)) / 5000.         &
-                     &                - 1.62 * TANH( (fsdept(ji,jj,jk) - 60.  ) / 650. )       &
-                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 35.  ) / 100. )       &
-                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 1000.) / 5000.)    )  &
-                     &              * (-TANH((fsdept(ji,jj,jk) - 500) / 150) + 1) / 2 
-                  sn(ji,jj,jk) = sn(ji,jj,jk) * tmask(ji,jj,jk)
-                  sb(ji,jj,jk) = sn(ji,jj,jk)
-               END DO
-            END DO
-         END DO
-
-      CASE ( 1 )                  ! T/S data fields read in dta_tem.nc/data_sal.nc files
-         IF(lwp) WRITE(numout,*)
-         IF(lwp) WRITE(numout,*) 'istate_gyre : initial T and S read from dta_tem.nc/data_sal.nc files'
-         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
-         IF(lwp) WRITE(numout,*) '              NetCDF FORMAT'
-
-         ! Read temperature field
-         ! ----------------------
-         CALL iom_open ( 'data_tem', inum )
-         CALL iom_get ( inum, jpdom_data, 'votemper', tn ) 
-         CALL iom_close( inum )
-
-         tn(:,:,:) = tn(:,:,:) * tmask(:,:,:) 
-         tb(:,:,:) = tn(:,:,:)
-
-         ! Read salinity field
-         ! -------------------
-         CALL iom_open ( 'data_sal', inum )
-         CALL iom_get ( inum, jpdom_data, 'vosaline', sn ) 
-         CALL iom_close( inum )
-
-         sn(:,:,:)  = sn(:,:,:) * tmask(:,:,:) 
-         sb(:,:,:)  = sn(:,:,:)
-
-      END SELECT
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '              Initial temperature and salinity profiles:'
-         WRITE(numout, "(9x,' level   gdept_0   temperature   salinity   ')" )
-         WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_0(jk), tn(2,2,jk), sn(2,2,jk), jk = 1, jpk )
-      ENDIF
-
-   END SUBROUTINE istate_gyre
-
-
-   SUBROUTINE istate_uvg
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE istate_uvg  ***
-      !!
-      !! ** Purpose :   Compute the geostrophic velocities from (tn,sn) fields
-      !!
-      !! ** Method  :   Using the hydrostatic hypothesis the now hydrostatic 
-      !!      pressure is computed by integrating the in-situ density from the
-      !!      surface to the bottom.
-      !!                 p=integral [ rau*g dz ]
-      !!----------------------------------------------------------------------
-      USE dynspg          ! surface pressure gradient             (dyn_spg routine)
-      USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine)
-      USE lbclnk          ! ocean lateral boundary condition (or mpp link)
-
-      INTEGER ::   ji, jj, jk        ! dummy loop indices
-      INTEGER ::   indic             ! ???
-      REAL(wp) ::   zmsv, zphv, zmsu, zphu, zalfg     ! temporary scalars
-      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zprn     ! workspace
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*) 
-      IF(lwp) WRITE(numout,*) 'istate_uvg : Start from Geostrophy'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
-
-      ! Compute the now hydrostatic pressure
-      ! ------------------------------------
-
-      zalfg = 0.5 * grav * rau0
-      
-      zprn(:,:,1) = zalfg * fse3w(:,:,1) * ( 1 + rhd(:,:,1) )       ! Surface value
-
-      DO jk = 2, jpkm1                                              ! Vertical integration from the surface
-         zprn(:,:,jk) = zprn(:,:,jk-1)   &
-            &         + zalfg * fse3w(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) )
-      END DO  
-
-      ! Compute geostrophic balance
-      ! ---------------------------
-      DO jk = 1, jpkm1
-         DO jj = 2, jpjm1
-            DO ji = fs_2, fs_jpim1   ! vertor opt.
-               zmsv = 1. / MAX(  umask(ji-1,jj+1,jk) + umask(ji  ,jj+1,jk)   &
-                               + umask(ji-1,jj  ,jk) + umask(ji  ,jj  ,jk) , 1.  )
-               zphv = ( zprn(ji  ,jj+1,jk) - zprn(ji-1,jj+1,jk) ) * umask(ji-1,jj+1,jk) / e1u(ji-1,jj+1)   &
-                    + ( zprn(ji+1,jj+1,jk) - zprn(ji  ,jj+1,jk) ) * umask(ji  ,jj+1,jk) / e1u(ji  ,jj+1)   &
-                    + ( zprn(ji  ,jj  ,jk) - zprn(ji-1,jj  ,jk) ) * umask(ji-1,jj  ,jk) / e1u(ji-1,jj  )   &
-                    + ( zprn(ji+1,jj  ,jk) - zprn(ji  ,jj  ,jk) ) * umask(ji  ,jj  ,jk) / e1u(ji  ,jj  )
-               zphv = 1. / rau0 * zphv * zmsv * vmask(ji,jj,jk)
-
-               zmsu = 1. / MAX(  vmask(ji+1,jj  ,jk) + vmask(ji  ,jj  ,jk)   &
-                               + vmask(ji+1,jj-1,jk) + vmask(ji  ,jj-1,jk) , 1.  )
-               zphu = ( zprn(ji+1,jj+1,jk) - zprn(ji+1,jj  ,jk) ) * vmask(ji+1,jj  ,jk) / e2v(ji+1,jj  )   &
-                    + ( zprn(ji  ,jj+1,jk) - zprn(ji  ,jj  ,jk) ) * vmask(ji  ,jj  ,jk) / e2v(ji  ,jj  )   &
-                    + ( zprn(ji+1,jj  ,jk) - zprn(ji+1,jj-1,jk) ) * vmask(ji+1,jj-1,jk) / e2v(ji+1,jj-1)   &
-                    + ( zprn(ji  ,jj  ,jk) - zprn(ji  ,jj-1,jk) ) * vmask(ji  ,jj-1,jk) / e2v(ji  ,jj-1)
-               zphu = 1. / rau0 * zphu * zmsu * umask(ji,jj,jk)
-
-               ! Compute the geostrophic velocities
-               un(ji,jj,jk) = -2. * zphu / ( ff(ji,jj) + ff(ji  ,jj-1) )
-               vn(ji,jj,jk) =  2. * zphv / ( ff(ji,jj) + ff(ji-1,jj  ) )
-            END DO
-         END DO
-      END DO
-
-      IF(lwp) WRITE(numout,*) '         we force to zero bottom velocity'
-
-      ! Susbtract the bottom velocity (level jpk-1 for flat bottom case)
-      ! to have a zero bottom velocity
-
-      DO jk = 1, jpkm1
-         un(:,:,jk) = ( un(:,:,jk) - un(:,:,jpkm1) ) * umask(:,:,jk)
-         vn(:,:,jk) = ( vn(:,:,jk) - vn(:,:,jpkm1) ) * vmask(:,:,jk)
-      END DO
-
-      CALL lbc_lnk( un, 'U', -1. )
-      CALL lbc_lnk( vn, 'V', -1. )
-      
-      ub(:,:,:) = un(:,:,:)
-      vb(:,:,:) = vn(:,:,:)
-      
-      ! WARNING !!!!!
-      ! after initializing u and v, we need to calculate the initial streamfunction bsf.
-      ! Otherwise, only the trend will be computed and the model will blow up (inconsistency).
-      ! to do that, we call dyn_spg with a special trick:
-      ! we fill ua and va with the velocities divided by dt, and the streamfunction will be brought to the
-      ! right value assuming the velocities have been set up in one time step.
-      ! we then set bsfd to zero (first guess for next step is d(psi)/dt = 0.)
-      !  sets up s false trend to calculate the barotropic streamfunction.
-
-      ua(:,:,:) = ub(:,:,:) / rdt
-      va(:,:,:) = vb(:,:,:) / rdt
-
-      ! calls dyn_spg. we assume euler time step, starting from rest.
-      indic = 0
-      CALL dyn_spg( nit000, indic )       ! surface pressure gradient
-
-      ! the new velocity is ua*rdt
-
-      CALL lbc_lnk( ua, 'U', -1. )
-      CALL lbc_lnk( va, 'V', -1. )
-
-      ub(:,:,:) = ua(:,:,:) * rdt
-      vb(:,:,:) = va(:,:,:) * rdt
-      ua(:,:,:) = 0.e0
-      va(:,:,:) = 0.e0
-      un(:,:,:) = ub(:,:,:)
-      vn(:,:,:) = vb(:,:,:)
-       
-      ! Compute the divergence and curl
-
-      CALL div_cur( nit000 )            ! now horizontal divergence and curl
-
-      hdivb(:,:,:) = hdivn(:,:,:)       ! set the before to the now value
-      rotb (:,:,:) = rotn (:,:,:)       ! set the before to the now value
-      !
-   END SUBROUTINE istate_uvg
-
-   !!=====================================================================
-END MODULE istate
Index: anches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/lbclnk.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/lbclnk.F90	(revision 2441)
+++ 	(revision )
@@ -1,275 +1,0 @@
-MODULE lbclnk
-   !!======================================================================
-   !!                       ***  MODULE  lbclnk  ***
-   !! Ocean        : lateral boundary conditions
-   !!=====================================================================
-   !! History :  OPA  ! 1997-06  (G. Madec)     Original code
-   !!   NEMO     1.0  ! 2002-09  (G. Madec)     F90: Free form and module
-   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment  
-   !!----------------------------------------------------------------------
-#if   defined key_mpp_mpi
-   !!----------------------------------------------------------------------
-   !!   'key_mpp_mpi'             MPI massively parallel processing library
-   !!----------------------------------------------------------------------
-   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
-   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
-   !!----------------------------------------------------------------------
-   USE lib_mpp          ! distributed memory computing library
-
-   INTERFACE lbc_lnk
-      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
-   END INTERFACE
-
-   INTERFACE lbc_lnk_e
-      MODULE PROCEDURE mpp_lnk_2d_e
-   END INTERFACE
-
-   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
-   PUBLIC lbc_lnk_e
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default option                              shared memory computing
-   !!----------------------------------------------------------------------
-   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
-   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh
-   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh
-   !!----------------------------------------------------------------------
-   USE oce             ! ocean dynamics and tracers   
-   USE dom_oce         ! ocean space and time domain 
-   USE in_out_manager  ! I/O manager
-   USE lbcnfd          ! north fold
-
-   IMPLICIT NONE
-   PRIVATE
-
-   INTERFACE lbc_lnk
-      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
-   END INTERFACE
-
-   INTERFACE lbc_lnk_e
-      MODULE PROCEDURE lbc_lnk_2d
-   END INTERFACE
-
-   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
-   PUBLIC   lbc_lnk_e 
-   
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case)
-      !!
-      !! ** Method  :   psign = -1 :    change the sign across the north fold
-      !!                      =  1 : no change of the sign across the north fold
-      !!                      =  0 : no change of the sign across the north fold and
-      !!                             strict positivity preserved: use inner row/column
-      !!                             for closed boundaries.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign 
-      !!----------------------------------------------------------------------
-      !
-      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
-      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
-      !
-   END SUBROUTINE lbc_lnk_3d_gather
-
-
-   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
-      !!---------------------------------------------------------------------
-      !!                  ***  ROUTINE lbc_lnk_3d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
-      !!
-      !! ** Method  :   psign = -1 :    change the sign across the north fold
-      !!                      =  1 : no change of the sign across the north fold
-      !!                      =  0 : no change of the sign across the north fold and
-      !!                             strict positivity preserved: use inner row/column
-      !!                             for closed boundaries.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
-      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign 
-      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
-      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
-      !!
-      REAL(wp) ::   zland
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
-      ELSE                         ;   zland = 0.e0
-      ENDIF
-
-
-      IF( PRESENT( cd_mpp ) ) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE
-         !
-         !                                     !  East-West boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
-            pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points
-            pt3d(jpi,:,:) = pt3d(  2  ,:,:)
-            !
-         CASE DEFAULT                             !**  East closed  --  West closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d( 1 ,:,:) = zland
-               pt3d(jpi,:,:) = zland
-            CASE ( 'F' )                               ! F-point
-               pt3d(jpi,:,:) = zland
-            END SELECT
-            !
-         END SELECT
-         !
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 2 )                               !**  South symmetric  --  North closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
-               pt3d(:, 1 ,:) = pt3d(:,3,:)
-               pt3d(:,jpj,:) = zland
-            CASE ( 'V' , 'F' )                         ! V-, F-points
-               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
-               pt3d(:,jpj,:) = zland
-            END SELECT
-            !
-         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
-            SELECT CASE ( cd_type )                    ! South : closed
-            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
-               pt3d(:, 1 ,:) = zland
-            END SELECT
-            !                                          ! North fold
-            pt3d( 1 ,jpj,:) = zland
-            pt3d(jpi,jpj,:) = zland
-            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
-            !
-         CASE DEFAULT                             !**  North closed  --  South closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d(:, 1 ,:) = zland
-               pt3d(:,jpj,:) = zland
-            CASE ( 'F' )                               ! F-point
-               pt3d(:,jpj,:) = zland
-            END SELECT
-            !
-         END SELECT
-         !
-      ENDIF
-      !
-   END SUBROUTINE lbc_lnk_3d
-
-
-   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!---------------------------------------------------------------------
-      !!                 ***  ROUTINE lbc_lnk_2d  ***
-      !!
-      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
-      !!
-      !! ** Method  :   psign = -1 :    change the sign across the north fold
-      !!                      =  1 : no change of the sign across the north fold
-      !!                      =  0 : no change of the sign across the north fold and
-      !!                             strict positivity preserved: use inner row/column
-      !!                             for closed boundaries.
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
-      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign 
-      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
-      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
-      !!
-      REAL(wp) ::   zland
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
-      ELSE                         ;   zland = 0.e0
-      ENDIF
-
-      IF (PRESENT(cd_mpp)) THEN
-         ! only fill the overlap area and extra allows 
-         ! this is in mpp case. In this module, just do nothing
-      ELSE      
-         !
-         !                                     ! East-West boundaries
-         !                                     ! ====================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
-            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
-            pt2d(jpi,:) = pt2d(  2  ,:)
-            !
-         CASE DEFAULT                             !** East closed  --  West closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
-               pt2d( 1 ,:) = zland
-               pt2d(jpi,:) = zland
-            CASE ( 'F' )                              ! F-point
-               pt2d(jpi,:) = zland
-            END SELECT
-            !
-         END SELECT
-         !
-         !                                     ! North-South boundaries
-         !                                     ! ======================
-         SELECT CASE ( nperio )
-         !
-         CASE ( 2 )                               !**  South symmetric  --  North closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
-               pt2d(:, 1 ) = pt2d(:,3)
-               pt2d(:,jpj) = zland
-            CASE ( 'V' , 'F' )                         ! V-, F-points
-               pt2d(:, 1 ) = psgn * pt2d(:,2)
-               pt2d(:,jpj) = zland
-            END SELECT
-            !
-         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
-            SELECT CASE ( cd_type )                    ! South : closed
-            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
-               pt2d(:, 1 ) = zland
-            END SELECT
-            !                                          ! North fold
-            pt2d( 1 ,1  ) = zland 
-            pt2d( 1 ,jpj) = zland 
-            pt2d(jpi,jpj) = zland
-            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
-            !
-         CASE DEFAULT                             !**  North closed  --  South closed
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt2d(:, 1 ) = zland
-               pt2d(:,jpj) = zland
-            CASE ( 'F' )                               ! F-point
-               pt2d(:,jpj) = zland
-            END SELECT
-            !
-         END SELECT
-         !
-      ENDIF
-      !    
-   END SUBROUTINE lbc_lnk_2d
-
-#endif
-
-   !!======================================================================
-END MODULE lbclnk
Index: anches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/lbcnfd.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/lbcnfd.F90	(revision 2441)
+++ 	(revision )
@@ -1,308 +1,0 @@
-MODULE lbcnfd
-   !!======================================================================
-   !!                       ***  MODULE  lbcnfd  ***
-   !! Ocean        : north fold  boundary conditions
-   !!======================================================================
-   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
-   !!----------------------------------------------------------------------
-
-   !!----------------------------------------------------------------------
-   !!   lbc_nfd       : generic interface for lbc_nfd_3d and lbc_nfd_2d routines
-   !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd)
-   !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd)
-   !!----------------------------------------------------------------------
-   USE oce            ! ocean dynamics and tracers   
-   USE dom_oce        ! ocean space and time domain 
-   USE in_out_manager ! I/O manager
-
-   IMPLICIT NONE
-   PRIVATE
-
-   INTERFACE lbc_nfd
-      MODULE PROCEDURE   lbc_nfd_3d, lbc_nfd_2d
-   END INTERFACE
-
-   PUBLIC   lbc_nfd   ! north fold conditions
-
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-CONTAINS
-
-   SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine lbc_nfd_3d  ***
-      !!
-      !! ** Purpose :   3D lateral boundary condition : North fold treatment
-      !!              without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt3d with updated values along the north fold
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                        !   = T , U , V , F , W points
-      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                        !   = -1. , the sign is changed if north fold boundary
-      !                                                        !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the boundary condition is applied
-      !
-      INTEGER  ::   ji, jk
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( jpni )
-      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
-      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
-      END SELECT
-      ijpjm1 = ijpj-1
-
-      DO jk = 1, jpk
-         !
-         SELECT CASE ( npolj )
-         !
-         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-               END DO
-               DO ji = jpiglo/2+1, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
-               END DO
-               DO ji = jpiglo/2, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
-               END DO
-            CASE ( 'V' )                               ! V-point
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
-               END DO
-            CASE ( 'F' )                               ! F-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
-               END DO
-            END SELECT
-            !
-         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
-            !
-            SELECT CASE ( cd_type )
-            CASE ( 'T' , 'W' )                         ! T-, W-point
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
-               END DO
-            CASE ( 'U' )                               ! U-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
-               END DO
-            CASE ( 'V' )                               ! V-point
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
-               END DO
-               DO ji = jpiglo/2+1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
-               END DO
-            CASE ( 'F' )                               ! F-point
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
-               END DO
-               DO ji = jpiglo/2+1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
-               END DO
-            END SELECT
-            !
-         CASE DEFAULT                           ! *  closed : the code probably never go through
-            !
-            SELECT CASE ( cd_type)
-            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
-               pt3d(:, 1  ,jk) = 0.e0
-               pt3d(:,ijpj,jk) = 0.e0
-            CASE ( 'F' )                               ! F-point
-               pt3d(:,ijpj,jk) = 0.e0
-            END SELECT
-            !
-         END SELECT     !  npolj
-         !
-      END DO
-      !
-   END SUBROUTINE lbc_nfd_3d
-
-
-   SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine lbc_nfd_2d  ***
-      !!
-      !! ** Purpose :   2D lateral boundary condition : North fold treatment
-      !!       without processor exchanges. 
-      !!
-      !! ** Method  :   
-      !!
-      !! ** Action  :   pt2d with updated values along the north fold
-      !!----------------------------------------------------------------------
-      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
-      !                                                      ! = T , U , V , F , W points
-      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
-      !                                                      !   = -1. , the sign is changed if north fold boundary
-      !                                                      !   =  1. , the sign is kept  if north fold boundary
-      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the boundary condition is applied
-      INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos
-      !
-      INTEGER  ::   ji, jl, ipr2dj
-      INTEGER  ::   ijt, iju, ijpj, ijpjm1
-      !!----------------------------------------------------------------------
-
-      SELECT CASE ( jpni )
-      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
-      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
-      END SELECT
-      !
-      IF( PRESENT(pr2dj) ) THEN           ! use of additional halos
-         ipr2dj = pr2dj
-         IF( jpni > 1 )   ijpj = ijpj + ipr2dj
-      ELSE
-         ipr2dj = 0 
-      ENDIF
-      !
-      ijpjm1 = ijpj-1
-
-
-      SELECT CASE ( npolj )
-      !
-      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
-         !
-         SELECT CASE ( cd_type )
-         !
-         CASE ( 'T' , 'W' )                               ! T- , W-points
-            DO jl = 0, ipr2dj
-               DO ji = 2, jpiglo
-                  ijt=jpiglo-ji+2
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
-               END DO
-            END DO
-            DO ji = jpiglo/2+1, jpiglo
-               ijt=jpiglo-ji+2
-               pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1)
-            END DO
-         CASE ( 'U' )                                     ! U-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
-               END DO
-            END DO
-            DO ji = jpiglo/2, jpiglo-1
-               iju = jpiglo-ji+1
-               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
-            END DO
-         CASE ( 'V' )                                     ! V-point
-            DO jl = -1, ipr2dj
-               DO ji = 2, jpiglo
-                  ijt = jpiglo-ji+2
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-3-jl)
-               END DO
-            END DO
-         CASE ( 'F' )                                     ! F-point
-            DO jl = -1, ipr2dj
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji+1
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl)
-               END DO
-            END DO
-         CASE ( 'I' )                                     ! ice U-V point (I-point)
-            DO jl = 0, ipr2dj
-               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
-               DO ji = 3, jpiglo
-                  iju = jpiglo - ji + 3
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
-         END SELECT
-         !
-      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
-         !
-         SELECT CASE ( cd_type )
-         CASE ( 'T' , 'W' )                               ! T-, W-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'U' )                                     ! U-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
-               END DO
-            END DO
-         CASE ( 'V' )                                     ! V-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo
-                  ijt = jpiglo-ji+1
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
-               END DO
-            END DO
-            DO ji = jpiglo/2+1, jpiglo
-               ijt = jpiglo-ji+1
-               pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)
-            END DO
-         CASE ( 'F' )                               ! F-point
-            DO jl = 0, ipr2dj
-               DO ji = 1, jpiglo-1
-                  iju = jpiglo-ji
-                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
-               END DO
-            END DO
-            DO ji = jpiglo/2+1, jpiglo-1
-               iju = jpiglo-ji
-               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
-            END DO
-         CASE ( 'I' )                                  ! ice U-V point (I-point)
-            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
-            DO jl = 0, ipr2dj
-               DO ji = 2 , jpiglo-1
-                  ijt = jpiglo - ji + 2
-                  pt2d(ji,ijpj+jl)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) )
-               END DO
-            END DO
-         END SELECT
-         !
-      CASE DEFAULT                           ! *  closed : the code probably never go through
-         !
-         SELECT CASE ( cd_type)
-         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         CASE ( 'F' )                                   ! F-point
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         CASE ( 'I' )                                   ! ice U-V point
-            pt2d(:, 1:1-ipr2dj     ) = 0.e0
-            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
-         END SELECT
-         !
-      END SELECT
-      !
-   END SUBROUTINE lbc_nfd_2d
-
-   !!======================================================================
-END MODULE lbcnfd
Index: anches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/lib_mpp.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/lib_mpp.F90	(revision 2441)
+++ 	(revision )
@@ -1,2586 +1,0 @@
-MODULE lib_mpp
-   !!======================================================================
-   !!                       ***  MODULE  lib_mpp  ***
-   !! Ocean numerics:  massively parallel processing library
-   !!=====================================================================
-   !! History :  OPA  !  1994  (M. Guyon, J. Escobar, M. Imbard)  Original code
-   !!            7.0  !  1997  (A.M. Treguier)  SHMEM additions
-   !!            8.0  !  1998  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
-   !!                 !  1998  (J.M. Molines) Open boundary conditions
-   !!   NEMO     1.0  !  2003  (J.-M. Molines, G. Madec)  F90, free form
-   !!                 !  2003  (J.M. Molines) add mpp_ini_north(_3d,_2d)
-   !!             -   !  2004  (R. Bourdalle Badie)  isend option in mpi
-   !!                 !  2004  (J.M. Molines) minloc, maxloc
-   !!             -   !  2005  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
-   !!             -   !  2005  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
-   !!             -   !  2005  (R. Benshila, G. Madec)  add extra halo case
-   !!             -   !  2008  (R. Benshila) add mpp_ini_ice
-   !!            3.2  !  2009  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
-   !!            3.2  !  2009  (O. Marti)    add mpp_ini_znl 
-   !!----------------------------------------------------------------------
-#if   defined key_mpp_mpi  
-   !!----------------------------------------------------------------------
-   !!   'key_mpp_mpi'             MPI massively parallel processing library
-   !!----------------------------------------------------------------------
-   !!   mynode      : indentify the processor unit
-   !!   mpp_lnk     : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d)
-   !!   mpp_lnk_3d_gather :  Message passing manadgement for two 3D arrays
-   !!   mpp_lnk_e   : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e)
-   !!   mpprecv     :
-   !!   mppsend     :   SUBROUTINE mpp_ini_znl
-   !!   mppscatter  :
-   !!   mppgather   :
-   !!   mpp_min     : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
-   !!   mpp_max     : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real
-   !!   mpp_sum     : generic interface for mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
-   !!   mpp_minloc  :
-   !!   mpp_maxloc  :
-   !!   mppsync     :
-   !!   mppstop     :
-   !!   mppobc      : variant of mpp_lnk for open boundary condition
-   !!   mpp_ini_north : initialisation of north fold
-   !!   mpp_lbc_north : north fold processors gathering
-   !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo
-   !!----------------------------------------------------------------------
-   !! History :
-   !!        !  94 (M. Guyon, J. Escobar, M. Imbard)  Original code
-   !!        !  97  (A.M. Treguier)  SHMEM additions
-   !!        !  98  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
-   !!   9.0  !  03  (J.-M. Molines, G. Madec)  F90, free form
-   !!        !  04  (R. Bourdalle Badie)  isend option in mpi
-   !!        !  05  (G. Madec, S. Masson)  npolj=5,6 F-point & ice cases
-   !!        !  05  (R. Redler) Replacement of MPI_COMM_WORLD except for MPI_Abort
-   !!        !  09  (R. Benshila) SHMEM suppression, north fold in lbc_nfd
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!---------------------------------------------------------------------
-   !! * Modules used
-   USE dom_oce                    ! ocean space and time domain 
-   USE in_out_manager             ! I/O manager
-   USE lbcnfd                     ! north fold treatment
-
-   IMPLICIT NONE
-   PRIVATE
-   
-   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free
-   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e
-   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc
-   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
-   PUBLIC   mpprecv, mppsend, mppscatter, mppgather
-   PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl
-   PUBLIC   mppsize, mpprank
-
-   !! * Interfaces
-   !! define generic interface for these routine as they are called sometimes
-   !! with scalar arguments instead of array arguments, which causes problems
-   !! for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ
-   INTERFACE mpp_min
-      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
-   END INTERFACE
-   INTERFACE mpp_max
-      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
-   END INTERFACE
-   INTERFACE mpp_sum
-# if defined key_mpp_rep
-      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, &
-                       mppsum_realdd, mppsum_a_realdd
-# else
-      MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real
-# endif
-   END INTERFACE
-   INTERFACE mpp_lbc_north
-      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 
-   END INTERFACE
-   INTERFACE mpp_minloc
-      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
-   END INTERFACE
-   INTERFACE mpp_maxloc
-      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
-   END INTERFACE
-   
-   !! ========================= !!
-   !!  MPI  variable definition !!
-   !! ========================= !!
-!$AGRIF_DO_NOT_TREAT
-   INCLUDE 'mpif.h'
-!$AGRIF_END_DO_NOT_TREAT
-   
-   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .TRUE.    !: mpp flag
-
-   INTEGER, PARAMETER         ::   nprocmax = 2**10   ! maximun dimension (required to be a power of 2)
-   
-   INTEGER ::   mppsize        ! number of process
-   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ]
-!$AGRIF_DO_NOT_TREAT
-   INTEGER, PUBLIC ::   mpi_comm_opa   ! opa local communicator
-!$AGRIF_END_DO_NOT_TREAT
-
-   INTEGER, PUBLIC :: MPI_SUMDD
-
-   ! variables used in case of sea-ice
-   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice
-   INTEGER ::   ngrp_ice        !  group ID for the ice processors (for rheology)
-   INTEGER ::   ndim_rank_ice   !  number of 'ice' processors
-   INTEGER ::   n_ice_root      !  number (in the comm_ice) of proc 0 in the ice comm
-   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_ice     ! dimension ndim_rank_ice
-
-   ! variables used for zonal integration
-   INTEGER, PUBLIC ::   ncomm_znl       !: communicator made by the processors on the same zonal average
-   LOGICAL, PUBLIC ::   l_znl_root      ! True on the 'left'most processor on the same row
-   INTEGER ::   ngrp_znl        ! group ID for the znl processors
-   INTEGER ::   ndim_rank_znl   ! number of processors on the same zonal average
-   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_znl  ! dimension ndim_rank_znl, number of the procs into the same znl domain
-   
-   ! North fold condition in mpp_mpi with jpni > 1
-   INTEGER ::   ngrp_world        ! group ID for the world processors
-   INTEGER ::   ngrp_opa          ! group ID for the opa processors
-   INTEGER ::   ngrp_north        ! group ID for the northern processors (to be fold)
-   INTEGER ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north
-   INTEGER ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !)
-   INTEGER ::   njmppmax          ! value of njmpp for the processors of the northern line
-   INTEGER ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm
-   INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_north   ! dimension ndim_rank_north
-
-   ! Type of send : standard, buffered, immediate
-   CHARACTER(len=1) ::   cn_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend)
-   LOGICAL          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I')
-   INTEGER          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend 
-      
-   REAL(wp), ALLOCATABLE, DIMENSION(:) :: tampon  ! buffer in case of bsend
-
-   ! message passing arrays
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   t4ns, t4sn   ! 2 x 3d for north-south & south-north
-   REAL(wp), DIMENSION(jpj,jpreci,jpk,2,2) ::   t4ew, t4we   ! 2 x 3d for east-west & west-east
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2,2) ::   t4p1, t4p2   ! 2 x 3d for north fold
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2)   ::   t3ns, t3sn   ! 3d for north-south & south-north
-   REAL(wp), DIMENSION(jpj,jpreci,jpk,2)   ::   t3ew, t3we   ! 3d for east-west & west-east
-   REAL(wp), DIMENSION(jpi,jprecj,jpk,2)   ::   t3p1, t3p2   ! 3d for north fold
-   REAL(wp), DIMENSION(jpi,jprecj,2)       ::   t2ns, t2sn   ! 2d for north-south & south-north
-   REAL(wp), DIMENSION(jpj,jpreci,2)       ::   t2ew, t2we   ! 2d for east-west & west-east
-   REAL(wp), DIMENSION(jpi,jprecj,2)       ::   t2p1, t2p2   ! 2d for north fold
-   REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ::   tr2ns, tr2sn  ! 2d for north-south & south-north + extra outer halo
-   REAL(wp), DIMENSION(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ::   tr2ew, tr2we  ! 2d for east-west   & west-east   + extra outer halo
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-   FUNCTION mynode(ldtxt, localComm)
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mynode  ***
-      !!                    
-      !! ** Purpose :   Find processor unit
-      !!
-      !!----------------------------------------------------------------------
-      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
-      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
-      INTEGER ::   mynode, ierr, code
-      LOGICAL ::   mpi_was_called
-      
-      NAMELIST/nammpp/ cn_mpi_send, nn_buffer
-      !!----------------------------------------------------------------------
-      !
-      WRITE(ldtxt(1),*)
-      WRITE(ldtxt(2),*) 'mynode : mpi initialisation'
-      WRITE(ldtxt(3),*) '~~~~~~ '
-      !
-      REWIND( numnam )               ! Namelist namrun : parameters of the run
-      READ  ( numnam, nammpp )
-      !                              ! control print
-      WRITE(ldtxt(4),*) '   Namelist nammpp'
-      WRITE(ldtxt(5),*) '      mpi send type                      cn_mpi_send = ', cn_mpi_send
-      WRITE(ldtxt(6),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer
-
-#if defined key_agrif
-      IF( Agrif_Root() ) THEN
-#endif
-         !!bug RB : should be clean to use Agrif in coupled mode
-#if ! defined key_agrif
-         CALL mpi_initialized ( mpi_was_called, code )
-         IF( code /= MPI_SUCCESS ) THEN
-            WRITE(*, cform_err)
-            WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized'
-            CALL mpi_abort( mpi_comm_world, code, ierr )
-         ENDIF
-
-         IF( PRESENT(localComm) .and. mpi_was_called ) THEN
-            mpi_comm_opa = localComm
-            SELECT CASE ( cn_mpi_send )
-            CASE ( 'S' )                ! Standard mpi send (blocking)
-               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)'
-            CASE ( 'B' )                ! Buffer mpi send (blocking)
-               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
-               CALL mpi_init_opa( ierr ) 
-            CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-               WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
-               l_isend = .TRUE.
-            CASE DEFAULT
-               WRITE(ldtxt(7),cform_err)
-               WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send
-               nstop = nstop + 1
-            END SELECT
-         ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
-            WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator '
-            WRITE(ldtxt(8),*) '          without calling MPI_Init before ! '
-            nstop = nstop + 1
-         ELSE
-#endif
-            SELECT CASE ( cn_mpi_send )
-            CASE ( 'S' )                ! Standard mpi send (blocking)
-               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)'
-               CALL mpi_init( ierr )
-            CASE ( 'B' )                ! Buffer mpi send (blocking)
-               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
-               CALL mpi_init_opa( ierr )
-            CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-               WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
-               l_isend = .TRUE.
-               CALL mpi_init( ierr )
-            CASE DEFAULT
-               WRITE(ldtxt(7),cform_err)
-               WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send
-               nstop = nstop + 1
-            END SELECT
-
-#if ! defined key_agrif
-            CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code)
-            IF( code /= MPI_SUCCESS ) THEN
-               WRITE(*, cform_err)
-               WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
-               CALL mpi_abort( mpi_comm_world, code, ierr )
-            ENDIF
-            !
-         ENDIF
-#endif
-#if defined key_agrif
-      ELSE
-         SELECT CASE ( cn_mpi_send )
-         CASE ( 'S' )                ! Standard mpi send (blocking)
-            WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)'
-         CASE ( 'B' )                ! Buffer mpi send (blocking)
-            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
-         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
-            l_isend = .TRUE.
-         CASE DEFAULT
-            WRITE(ldtxt(7),cform_err)
-            WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send
-            nstop = nstop + 1
-         END SELECT
-      ENDIF
-
-      mpi_comm_opa = mpi_comm_world
-#endif
-      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
-      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )
-      mynode = mpprank
-      !
-#if defined key_mpp_rep
-      CALL MPI_OP_CREATE(DDPDD_MPI, .TRUE., MPI_SUMDD, ierr)
-#endif
-      !
-   END FUNCTION mynode
-
-
-   SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d  ***
-      !!
-      !! ** Purpose :   Message passing manadgement
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors 
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab     ! 3D array on which the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                             ! = T , U , V , F , W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                             ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL      , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
-      REAL(wp)        , OPTIONAL      , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jk, jl             ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
-         !
-         ! WARNING ptab is defined only between nld and nle
-         DO jk = 1, jpk
-            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)   
-               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk)
-               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk)
-            END DO
-            DO ji = nlci+1, jpi                 ! added column(s) (full)
-               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk)
-               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk)
-               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk)
-            END DO
-         END DO
-         !
-      ELSE                              ! standard close or cyclic treatment 
-         !
-         !                                   ! East-West boundaries
-         !                                        !* Cyclic east-west
-         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            ptab( 1 ,:,:) = ptab(jpim1,:,:)
-            ptab(jpi,:,:) = ptab(  2  ,:,:)
-         ELSE                                     !* closed
-            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
-                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
-         ENDIF
-         !                                   ! North-South boundaries (always closed)
-         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
-                                      ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
-         !
-      ENDIF
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
-         END DO
-      END SELECT  
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk
-      !
-      SELECT CASE ( nbondi ) 
-      CASE ( -1 )
-         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci-jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
-         END DO
-      CASE ( 0 ) 
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk
-      !
-      SELECT CASE ( nbondj )     
-      CASE ( -1 )
-         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 ) 
-         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj-jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
-         END DO
-      CASE ( 0 ) 
-         DO jl = 1, jprecj
-            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab(:,jl,:) = t3sn(:,jl,:,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-   END SUBROUTINE mpp_lnk_3d
-
-
-   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d  ***
-      !!                  
-      !! ** Purpose :   Message passing manadgement for 2d array
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors 
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
-      !                                                         ! = T , U , V , F , W and I points
-      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
-      !                                                         ! =  1. , the sign is kept
-      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
-      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
-      !!
-      INTEGER  ::   ji, jj, jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      REAL(wp) ::   zland
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-
-      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
-      ELSE                         ;   zland = 0.e0      ! zero by default
-      ENDIF
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !
-      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
-         !
-         ! WARNING pt2d is defined only between nld and nle
-         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
-            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)   
-            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej)
-            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej)
-         END DO
-         DO ji = nlci+1, jpi                 ! added column(s) (full)
-            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej)
-            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     )
-            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej)
-         END DO
-         !
-      ELSE                              ! standard close or cyclic treatment 
-         !
-         !                                   ! East-West boundaries
-         IF( nbondi == 2 .AND.   &                ! Cyclic east-west
-            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west
-            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east
-         ELSE                                     ! closed
-            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
-                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
-         ENDIF
-         !                                   ! North-South boundaries (always closed)
-            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
-                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north
-         !
-      ENDIF
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            t2ew(:,jl,1) = pt2d(jpreci+jl,:)
-            t2we(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr )
-         CALL mpprecv( 2, t2we(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t2we(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            pt2d(iihom+jl,:) = t2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = t2we(:,jl,2)
-            pt2d(iihom+jl,:) = t2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            pt2d(jl      ,:) = t2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj
-         DO jl = 1, jprecj
-            t2sn(:,jl,1) = pt2d(:,ijhom +jl)
-            t2ns(:,jl,1) = pt2d(:,jprecj+jl)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = t2sn(:,jl,2)
-            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
-         END DO
-      CASE ( 1 ) 
-         DO jl = 1, jprecj
-            pt2d(:,jl      ) = t2sn(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      !
-      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
-         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
-         END SELECT
-         !
-      ENDIF
-      !
-   END SUBROUTINE mpp_lnk_2d
-
-
-   SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_3d_gather  ***
-      !!
-      !! ** Purpose :   Message passing manadgement for two 3D arrays
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors 
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !! ** Action  :   ptab1 and ptab2  with update value at its periphery
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which 
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays 
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points
-      REAL(wp)                        , INTENT(in   ) ::   psgn      ! =-1 the sign change across the north fold boundary
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER  ::   jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      !                                      ! East-West boundaries
-      !                                           !* Cyclic east-west
-      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-         ptab1( 1 ,:,:) = ptab1(jpim1,:,:)
-         ptab1(jpi,:,:) = ptab1(  2  ,:,:)
-         ptab2( 1 ,:,:) = ptab2(jpim1,:,:)
-         ptab2(jpi,:,:) = ptab2(  2  ,:,:)
-      ELSE                                        !* closed
-         IF( .NOT. cd_type1 == 'F' )   ptab1(     1       :jpreci,:,:) = 0.e0    ! south except at F-point
-         IF( .NOT. cd_type2 == 'F' )   ptab2(     1       :jpreci,:,:) = 0.e0
-                                       ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0    ! north
-                                       ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0
-      ENDIF
-
-      
-      !                                      ! North-South boundaries
-      IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0.e0    ! south except at F-point
-      IF( .NOT. cd_type2 == 'F' )   ptab2(:,     1       :jprecj,:) = 0.e0
-                                    ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0    ! north
-                                    ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
-
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci
-         DO jl = 1, jpreci
-            t4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
-            t4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
-            t4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
-            t4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = jpreci * jpj * jpk *2
-      !
-      SELECT CASE ( nbondi ) 
-      CASE ( -1 )
-         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr )
-         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, jpreci
-            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
-            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
-         END DO
-      CASE ( 0 ) 
-         DO jl = 1, jpreci
-            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
-            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
-            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
-            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jpreci
-            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
-            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj - nrecj
-         DO jl = 1, jprecj
-            t4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)
-            t4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)
-            t4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)
-            t4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = jprecj * jpi * jpk * 2
-      !
-      SELECT CASE ( nbondj )     
-      CASE ( -1 )
-         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr )
-         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 ) 
-         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, jprecj
-            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)
-            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
-         END DO
-      CASE ( 0 ) 
-         DO jl = 1, jprecj
-            ptab1(:,jl      ,:) = t4sn(:,jl,:,1,2)
-            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)
-            ptab2(:,jl      ,:) = t4sn(:,jl,:,2,2)
-            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, jprecj
-            ptab1(:,jl,:) = t4sn(:,jl,:,1,2)
-            ptab2(:,jl,:) = t4sn(:,jl,:,2,2)
-         END DO
-      END SELECT
-
-
-      ! 4. north fold treatment
-      ! -----------------------
-      IF( npolj /= 0 ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )                                           
-            CALL lbc_nfd      ( ptab1, cd_type1, psgn )   ! only for northern procs.
-            CALL lbc_nfd      ( ptab2, cd_type2, psgn )
-         CASE DEFAULT
-            CALL mpp_lbc_north( ptab1, cd_type1, psgn )   ! for all northern procs.
-            CALL mpp_lbc_north (ptab2, cd_type2, psgn)
-         END SELECT 
-         !
-      ENDIF
-      !
-   END SUBROUTINE mpp_lnk_3d_gather
-
-
-   SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpp_lnk_2d_e  ***
-      !!                  
-      !! ** Purpose :   Message passing manadgement for 2d array (with halo)
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
-      !!      between processors following neighboring subdomains.
-      !!            domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    jpr2di : number of rows for extra outer halo
-      !!                    jpr2dj : number of columns for extra outer halo
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors 
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
-      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
-      !                                                                                         ! = T , U , V , F , W and I points
-      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the
-      !!                                                                                        ! north boundary, =  1. otherwise
-      INTEGER  ::   jl   ! dummy loop indices
-      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
-      INTEGER  ::   ipreci, iprecj             ! temporary integers
-      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
-      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-
-      ipreci = jpreci + jpr2di      ! take into account outer extra 2D overlap area
-      iprecj = jprecj + jpr2dj
-
-
-      ! 1. standard boundary treatment
-      ! ------------------------------
-      ! Order matters Here !!!!
-      !
-      !                                      !* North-South boundaries (always colsed)
-      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jpr2dj   :  jprecj  ) = 0.e0    ! south except at F-point
-                                   pt2d(:,nlcj-jprecj+1:jpj+jpr2dj) = 0.e0    ! north
-                                
-      !                                      ! East-West boundaries
-      !                                           !* Cyclic east-west
-      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
-         pt2d(1-jpr2di:     1    ,:) = pt2d(jpim1-jpr2di:  jpim1 ,:)       ! east
-         pt2d(   jpi  :jpi+jpr2di,:) = pt2d(     2      :2+jpr2di,:)       ! west
-         !
-      ELSE                                        !* closed
-         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpr2di   :jpreci    ,:) = 0.e0    ! south except at F-point
-                                      pt2d(nlci-jpreci+1:jpi+jpr2di,:) = 0.e0    ! north
-      ENDIF
-      !
-
-      ! north fold treatment
-      ! -----------------------
-      IF( npolj /= 0 ) THEN
-         !
-         SELECT CASE ( jpni )
-         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jpr2dj), cd_type, psgn, pr2dj=jpr2dj )
-         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               )
-         END SELECT 
-         !
-      ENDIF
-
-      ! 2. East and west directions exchange
-      ! ------------------------------------
-      ! we play with the neigbours AND the row number because of the periodicity 
-      !
-      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
-      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
-         iihom = nlci-nreci-jpr2di
-         DO jl = 1, ipreci
-            tr2ew(:,jl,1) = pt2d(jpreci+jl,:)
-            tr2we(:,jl,1) = pt2d(iihom +jl,:)
-         END DO
-      END SELECT
-      !
-      !                           ! Migrations
-      imigr = ipreci * ( jpj + 2*jpr2dj)
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr )
-         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      iihom = nlci - jpreci
-      !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         DO jl = 1, ipreci
-            pt2d(iihom+jl,:) = tr2ew(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, ipreci
-            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
-            pt2d( iihom+jl,:) = tr2ew(:,jl,2)
-         END DO
-      CASE ( 1 )
-         DO jl = 1, ipreci
-            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
-         END DO
-      END SELECT
-
-
-      ! 3. North and south directions
-      ! -----------------------------
-      ! always closed : we play only with the neigbours
-      !
-      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
-         ijhom = nlcj-nrecj-jpr2dj
-         DO jl = 1, iprecj
-            tr2sn(:,jl,1) = pt2d(:,ijhom +jl)
-            tr2ns(:,jl,1) = pt2d(:,jprecj+jl)
-         END DO
-      ENDIF
-      !
-      !                           ! Migrations
-      imigr = iprecj * ( jpi + 2*jpr2di )
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      CASE ( 0 )
-         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr )
-         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)
-      CASE ( 1 )
-         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr )
-         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
-      END SELECT
-      !
-      !                           ! Write Dirichlet lateral conditions
-      ijhom = nlcj - jprecj  
-      !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         DO jl = 1, iprecj
-            pt2d(:,ijhom+jl) = tr2ns(:,jl,2)
-         END DO
-      CASE ( 0 )
-         DO jl = 1, iprecj
-            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
-            pt2d(:,ijhom+jl ) = tr2ns(:,jl,2)
-         END DO
-      CASE ( 1 ) 
-         DO jl = 1, iprecj
-            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
-         END DO
-      END SELECT
-
-   END SUBROUTINE mpp_lnk_2d_e
-
-
-   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsend  ***
-      !!                   
-      !! ** Purpose :   Send messag passing array
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
-      INTEGER , INTENT(in   ) ::   kbytes     ! size of the array pmess
-      INTEGER , INTENT(in   ) ::   kdest      ! receive process number
-      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message
-      INTEGER , INTENT(in   ) ::   md_req     ! argument for isend
-      !!
-      INTEGER ::   iflag
-      !!----------------------------------------------------------------------
-      !
-      SELECT CASE ( cn_mpi_send )
-      CASE ( 'S' )                ! Standard mpi send (blocking)
-         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag )
-      CASE ( 'B' )                ! Buffer mpi send (blocking)
-         CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag )
-      CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-         ! be carefull, one more argument here : the mpi request identifier..
-         CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa, md_req, iflag )
-      END SELECT
-      !
-   END SUBROUTINE mppsend
-
-
-   SUBROUTINE mpprecv( ktyp, pmess, kbytes )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mpprecv  ***
-      !!
-      !! ** Purpose :   Receive messag passing array
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
-      INTEGER , INTENT(in   ) ::   kbytes     ! suze of the array pmess
-      INTEGER , INTENT(in   ) ::   ktyp       ! Tag of the recevied message
-      !!
-      INTEGER :: istatus(mpi_status_size)
-      INTEGER :: iflag
-      !!----------------------------------------------------------------------
-      !
-      CALL mpi_recv( pmess, kbytes, mpi_double_precision, mpi_any_source, ktyp, mpi_comm_opa, istatus, iflag )
-      !
-   END SUBROUTINE mpprecv
-
-
-   SUBROUTINE mppgather( ptab, kp, pio )
-      !!----------------------------------------------------------------------
-      !!                   ***  routine mppgather  ***
-      !!                   
-      !! ** Purpose :   Transfert between a local subdomain array and a work 
-      !!     array which is distributed following the vertical level.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj),       INTENT(in   ) ::   ptab   ! subdomain input array
-      INTEGER ,                           INTENT(in   ) ::   kp     ! record length
-      REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT(  out) ::   pio    ! subdomain input array
-      !!
-      INTEGER :: itaille, ierror   ! temporary integer
-      !!---------------------------------------------------------------------
-      !
-      itaille = jpi * jpj
-      CALL mpi_gather( ptab, itaille, mpi_double_precision, pio, itaille     ,   &
-         &                            mpi_double_precision, kp , mpi_comm_opa, ierror ) 
-      !
-   END SUBROUTINE mppgather
-
-
-   SUBROUTINE mppscatter( pio, kp, ptab )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppscatter  ***
-      !!
-      !! ** Purpose :   Transfert between awork array which is distributed 
-      !!      following the vertical level and the local subdomain array.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpnij)  ::  pio        ! output array
-      INTEGER                             ::   kp        ! Tag (not used with MPI
-      REAL(wp), DIMENSION(jpi,jpj)        ::  ptab       ! subdomain array input
-      !!
-      INTEGER :: itaille, ierror   ! temporary integer
-      !!---------------------------------------------------------------------
-      !
-      itaille=jpi*jpj
-      !
-      CALL mpi_scatter( pio, itaille, mpi_double_precision, ptab, itaille     ,   &
-         &                            mpi_double_precision, kp  , mpi_comm_opa, ierror )
-      !
-   END SUBROUTINE mppscatter
-
-
-   SUBROUTINE mppmax_a_int( ktab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_a_int  ***
-      !! 
-      !! ** Purpose :   Find maximum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                  ::   kdim   ! size of array
-      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab   ! input array
-      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom   ! 
-      !!
-      INTEGER :: ierror, localcomm   ! temporary integer
-      INTEGER, DIMENSION(kdim) ::   iwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, localcomm, ierror )
-      !
-      ktab(:) = iwork(:)
-      !
-   END SUBROUTINE mppmax_a_int
-
-
-   SUBROUTINE mppmax_int( ktab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_int  ***
-      !!
-      !! ** Purpose :   Find maximum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(inout)           ::   ktab      ! ???
-      INTEGER, INTENT(in   ), OPTIONAL ::   kcom      ! ???
-      !! 
-      INTEGER ::   ierror, iwork, localcomm   ! temporary integer
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa 
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror)
-      !
-      ktab = iwork
-      !
-   END SUBROUTINE mppmax_int
-
-
-   SUBROUTINE mppmin_a_int( ktab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_a_int  ***
-      !! 
-      !! ** Purpose :   Find minimum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER , INTENT( in  )                  ::   kdim        ! size of array
-      INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array
-      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
-      !!
-      INTEGER ::   ierror, localcomm   ! temporary integer
-      INTEGER, DIMENSION(kdim) ::   iwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_min, localcomm, ierror )
-      !
-      ktab(:) = iwork(:)
-      !
-   END SUBROUTINE mppmin_a_int
-
-
-   SUBROUTINE mppmin_int( ktab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_int  ***
-      !!
-      !! ** Purpose :   Find minimum value in an integer layout array
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(inout) ::   ktab      ! ???
-      INTEGER , INTENT( in  ), OPTIONAL        ::   kcom        ! input array
-      !!
-      INTEGER ::  ierror, iwork, localcomm
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-     CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror )
-      !
-      ktab = iwork
-      !
-   END SUBROUTINE mppmin_int
-
-
-   SUBROUTINE mppsum_a_int( ktab, kdim )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_int  ***
-      !!                    
-      !! ** Purpose :   Global integer sum, 1D array case
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in   )                   ::   kdim      ! ???
-      INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab      ! ???
-      !!
-      INTEGER :: ierror
-      INTEGER, DIMENSION (kdim) ::  iwork
-      !!----------------------------------------------------------------------
-      !
-      CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
-      !
-      ktab(:) = iwork(:)
-      !
-   END SUBROUTINE mppsum_a_int
-
-
-   SUBROUTINE mppsum_int( ktab )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppsum_int  ***
-      !!                  
-      !! ** Purpose :   Global integer sum
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(inout) ::   ktab
-      !! 
-      INTEGER :: ierror, iwork
-      !!----------------------------------------------------------------------
-      !
-      CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_sum, mpi_comm_opa, ierror )
-      !
-      ktab = iwork
-      !
-   END SUBROUTINE mppsum_int
-
-
-   SUBROUTINE mppmax_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppmax_a_real  ***
-      !!                  
-      !! ** Purpose :   Maximum
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                  ::   kdim
-      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
-      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
-      !!
-      INTEGER :: ierror, localcomm
-      REAL(wp), DIMENSION(kdim) ::  zwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror )
-      ptab(:) = zwork(:)
-      !
-   END SUBROUTINE mppmax_a_real
-
-
-   SUBROUTINE mppmax_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmax_real  ***
-      !!                    
-      !! ** Purpose :   Maximum
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), INTENT(inout)           ::   ptab   ! ???
-      INTEGER , INTENT(in   ), OPTIONAL ::   kcom   ! ???
-      !!
-      INTEGER  ::   ierror, localcomm
-      REAL(wp) ::   zwork
-      !!----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa 
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_max, localcomm, ierror )
-      ptab = zwork
-      !
-   END SUBROUTINE mppmax_real
-
-
-   SUBROUTINE mppmin_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                 ***  routine mppmin_a_real  ***
-      !!                  
-      !! ** Purpose :   Minimum of REAL, array case
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                  ::   kdim
-      REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
-      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom
-      !!
-      INTEGER :: ierror, localcomm
-      REAL(wp), DIMENSION(kdim) ::   zwork
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa 
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_min, localcomm, ierror )
-      ptab(:) = zwork(:)
-      !
-   END SUBROUTINE mppmin_a_real
-
-
-   SUBROUTINE mppmin_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppmin_real  ***
-      !! 
-      !! ** Purpose :   minimum of REAL, scalar case
-      !!
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(inout)           ::   ptab        ! 
-      INTEGER , INTENT(in   ), OPTIONAL :: kcom
-      !!
-      INTEGER  ::   ierror
-      REAL(wp) ::   zwork
-      INTEGER :: localcomm
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa 
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_min, localcomm, ierror )
-      ptab = zwork
-      !
-   END SUBROUTINE mppmin_real
-
-
-   SUBROUTINE mppsum_a_real( ptab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_real  ***
-      !! 
-      !! ** Purpose :   global sum, REAL ARRAY argument case
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER , INTENT( in )                     ::   kdim      ! size of ptab
-      REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array
-      INTEGER , INTENT( in ), OPTIONAL           :: kcom
-      !!
-      INTEGER                   ::   ierror    ! temporary integer
-      INTEGER                   ::   localcomm 
-      REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace 
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa 
-      IF( PRESENT(kcom) )   localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_sum, localcomm, ierror )
-      ptab(:) = zwork(:)
-      !
-   END SUBROUTINE mppsum_a_real
-
-
-   SUBROUTINE mppsum_real( ptab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_real  ***
-      !!              
-      !! ** Purpose :   global sum, SCALAR argument case
-      !!
-      !!-----------------------------------------------------------------------
-      REAL(wp), INTENT(inout)           ::   ptab   ! input scalar
-      INTEGER , INTENT(in   ), OPTIONAL ::   kcom
-      !!
-      INTEGER  ::   ierror, localcomm 
-      REAL(wp) ::   zwork
-      !!-----------------------------------------------------------------------
-      !
-      localcomm = mpi_comm_opa 
-      IF( PRESENT(kcom) ) localcomm = kcom
-      !
-      CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_sum, localcomm, ierror )
-      ptab = zwork
-      !
-   END SUBROUTINE mppsum_real
-
-# if defined key_mpp_rep
-   SUBROUTINE mppsum_realdd( ytab, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_realdd ***
-      !!
-      !! ** Purpose :   global sum in Massively Parallel Processing
-      !!                SCALAR argument case for double-double precision
-      !!
-      !!-----------------------------------------------------------------------
-      COMPLEX(wp), INTENT(inout)         :: ytab    ! input scalar
-      INTEGER , INTENT( in  ), OPTIONAL :: kcom
-
-      !! * Local variables   (MPI version)
-      INTEGER  ::    ierror
-      INTEGER  ::   localcomm
-      COMPLEX(wp) :: zwork
-
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-
-      ! reduce local sums into global sum
-      CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, &
-                       MPI_SUMDD,localcomm,ierror)
-      ytab = zwork
-
-   END SUBROUTINE mppsum_realdd
-  
-  
-   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsum_a_realdd  ***
-      !!
-      !! ** Purpose :   global sum in Massively Parallel Processing
-      !!                COMPLEX ARRAY case for double-double precision
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER , INTENT( in )                        ::   kdim      ! size of ytab
-      COMPLEX(wp), DIMENSION(kdim), INTENT( inout ) ::   ytab      ! input array
-      INTEGER , INTENT( in  ), OPTIONAL :: kcom
-
-      !! * Local variables   (MPI version)
-      INTEGER                      :: ierror    ! temporary integer
-      INTEGER                      ::   localcomm
-      COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace
-
-      localcomm = mpi_comm_opa
-      IF( PRESENT(kcom) ) localcomm = kcom
-
-      CALL MPI_ALLREDUCE (ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, &
-                       MPI_SUMDD,localcomm,ierror)
-      ytab(:) = zwork(:)
-
-   END SUBROUTINE mppsum_a_realdd
-# endif   
-   
-   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj )
-      !!------------------------------------------------------------------------
-      !!             ***  routine mpp_minloc  ***
-      !!
-      !! ** Purpose :   Compute the global minimum of an array ptab
-      !!              and also give its global position
-      !!
-      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
-      !!
-      !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab    ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask   ! Local mask
-      REAL(wp)                     , INTENT(  out) ::   pmin    ! Global minimum of ptab
-      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of minimum in global frame
-      !!
-      INTEGER , DIMENSION(2)   ::   ilocs
-      INTEGER :: ierror
-      REAL(wp) ::   zmin   ! local minimum
-      REAL(wp), DIMENSION(2,1) ::   zain, zaout
-      !!-----------------------------------------------------------------------
-      !
-      zmin  = MINVAL( ptab(:,:) , mask= pmask == 1.e0 )
-      ilocs = MINLOC( ptab(:,:) , mask= pmask == 1.e0 )
-      !
-      ki = ilocs(1) + nimpp - 1
-      kj = ilocs(2) + njmpp - 1
-      !
-      zain(1,:)=zmin
-      zain(2,:)=ki+10000.*kj
-      !
-      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
-      !
-      pmin = zaout(1,1)
-      kj = INT(zaout(2,1)/10000.)
-      ki = INT(zaout(2,1) - 10000.*kj )
-      !
-   END SUBROUTINE mpp_minloc2d
-
-
-   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj ,kk)
-      !!------------------------------------------------------------------------
-      !!             ***  routine mpp_minloc  ***
-      !!
-      !! ** Purpose :   Compute the global minimum of an array ptab
-      !!              and also give its global position
-      !!
-      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
-      !!
-      !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
-      REAL(wp)                         , INTENT(  out) ::   pmin         ! Global minimum of ptab
-      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame
-      !!
-      INTEGER  ::   ierror
-      REAL(wp) ::   zmin     ! local minimum
-      INTEGER , DIMENSION(3)   ::   ilocs
-      REAL(wp), DIMENSION(2,1) ::   zain, zaout
-      !!-----------------------------------------------------------------------
-      !
-      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
-      !
-      ki = ilocs(1) + nimpp - 1
-      kj = ilocs(2) + njmpp - 1
-      kk = ilocs(3)
-      !
-      zain(1,:)=zmin
-      zain(2,:)=ki+10000.*kj+100000000.*kk
-      !
-      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
-      !
-      pmin = zaout(1,1)
-      kk   = INT( zaout(2,1) / 100000000. )
-      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
-      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
-      !
-   END SUBROUTINE mpp_minloc3d
-
-
-   SUBROUTINE mpp_maxloc2d( ptab, pmask, pmax, ki, kj )
-      !!------------------------------------------------------------------------
-      !!             ***  routine mpp_maxloc  ***
-      !!
-      !! ** Purpose :   Compute the global maximum of an array ptab
-      !!              and also give its global position
-      !!
-      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
-      !!
-      !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab     ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask    ! Local mask
-      REAL(wp)                     , INTENT(  out) ::   pmax     ! Global maximum of ptab
-      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of maximum in global frame
-      !!  
-      INTEGER  :: ierror
-      INTEGER, DIMENSION (2)   ::   ilocs
-      REAL(wp) :: zmax   ! local maximum
-      REAL(wp), DIMENSION(2,1) ::   zain, zaout
-      !!-----------------------------------------------------------------------
-      !
-      zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1.e0 )
-      ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1.e0 )
-      !
-      ki = ilocs(1) + nimpp - 1
-      kj = ilocs(2) + njmpp - 1
-      !
-      zain(1,:) = zmax
-      zain(2,:) = ki + 10000. * kj
-      !
-      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
-      !
-      pmax = zaout(1,1)
-      kj   = INT( zaout(2,1) / 10000.     )
-      ki   = INT( zaout(2,1) - 10000.* kj )
-      !
-   END SUBROUTINE mpp_maxloc2d
-
-
-   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
-      !!------------------------------------------------------------------------
-      !!             ***  routine mpp_maxloc  ***
-      !!
-      !! ** Purpose :  Compute the global maximum of an array ptab
-      !!              and also give its global position
-      !!
-      !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
-      !!
-      !!--------------------------------------------------------------------------
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
-      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
-      REAL(wp)                         , INTENT(  out) ::   pmax         ! Global maximum of ptab
-      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame
-      !!   
-      REAL(wp) :: zmax   ! local maximum
-      REAL(wp), DIMENSION(2,1) ::   zain, zaout
-      INTEGER , DIMENSION(3)   ::   ilocs
-      INTEGER :: ierror
-      !!-----------------------------------------------------------------------
-      !
-      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
-      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
-      !
-      ki = ilocs(1) + nimpp - 1
-      kj = ilocs(2) + njmpp - 1
-      kk = ilocs(3)
-      !
-      zain(1,:)=zmax
-      zain(2,:)=ki+10000.*kj+100000000.*kk
-      !
-      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
-      !
-      pmax = zaout(1,1)
-      kk   = INT( zaout(2,1) / 100000000. )
-      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
-      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
-      !
-   END SUBROUTINE mpp_maxloc3d
-
-
-   SUBROUTINE mppsync()
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppsync  ***
-      !!                   
-      !! ** Purpose :   Massively parallel processors, synchroneous
-      !!
-      !!-----------------------------------------------------------------------
-      INTEGER :: ierror
-      !!-----------------------------------------------------------------------
-      !
-      CALL mpi_barrier( mpi_comm_opa, ierror )
-      !
-   END SUBROUTINE mppsync
-
-
-   SUBROUTINE mppstop
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppstop  ***
-      !!                   
-      !! ** purpose :   Stop massilively parallel processors method
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER ::   info
-      !!----------------------------------------------------------------------
-      !
-      CALL mppsync
-      CALL mpi_finalize( info )
-      !
-   END SUBROUTINE mppstop
-
-
-   SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij )
-      !!----------------------------------------------------------------------
-      !!                  ***  routine mppobc  ***
-      !! 
-      !! ** Purpose :   Message passing manadgement for open boundary
-      !!     conditions array
-      !!
-      !! ** Method  :   Use mppsend and mpprecv function for passing mask
-      !!       between processors following neighboring subdomains.
-      !!       domain parameters
-      !!                    nlci   : first dimension of the local subdomain
-      !!                    nlcj   : second dimension of the local subdomain
-      !!                    nbondi : mark for "east-west local boundary"
-      !!                    nbondj : mark for "north-south local boundary"
-      !!                    noea   : number for local neighboring processors 
-      !!                    nowe   : number for local neighboring processors
-      !!                    noso   : number for local neighboring processors
-      !!                    nono   : number for local neighboring processors
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices
-      INTEGER , INTENT(in   )                     ::   kl         ! index of open boundary
-      INTEGER , INTENT(in   )                     ::   kk         ! vertical dimension
-      INTEGER , INTENT(in   )                     ::   ktype      ! define north/south or east/west cdt
-      !                                                           !  = 1  north/south  ;  = 2  east/west
-      INTEGER , INTENT(in   )                     ::   kij        ! horizontal dimension
-      REAL(wp), INTENT(inout), DIMENSION(kij,kk)  ::   ptab       ! variable array
-      !! 
-      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
-      INTEGER  ::   iipt0, iipt1, ilpt1   ! temporary integers
-      INTEGER  ::   ijpt0, ijpt1          !    -          -
-      INTEGER  ::   imigr, iihom, ijhom   !    -          -
-      INTEGER ::   ml_req1, ml_req2, ml_err    ! for key_mpi_isend
-      INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend
-      REAL(wp), DIMENSION(jpi,jpj) ::   ztab   ! temporary workspace
-      !!----------------------------------------------------------------------
-
-      ! boundary condition initialization
-      ! ---------------------------------
-      ztab(:,:) = 0.e0
-      !
-      IF( ktype==1 ) THEN                                  ! north/south boundaries
-         iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci     ) )
-         iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) )
-         ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci     ) )
-         ijpt0 = MAX( 1, MIN(kl  - njmpp+1, nlcj     ) )
-         ijpt1 = MAX( 0, MIN(kl  - njmpp+1, nlcj - 1 ) )
-      ELSEIF( ktype==2 ) THEN                              ! east/west boundaries
-         iipt0 = MAX( 1, MIN(kl  - nimpp+1, nlci     ) )
-         iipt1 = MAX( 0, MIN(kl  - nimpp+1, nlci - 1 ) )
-         ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj     ) )
-         ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) )
-         ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) )
-      ELSE
-         CALL ctl_stop( 'mppobc: bad ktype' )
-      ENDIF
-      
-      ! Communication level by level
-      ! ----------------------------
-!!gm Remark : this is very time consumming!!!
-      !                                         ! ------------------------ !
-      DO jk = 1, kk                             !   Loop over the levels   !
-         !                                      ! ------------------------ !
-         !
-         IF( ktype == 1 ) THEN                               ! north/south boundaries
-            DO jj = ijpt0, ijpt1
-               DO ji = iipt0, iipt1
-                  ztab(ji,jj) = ptab(ji,jk)
-               END DO
-            END DO
-         ELSEIF( ktype == 2 ) THEN                           ! east/west boundaries
-            DO jj = ijpt0, ijpt1
-               DO ji = iipt0, iipt1
-                  ztab(ji,jj) = ptab(jj,jk)
-               END DO
-            END DO
-         ENDIF
-
-
-         ! 1. East and west directions
-         ! ---------------------------
-         !
-         IF( nbondi /= 2 ) THEN         ! Read Dirichlet lateral conditions
-            iihom = nlci-nreci
-            DO jl = 1, jpreci
-               t2ew(:,jl,1) = ztab(jpreci+jl,:)
-               t2we(:,jl,1) = ztab(iihom +jl,:)
-            END DO
-         ENDIF
-         !
-         !                              ! Migrations
-         imigr=jpreci*jpj
-         !
-         IF( nbondi == -1 ) THEN
-            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-            CALL mpprecv( 1, t2ew(1,1,2), imigr )
-            IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err )
-         ELSEIF( nbondi == 0 ) THEN
-            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
-            CALL mpprecv( 1, t2ew(1,1,2), imigr )
-            CALL mpprecv( 2, t2we(1,1,2), imigr )
-            IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err )
-            IF(l_isend)   CALL mpi_wait( ml_req2, ml_stat, ml_err )
-         ELSEIF( nbondi == 1 ) THEN
-            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
-            CALL mpprecv( 2, t2we(1,1,2), imigr )
-            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
-         ENDIF
-         !
-         !                              ! Write Dirichlet lateral conditions
-         iihom = nlci-jpreci
-         !
-         IF( nbondi == 0 .OR. nbondi == 1 ) THEN
-            DO jl = 1, jpreci
-               ztab(jl,:) = t2we(:,jl,2)
-            END DO
-         ENDIF
-         IF( nbondi == -1 .OR. nbondi == 0 ) THEN
-            DO jl = 1, jpreci
-               ztab(iihom+jl,:) = t2ew(:,jl,2)
-            END DO
-         ENDIF
-
-
-         ! 2. North and south directions
-         ! -----------------------------
-         !
-         IF( nbondj /= 2 ) THEN         ! Read Dirichlet lateral conditions
-            ijhom = nlcj-nrecj
-            DO jl = 1, jprecj
-               t2sn(:,jl,1) = ztab(:,ijhom +jl)
-               t2ns(:,jl,1) = ztab(:,jprecj+jl)
-            END DO
-         ENDIF
-         !
-         !                              ! Migrations
-         imigr = jprecj * jpi
-         !
-         IF( nbondj == -1 ) THEN
-            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
-            CALL mpprecv( 3, t2ns(1,1,2), imigr )
-            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
-         ELSEIF( nbondj == 0 ) THEN
-            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
-            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
-            CALL mpprecv( 3, t2ns(1,1,2), imigr )
-            CALL mpprecv( 4, t2sn(1,1,2), imigr )
-            IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err )
-            IF( l_isend )   CALL mpi_wait( ml_req2, ml_stat, ml_err )
-         ELSEIF( nbondj == 1 ) THEN
-            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
-            CALL mpprecv( 4, t2sn(1,1,2), imigr)
-            IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err )
-         ENDIF
-         !
-         !                              ! Write Dirichlet lateral conditions
-         ijhom = nlcj - jprecj
-         IF( nbondj == 0 .OR. nbondj == 1 ) THEN
-            DO jl = 1, jprecj
-               ztab(:,jl) = t2sn(:,jl,2)
-            END DO
-         ENDIF
-         IF( nbondj == 0 .OR. nbondj == -1 ) THEN
-            DO jl = 1, jprecj
-               ztab(:,ijhom+jl) = t2ns(:,jl,2)
-            END DO
-         ENDIF
-         IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN
-            DO jj = ijpt0, ijpt1            ! north/south boundaries
-               DO ji = iipt0,ilpt1
-                  ptab(ji,jk) = ztab(ji,jj)  
-               END DO
-            END DO
-         ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN
-            DO jj = ijpt0, ilpt1            ! east/west boundaries
-               DO ji = iipt0,iipt1
-                  ptab(jj,jk) = ztab(ji,jj) 
-               END DO
-            END DO
-         ENDIF
-         !
-      END DO
-      !
-   END SUBROUTINE mppobc
-   
-
-   SUBROUTINE mpp_comm_free( kcom )
-      !!----------------------------------------------------------------------
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kcom
-      !!
-      INTEGER :: ierr
-      !!----------------------------------------------------------------------
-      !
-      CALL MPI_COMM_FREE(kcom, ierr)
-      !
-   END SUBROUTINE mpp_comm_free
-
-
-   SUBROUTINE mpp_ini_ice( pindic )
-      !!----------------------------------------------------------------------
-      !!               ***  routine mpp_ini_ice  ***
-      !!
-      !! ** Purpose :   Initialize special communicator for ice areas
-      !!      condition together with global variables needed in the ddmpp folding
-      !!
-      !! ** Method  : - Look for ice processors in ice routines
-      !!              - Put their number in nrank_ice
-      !!              - Create groups for the world processors and the ice processors
-      !!              - Create a communicator for ice processors
-      !!
-      !! ** output
-      !!      njmppmax = njmpp for northern procs
-      !!      ndim_rank_ice = number of processors with ice
-      !!      nrank_ice (ndim_rank_ice) = ice processors
-      !!      ngrp_world = group ID for the world processors
-      !!      ngrp_ice = group ID for the ice processors
-      !!      ncomm_ice = communicator for the ice procs.
-      !!      n_ice_root = number (in the world) of proc 0 in the ice comm.
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) :: pindic
-      !!
-      INTEGER :: ierr
-      INTEGER :: jjproc
-      INTEGER :: ii
-      INTEGER, DIMENSION(jpnij) :: kice
-      INTEGER, DIMENSION(jpnij) :: zwork
-      !!----------------------------------------------------------------------
-      !
-      ! Look for how many procs with sea-ice
-      !
-      kice = 0
-      DO jjproc = 1, jpnij
-         IF( jjproc == narea .AND. pindic .GT. 0 )   kice(jjproc) = 1    
-      END DO
-      !
-      zwork = 0
-      CALL MPI_ALLREDUCE( kice, zwork, jpnij, mpi_integer, mpi_sum, mpi_comm_opa, ierr )
-      ndim_rank_ice = SUM( zwork )          
-
-      ! Allocate the right size to nrank_north
-#if ! defined key_agrif
-      IF( ALLOCATED ( nrank_ice ) )   DEALLOCATE( nrank_ice )
-#else
-      IF( ASSOCIATED( nrank_ice ) )   DEALLOCATE( nrank_ice )
-#endif
-      ALLOCATE( nrank_ice(ndim_rank_ice) )
-      !
-      ii = 0     
-      nrank_ice = 0
-      DO jjproc = 1, jpnij
-         IF( zwork(jjproc) == 1) THEN
-            ii = ii + 1
-            nrank_ice(ii) = jjproc -1 
-         ENDIF
-      END DO
-
-      ! Create the world group
-      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr )
-
-      ! Create the ice group from the world group
-      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_ice, nrank_ice, ngrp_ice, ierr )
-
-      ! Create the ice communicator , ie the pool of procs with sea-ice
-      CALL MPI_COMM_CREATE( mpi_comm_opa, ngrp_ice, ncomm_ice, ierr )
-
-      ! Find proc number in the world of proc 0 in the north
-      ! The following line seems to be useless, we just comment & keep it as reminder
-      ! CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_ice,1,0,ngrp_world,n_ice_root,ierr)
-      !
-   END SUBROUTINE mpp_ini_ice
-
-
-   SUBROUTINE mpp_ini_znl
-      !!----------------------------------------------------------------------
-      !!               ***  routine mpp_ini_znl  ***
-      !!
-      !! ** Purpose :   Initialize special communicator for computing zonal sum
-      !!
-      !! ** Method  : - Look for processors in the same row
-      !!              - Put their number in nrank_znl
-      !!              - Create group for the znl processors
-      !!              - Create a communicator for znl processors
-      !!              - Determine if processor should write znl files
-      !!
-      !! ** output
-      !!      ndim_rank_znl = number of processors on the same row
-      !!      ngrp_znl = group ID for the znl processors
-      !!      ncomm_znl = communicator for the ice procs.
-      !!      n_znl_root = number (in the world) of proc 0 in the ice comm.
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER :: ierr
-      INTEGER :: jproc
-      INTEGER :: ii
-      INTEGER, DIMENSION(jpnij) :: kwork
-      !
-      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_world     : ', ngrp_world
-      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_world : ', mpi_comm_world
-      !-$$     WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - mpi_comm_opa   : ', mpi_comm_opa
-      !
-      IF ( jpnj == 1 ) THEN
-         ngrp_znl  = ngrp_world
-         ncomm_znl = mpi_comm_opa
-      ELSE
-         !
-         CALL MPI_ALLGATHER ( njmpp, 1, mpi_integer, kwork, 1, mpi_integer, mpi_comm_opa, ierr )
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - kwork pour njmpp : ', kwork
-         !-$$        CALL flush(numout)
-         !
-         ! Count number of processors on the same row
-         ndim_rank_znl = 0
-         DO jproc=1,jpnij
-            IF ( kwork(jproc) == njmpp ) THEN
-               ndim_rank_znl = ndim_rank_znl + 1
-            ENDIF
-         END DO
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ndim_rank_znl : ', ndim_rank_znl
-         !-$$        CALL flush(numout)
-         ! Allocate the right size to nrank_znl
-#if ! defined key_agrif
-         IF (ALLOCATED (nrank_znl)) DEALLOCATE(nrank_znl)
-#else
-         IF (ASSOCIATED(nrank_znl)) DEALLOCATE(nrank_znl)
-#endif
-         ALLOCATE(nrank_znl(ndim_rank_znl))
-         ii = 0     
-         nrank_znl (:) = 0
-         DO jproc=1,jpnij
-            IF ( kwork(jproc) == njmpp) THEN
-               ii = ii + 1
-               nrank_znl(ii) = jproc -1 
-            ENDIF
-         END DO
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - nrank_znl : ', nrank_znl
-         !-$$        CALL flush(numout)
-
-         ! Create the opa group
-         CALL MPI_COMM_GROUP(mpi_comm_opa,ngrp_opa,ierr)
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_opa : ', ngrp_opa
-         !-$$        CALL flush(numout)
-
-         ! Create the znl group from the opa group
-         CALL MPI_GROUP_INCL  ( ngrp_opa, ndim_rank_znl, nrank_znl, ngrp_znl, ierr )
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ngrp_znl ', ngrp_znl
-         !-$$        CALL flush(numout)
-
-         ! Create the znl communicator from the opa communicator, ie the pool of procs in the same row
-         CALL MPI_COMM_CREATE ( mpi_comm_opa, ngrp_znl, ncomm_znl, ierr )
-         !-$$        WRITE (numout,*) 'mpp_ini_znl ', nproc, ' - ncomm_znl ', ncomm_znl
-         !-$$        CALL flush(numout)
-         !
-      END IF
-
-      ! Determines if processor if the first (starting from i=1) on the row
-      IF ( jpni == 1 ) THEN 
-         l_znl_root = .TRUE.
-      ELSE
-         l_znl_root = .FALSE.
-         kwork (1) = nimpp
-         CALL mpp_min ( kwork(1), kcom = ncomm_znl)
-         IF ( nimpp == kwork(1)) l_znl_root = .TRUE.
-      END IF
-
-   END SUBROUTINE mpp_ini_znl
-
-
-   SUBROUTINE mpp_ini_north
-      !!----------------------------------------------------------------------
-      !!               ***  routine mpp_ini_north  ***
-      !!
-      !! ** Purpose :   Initialize special communicator for north folding 
-      !!      condition together with global variables needed in the mpp folding
-      !!
-      !! ** Method  : - Look for northern processors
-      !!              - Put their number in nrank_north
-      !!              - Create groups for the world processors and the north processors
-      !!              - Create a communicator for northern processors
-      !!
-      !! ** output
-      !!      njmppmax = njmpp for northern procs
-      !!      ndim_rank_north = number of processors in the northern line
-      !!      nrank_north (ndim_rank_north) = number  of the northern procs.
-      !!      ngrp_world = group ID for the world processors
-      !!      ngrp_north = group ID for the northern processors
-      !!      ncomm_north = communicator for the northern procs.
-      !!      north_root = number (in the world) of proc 0 in the northern comm.
-      !!
-      !!----------------------------------------------------------------------
-      INTEGER ::   ierr
-      INTEGER ::   jjproc
-      INTEGER ::   ii, ji
-      !!----------------------------------------------------------------------
-      !
-      njmppmax = MAXVAL( njmppt )
-      !
-      ! Look for how many procs on the northern boundary
-      ndim_rank_north = 0
-      DO jjproc = 1, jpnij
-         IF( njmppt(jjproc) == njmppmax )   ndim_rank_north = ndim_rank_north + 1
-      END DO
-      !
-      ! Allocate the right size to nrank_north
-#if ! defined key_agrif
-      IF (ALLOCATED (nrank_north)) DEALLOCATE(nrank_north)
-#else
-      IF (ASSOCIATED(nrank_north)) DEALLOCATE(nrank_north)
-#endif
-      ALLOCATE( nrank_north(ndim_rank_north) )
-
-      ! Fill the nrank_north array with proc. number of northern procs.
-      ! Note : the rank start at 0 in MPI
-      ii = 0
-      DO ji = 1, jpnij
-         IF ( njmppt(ji) == njmppmax   ) THEN
-            ii=ii+1
-            nrank_north(ii)=ji-1
-         END IF
-      END DO
-      !
-      ! create the world group
-      CALL MPI_COMM_GROUP( mpi_comm_opa, ngrp_world, ierr )
-      !
-      ! Create the North group from the world group
-      CALL MPI_GROUP_INCL( ngrp_world, ndim_rank_north, nrank_north, ngrp_north, ierr )
-      !
-      ! Create the North communicator , ie the pool of procs in the north group
-      CALL MPI_COMM_CREATE( mpi_comm_opa, ngrp_north, ncomm_north, ierr )
-      !
-   END SUBROUTINE mpp_ini_north
-
-
-   SUBROUTINE mpp_lbc_north_3d( pt3d, cd_type, psgn )
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_3d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
-      !!              in mpp configuration in case of jpn1 > 1
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather 
-      !!              the 4 northern lines of the global domain on 1 processor
-      !!              and apply lbc north-fold on this sub array. Then we
-      !!              scatter the north fold array back to the processors.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the b.c. is applied
-      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      !                                                              !   = T ,  U , V , F or W  gridpoints
-      REAL(wp)                        , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ijpjm1, ij, iproc
-      REAL(wp), DIMENSION(jpiglo,4,jpk)      ::   ztab
-      REAL(wp), DIMENSION(jpi   ,4,jpk)      ::   znorthloc
-      REAL(wp), DIMENSION(jpi   ,4,jpk,jpni) ::   znorthgloio
-      !!----------------------------------------------------------------------
-      !   
-      ijpj   = 4
-      ijpjm1 = 3
-      !
-      DO jj = nlcj - ijpj +1, nlcj          ! put in znorthloc the last 4 jlines of pt3d
-         ij = jj - nlcj + ijpj
-         znorthloc(:,ij,:) = pt3d(:,jj,:)
-      END DO
-      !
-      !                                     ! Build in procs of ncomm_north the znorthgloio
-      itaille = jpi * jpk * ijpj
-      CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
-         &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-      !
-      !                                     ! recover the global north array
-      DO jr = 1, ndim_rank_north
-         iproc = nrank_north(jr) + 1
-         ildi  = nldit (iproc)
-         ilei  = nleit (iproc)
-         iilb  = nimppt(iproc)
-         DO jj = 1, 4
-            DO ji = ildi, ilei
-               ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr)
-            END DO
-         END DO
-      END DO
-      !
-      CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
-      !
-      DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
-         ij = jj - nlcj + ijpj
-         DO ji= 1, nlci
-            pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:)
-         END DO
-      END DO
-      !
-   END SUBROUTINE mpp_lbc_north_3d
-
-
-   SUBROUTINE mpp_lbc_north_2d( pt2d, cd_type, psgn)
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_2d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
-      !!              in mpp configuration in case of jpn1 > 1 (for 2d array )
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather 
-      !!              the 4 northern lines of the global domain on 1 processor
-      !!              and apply lbc north-fold on this sub array. Then we
-      !!              scatter the north fold array back to the processors.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the b.c. is applied
-      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
-      !                                                          !   = T ,  U , V , F or W  gridpoints
-      REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
-      !!                                                             ! =  1. , the sign is kept
-      INTEGER ::   ji, jj, jr
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ijpjm1, ij, iproc
-      REAL(wp), DIMENSION(jpiglo,4)      ::   ztab
-      REAL(wp), DIMENSION(jpi   ,4)      ::   znorthloc
-      REAL(wp), DIMENSION(jpi   ,4,jpni) ::   znorthgloio
-      !!----------------------------------------------------------------------
-      !
-      ijpj   = 4
-      ijpjm1 = 3
-      !
-      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d
-         ij = jj - nlcj + ijpj
-         znorthloc(:,ij) = pt2d(:,jj)
-      END DO
-
-      !                                     ! Build in procs of ncomm_north the znorthgloio
-      itaille = jpi * ijpj
-      CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,        &
-         &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-      !
-      DO jr = 1, ndim_rank_north            ! recover the global north array
-         iproc = nrank_north(jr) + 1
-         ildi=nldit (iproc)
-         ilei=nleit (iproc)
-         iilb=nimppt(iproc)
-         DO jj = 1, 4
-            DO ji = ildi, ilei
-               ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
-            END DO
-         END DO
-      END DO
-      !
-      CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
-      !
-      !
-      DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt2d
-         ij = jj - nlcj + ijpj
-         DO ji = 1, nlci
-            pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
-         END DO
-      END DO
-      !
-   END SUBROUTINE mpp_lbc_north_2d
-
-
-   SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn)
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_lbc_north_2d  ***
-      !!
-      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
-      !!              in mpp configuration in case of jpn1 > 1 and for 2d 
-      !!              array with outer extra halo
-      !!
-      !! ** Method  :   North fold condition and mpp with more than one proc
-      !!              in i-direction require a specific treatment. We gather 
-      !!              the 4+2*jpr2dj northern lines of the global domain on 1 
-      !!              processor and apply lbc north-fold on this sub array. 
-      !!              Then we scatter the north fold array back to the processors.
-      !!
-      !!----------------------------------------------------------------------
-      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
-      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points
-      !                                                                                         !   = T ,  U , V , F or W -points
-      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! = -1. the sign change across the  
-      !!                                                                                        ! north fold, =  1. otherwise
-      INTEGER ::   ji, jj, jr
-      INTEGER ::   ierr, itaille, ildi, ilei, iilb
-      INTEGER ::   ijpj, ij, iproc
-      REAL(wp), DIMENSION(jpiglo,4+2*jpr2dj)      ::   ztab
-      REAL(wp), DIMENSION(jpi   ,4+2*jpr2dj)      ::   znorthloc
-      REAL(wp), DIMENSION(jpi   ,4+2*jpr2dj,jpni) ::   znorthgloio
-      !!----------------------------------------------------------------------
-      !
-      ijpj=4
-
-      ij=0
-      ! put in znorthloc the last 4 jlines of pt2d
-      DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
-         ij = ij + 1
-         DO ji = 1, jpi
-            znorthloc(ji,ij)=pt2d(ji,jj)
-         END DO
-      END DO
-      !
-      itaille = jpi * ( ijpj + 2 * jpr2dj )
-      CALL MPI_ALLGATHER( znorthloc(1,1)    , itaille, MPI_DOUBLE_PRECISION,    &
-         &                znorthgloio(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
-      !
-      DO jr = 1, ndim_rank_north            ! recover the global north array
-         iproc = nrank_north(jr) + 1
-         ildi = nldit (iproc)
-         ilei = nleit (iproc)
-         iilb = nimppt(iproc)
-         DO jj = 1, ijpj+2*jpr2dj
-            DO ji = ildi, ilei
-               ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
-            END DO
-         END DO
-      END DO
-
-
-      ! 2. North-Fold boundary conditions
-      ! ----------------------------------
-      CALL lbc_nfd( ztab(:,:), cd_type, psgn, pr2dj = jpr2dj )
-
-      ij = jpr2dj
-      !! Scatter back to pt2d
-      DO jj = nlcj - ijpj + 1 , nlcj +jpr2dj
-      ij  = ij +1 
-         DO ji= 1, nlci
-            pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
-         END DO
-      END DO
-      !
-   END SUBROUTINE mpp_lbc_north_e
-
-
-   SUBROUTINE mpi_init_opa( code )
-      !!---------------------------------------------------------------------
-      !!                   ***  routine mpp_init.opa  ***
-      !!
-      !! ** Purpose :: export and attach a MPI buffer for bsend
-      !!
-      !! ** Method  :: define buffer size in namelist, if 0 no buffer attachment
-      !!            but classical mpi_init
-      !! 
-      !! History :: 01/11 :: IDRIS initial version for IBM only  
-      !!            08/04 :: R. Benshila, generalisation
-      !!---------------------------------------------------------------------
-      INTEGER                                 :: code, ierr
-      LOGICAL                                 :: mpi_was_called
-      !!---------------------------------------------------------------------
-      !
-      CALL mpi_initialized( mpi_was_called, code )      ! MPI initialization
-      IF ( code /= MPI_SUCCESS ) THEN
-         CALL ctl_stop( ' lib_mpp: Error in routine mpi_initialized' )
-         CALL mpi_abort( mpi_comm_world, code, ierr )
-      ENDIF
-      !
-      IF( .NOT. mpi_was_called ) THEN
-         CALL mpi_init( code )
-         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code )
-         IF ( code /= MPI_SUCCESS ) THEN
-            CALL ctl_stop( ' lib_mpp: Error in routine mpi_comm_dup' )
-            CALL mpi_abort( mpi_comm_world, code, ierr )
-         ENDIF
-      ENDIF
-      !
-      IF( nn_buffer > 0 ) THEN
-         IF ( lwp ) WRITE(numout,*) 'mpi_bsend, buffer allocation of  : ', nn_buffer
-         ! Buffer allocation and attachment
-         ALLOCATE( tampon(nn_buffer) )
-         CALL mpi_buffer_attach( tampon, nn_buffer,code )
-      ENDIF
-      !
-   END SUBROUTINE mpi_init_opa
-
-#if defined key_mpp_rep
-   SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype)
-      !!---------------------------------------------------------------------
-      !!   Routine DDPDD_MPI: used by reduction operator MPI_SUMDD
-      !!
-      !!   Modification of original codes written by David H. Bailey
-      !!   This subroutine computes yddb(i) = ydda(i)+yddb(i)
-      !!---------------------------------------------------------------------
-      INTEGER, INTENT(in)                         :: ilen, itype
-      COMPLEX(wp), DIMENSION(ilen), INTENT(in)     :: ydda
-      COMPLEX(wp), DIMENSION(ilen), INTENT(inout)  :: yddb
-      !
-      REAL(wp) :: zerr, zt1, zt2    ! local work variables
-      INTEGER :: ji, ztmp           ! local scalar
-
-      ztmp = itype   ! avoid compilation warning
-
-      DO ji=1,ilen
-      ! Compute ydda + yddb using Knuth's trick.
-         zt1  = real(ydda(ji)) + real(yddb(ji))
-         zerr = zt1 - real(ydda(ji))
-         zt2  = ((real(yddb(ji)) - zerr) + (real(ydda(ji)) - (zt1 - zerr))) &
-                + aimag(ydda(ji)) + aimag(yddb(ji))
-
-         ! The result is zt1 + zt2, after normalization.
-         yddb(ji) = cmplx ( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1),wp )
-      END DO
-
-   END SUBROUTINE DDPDD_MPI
-#endif
-
-#else
-   !!----------------------------------------------------------------------
-   !!   Default case:            Dummy module        share memory computing
-   !!----------------------------------------------------------------------
-
-   INTERFACE mpp_sum
-      MODULE PROCEDURE mpp_sum_a2s, mpp_sum_as, mpp_sum_ai, mpp_sum_s, mpp_sum_i,  &
-             &         mpp_sum_c, mpp_sum_ac 
-   END INTERFACE
-   INTERFACE mpp_max
-      MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real
-   END INTERFACE
-   INTERFACE mpp_min
-      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
-   END INTERFACE
-   INTERFACE mppobc
-      MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d
-   END INTERFACE
-   INTERFACE mpp_minloc
-      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
-   END INTERFACE
-   INTERFACE mpp_maxloc
-      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
-   END INTERFACE
-
-   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
-   INTEGER :: ncomm_ice
-
-CONTAINS
-
-   FUNCTION mynode( ldtxt, localComm ) RESULT (function_value)
-      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
-      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
-      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0
-      IF( .FALSE. )   ldtxt(:) = 'never done'
-   END FUNCTION mynode
-
-   SUBROUTINE mppsync                       ! Dummy routine
-   END SUBROUTINE mppsync
-
-   SUBROUTINE mpp_sum_as( parr, kdim, kcom )      ! Dummy routine
-      REAL   , DIMENSION(:) :: parr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1), kcom
-   END SUBROUTINE mpp_sum_as
-
-   SUBROUTINE mpp_sum_a2s( parr, kdim, kcom )      ! Dummy routine
-      REAL   , DIMENSION(:,:) :: parr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1), kcom
-   END SUBROUTINE mpp_sum_a2s
-
-   SUBROUTINE mpp_sum_ai( karr, kdim, kcom )      ! Dummy routine
-      INTEGER, DIMENSION(:) :: karr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1), kcom
-   END SUBROUTINE mpp_sum_ai
-
-   SUBROUTINE mpp_sum_ac( yarr, kdim, kcom )      ! Dummy routine
-      COMPLEX, DIMENSION(:) :: yarr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_ac: You should not have seen this print! error?', kdim, yarr(1), kcom
-   END SUBROUTINE mpp_sum_ac
-
-   SUBROUTINE mpp_sum_s( psca, kcom )            ! Dummy routine
-      REAL                  :: psca
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca, kcom
-   END SUBROUTINE mpp_sum_s
- 
-   SUBROUTINE mpp_sum_i( kint, kcom )            ! Dummy routine
-      integer               :: kint
-      INTEGER, OPTIONAL     :: kcom
-      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint, kcom
-   END SUBROUTINE mpp_sum_i
-
-   SUBROUTINE mpp_sum_c( ysca, kcom )            ! Dummy routine
-      COMPLEX               :: ysca
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mpp_sum_c: You should not have seen this print! error?', ysca, kcom
-   END SUBROUTINE mpp_sum_c
-
-   SUBROUTINE mppmax_a_real( parr, kdim, kcom )
-      REAL   , DIMENSION(:) :: parr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmax_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
-   END SUBROUTINE mppmax_a_real
-
-   SUBROUTINE mppmax_real( psca, kcom )
-      REAL                  :: psca
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmax_real: You should not have seen this print! error?', psca, kcom
-   END SUBROUTINE mppmax_real
-
-   SUBROUTINE mppmin_a_real( parr, kdim, kcom )
-      REAL   , DIMENSION(:) :: parr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmin_a_real: You should not have seen this print! error?', kdim, parr(1), kcom
-   END SUBROUTINE mppmin_a_real
-
-   SUBROUTINE mppmin_real( psca, kcom )
-      REAL                  :: psca
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmin_real: You should not have seen this print! error?', psca, kcom
-   END SUBROUTINE mppmin_real
-
-   SUBROUTINE mppmax_a_int( karr, kdim ,kcom)
-      INTEGER, DIMENSION(:) :: karr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmax_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
-   END SUBROUTINE mppmax_a_int
-
-   SUBROUTINE mppmax_int( kint, kcom)
-      INTEGER               :: kint
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmax_int: You should not have seen this print! error?', kint, kcom
-   END SUBROUTINE mppmax_int
-
-   SUBROUTINE mppmin_a_int( karr, kdim, kcom )
-      INTEGER, DIMENSION(:) :: karr
-      INTEGER               :: kdim
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmin_a_int: You should not have seen this print! error?', kdim, karr(1), kcom
-   END SUBROUTINE mppmin_a_int
-
-   SUBROUTINE mppmin_int( kint, kcom )
-      INTEGER               :: kint
-      INTEGER, OPTIONAL     :: kcom 
-      WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom
-   END SUBROUTINE mppmin_int
-
-   SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij )
-      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
-      REAL, DIMENSION(:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij
-   END SUBROUTINE mppobc_1d
-
-   SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij )
-      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
-      REAL, DIMENSION(:,:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij
-   END SUBROUTINE mppobc_2d
-
-   SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij )
-      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
-      REAL, DIMENSION(:,:,:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij
-   END SUBROUTINE mppobc_3d
-
-   SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij )
-      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij
-      REAL, DIMENSION(:,:,:,:) ::   parr           ! variable array
-      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij
-   END SUBROUTINE mppobc_4d
-
-   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj )
-      REAL                   :: pmin
-      REAL , DIMENSION (:,:) :: ptab, pmask
-      INTEGER :: ki, kj
-      WRITE(*,*) 'mpp_minloc2d: You should not have seen this print! error?', pmin, ki, kj, ptab(1,1), pmask(1,1)
-   END SUBROUTINE mpp_minloc2d
-
-   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj, kk )
-      REAL                     :: pmin
-      REAL , DIMENSION (:,:,:) :: ptab, pmask
-      INTEGER :: ki, kj, kk
-      WRITE(*,*) 'mpp_minloc3d: You should not have seen this print! error?', pmin, ki, kj, kk, ptab(1,1,1), pmask(1,1,1)
-   END SUBROUTINE mpp_minloc3d
-
-   SUBROUTINE mpp_maxloc2d( ptab, pmask, pmax, ki, kj )
-      REAL                   :: pmax
-      REAL , DIMENSION (:,:) :: ptab, pmask
-      INTEGER :: ki, kj
-      WRITE(*,*) 'mpp_maxloc2d: You should not have seen this print! error?', pmax, ki, kj, ptab(1,1), pmask(1,1)
-   END SUBROUTINE mpp_maxloc2d
-
-   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
-      REAL                     :: pmax
-      REAL , DIMENSION (:,:,:) :: ptab, pmask
-      INTEGER :: ki, kj, kk
-      WRITE(*,*) 'mpp_maxloc3d: You should not have seen this print! error?', pmax, ki, kj, kk, ptab(1,1,1), pmask(1,1,1)
-   END SUBROUTINE mpp_maxloc3d
-
-   SUBROUTINE mppstop
-      WRITE(*,*) 'mppstop: You should not have seen this print! error?'
-   END SUBROUTINE mppstop
-
-   SUBROUTINE mpp_ini_ice( kcom )
-      INTEGER :: kcom
-      WRITE(*,*) 'mpp_ini_ice: You should not have seen this print! error?', kcom
-   END SUBROUTINE mpp_ini_ice
-
-   SUBROUTINE mpp_ini_znl
-      WRITE(*,*) 'mpp_ini_znl: You should not have seen this print! error?'
-   END SUBROUTINE mpp_ini_znl
-
-   SUBROUTINE mpp_comm_free( kcom )
-      INTEGER :: kcom
-      WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom
-   END SUBROUTINE mpp_comm_free
-#endif
-   !!----------------------------------------------------------------------
-END MODULE lib_mpp
Index: anches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/mppini.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/mppini.F90	(revision 2441)
+++ 	(revision )
@@ -1,493 +1,0 @@
-MODULE mppini
-   !!==============================================================================
-   !!                       ***  MODULE mppini   ***
-   !! Ocean initialization : distributed memory computing initialization
-   !!==============================================================================
-
-   !!----------------------------------------------------------------------
-   !!   mpp_init       : Lay out the global domain over processors
-   !!   mpp_init2      : Lay out the global domain over processors 
-   !!                    with land processor elimination
-   !!   mpp_init_ioispl: IOIPSL initialization in mpp
-   !!----------------------------------------------------------------------
-   !! * Modules used
-   USE dom_oce         ! ocean space and time domain 
-   USE in_out_manager  ! I/O Manager
-   USE lib_mpp         ! distribued memory computing library
-   USE ioipsl
-
-   IMPLICIT NONE
-   PRIVATE
-
-   !! * Routine accessibility
-   PUBLIC mpp_init       ! called by opa.F90
-   PUBLIC mpp_init2      ! called by opa.F90
-
-   !! * Substitutions
-#  include "domzgr_substitute.h90"
-   !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
-CONTAINS
-
-#if ! defined key_mpp_mpi
-   !!----------------------------------------------------------------------
-   !!   Default option :                            shared memory computing
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE mpp_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init  ***
-      !!
-      !! ** Purpose :   Lay out the global domain over processors.
-      !!
-      !! ** Method  :   Shared memory computing, set the local processor
-      !!      variables to the value of the global domain
-      !!
-      !! History :
-      !!   9.0  !  04-01  (G. Madec, J.M. Molines)  F90 : free form, north fold jpni >1
-      !!----------------------------------------------------------------------
-
-      ! No mpp computation
-      nimpp  = 1
-      njmpp  = 1
-      nlci   = jpi
-      nlcj   = jpj
-      nldi   = 1
-      nldj   = 1
-      nlei   = jpi
-      nlej   = jpj
-      nperio = jperio
-      nbondi = 2
-      nbondj = 2
-      nidom  = FLIO_DOM_NONE
-      npolj = jperio
-
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing'
-         WRITE(numout,*) '~~~~~~~~~~~: '
-         WRITE(numout,*) '         nperio = ', nperio
-         WRITE(numout,*) '         npolj  = ', npolj
-         WRITE(numout,*) '         nimpp  = ', nimpp
-         WRITE(numout,*) '         njmpp  = ', njmpp
-      ENDIF
-
-      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) &
-          CALL ctl_stop( 'equality  jpni = jpnj = jpnij = 1 is not satisfied',   &
-          &              'the domain is lay out for distributed memory computing! ' )
-
-   END SUBROUTINE mpp_init
-
-
-   SUBROUTINE mpp_init2 
-      CALL mpp_init                             ! same routine as mpp_init
-   END SUBROUTINE mpp_init2
-
-#else
-   !!----------------------------------------------------------------------
-   !!   'key_mpp_mpi'          OR         MPI massively parallel processing
-   !!----------------------------------------------------------------------
-
-   SUBROUTINE mpp_init
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init  ***
-      !!                    
-      !! ** Purpose :   Lay out the global domain over processors.
-      !!
-      !! ** Method  :   Global domain is distributed in smaller local domains.
-      !!      Periodic condition is a function of the local domain position
-      !!      (global boundary or neighbouring domain) and of the global
-      !!      periodic
-      !!      Type :         jperio global periodic condition
-      !!                     nperio local  periodic condition
-      !!
-      !! ** Action  : - set domain parameters
-      !!                    nimpp     : longitudinal index 
-      !!                    njmpp     : latitudinal  index
-      !!                    nperio    : lateral condition type 
-      !!                    narea     : number for local area
-      !!                    nlci      : first dimension
-      !!                    nlcj      : second dimension
-      !!                    nbondi    : mark for "east-west local boundary"
-      !!                    nbondj    : mark for "north-south local boundary"
-      !!                    nproc     : number for local processor
-      !!                    noea      : number for local neighboring processor
-      !!                    nowe      : number for local neighboring processor
-      !!                    noso      : number for local neighboring processor
-      !!                    nono      : number for local neighboring processor
-      !!
-      !! History :
-      !!        !  94-11  (M. Guyon)  Original code
-      !!        !  95-04  (J. Escobar, M. Imbard)
-      !!        !  98-02  (M. Guyon)  FETI method
-      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
-      !!   8.5  !  02-08  (G. Madec)  F90 : free form
-      !!----------------------------------------------------------------------
-      !! * Local variables
-      INTEGER ::   ji, jj, jn               ! dummy loop indices
-      INTEGER ::   &
-         ii, ij, ifreq, il1, il2,        &  ! temporary integers
-         iresti, irestj, ijm1, imil,     &  !    "          "
-         inum                               ! temporary logical unit
-
-      INTEGER, DIMENSION(jpni,jpnj) ::   &
-         iimppt, ijmppt, ilcit, ilcjt       ! temporary workspace
-      REAL(wp) ::   zidom, zjdom            ! temporary scalars
-      !!----------------------------------------------------------------------
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'mpp_init : Message Passing MPI'
-      IF(lwp) WRITE(numout,*) '~~~~~~~~'
-
-
-      !  1. Dimension arrays for subdomains
-      ! -----------------------------------
-      !  Computation of local domain sizes ilcit() ilcjt()
-      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
-      !  dimensions divided by the number of processors minus the overlap
-      !  array (cf. par_oce.F90).
-      
-      nreci  = 2 * jpreci
-      nrecj  = 2 * jprecj
-      iresti = MOD( jpiglo - nreci , jpni )
-      irestj = MOD( jpjglo - nrecj , jpnj )
-
-      IF(  iresti == 0 )   iresti = jpni
-      DO jj = 1, jpnj
-         DO ji = 1, iresti
-            ilcit(ji,jj) = jpi
-         END DO
-         DO ji = iresti+1, jpni
-            ilcit(ji,jj) = jpi -1
-         END DO
-      END DO
-      
-      IF( irestj == 0 )   irestj = jpnj
-      DO ji = 1, jpni
-         DO jj = 1, irestj
-            ilcjt(ji,jj) = jpj
-         END DO
-         DO jj = irestj+1, jpnj
-            ilcjt(ji,jj) = jpj -1
-         END DO
-      END DO
-      
-      IF(lwp) THEN
-         WRITE(numout,*)
-         WRITE(numout,*) '           defines mpp subdomains'
-         WRITE(numout,*) '           ----------------------'
-         WRITE(numout,*) '           iresti=',iresti,' irestj=',irestj
-         WRITE(numout,*) '           jpni  =',jpni  ,' jpnj  =',jpnj
-         ifreq = 4
-         il1   = 1
-         DO jn = 1, (jpni-1)/ifreq+1
-            il2 = MIN( jpni, il1+ifreq-1 )
-            WRITE(numout,*)
-            WRITE(numout,9200) ('***',ji = il1,il2-1)
-            DO jj = jpnj, 1, -1
-               WRITE(numout,9203) ('   ',ji = il1,il2-1)
-               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
-               WRITE(numout,9203) ('   ',ji = il1,il2-1)
-               WRITE(numout,9200) ('***',ji = il1,il2-1)
-            END DO
-            WRITE(numout,9201) (ji,ji = il1,il2)
-            il1 = il1+ifreq
-         END DO
- 9200    FORMAT('     ***',20('*************',a3))
- 9203    FORMAT('     *     ',20('         *   ',a3))
- 9201    FORMAT('        ',20('   ',i3,'          '))
- 9202    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
-      ENDIF
-
-      zidom = nreci
-      DO ji = 1, jpni
-         zidom = zidom + ilcit(ji,1) - nreci
-      END DO
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo
-      
-      zjdom = nrecj
-      DO jj = 1, jpnj
-         zjdom = zjdom + ilcjt(1,jj) - nrecj
-      END DO
-      IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo
-      IF(lwp) WRITE(numout,*)
-      
-
-      !  2. Index arrays for subdomains
-      ! -------------------------------
-      
-      iimppt(:,:) = 1
-      ijmppt(:,:) = 1
-      
-      IF( jpni > 1 ) THEN
-         DO jj = 1, jpnj
-            DO ji = 2, jpni
-               iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
-            END DO
-         END DO
-      ENDIF
-
-      IF( jpnj > 1 ) THEN
-         DO jj = 2, jpnj
-            DO ji = 1, jpni
-               ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
-            END DO
-         END DO
-      ENDIF
-      
-      ! 3. Subdomain description
-      ! ------------------------
-
-      DO jn = 1, jpnij
-         ii = 1 + MOD( jn-1, jpni )
-         ij = 1 + (jn-1) / jpni
-         nimppt(jn) = iimppt(ii,ij)
-         njmppt(jn) = ijmppt(ii,ij)
-         nlcit (jn) = ilcit (ii,ij)     
-         nlci       = nlcit (jn)     
-         nlcjt (jn) = ilcjt (ii,ij)     
-         nlcj       = nlcjt (jn)
-         nbondj = -1                                   ! general case
-         IF( jn   >  jpni          )   nbondj = 0      ! first row of processor
-         IF( jn   >  (jpnj-1)*jpni )   nbondj = 1      ! last  row of processor
-         IF( jpnj == 1             )   nbondj = 2      ! one processor only in j-direction
-         ibonjt(jn) = nbondj
-         
-         nbondi = 0                                    ! 
-         IF( MOD( jn, jpni ) == 1 )   nbondi = -1      !
-         IF( MOD( jn, jpni ) == 0 )   nbondi =  1      !
-         IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction
-         ibonit(jn) = nbondi
-         
-         nldi =  1   + jpreci
-         nlei = nlci - jpreci
-         IF( nbondi == -1 .OR. nbondi == 2 )   nldi = 1
-         IF( nbondi ==  1 .OR. nbondi == 2 )   nlei = nlci
-         nldj =  1   + jprecj
-         nlej = nlcj - jprecj
-         IF( nbondj == -1 .OR. nbondj == 2 )   nldj = 1
-         IF( nbondj ==  1 .OR. nbondj == 2 )   nlej = nlcj
-         nldit(jn) = nldi
-         nleit(jn) = nlei
-         nldjt(jn) = nldj
-         nlejt(jn) = nlej
-      END DO
-      
-
-      ! 4. From global to local
-      ! -----------------------
-
-      nperio = 0
-      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
-
-
-      ! 5. Subdomain neighbours
-      ! ----------------------
-
-      nproc = narea - 1
-      noso  = nproc - jpni
-      nowe  = nproc - 1
-      noea  = nproc + 1
-      nono  = nproc + jpni
-      ! great neighbours
-      npnw = nono - 1
-      npne = nono + 1
-      npsw = noso - 1
-      npse = noso + 1
-      nbsw = 1
-      nbnw = 1
-      IF( MOD( nproc, jpni ) == 0 ) THEN
-         nbsw = 0
-         nbnw = 0
-      ENDIF
-      nbse = 1
-      nbne = 1
-      IF( MOD( nproc, jpni ) == jpni-1 ) THEN
-         nbse = 0
-         nbne = 0
-      ENDIF
-      IF(nproc < jpni) THEN
-         nbsw = 0
-         nbse = 0
-      ENDIF
-      IF( nproc >= (jpnj-1)*jpni ) THEN
-         nbnw = 0
-         nbne = 0
-      ENDIF
-      nlcj = nlcjt(narea)  
-      nlci = nlcit(narea)  
-      nldi = nldit(narea)
-      nlei = nleit(narea)
-      nldj = nldjt(narea)
-      nlej = nlejt(narea)
-      nbondi = ibonit(narea)
-      nbondj = ibonjt(narea)
-      nimpp  = nimppt(narea)  
-      njmpp  = njmppt(narea)  
-
-     ! Save processor layout in layout.dat file 
-       IF (lwp) THEN
-        CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
-        WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
-        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
-        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
-
-        DO  jn = 1, jpnij
-         WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
-                                      nldit(jn), nldjt(jn), &
-                                      nleit(jn), nlejt(jn), &
-                                      nimppt(jn), njmppt(jn)
-        END DO
-        CLOSE(inum)   
-      END IF
-
-
-      ! w a r n i n g  narea (zone) /= nproc (processors)!
-
-      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
-         IF( jpni == 1 )THEN
-            nbondi = 2
-            nperio = 1
-         ELSE
-            nbondi = 0
-         ENDIF
-         IF( MOD( narea, jpni ) == 0 ) THEN
-            noea = nproc-(jpni-1)
-            npne = npne-jpni
-            npse = npse-jpni
-         ENDIF
-         IF( MOD( narea, jpni ) == 1 ) THEN
-            nowe = nproc+(jpni-1)
-            npnw = npnw+jpni
-            npsw = npsw+jpni
-         ENDIF
-         nbsw = 1
-         nbnw = 1
-         nbse = 1
-         nbne = 1
-         IF( nproc < jpni ) THEN
-            nbsw = 0
-            nbse = 0
-         ENDIF
-         IF( nproc >= (jpnj-1)*jpni ) THEN
-            nbnw = 0
-            nbne = 0
-         ENDIF
-      ENDIF
-      npolj = 0
-      IF( jperio == 3 .OR. jperio == 4 ) THEN
-         ijm1 = jpni*(jpnj-1)
-         imil = ijm1+(jpni+1)/2
-         IF( narea > ijm1 ) npolj = 3
-         IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
-         IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
-      ENDIF
-      IF( jperio == 5 .OR. jperio == 6 ) THEN
-          ijm1 = jpni*(jpnj-1)
-          imil = ijm1+(jpni+1)/2
-          IF( narea > ijm1) npolj = 5
-          IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
-          IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
-      ENDIF
-
-      ! Periodicity : no corner if nbondi = 2 and nperio != 1
-
-      IF(lwp) THEN
-         WRITE(numout,*) ' nproc  = ', nproc
-         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
-         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
-         WRITE(numout,*) ' nbondi = ', nbondi
-         WRITE(numout,*) ' nbondj = ', nbondj
-         WRITE(numout,*) ' npolj  = ', npolj
-         WRITE(numout,*) ' nperio = ', nperio
-         WRITE(numout,*) ' nlci   = ', nlci
-         WRITE(numout,*) ' nlcj   = ', nlcj
-         WRITE(numout,*) ' nimpp  = ', nimpp
-         WRITE(numout,*) ' njmpp  = ', njmpp
-         WRITE(numout,*) ' nbse   = ', nbse  , ' npse   = ', npse
-         WRITE(numout,*) ' nbsw   = ', nbsw  , ' npsw   = ', npsw
-         WRITE(numout,*) ' nbne   = ', nbne  , ' npne   = ', npne
-         WRITE(numout,*) ' nbnw   = ', nbnw  , ' npnw   = ', npnw
-      ENDIF
-
-      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' )
-
-      ! Prepare mpp north fold
-
-      IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
-         CALL mpp_ini_north
-      END IF
-
-      ! Prepare NetCDF output file (if necessary)
-      CALL mpp_init_ioipsl
-
-   END SUBROUTINE mpp_init
-
-#  include "mppini_2.h90"
-
-# if defined key_dimgout
-   !!----------------------------------------------------------------------
-   !!   'key_dimgout'                  NO use of NetCDF files
-   !!----------------------------------------------------------------------
-   SUBROUTINE mpp_init_ioipsl       ! Dummy routine
-   END SUBROUTINE mpp_init_ioipsl  
-# else
-   SUBROUTINE mpp_init_ioipsl
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init_ioipsl  ***
-      !!
-      !! ** Purpose :   
-      !!
-      !! ** Method  :   
-      !!
-      !! History :
-      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL 
-      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
-      !!----------------------------------------------------------------------
-      !! Local declarations
-
-      INTEGER, DIMENSION(2) ::   &
-         iglo, iloc, iabsf, iabsl, ihals, ihale, idid
-      !!----------------------------------------------------------------------
-
-      ! The domain is split only horizontally along i- or/and j- direction
-      ! So we need at the most only 1D arrays with 2 elements.
-      ! Set idompar values equivalent to the jpdom_local_noextra definition
-      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
-      iglo(1) = jpiglo
-      iglo(2) = jpjglo
-      iloc(1) = nlci
-      iloc(2) = nlcj
-      iabsf(1) = nimppt(narea)
-      iabsf(2) = njmppt(narea)
-      iabsl(:) = iabsf(:) + iloc(:) - 1
-      ihals(1) = nldi - 1
-      ihals(2) = nldj - 1
-      ihale(1) = nlci - nlei
-      ihale(2) = nlcj - nlej
-      idid(1) = 1
-      idid(2) = 2
-
-      IF(lwp) THEN
-          WRITE(numout,*)
-          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
-          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
-          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
-          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
-      ENDIF
-
-      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
-
-   END SUBROUTINE mpp_init_ioipsl  
-
-# endif
-#endif
-
-   !!======================================================================
-END MODULE mppini
Index: anches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/mppini_2.h90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/mppini_2.h90	(revision 2441)
+++ 	(revision )
@@ -1,525 +1,0 @@
-   SUBROUTINE mpp_init2
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE mpp_init2  ***
-      !!
-      !! * Purpose :   Lay out the global domain over processors.
-      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
-      !!     FOR DEFINING BETTER CUTTING OUT.
-      !!       This routine is used with a the bathymetry file.
-      !!       In this version, the land processors are avoided and the adress
-      !!     processor (nproc, narea,noea, ...) are calculated again.
-      !!     The jpnij parameter can be lesser than jpni x jpnj
-      !!     and this jpnij parameter must be calculated before with an
-      !!     algoritmic preprocessing program.
-      !!
-      !! ** Method  :   Global domain is distributed in smaller local domains.
-      !!      Periodic condition is a function of the local domain position
-      !!      (global boundary or neighbouring domain) and of the global
-      !!      periodic
-      !!      Type :         jperio global periodic condition
-      !!                     nperio local  periodic condition
-      !!
-      !! ** Action :        nimpp     : longitudinal index 
-      !!                    njmpp     : latitudinal  index
-      !!                    nperio    : lateral condition type 
-      !!                    narea     : number for local area
-      !!                    nlci      : first dimension
-      !!                    nlcj      : second dimension
-      !!                    nproc     : number for local processor
-      !!                    noea      : number for local neighboring processor
-      !!                    nowe      : number for local neighboring processor
-      !!                    noso      : number for local neighboring processor
-      !!                    nono      : number for local neighboring processor
-      !!
-      !! History :
-      !!        !  94-11  (M. Guyon)  Original code
-      !!        !  95-04  (J. Escobar, M. Imbard)
-      !!        !  98-02  (M. Guyon)  FETI method
-      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
-      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
-      !!----------------------------------------------------------------------
-      USE in_out_manager  ! I/O Manager
-      USE iom
-      !! 
-      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
-      INTEGER ::  inum                        ! temporary logical unit
-      INTEGER ::   &
-         ii, ij, ifreq, il1, il2,          &  ! temporary integers
-         icont, ili, ilj,                  &  !    "          "
-         isurf, ijm1, imil,                &  !    "          "
-         iino, ijno, iiso, ijso,           &  !    "          " 
-         iiea, ijea, iiwe, ijwe,           &  !    "          "
-         iinw, ijnw, iine, ijne,           &  !    "          "
-         iisw, ijsw, iise, ijse,           &  !    "          "
-         iresti, irestj, iproc                !    "          "
-      INTEGER, DIMENSION(jpnij) ::   &
-         iin, ijn          
-      INTEGER, DIMENSION(jpni,jpnj) ::   &
-         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace
-         ipproc, ibondj, ibondi, ipolj ,   &  !    "           "
-         ilei  , ilej  , ildi  , ildj  ,   &  !    "           "
-         ioea  , iowe  , ioso  , iono  ,   &  !    "           "
-         ione  , ionw  , iose  , iosw  ,   &  !    "           "
-         ibne  , ibnw  , ibse  , ibsw         !    "           "
-      INTEGER,  DIMENSION(jpiglo,jpjglo) ::   &
-         imask                                ! temporary global workspace
-      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
-         zdta                   ! temporary data workspace
-      REAL(wp) ::   zidom , zjdom          ! temporary scalars
-
-      ! read namelist for ln_zco
-      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
-
-      !!----------------------------------------------------------------------
-      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
-      !! $Id$
-      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
-      !!----------------------------------------------------------------------
-      
-      REWIND ( numnam )              ! Read Namelist namzgr : vertical coordinate'
-      READ   ( numnam, namzgr )
-
-      IF(lwp)WRITE(numout,*)
-      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
-      IF(lwp)WRITE(numout,*) '~~~~~~~~'
-      IF(lwp)WRITE(numout,*) ' '
-
-      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
-
-      ! 0. initialisation
-      ! -----------------
-
-      ! open the file
-      ! Remember that at this level in the code, mpp is not yet initialized, so
-      ! the file must be open with jpdom_unknown, and kstart amd kcount forced 
-      IF ( ln_zco ) THEN 
-         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
-         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
-      ELSE
-         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
-         CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
-      ENDIF
-      CALL iom_close (inum)
-
-      ! land/sea mask over the global/zoom domain
-
-      imask(:,:)=1
-      WHERE ( zdta(:,:) <= 0. ) imask = 0
-
-      !  1. Dimension arrays for subdomains
-      ! -----------------------------------
-
-      !  Computation of local domain sizes ilci() ilcj()
-      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
-      !  The subdomains are squares leeser than or equal to the global
-      !  dimensions divided by the number of processors minus the overlap
-      !  array.
-
-      nreci=2*jpreci
-      nrecj=2*jprecj
-      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
-      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
-
-      ilci(1:iresti      ,:) = jpi
-      ilci(iresti+1:jpni ,:) = jpi-1
-
-      ilcj(:,      1:irestj) = jpj
-      ilcj(:, irestj+1:jpnj) = jpj-1
-
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
-      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
-
-      zidom = nreci + sum(ilci(:,1) - nreci ) 
-      IF(lwp) WRITE(numout,*)
-      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
-
-      zjdom = nrecj + sum(ilcj(1,:) - nrecj ) 
-      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
-      IF(lwp) WRITE(numout,*)
-
-
-      !  2. Index arrays for subdomains
-      ! -------------------------------
-
-      iimppt(:,:) = 1
-      ijmppt(:,:) = 1
-      ipproc(:,:) = -1
-
-      IF( jpni > 1 )THEN
-         DO jj = 1, jpnj
-            DO ji = 2, jpni
-               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
-            END DO
-         END DO
-      ENDIF
-
-      IF( jpnj > 1 )THEN
-         DO jj = 2, jpnj
-            DO ji = 1, jpni
-               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
-            END DO
-         END DO
-      ENDIF
-
-
-      ! 3. Subdomain description in the Regular Case
-      ! --------------------------------------------
-
-      nperio = 0
-      icont = -1
-      DO jarea = 1, jpni*jpnj
-         ii = 1 + MOD(jarea-1,jpni)
-         ij = 1 +    (jarea-1)/jpni
-         ili = ilci(ii,ij)
-         ilj = ilcj(ii,ij)
-
-         ibondj(ii,ij) = -1
-         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
-         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
-         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
-
-         ibondi(ii,ij) = 0
-         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
-         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
-         IF( jpni            == 1 )   ibondi(ii,ij) =  2
-
-         ! 2.4 Subdomain neighbors
-
-         iproc = jarea - 1
-         ioso(ii,ij) = iproc - jpni
-         iowe(ii,ij) = iproc - 1
-         ioea(ii,ij) = iproc + 1
-         iono(ii,ij) = iproc + jpni
-         ildi(ii,ij) = 1 + jpreci
-         ilei(ii,ij) = ili -jpreci
-         ionw(ii,ij) = iono(ii,ij) - 1
-         ione(ii,ij) = iono(ii,ij) + 1
-         iosw(ii,ij) = ioso(ii,ij) - 1
-         iose(ii,ij) = ioso(ii,ij) + 1
-         ibsw(ii,ij) = 1
-         ibnw(ii,ij) = 1
-         IF( MOD(iproc,jpni) == 0 ) THEN
-            ibsw(ii,ij) = 0
-            ibnw(ii,ij) = 0
-         ENDIF
-         ibse(ii,ij) = 1
-         ibne(ii,ij) = 1
-         IF( MOD(iproc,jpni) == jpni-1 ) THEN
-            ibse(ii,ij) = 0
-            ibne(ii,ij) = 0
-         ENDIF
-         IF( iproc < jpni ) THEN
-            ibsw(ii,ij) = 0
-            ibse(ii,ij) = 0
-         ENDIF
-         IF( iproc >= (jpnj-1)*jpni ) THEN
-            ibnw(ii,ij) = 0
-            ibne(ii,ij) = 0
-         ENDIF
-         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
-         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
-         ildj(ii,ij) =  1  + jprecj
-         ilej(ii,ij) = ilj - jprecj
-         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
-         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
-
-         ! warning ii*ij (zone) /= nproc (processors)!
-
-         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
-            IF( jpni == 1 )THEN
-               ibondi(ii,ij) = 2
-               nperio = 1
-            ELSE
-               ibondi(ii,ij) = 0
-            ENDIF
-            IF( MOD(jarea,jpni) == 0 ) THEN
-               ioea(ii,ij) = iproc - (jpni-1)
-               ione(ii,ij) = ione(ii,ij) - jpni
-               iose(ii,ij) = iose(ii,ij) - jpni
-            ENDIF
-            IF( MOD(jarea,jpni) == 1 ) THEN
-               iowe(ii,ij) = iproc + jpni - 1
-               ionw(ii,ij) = ionw(ii,ij) + jpni
-               iosw(ii,ij) = iosw(ii,ij) + jpni 
-            ENDIF
-            ibsw(ii,ij) = 1
-            ibnw(ii,ij) = 1
-            ibse(ii,ij) = 1
-            ibne(ii,ij) = 1
-            IF( iproc < jpni ) THEN
-               ibsw(ii,ij) = 0
-               ibse(ii,ij) = 0
-            ENDIF
-            IF( iproc >= (jpnj-1)*jpni ) THEN
-               ibnw(ii,ij) = 0
-               ibne(ii,ij) = 0
-            ENDIF
-         ENDIF
-         ipolj(ii,ij) = 0
-         IF( jperio == 3 .OR. jperio == 4 ) THEN
-            ijm1 = jpni*(jpnj-1)
-            imil = ijm1+(jpni+1)/2
-            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
-            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
-            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1
-         ENDIF
-         IF( jperio == 5 .OR. jperio == 6 ) THEN
-            ijm1 = jpni*(jpnj-1)
-            imil = ijm1+(jpni+1)/2
-            IF( jarea > ijm1) ipolj(ii,ij) = 5
-            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
-            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1
-         ENDIF
-
-         isurf = 0
-         DO jj = 1+jprecj, ilj-jprecj
-            DO  ji = 1+jpreci, ili-jpreci
-               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
-            END DO
-         END DO
-         IF(isurf /= 0) THEN
-            icont = icont + 1
-            ipproc(ii,ij) = icont
-            iin(icont+1) = ii
-            ijn(icont+1) = ij
-         ENDIF
-      END DO
-
-      ! Control
-      IF(icont+1 /= jpnij) THEN
-         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
-         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 
-         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
-         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
-      ENDIF
-
-      ! 4. Subdomain print
-      ! ------------------
-
-      IF(lwp) THEN
-         ifreq = 4
-         il1 = 1
-         DO jn = 1,(jpni-1)/ifreq+1
-            il2 = MIN(jpni,il1+ifreq-1)
-            WRITE(numout,*)
-            WRITE(numout,9400) ('***',ji=il1,il2-1)
-            DO jj = jpnj, 1, -1
-               WRITE(numout,9403) ('   ',ji=il1,il2-1)
-               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
-               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
-               WRITE(numout,9403) ('   ',ji=il1,il2-1)
-               WRITE(numout,9400) ('***',ji=il1,il2-1)
-            END DO
-            WRITE(numout,9401) (ji,ji=il1,il2)
-            il1 = il1+ifreq
-         END DO
- 9400     FORMAT('     ***',20('*************',a3))
- 9403     FORMAT('     *     ',20('         *   ',a3))
- 9401     FORMAT('        ',20('   ',i3,'          '))
- 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
- 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
-      ENDIF
-
-
-      ! 5. neighbour treatment
-      ! ----------------------
-
-      DO jarea = 1, jpni*jpnj
-         iproc = jarea-1
-         ii = 1 + MOD(jarea-1,jpni)
-         ij = 1 +    (jarea-1)/jpni
-         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
-            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
-            iino = 1 + MOD(iono(ii,ij),jpni)
-            ijno = 1 +    (iono(ii,ij))/jpni
-            IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2
-            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
-            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
-            iiso = 1 + MOD(ioso(ii,ij),jpni)
-            ijso = 1 +    (ioso(ii,ij))/jpni
-            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
-            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
-            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
-            iiea = 1 + MOD(ioea(ii,ij),jpni)
-            ijea = 1 +    (ioea(ii,ij))/jpni
-            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
-            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
-            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
-            iiwe = 1 + MOD(iowe(ii,ij),jpni)
-            ijwe = 1 +    (iowe(ii,ij))/jpni
-            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
-            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
-            iine = 1 + MOD(ione(ii,ij),jpni)
-            ijne = 1 +    (ione(ii,ij))/jpni
-            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
-            iisw = 1 + MOD(iosw(ii,ij),jpni)
-            ijsw = 1 +    (iosw(ii,ij))/jpni
-            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
-            iinw = 1 + MOD(ionw(ii,ij),jpni)
-            ijnw = 1 +    (ionw(ii,ij))/jpni
-            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
-         ENDIF
-         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
-            iise = 1 + MOD(iose(ii,ij),jpni)
-            ijse = 1 +    (iose(ii,ij))/jpni
-            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
-         ENDIF
-      END DO
-
-
-      ! 6. Change processor name
-      ! ------------------------
-
-      nproc = narea-1
-      ii = iin(narea)
-      ij = ijn(narea)
-      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiso = 1 + MOD(ioso(ii,ij),jpni)
-         ijso = 1 +    (ioso(ii,ij))/jpni
-         noso = ipproc(iiso,ijso)
-      ENDIF
-      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiwe = 1 + MOD(iowe(ii,ij),jpni)
-         ijwe = 1 +    (iowe(ii,ij))/jpni
-         nowe = ipproc(iiwe,ijwe)
-      ENDIF
-      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iiea = 1 + MOD(ioea(ii,ij),jpni)
-         ijea = 1 +    (ioea(ii,ij))/jpni
-         noea = ipproc(iiea,ijea)
-      ENDIF
-      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iino = 1 + MOD(iono(ii,ij),jpni)
-         ijno = 1 +    (iono(ii,ij))/jpni
-         nono = ipproc(iino,ijno)
-      ENDIF
-      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iise = 1 + MOD(iose(ii,ij),jpni)
-         ijse = 1 +    (iose(ii,ij))/jpni
-         npse = ipproc(iise,ijse)
-      ENDIF
-      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iisw = 1 + MOD(iosw(ii,ij),jpni)
-         ijsw = 1 +    (iosw(ii,ij))/jpni
-         npsw = ipproc(iisw,ijsw)
-      ENDIF
-      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iine = 1 + MOD(ione(ii,ij),jpni)
-         ijne = 1 +    (ione(ii,ij))/jpni
-         npne = ipproc(iine,ijne)
-      ENDIF
-      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN 
-         iinw = 1 + MOD(ionw(ii,ij),jpni)
-         ijnw = 1 +    (ionw(ii,ij))/jpni
-         npnw = ipproc(iinw,ijnw)
-      ENDIF
-      nbnw = ibnw(ii,ij)
-      nbne = ibne(ii,ij)
-      nbsw = ibsw(ii,ij)
-      nbse = ibse(ii,ij)
-      nlcj = ilcj(ii,ij)  
-      nlci = ilci(ii,ij)  
-      nldi = ildi(ii,ij)
-      nlei = ilei(ii,ij)
-      nldj = ildj(ii,ij)
-      nlej = ilej(ii,ij)
-      nbondi = ibondi(ii,ij)
-      nbondj = ibondj(ii,ij)
-      nimpp = iimppt(ii,ij)  
-      njmpp = ijmppt(ii,ij)  
-      DO jproc = 1, jpnij
-         ii = iin(jproc)
-         ij = ijn(jproc)
-         nimppt(jproc) = iimppt(ii,ij)  
-         njmppt(jproc) = ijmppt(ii,ij)  
-         nlcjt(jproc) = ilcj(ii,ij)
-         nlcit(jproc) = ilci(ii,ij)
-         nldit(jproc) = ildi(ii,ij)
-         nleit(jproc) = ilei(ii,ij)
-         nldjt(jproc) = ildj(ii,ij)
-         nlejt(jproc) = ilej(ii,ij)
-      END DO
-
-      ! Save processor layout in ascii file
-      IF (lwp) THEN
-         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
-         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
-         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
-
-        DO  jproc = 1, jpnij
-         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
-                                      nldit(jproc), nldjt(jproc), &
-                                      nleit(jproc), nlejt(jproc), &
-                                      nimppt(jproc), njmppt(jproc)
-        END DO
-        CLOSE(inum)   
-      END IF
-
-      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' )
-
-      ! Prepare mpp north fold
-
-      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
-         CALL mpp_ini_north
-         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
-      ENDIF
-
-      ! Defined npolj, either 0, 3 , 4 , 5 , 6
-      ! In this case the important thing is that npolj /= 0
-      ! Because if we go through these line it is because jpni >1 and thus
-      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
-
-      npolj = 0
-      ij = ijn(narea)
-
-      IF( jperio == 3 .OR. jperio == 4 ) THEN
-         IF( ij == jpnj ) npolj = 3
-      ENDIF
-
-      IF( jperio == 5 .OR. jperio == 6 ) THEN
-         IF( ij == jpnj ) npolj = 5
-      ENDIF
-
-      ! Prepare NetCDF output file (if necessary)
-      CALL mpp_init_ioipsl
-
-      ! Periodicity : no corner if nbondi = 2 and nperio != 1
-
-      IF(lwp) THEN
-         WRITE(numout,*) ' nproc=  ',nproc
-         WRITE(numout,*) ' nowe=   ',nowe
-         WRITE(numout,*) ' noea=   ',noea
-         WRITE(numout,*) ' nono=   ',nono
-         WRITE(numout,*) ' noso=   ',noso
-         WRITE(numout,*) ' nbondi= ',nbondi
-         WRITE(numout,*) ' nbondj= ',nbondj
-         WRITE(numout,*) ' npolj=  ',npolj
-         WRITE(numout,*) ' nperio= ',nperio
-         WRITE(numout,*) ' nlci=   ',nlci
-         WRITE(numout,*) ' nlcj=   ',nlcj
-         WRITE(numout,*) ' nimpp=  ',nimpp
-         WRITE(numout,*) ' njmpp=  ',njmpp
-         WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse
-         WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw
-         WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne
-         WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw
-      ENDIF
-
-   END SUBROUTINE mpp_init2
Index: /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/opa.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/opa.F90	(revision 2441)
+++ /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/opa.F90	(revision 2442)
@@ -1,7 +1,7 @@
 MODULE opa
-   !!==============================================================================
+   !!======================================================================
    !!                       ***  MODULE opa   ***
    !! Ocean system   : OPA ocean dynamics (including on-line tracers and sea-ice)
-   !!==============================================================================
+   !!======================================================================
    !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code
    !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec)
@@ -179,7 +179,7 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER :: ilocal_comm
-      CHARACTER(len=80),dimension(10) ::   cltxt = ''
-      INTEGER                         ::   ji   ! local loop indices
+      INTEGER ::   ji            ! dummy loop indices
+      INTEGER :: ilocal_comm   ! local integer
+      CHARACTER(len=80), DIMENSION(10) ::   cltxt = ''
       !!
       NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
@@ -198,7 +198,7 @@
       IF( Agrif_Root() ) THEN
 # if defined key_oasis3 || defined key_oasis4
-         CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis
+         CALL cpl_prism_init( ilocal_comm )   ! nemo local communicator given by oasis
 # endif
-         CALL  init_ioclient( ilocal_comm )      ! exchange io_server nemo local communicator with the io_server
+         CALL  init_ioclient( ilocal_comm )   ! exchange io_server nemo local communicator with the io_server
       ENDIF
       narea = mynode( cltxt, ilocal_comm )    ! Nodes selection
@@ -206,5 +206,5 @@
 # if defined key_oasis3 || defined key_oasis4
       IF( Agrif_Root() ) THEN
-         CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis
+         CALL cpl_prism_init( ilocal_comm )   ! nemo local communicator given by oasis
       ENDIF
       narea = mynode( cltxt, ilocal_comm )    ! Nodes selection (control print return in cltxt)
@@ -321,18 +321,12 @@
    SUBROUTINE opa_ctl
       !!----------------------------------------------------------------------
-      !!                     ***  ROUTINE opa  ***
-      !!
-      !! ** Purpose :   Initialise logical flags that control the choice of
-      !!              some algorithm or control print
-      !!
-      !! ** Method  : - print namctl information
-      !!              - Read in namilist namflg logical flags
-      !!----------------------------------------------------------------------
-      NAMELIST/namdyn_hpg/ ln_hpg_zco   , ln_hpg_zps   , ln_hpg_sco, ln_hpg_hel,   &
-         &                 ln_hpg_wdj   , ln_hpg_djc   , ln_hpg_rot, rn_gamma  ,   &
-         &                 ln_dynhpg_imp, nn_dynhpg_rst
-      !!----------------------------------------------------------------------
-
-      IF(lwp) THEN                 ! Parameter print
+      !!                     ***  ROUTINE opa_ctl  ***
+      !!
+      !! ** Purpose :   control print setting 
+      !!
+      !! ** Method  : - print namctl information and check some consistencies
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                  ! Parameter print
          WRITE(numout,*)
          WRITE(numout,*) 'opa_ctl: Control prints & Benchmark'
@@ -349,5 +343,5 @@
          WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench
       ENDIF
-
+      !
       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
       nictls    = nn_ictls
@@ -358,6 +352,5 @@
       jsplt     = nn_jsplt
       nbench    = nn_bench
-
-      !                           ! Parameter control
+      !                             ! Parameter control
       !
       IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
@@ -397,6 +390,6 @@
          ENDIF
       ENDIF
-
-      IF( nbench == 1 )   THEN            ! Benchmark 
+      !
+      IF( nbench == 1 ) THEN              ! Benchmark 
          SELECT CASE ( cp_cfg )
          CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' )
@@ -406,7 +399,7 @@
       ENDIF
       !
-      IF( lk_c1d .AND. .NOT. lk_iomput )  &
-        CALL ctl_stop( ' The 1D vertical configuration must be used in conjunction',   &
-            &          ' with the IOM Input/Output manager. Compile with key_iomput enabled' )
+      IF( lk_c1d .AND. .NOT.lk_iomput )   CALL ctl_stop( 'opa_ctl: The 1D configuration must be used ',   &
+         &                                               'with the IOM Input/Output manager. '        ,   &
+         &                                               'Compile with key_iomput enabled' )
       !
    END SUBROUTINE opa_ctl
@@ -430,5 +423,6 @@
       IF( numevo_ice /= -1 )   CLOSE( numevo_ice )   ! ice variables (temp. evolution)
       IF( numout     /=  6 )   CLOSE( numout     )   ! standard model output file
-      numout = 6   ! redefine numout in case it is used after this point...
+      !
+      numout = 6                                     ! redefine numout in case it is used after this point...
       !
    END SUBROUTINE opa_closefile
