Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 4015)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90	(revision 4015)
@@ -0,0 +1,369 @@
+MODULE crs   
+   !!======================================================================
+   !!                         ***  MODULE crs_dom  ***
+   !!        Declare the coarse grid domain and other public variables 
+   !!        then allocate them if needed.
+   !!======================================================================
+   !!  History     2012-06  Editing  (J. Simeon, G. Madec, C. Ethe, C. Calone) Original code
+   !!----------------------------------------------------------------------
+   USE par_oce  
+   USE dom_oce
+   USE in_out_manager
+
+
+   IMPLICIT NONE
+   PUBLIC
+
+   
+   PUBLIC crs_dom_alloc  ! Called from crsini.F90
+   PUBLIC dom_grid_glo   
+   PUBLIC dom_grid_crs 
+
+      ! Domain variables
+      INTEGER  ::  jpiglo_crs ,   &             !: 1st dimension of global coarse grid domain
+                   jpjglo_crs                   !: 2nd dimension of global coarse grid domain
+      INTEGER  ::  jpi_crs ,   &                !: 1st dimension of local coarse grid domain
+                   jpj_crs                      !: 2nd dimension of local coarse grid domain
+      INTEGER  ::  jpi_full ,  &                !: 1st dimension of local parent grid domain
+                   jpj_full                     !: 2nd dimension of local parent grid domain
+
+      INTEGER  ::  nistr , njstr
+      INTEGER  ::  niend , njend
+
+      INTEGER  ::  jpi_crsm1, jpj_crsm1         !: loop indices      
+      INTEGER  ::  jpiglo_crsm1, jpjglo_crsm1   !: loop indices      
+      INTEGER  ::  nperio_full, nperio_crs      !: jperio of parent and coarse grids
+      INTEGER  ::  npolj_full, npolj_crs        !: north fold mark
+      INTEGER  ::  jpiglo_full, jpjglo_full     !: jpiglo / jpjglo
+      INTEGER  ::  npiglo, npjglo               !: jpjglo
+      INTEGER  ::  nlci_full, nlcj_full         !: i-, j-dimension of local or sub domain on parent grid
+      INTEGER  ::  nldi_full, nldj_full         !: starting indices of internal sub-domain on parent grid
+      INTEGER  ::  nlei_full, nlej_full         !: ending indices of internal sub-domain on parent grid
+      INTEGER  ::  nlci_crs, nlcj_crs           !: i-, j-dimension of local or sub domain on coarse grid
+      INTEGER  ::  nldi_crs, nldj_crs           !: starting indices of internal sub-domain on coarse grid
+      INTEGER  ::  nlei_crs, nlej_crs           !: ending indices of internal sub-domain on coarse grid
+      INTEGER  ::  narea_full, narea_crs        !: node
+      INTEGER  ::  jpnij_full, jpnij_crs        !: =jpni*jpnj, the pe decomposition
+      INTEGER  ::  jpim1_full, jpjm1_full       !: 
+      INTEGER  ::  nimpp_full, njmpp_full       !: global position of point (1,1) of subdomain on parent grid
+      INTEGER  ::  nimpp_crs, njmpp_crs         !: set to 1,1 for now .  Valid only for monoproc
+      INTEGER  ::  nreci_full, nrecj_full
+      INTEGER  ::  nreci_crs, nrecj_crs
+      !cc
+      INTEGER ::   noea_full, nowe_full        !: index of the local neighboring processors in
+      INTEGER ::   noso_full, nono_full        !: east, west, south and north directions
+      INTEGER ::   npne_full, npnw_full        !: index of north east and north west processor
+      INTEGER ::   npse_full, npsw_full        !: index of south east and south west processor
+      INTEGER ::   nbne_full, nbnw_full        !: logical of north east & north west processor
+      INTEGER ::   nbse_full, nbsw_full        !: logical of south east & south west processor
+      INTEGER ::   nidom_full                  !: ???
+      INTEGER ::   nproc_full                  !:number for local processor
+      INTEGER ::   nbondi_full, nbondj_full    !: mark of i- and j-direction local boundaries
+      INTEGER ::   noea_crs, nowe_crs          !: index of the local neighboring processors in
+      INTEGER ::   noso_crs, nono_crs          !: east, west, south and north directions
+      INTEGER ::   npne_crs, npnw_crs          !: index of north east and north west processor
+      INTEGER ::   npse_crs, npsw_crs          !: index of south east and south west processor
+      INTEGER ::   nbne_crs, nbnw_crs          !: logical of north east & north west processor
+      INTEGER ::   nbse_crs, nbsw_crs          !: logical of south east & south west processor
+      INTEGER ::   nidom_crs                   !: ???
+      INTEGER ::   nproc_crs                   !:number for local processor
+      INTEGER ::   nbondi_crs, nbondj_crs      !: mark of i- and j-direction local boundaries
+      
+
+      INTEGER, DIMENSION(:), ALLOCATABLE :: mis_crs, mie_crs, mis2_crs, mie2_crs  ! starting and ending i-indices of parent subset
+      INTEGER, DIMENSION(:), ALLOCATABLE :: mjs_crs, mje_crs, mjs2_crs, mje2_crs ! starting and ending  j-indices of parent subset
+      INTEGER, DIMENSION(:), ALLOCATABLE :: mjg_crs, mig_crs
+      INTEGER  :: mxbinctr, mybinctr            ! central point in grid box
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nlcit_crs, nlcit_full  !: dimensions of every subdomain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nldit_crs, nldit_full     !: first, last indoor index for each i-domain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nleit_crs, nleit_full    !: first, last indoor index for each j-domain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nimppt_crs, nimppt_full    !: first, last indoor index for each j-domain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nlcjt_crs, nlcjt_full  !: dimensions of every subdomain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nldjt_crs, nldjt_full     !: first, last indoor index for each i-domain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   nlejt_crs, nlejt_full    !: first, last indoor index for each j-domain
+      INTEGER, DIMENSION(:), ALLOCATABLE ::   njmppt_crs, njmppt_full    !: first, last indoor index for each j-domain
+
+ 
+      ! Masks
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_crs, umask_crs, vmask_crs, fmask_crs
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs
+      
+  !    REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: tmask_i_crs, tpol, fpol      
+
+      ! Scale factors
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1t_crs, e2t_crs, e1e2t_crs ! horizontal scale factors grid type T
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1u_crs, e2u_crs ! horizontal scale factors grid type U
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1v_crs, e2v_crs ! horizontal scale factors grid type V
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1f_crs, e2f_crs ! horizontal scale factors grid type F
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_crs, e3u_crs, e3v_crs, e3f_crs, e3w_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_max_crs, e3u_max_crs, e3v_max_crs, e3w_max_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: fse3t_crs, fse3u_crs, fse3v_crs, fse3f_crs, fse3w_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: fse3t_n_crs, fse3t_b_crs, fse3t_a_crs
+      
+      ! Surface
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_crs, e2e3u_crs, e1e3v_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e1e2w_msk, e2e3u_msk, e1e3v_msk
+                                                                  ! vertical scale factors 
+      ! Coordinates
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphit_crs, glamt_crs, gphif_crs, glamf_crs 
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: gphiu_crs, glamu_crs, gphiv_crs, glamv_crs 
+      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: ff_crs
+      INTEGER,  DIMENSION(:,:),   ALLOCATABLE :: mbathy_crs, mbkt_crs, mbku_crs, mbkv_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: gdept_crs, gdepu_crs, gdepv_crs, gdepw_crs
+
+      ! Weights
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: facsurfv, facsurfu, facvol_t, facvol_w
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ocean_volume_crs_t, ocean_volume_crs_w, bt_crs, r1_bt_crs
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: crs_surfu_wgt, crs_surfv_wgt, crs_surfw_wgt, crs_volt_wgt
+
+      ! CRS Namelist
+      INTEGER           :: nn_factx   = 3       !: reduction factor of x-dimension of the parent grid
+      INTEGER           :: nn_facty   = 3       !: reduction factor of y-dimension of the parent grid
+      INTEGER           :: nn_binref  = 0       !: 0 = binning starts north fold (equator could be asymmetric)
+                                                !: 1 = binning centers at equator (north fold my have artifacts)     
+                                                !:    for even reduction factors, equator placed in bin biased south
+      INTEGER           :: nn_msh_crs = 1       !: Organization of mesh mask output
+                                                !: 0 = no mesh mask output
+                                                !: 1 = unified mesh mask output
+                                                !: 2 = 2 separate mesh mask output
+                                                !: 3 = 3 separate mesh mask output
+      INTEGER           :: nn_crs_kz    =    0       !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN) 
+      LOGICAL           :: ln_crs_wn    = .FALSE.    !: coarsening wn or computation using horizontal divergence 
+      !
+      INTEGER           :: nrestx, nresty       !: for determining odd or even reduction factor
+
+
+      ! Grid reduction factors
+      REAL(wp)     ::  rfactx_r                !: inverse of x-dim reduction factor
+      REAL(wp)     ::  rfacty_r                !: inverse of y-dim reduction factor
+      REAL(wp)     ::  rfactxy 
+
+      !! Horizontal grid parameters for domhgr
+      !! =====================================
+      INTEGER  ::   nphgr_msh_crs = 0   !: type of horizontal mesh
+      !                                 !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
+      !                                 !  = 1 geographical mesh on the sphere with regular grid-spacing
+      !                                 !  = 2 f-plane with regular grid-spacing
+      !                                 !  = 3 beta-plane with regular grid-spacing
+      !                                 !  = 4 Mercator grid with T/U point at the equator
+      
+      ! Physical and dynamical ocean fields for output or passing to TOP, time-mean fields
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE      :: tsn_crs
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: un_crs, vn_crs, wn_crs, rke_crs
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE      :: hdivn_crs    
+      REAL(wp), DIMENSION(:,:)    , ALLOCATABLE      :: sshn_crs    
+
+      ! 
+      ! Surface fluxes to pass to TOP
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: qsr_crs, emp_b_crs, fr_i_crs, wndm_crs, emp_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: utau_crs, vtau_crs
+      REAL(wp), PUBLIC, DIMENSION(:,:)  , ALLOCATABLE :: rnf_crs
+
+      ! Vertical diffusion
+      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avt_crs           !: vert. diffusivity coef. [m2/s] at w-point for temp  
+# if defined key_zdfddm
+      REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:)  ::  avs_crs           !: salinity vertical diffusivity coeff. [m2/s] at w-point
+# endif
+
+      ! Mixing and Mixed Layer Depth
+      INTEGER,  PUBLIC, ALLOCATABLE, DIMENSION(:,:)    ::  nmln_crs, hmld_crs, hmlp_crs, hmlpt_crs                       
+
+      ! Direction of lateral diffusion
+
+
+CONTAINS
+   
+   INTEGER FUNCTION crs_dom_alloc()
+      !!-------------------------------------------------------------------
+      !!                     *** FUNCTION crs_dom_alloc ***
+      !!  ** Purpose :   Allocate public crs arrays  
+      !!-------------------------------------------------------------------
+      !! Local variables
+      INTEGER, DIMENSION(17) :: ierr
+
+      ierr(:) = 0
+
+      ! Set up bins for coarse grid, horizontal only.
+      ALLOCATE( mis2_crs(jpiglo_crs) , mie2_crs(jpiglo_crs) , mjs2_crs(jpjglo_crs) , mje2_crs(jpjglo_crs),&
+      & mig_crs(jpi_crs), mjg_crs(jpj_crs),  STAT=ierr(1) )
+
+      ! Set up Mask and Mesh
+
+      ALLOCATE( tmask_crs(jpi_crs,jpj_crs,jpk) , fmask_crs(jpi_crs,jpj_crs,jpk) ,  &
+         &      umask_crs(jpi_crs,jpj_crs,jpk) , vmask_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(2))
+
+      ALLOCATE( tmask_i_crs(jpi_crs,jpj_crs), rnfmsk_crs(jpi_crs,jpj_crs), &
+      &     tpol_crs(jpiglo_crs,jpjglo_crs), fpol_crs(jpiglo_crs,jpjglo_crs), STAT=ierr(3) )
+
+      ALLOCATE( gphit_crs(jpi_crs,jpj_crs) , glamt_crs(jpi_crs,jpj_crs) , & 
+         &      gphiu_crs(jpi_crs,jpj_crs) , glamu_crs(jpi_crs,jpj_crs) , &
+         &      gphiv_crs(jpi_crs,jpj_crs) , glamv_crs(jpi_crs,jpj_crs) , &
+         &      gphif_crs(jpi_crs,jpj_crs) , glamf_crs(jpi_crs,jpj_crs) , &
+         &      ff_crs(jpi_crs,jpj_crs)    , STAT=ierr(4))
+
+      ALLOCATE( e1t_crs(jpi_crs,jpj_crs) , e2t_crs(jpi_crs,jpj_crs) , & 
+         &      e1u_crs(jpi_crs,jpj_crs) , e2u_crs(jpi_crs,jpj_crs) , & 
+         &      e1v_crs(jpi_crs,jpj_crs) , e2v_crs(jpi_crs,jpj_crs) , &
+         &      e1f_crs(jpi_crs,jpj_crs) , e2f_crs(jpi_crs,jpj_crs) , &
+         &      e1e2t_crs(jpi_crs,jpj_crs), STAT=ierr(5))
+
+      ALLOCATE( fse3t_crs(jpi_crs,jpj_crs,jpk)  , fse3w_crs(jpi_crs,jpj_crs,jpk) , & 
+         &      fse3u_crs(jpi_crs,jpj_crs,jpk)  , fse3v_crs(jpi_crs,jpj_crs,jpk) , & 
+         &      e3t_crs(jpi_crs,jpj_crs,jpk)    , e3w_crs(jpi_crs,jpj_crs,jpk)   , & 
+         &      e3u_crs(jpi_crs,jpj_crs,jpk)    , e3v_crs(jpi_crs,jpj_crs,jpk)   , &
+         &      e3f_crs(jpi_crs,jpj_crs,jpk)    , fse3f_crs(jpi_crs,jpj_crs,jpk) , & 
+         &      e3t_max_crs(jpi_crs,jpj_crs,jpk), e3w_max_crs(jpi_crs,jpj_crs,jpk), & 
+         &      e3u_max_crs(jpi_crs,jpj_crs,jpk), e3v_max_crs(jpi_crs,jpj_crs,jpk)   , &
+         &      fse3t_b_crs(jpi_crs,jpj_crs,jpk), fse3t_n_crs(jpi_crs,jpj_crs,jpk),&
+         &      fse3t_a_crs(jpi_crs,jpj_crs,jpk), e1e2w_msk(jpi_crs,jpj_crs,jpk) , &
+         &      e2e3u_msk(jpi_crs,jpj_crs,jpk)  , e1e3v_msk(jpi_crs,jpj_crs,jpk) , &
+         &      e1e2w_crs(jpi_crs,jpj_crs,jpk)  , e2e3u_crs(jpi_crs,jpj_crs,jpk) , &
+         &      e1e3v_crs(jpi_crs,jpj_crs,jpk)  , STAT=ierr(6))
+
+
+      ALLOCATE( facsurfv(jpi_crs,jpj_crs,jpk) , facsurfu(jpi_crs,jpj_crs,jpk) , & 
+         &      facvol_t(jpi_crs,jpj_crs,jpk) , facvol_w(jpi_crs,jpj_crs,jpk) , &
+         &      ocean_volume_crs_t(jpi_crs,jpj_crs,jpk) , ocean_volume_crs_w(jpi_crs,jpj_crs,jpk), &
+         &      bt_crs(jpi_crs,jpj_crs,jpk)   , r1_bt_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(7))
+
+
+      ALLOCATE( crs_surfu_wgt(jpi_crs,jpj_crs,jpk) , crs_surfv_wgt(jpi_crs,jpj_crs,jpk) , & 
+         &      crs_surfw_wgt(jpi_crs,jpj_crs,jpk) , crs_volt_wgt(jpi_crs,jpj_crs,jpk) , STAT=ierr(8))
+
+
+      ALLOCATE( mbathy_crs(jpi_crs,jpj_crs) , mbkt_crs(jpi_crs,jpj_crs) , &
+         &      mbku_crs(jpi_crs,jpj_crs)   , mbkv_crs(jpi_crs,jpj_crs) , STAT=ierr(9))
+
+      ALLOCATE( gdept_crs(jpi_crs,jpj_crs,jpk) , gdepu_crs(jpi_crs,jpj_crs,jpk) , &
+         &      gdepv_crs(jpi_crs,jpj_crs,jpk) , gdepw_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(10) )
+
+
+      ALLOCATE( un_crs(jpi_crs,jpj_crs,jpk) , vn_crs(jpi_crs,jpj_crs,jpk) , &
+         &      wn_crs(jpi_crs,jpj_crs,jpk) , hdivn_crs(jpi_crs,jpj_crs,jpk),&
+         &      rke_crs(jpi_crs,jpj_crs,jpk),                                STAT=ierr(11))
+
+     ALLOCATE( sshn_crs(jpi_crs,jpj_crs),  emp_crs(jpi_crs,jpj_crs) , emp_b_crs(jpi_crs,jpj_crs), &
+         &      qsr_crs(jpi_crs,jpj_crs) , wndm_crs(jpi_crs,jpj_crs), utau_crs(jpi_crs,jpj_crs) , &
+         &      vtau_crs(jpi_crs,jpj_crs), rnf_crs(jpi_crs, jpj_crs) , &
+         &      fr_i_crs(jpi_crs, jpj_crs),   STAT=ierr(12)  )
+
+     ALLOCATE( tsn_crs(jpi_crs,jpj_crs,jpk,jpts), avt_crs(jpi_crs,jpj_crs,jpk),    &
+# if defined key_zdfddm
+         &      avs_crs(jpi_crs,jpj_crs,jpk),    &
+# endif
+         &      STAT=ierr(13) )
+
+      ALLOCATE( nmln_crs(jpi_crs,jpj_crs) , hmld_crs(jpi_crs,jpj_crs) , &
+         &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) )
+         
+      ALLOCATE( nimppt_crs(jpnij) , nlcit_crs(jpnij) , nldit_crs(jpnij) , nleit_crs(jpnij), &
+       &  nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   &
+                njmppt_crs(jpnij) , nlcjt_crs(jpnij) , nldjt_crs(jpnij) , nlejt_crs(jpnij), &
+       &  njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) )
+
+         
+      crs_dom_alloc = MAXVAL(ierr)
+
+   END FUNCTION crs_dom_alloc
+   
+   INTEGER FUNCTION crs_dom_alloc2()
+      !!-------------------------------------------------------------------
+      !!                     *** FUNCTION crs_dom_alloc ***
+      !!  ** Purpose :   Allocate public crs arrays  
+      !!-------------------------------------------------------------------
+      !! Local variables
+      INTEGER, DIMENSION(1) :: ierr
+
+      ierr(:) = 0
+      
+      ALLOCATE( mjs_crs(nlej_crs) , mje_crs(nlej_crs), mis_crs(nlei_crs) , mie_crs(nlei_crs), STAT=ierr(1) )
+      crs_dom_alloc2 = MAXVAL(ierr)
+
+      END FUNCTION crs_dom_alloc2
+
+   SUBROUTINE dom_grid_glo
+      !!--------------------------------------------------------------------
+      !!                       ***  MODULE dom_grid_glo  ***
+      !!
+      !! ** Purpose : +Return back to parent grid domain 
+      !!---------------------------------------------------------------------
+
+      !                         Return to parent grid domain
+      jpi    = jpi_full
+      jpj    = jpj_full
+      jpim1  = jpim1_full
+      jpjm1  = jpjm1_full
+      nperio = nperio_full
+
+      npolj  = npolj_full
+      jpiglo = jpiglo_full
+      jpjglo = jpjglo_full
+
+      nlci   = nlci_full
+      nlcj   = nlcj_full
+      nldi   = nldi_full
+      nldj   = nldj_full
+      nlei   = nlei_full
+      nlej   = nlej_full
+      nimpp  = nimpp_full
+      njmpp  = njmpp_full
+      
+      nlcit(:)  = nlcit_full(:)
+      nldit(:)  = nldit_full(:)
+      nleit(:)  = nleit_full(:)
+      nimppt(:) = nimppt_full(:)
+      nlcjt(:)  = nlcjt_full(:)
+      nldjt(:)  = nldjt_full(:)
+      nlejt(:)  = nlejt_full(:)
+      njmppt(:) = njmppt_full(:)
+
+   END SUBROUTINE dom_grid_glo
+
+   SUBROUTINE dom_grid_crs
+      !!--------------------------------------------------------------------
+      !!                       ***  MODULE dom_grid_crs  ***
+      !!
+      !! ** Purpose :  Save the parent grid information & Switch to coarse grid domain
+      !!---------------------------------------------------------------------
+
+ 
+      !
+      !                        Switch to coarse grid domain
+      jpi    = jpi_crs
+      jpj    = jpj_crs
+      jpim1  = jpi_crsm1
+      jpjm1  = jpj_crsm1
+      nperio = nperio_crs
+
+      npolj  = npolj_crs
+      jpiglo = jpiglo_crs
+      jpjglo = jpjglo_crs
+
+
+      nlci   = nlci_crs
+      nlcj   = nlcj_crs
+      nldi   = nldi_crs
+      nlei   = nlei_crs
+      nlej   = nlej_crs
+      nldj   = nldj_crs
+      nimpp  = nimpp_crs
+      njmpp  = njmpp_crs
+      
+      nlcit(:)  = nlcit_crs(:)
+      nldit(:)  = nldit_crs(:)
+      nleit(:)  = nleit_crs(:)
+      nimppt(:) = nimppt_crs(:)
+      nlcjt(:)  = nlcjt_crs(:)
+      nldjt(:)  = nldjt_crs(:)
+      nlejt(:)  = nlejt_crs(:)
+      njmppt(:) = njmppt_crs(:)
+
+
+      !
+   END SUBROUTINE dom_grid_crs
+   
+      
+   !!======================================================================
+
+END MODULE crs
+
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90	(revision 4015)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90	(revision 4015)
@@ -0,0 +1,1995 @@
+MODULE crsdom
+   !!===================================================================
+   !!                  ***  crs.F90 ***
+   !!  Purpose: Interface for calculating quantities from a  
+   !!           higher-resolution grid for the coarse grid.
+   !!
+   !!  Method:  Given the user-defined reduction factor, 
+   !!           the averaging bins are set: 
+   !!           - nn_binref = 0, starting from the north 
+   !!           to the south in the model interior domain, 
+   !!           in this way the north fold and redundant halo cells  
+   !!           could be handled in a consistent manner and 
+   !!           the irregularities of bin size can be handled
+   !!           more naturally by the presence of land
+   !!           in the southern boundary.  Thus the southernmost bin 
+   !!           could be of an irregular bin size.
+   !!           Information on the parent grid is retained, specifically,
+   !!           each coarse grid cell's volume and ocean surface 
+   !!           at the faces, relative to the parent grid.
+   !!           - nn_binref = 1 (not yet available), starting
+   !!           at a centralized bin at the equator, being only
+   !!           truly centered for odd-numbered j-direction reduction 
+   !!           factors.
+   !!  References:  Aumont, O., J.C. Orr, D. Jamous, P. Monfray
+   !!               O. Marti and G. Madec, 1998. A degradation 
+   !!               approach to accelerate simulations to steady-state 
+   !!               in a 3-D tracer transport model of the global ocean.
+   !!               Climate Dynamics, 14:101-116.
+   !!  History: 
+   !!       Original.   May 2012.  (J. Simeon, C. Calone, G. Madec, C. Ethe)
+   !!===================================================================
+
+   USE dom_oce        ! ocean space and time domain and to get jperio
+   USE wrk_nemo       ! work arrays
+   USE crs            ! domain for coarse grid
+   USE in_out_manager 
+   USE par_kind, ONLY: wp
+   USE crslbclnk
+   
+
+   IMPLICIT NONE
+
+   PRIVATE 
+
+   PUBLIC crs_dom_ope
+   PUBLIC crs_dom_e3, crs_dom_sfc, crs_dom_msk, crs_dom_hgr, crs_dom_coordinates
+   PUBLIC crs_dom_facvol, crs_dom_def, crs_dom_bat
+
+   INTERFACE crs_dom_ope
+      MODULE PROCEDURE crs_dom_ope_3d, crs_dom_ope_2d
+   END INTERFACE
+
+   !! Substitutions
+#  include "domzgr_substitute.h90"
+   
+CONTAINS
+
+
+   SUBROUTINE crs_dom_msk
+      
+      INTEGER  ::  ji, jj, jk                   ! dummy loop indices
+      INTEGER  ::  ijie,ijis,ijje,ijjs
+      REAL(wp) ::  zmask
+      
+      ! Initialize
+
+      tmask_crs(:,:,:) = 0.0
+      vmask_crs(:,:,:) = 0.0
+      umask_crs(:,:,:) = 0.0
+      fmask_crs(:,:,:) = 0.0
+      
+      DO jk = 1, jpkm1
+         DO ji = 2, nlei_crs  
+            ijie = mie_crs(ji)
+            ijis = mis_crs(ji)
+            DO jj = nldj_crs, nlej_crs 
+               ijje = mje_crs(jj) 
+               ijjs = mjs_crs(jj) 
+                                 
+               zmask = 0.0
+               zmask = SUM( tmask(ijis:ijie,ijjs:ijje,jk) ) 
+               IF ( zmask > 0.0 ) tmask_crs(ji,jj,jk) = 1.0
+               
+               zmask = 0.0
+               zmask = SUM( vmask(ijis:ijie,ijje     ,jk) )  
+               IF ( zmask > 0.0 ) vmask_crs(ji,jj,jk) = 1.0
+               
+               zmask = 0.0
+               zmask = SUM( umask(ijie     ,ijjs:ijje,jk) )  
+               IF ( zmask > 0.0 ) umask_crs(ji,jj,jk) = 1.0
+               
+               fmask_crs(ji,jj,jk) = fmask(ijie,ijje,jk)  
+
+            ENDDO
+         ENDDO
+      ENDDO
+      !
+      CALL crs_lbc_lnk( tmask_crs, 'T', 1.0 )
+      CALL crs_lbc_lnk( vmask_crs, 'V', 1.0 )
+      CALL crs_lbc_lnk( umask_crs, 'U', 1.0 )
+      CALL crs_lbc_lnk( fmask_crs, 'F', 1.0 )
+      !
+   END SUBROUTINE crs_dom_msk
+
+   SUBROUTINE crs_dom_coordinates( p_gphi, p_glam, cd_type, p_gphi_crs, p_glam_crs )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crs_coordinates ***
+      !! ** Purpose :  Determine the coordinates for the coarse grid
+      !! 
+      !! ** Method  :  From the parent grid subset, search for the central
+      !!               point.  For an odd-numbered reduction factor,
+      !!               the coordinate will be that of the central T-cell.
+      !!               For an even-numbered reduction factor, of a non-square
+      !!               coarse grid box, the coordinate will be that of 
+      !!               the east or north face or more likely.  For a square
+      !!               coarse grid box, the coordinate will be that of
+      !!               the central f-corner.
+      !!
+      !! ** Input   :  p_gphi = parent grid gphi[t|u|v|f]
+      !!               p_glam = parent grid glam[t|u|v|f]
+      !!               cd_type  = grid type (T,U,V,F)
+      !! ** Output  :  p_gphi_crs = coarse grid gphi[t|u|v|f]
+      !!               p_glam_crs = coarse grid glam[t|u|v|f]
+      !!              
+      !! History. 1 Jun.
+      !!----------------------------------------------------------------
+      !! Arguments
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(in)  :: p_gphi  ! Parent grid latitude
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(in)  :: p_glam  ! Parent grid longitude
+      CHARACTER(len=1),                     INTENT(in)  :: cd_type   ! grid type (T,U,V,F) 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(out) :: p_gphi_crs  ! Coarse grid latitude
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(out) :: p_glam_crs  ! Coarse grid longitude
+
+      !! Local variables
+      INTEGER :: ji, jj, jk                   ! dummy loop indices
+      INTEGER :: ijis, ijjs
+
+  
+      SELECT CASE ( cd_type )
+         CASE ( 'T' )
+            DO jj =  nldj_crs, nlej_crs
+               ijjs = mjs_crs(jj) + mybinctr
+               DO ji = 2, nlei_crs
+                  ijis = mis_crs(ji) + mxbinctr 
+                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
+                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ENDDO
+            ENDDO
+         CASE ( 'U' )
+            DO jj =  nldj_crs, nlej_crs
+               ijjs = mjs_crs(jj) + mybinctr                  
+               DO ji = 2, nlei_crs
+                  ijis = mis_crs(ji)
+                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
+                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ENDDO
+            ENDDO
+         CASE ( 'V' )
+            DO jj =  nldj_crs, nlej_crs
+               ijjs = mjs_crs(jj)
+               DO ji = 2, nlei_crs
+                  ijis = mis_crs(ji) + mxbinctr 
+                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
+                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ENDDO
+            ENDDO
+         CASE ( 'F' )
+            DO jj =  nldj_crs, nlej_crs
+               ijjs = mjs_crs(jj)
+               DO ji = 2, nlei_crs
+                  ijis = mis_crs(ji)
+                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs)
+                  p_glam_crs(ji,jj) = p_glam(ijis,ijjs)
+               ENDDO
+            ENDDO
+      END SELECT
+
+      ! Retroactively add back the boundary halo cells.
+      CALL crs_lbc_lnk( p_gphi_crs, cd_type, 1.0 )
+      CALL crs_lbc_lnk( p_glam_crs, cd_type, 1.0 )
+         
+      ! Fill up jrow=1 which is zeroed out or not handled by lbc_lnk and lbc_nfd
+      SELECT CASE ( cd_type )
+         CASE ( 'T', 'V' )
+            DO ji = 2, nlei_crs
+               ijis = mis_crs(ji) + mxbinctr 
+               p_gphi_crs(ji,1) = p_gphi(ijis,1)
+               p_glam_crs(ji,1) = p_glam(ijis,1)
+            ENDDO
+         CASE ( 'U', 'F' )
+            DO ji = 2, nlei_crs
+               ijis = mis_crs(ji) 
+               p_gphi_crs(ji,1) = p_gphi(ijis,1)
+               p_glam_crs(ji,1) = p_glam(ijis,1)
+            ENDDO
+      END SELECT
+
+      !                                             ! Fill i=1, i=jpi at j=1
+      p_gphi_crs(1      ,1) = p_gphi(jpi_crsm1,1)
+      p_glam_crs(1      ,1) = p_glam(jpi_crsm1,1)
+      !                                             ! Fill upper-right corner i=1, j=jpj_crs
+      p_gphi_crs(jpi_crs,1) = p_gphi(2        ,1)
+      p_glam_crs(jpi_crs,1) = p_glam(2        ,1)
+      !                                            
+   END SUBROUTINE crs_dom_coordinates
+
+  SUBROUTINE crs_dom_hgr( p_e1, p_e2, cd_type, p_e1_crs, p_e2_crs )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crs_dom_hgr ***
+      !!
+      !! ** Purpose :  Get coarse grid horizontal scale factors and unmasked fraction
+      !!
+      !! ** Method  :  For grid types T,U,V,Fthe 2D scale factors of 
+      !!               the coarse grid are the sum of the east or north faces of the 
+      !!               parent grid subset comprising the coarse grid box.     
+      !!               - e1,e2 Scale factors
+      !!                 Valid arguments: 
+      !! ** Inputs  : p_e1, p_e2  = parent grid e1 or e2 (t,u,v,f)
+      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V)
+      !! ** Outputs : p_e1_crs, p_e2_crs  = parent grid e1 or e2 (t,u,v,f)
+      !!
+      !! History.     4 Jun.  Write for WGT and scale factors only
+      !!----------------------------------------------------------------
+      !! 
+      !!  Arguments
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(in)  :: p_e1     ! Parent grid U,V scale factors (e1)
+      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(in)  :: p_e2     ! Parent grid U,V scale factors (e2)
+      CHARACTER(len=1)                    , INTENT(in)  :: cd_type  ! grid type U,V 
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(out) :: p_e1_crs ! Coarse grid box 2D quantity
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(out) :: p_e2_crs ! Coarse grid box 2D quantity
+
+      !! Local variables
+      INTEGER :: ji, jj, jk     ! dummy loop indices
+      INTEGER :: ijie,ijis,ijje,ijjs,ijrs
+  
+      !!----------------------------------------------------------------  
+      ! Initialize      
+
+      DO jk = 1, jpk    
+         DO ji = 2, nlei_crs
+            ijie = mie_crs(ji)
+            ijis = mis_crs(ji)
+            DO jj = nldj_crs, nlej_crs
+               ijje = mje_crs(jj) 
+               ijjs = mjs_crs(jj)                   
+               ijrs =  mje_crs(jj) - mjs_crs(jj)
+               ! Only for a factro 3 coarsening
+               SELECT CASE ( cd_type )
+                   CASE ( 'T' )
+                      IF( ijrs == 0 .OR. ijrs == 1 ) THEN
+                        ! Si à la frontière sud on a pas assez de maille de la grille mère
+                         p_e1_crs(ji,jj) = p_e1(ijie-1,ijje) * nn_factx
+                         p_e2_crs(ji,jj) = p_e2(ijie-1,ijje) * nn_facty
+                      ELSE
+                         p_e1_crs(ji,jj) = p_e1(ijie-1,ijje-1) * nn_factx
+                         p_e2_crs(ji,jj) = p_e2(ijie-1,ijje-1) * nn_facty
+                      ENDIF
+                   CASE ( 'U' )
+                      IF( ijrs == 0 .OR. ijrs == 1 ) THEN
+                         ! Si à la frontière sud on a pas assez de maille de la grille mère
+                         p_e1_crs(ji,jj) = p_e1(ijie,ijje) * nn_factx                            
+                         p_e2_crs(ji,jj) = p_e2(ijie,ijje) * nn_facty
+                      ELSE
+                         p_e1_crs(ji,jj) = p_e1(ijie,ijje-1) * nn_factx
+                         p_e2_crs(ji,jj) = p_e2(ijie,ijje-1) * nn_facty
+                      ENDIF
+                   CASE ( 'V' )
+                         p_e1_crs(ji,jj) = p_e1(ijie-1,ijje) * nn_factx                            
+                         p_e2_crs(ji,jj) = p_e2(ijie-1,ijje) * nn_facty
+                   CASE ( 'F' )
+                         p_e1_crs(ji,jj) = p_e1(ijie,ijje) * nn_factx                            
+                         p_e2_crs(ji,jj) = p_e2(ijie,ijje) * nn_facty
+               END SELECT
+            ENDDO
+         ENDDO
+      ENDDO
+
+      CALL crs_lbc_lnk( p_e1_crs, cd_type, 1.0, pval=1.0 )
+      CALL crs_lbc_lnk( p_e2_crs, cd_type, 1.0, pval=1.0 )
+
+   END SUBROUTINE crs_dom_hgr
+
+
+   SUBROUTINE crs_dom_facvol( p_mask, cd_type, p_e1, p_e2, p_e3, p_fld1_crs, p_fld2_crs )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crsfun_wgt ***
+      !! ** Purpose :  Three applications.
+      !!               1) SUM. Get coarse grid horizontal scale factors and unmasked fraction
+      !!               2) VOL. Get coarse grid box volumes
+      !!               3) WGT. Weighting multiplier for volume-weighted and/or
+      !!                       area-weighted averages.
+      !!                       Weights (i.e. the denominator) calculated here 
+      !!                       to avoid IF-tests and division.
+      !! ** Method  :  1) SUM.  For grid types T,U,V,F (and W) the 2D scale factors of 
+      !!               the coarse grid are the sum of the east or north faces of the 
+      !!               parent grid subset comprising the coarse grid box.  
+      !!               The fractions of masked:total surface (3D) on the east, 
+      !!               north and top faces is, optionally, also output.
+      !!               - Top face area sum
+      !!                 Valid arguments: cd_type, cd_op='W', p_pmask, p_e1, p_e2 
+      !!               - Top face ocean surface fraction
+      !!                 Valid arguments: cd_type, cd_op='W', p_pmask, p_e1, p_e2       
+      !!               - e1,e2 Scale factors
+      !!                 Valid arguments: 
+      !!               2) VOL.  For grid types W and T, the coarse grid box
+      !!               volumes are output. Also optionally, the fraction of  
+      !!               masked:total volume of the parent grid subset is output (i.e. facvol).
+      !!               3) WGT. Based on the grid type, the denominator is pre-determined here to  
+      !!               perform area- or volume- weighted averages, 
+      !!               to avoid IF-tests and divisions.
+      !! ** Inputs  : p_e1, p_e2  = parent grid e1 or e2 (t,u,v,f)
+      !!              p_pmask     = parent grid mask (T,U,V,F) 
+      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V)
+      !!              cd_op       = applied operation (SUM, VOL, WGT)
+      !!              p_fse3      = (Optional) parent grid vertical level thickness (fse3u or fse3v)
+      !! ** Outputs : p_cfield2d_1 = (Optional) 2D field on coarse grid
+      !!              p_cfield2d_2 = (Optional) 2D field on coarse grid
+      !!              p_cfield3d_1 = (Optional) 3D field on coarse grid
+      !!              p_cfield3d_2 = (Optional) 3D field on coarse grid
+      !!
+      !! History.     4 Jun.  Write for WGT and scale factors only
+      !!----------------------------------------------------------------
+      !! 
+      !!  Arguments
+      CHARACTER(len=1),                         INTENT(in)  :: cd_type  ! grid type U,V 
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_mask  ! Parent grid U,V mask
+      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e1     ! Parent grid U,V scale factors (e1)
+      REAL(wp), DIMENSION(jpi,jpj)            , INTENT(in)  :: p_e2     ! Parent grid U,V scale factors (e2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk)        , INTENT(in)  :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v)
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld1_crs ! Coarse grid box 3D quantity 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out) :: p_fld2_crs ! Coarse grid box 3D quantity 
+
+      !! Local variables
+      REAL(wp)                                :: zdAm
+      INTEGER                                 :: ji, jj, jk       ! dummy loop indices
+      INTEGER                                 :: ii, ij, ijie,ijje
+
+      REAL(wp), DIMENSION(:,:,:), POINTER     :: zvol      
+      !!----------------------------------------------------------------  
+   
+      CALL wrk_alloc( jpi, jpj, jpk, zvol )
+
+      DO jk = 1, jpk
+         zvol(:,:,jk) =  p_e1(:,:) * p_e2(:,:) * p_e3(:,:,jk) 
+      ENDDO
+
+      DO jk = 1, jpk           
+         DO ji = nistr, niend, nn_factx
+            DO jj   = njstr, njend, nn_facty
+               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+               ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+               ijje = mje_crs(ij)
+               ijie = mie_crs(ii)
+               !
+               p_fld1_crs(ii,ij,jk) =  zvol(ji,jj  ,jk) + zvol(ji+1,jj  ,jk) + zvol(ji+2,jj  ,jk)  &
+                   &                 + zvol(ji,jj+1,jk) + zvol(ji+1,jj+1,jk) + zvol(ji+2,jj+1,jk)  &
+                   &                 + zvol(ji,jj+2,jk) + zvol(ji+1,jj+2,jk) + zvol(ji+2,jj+2,jk)  
+            ENDDO
+         ENDDO
+      ENDDO
+
+      IF( cd_type == 'T' ) THEN
+         DO jk = 1, jpk           
+            DO ji = nistr, niend, nn_factx
+               DO jj   = njstr, njend, nn_facty
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                  ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                  ijje = mje_crs(ij)
+                  ijie = mie_crs(ii)
+                  !
+                  zdAm =  zvol(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk)  &
+                    &   + zvol(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk)  &
+                    &   + zvol(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk)  &
+                    &   + zvol(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk)  &
+                    &   + zvol(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk)  &
+                    &   + zvol(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk)  &
+                    &   + zvol(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk)  &
+                    &   + zvol(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk)  &
+                    &   + zvol(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)
+                    ! 
+                   IF( p_fld1_crs(ii,ij,jk) /= 0._wp ) p_fld2_crs(ii,ij,jk) = zdAm / p_fld1_crs(ii,ij,jk) 
+                   ! 
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDIF
+      !
+      IF( cd_type == 'W' ) THEN
+         DO jk = 2, jpk           
+            DO ji = nistr, niend, nn_factx
+               DO jj   = njstr, njend, nn_facty
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                  ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                  ijje = mje_crs(ij)
+                  ijie = mie_crs(ii)
+                  !
+                  zdAm =  zvol(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1)  &
+                    &   + zvol(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1)  &
+                    &   + zvol(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1)  &
+                    &   + zvol(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1)  &
+                    &   + zvol(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1)  &
+                    &   + zvol(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1)  &
+                    &   + zvol(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1)  &
+                    &   + zvol(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1)  &
+                    &   + zvol(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1)
+                  !
+                  IF( p_fld1_crs(ii,ij,jk) /= 0._wp ) p_fld2_crs(ii,ij,jk) = zdAm / p_fld1_crs(ii,ij,jk) 
+                  !
+               ENDDO
+            ENDDO
+         ENDDO
+         DO ji = nistr, niend, nn_factx
+            DO jj   = njstr, njend, nn_facty
+               ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+               ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+               ijje = mje_crs(ij)
+               ijie = mie_crs(ii)
+               !
+               zdAm =  zvol(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1)  &
+                 &   + zvol(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1)  &
+                 &   + zvol(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1)  &
+                 &   + zvol(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1)  &
+                 &   + zvol(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1)  &
+                 &   + zvol(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1)  &
+                 &   + zvol(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1)  &
+                 &   + zvol(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1)  &
+                 &   + zvol(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1)
+               ! 
+               IF( p_fld1_crs(ii,ij,1) /= 0._wp ) p_fld2_crs(ii,ij,1) = zdAm / p_fld2_crs(ii,ij,1) 
+               ! 
+            ENDDO
+         ENDDO
+      ENDIF
+      
+      !                                             !  Retroactively add back the boundary halo cells.
+      CALL crs_lbc_lnk( p_fld1_crs, cd_type, 1.0 ) 
+      CALL crs_lbc_lnk( p_fld2_crs, cd_type, 1.0 ) 
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zvol )
+      !
+   END SUBROUTINE crs_dom_facvol
+
+
+   SUBROUTINE crs_dom_ope_3d( p_fld, cd_op, cd_type, p_mask, p_fld_crs, p_e12, p_e3, p_surf_crs, p_mask_crs )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crsfun_UV ***
+      !! ** Purpose :  Average, area-weighted, of U or V on the east and north faces 
+      !!
+      !! ** Method  :  The U and V velocities (3D) are determined as the area-weighted averages
+      !!               on the east and north faces, respectively,
+      !!               of the parent grid subset comprising the coarse grid box. 
+      !!               In the case of the V and F grid, the last jrow minus 1 is spurious.
+      !! ** Inputs  : p_e1_e2     = parent grid e1 or e2 (t,u,v,f)
+      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V)
+      !!              psgn        = sign change over north fold (See lbclnk.F90)
+      !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors; 
+      !!                                       for velocities (U or V)
+      !!              p_fse3      = parent grid vertical level thickness (fse3u or fse3v)
+      !!              p_pfield    = U or V on the parent grid
+      !!              p_surf_crs  = (Optional) Coarse grid weight for averaging
+      !! ** Outputs : p_cfield3d = 3D field on coarse grid
+      !!
+      !! History.  29 May.  completed draft.
+      !!            4 Jun.  Revision for WGT
+      !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights.
+      !!----------------------------------------------------------------
+      !! 
+      !!  Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_fld   ! T, U, V or W on parent grid
+      CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN
+      CHARACTER(len=1),                         INTENT(in)           :: cd_type    ! grid type U,V 
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask
+      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v)
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator    
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V mask
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity 
+
+      !! Local variables
+      INTEGER  :: ji, jj, jk                 ! dummy loop indices
+      INTEGER  :: ijie, ijje, ii, ij
+      REAL(wp) :: zflcrs, zsfcrs   
+      REAL(wp) :: zeps = 1.e20    
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf   
+
+      !!----------------------------------------------------------------  
+   
+
+      SELECT CASE ( cd_op )
+      
+         CASE ( 'VOL' )
+      
+            CALL wrk_alloc( jpi, jpj, jpk, zsurf )
+            DO jk = 1, jpk
+              zsurf(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk)
+            ENDDO
+         
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T' )
+         
+                  DO jk = 1, jpk
+                    
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+ 
+                           zflcrs =  p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                             &     + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                             &     + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) &
+                             &     + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) &
+                             &     + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) &
+                             &     + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) &
+                             &     + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) &
+                             &     + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) &
+                             &     + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) 
+ 
+                           zsfcrs =  zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                             &     + zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                             &     + zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) &
+                             &     + zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) &
+                             &     + zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) &
+                             &     + zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) &
+                             &     + zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) &
+                             &     + zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) &
+                             &     + zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) 
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs
+
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+            
+               CASE( 'W' )
+         
+                  DO jk = 2, jpk
+                    
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+ 
+                           zflcrs =  p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1) &
+                             &     + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1) &
+                             &     + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1) &
+                             &     + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1) &
+                             &     + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1) &
+                             &     + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1) &
+                             &     + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1) &
+                             &     + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1) &
+                             &     + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) 
+ 
+                           zsfcrs =  zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1) &
+                             &     + zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1) &
+                             &     + zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1) &
+                             &     + zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1) &
+                             &     + zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1) &
+                             &     + zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1) &
+                             &     + zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1) &
+                             &     + zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1) &
+                             &     + zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) 
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,jk) = zflcrs / zsfcrs
+
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+                  DO ji = nistr, niend, nn_factx
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+
+                          zflcrs =   p_fld(ji  ,jj  ,1) * zsurf(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1) &
+                             &     + p_fld(ji+1,jj  ,1) * zsurf(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1) &
+                             &     + p_fld(ji+2,jj  ,1) * zsurf(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1) &
+                             &     + p_fld(ji  ,jj+1,1) * zsurf(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1) &
+                             &     + p_fld(ji+1,jj+1,1) * zsurf(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1) &
+                             &     + p_fld(ji+2,jj+1,1) * zsurf(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1) &
+                             &     + p_fld(ji  ,jj+2,1) * zsurf(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1) &
+                             &     + p_fld(ji+1,jj+2,1) * zsurf(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1) &
+                             &     + p_fld(ji+2,jj+2,1) * zsurf(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) 
+ 
+                           zsfcrs =  zsurf(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1) &
+                             &     + zsurf(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1) &
+                             &     + zsurf(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1) &
+                             &     + zsurf(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1) &
+                             &     + zsurf(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1) &
+                             &     + zsurf(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1) &
+                             &     + zsurf(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1) &
+                             &     + zsurf(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1) &
+                             &     + zsurf(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) 
+                         
+                        p_fld_crs(ii,ij,1) = zflcrs
+                        IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij,1) = zflcrs / zsfcrs
+
+                     ENDDO      
+                  ENDDO
+
+              END SELECT
+
+              CALL wrk_dealloc( jpi, jpj, jpk, zsurf )
+
+         CASE ( 'SUM' )
+         
+            CALL wrk_alloc( jpi, jpj, jpk, zsurf )
+
+            IF( PRESENT( p_e3 ) ) THEN
+               DO jk = 1, jpk
+                 zsurf(:,:,jk) =  p_e12(:,:) * p_e3(:,:,jk)
+               ENDDO
+            ELSE
+               DO jk = 1, jpk
+                 zsurf(:,:,jk) =  p_e12(:,:) 
+               ENDDO
+            ENDIF
+
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+ 
+                           zflcrs  =  p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk) &
+                             &      + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk) &
+                             &      + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk) &
+                             &      + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk) &
+                             &      + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk) &
+                             &      + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk) &
+                             &      + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk) &
+                             &      + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk) &
+                             &      + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) 
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+            
+               CASE( 'W' )
+         
+                  DO jk = 2, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs  =  p_fld(ji  ,jj  ,jk) * zsurf(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1) &
+                             &      + p_fld(ji+1,jj  ,jk) * zsurf(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1) &
+                             &      + p_fld(ji+2,jj  ,jk) * zsurf(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1) &
+                             &      + p_fld(ji  ,jj+1,jk) * zsurf(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1) &
+                             &      + p_fld(ji+1,jj+1,jk) * zsurf(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1) &
+                             &      + p_fld(ji+2,jj+1,jk) * zsurf(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1) &
+                             &      + p_fld(ji  ,jj+2,jk) * zsurf(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1) &
+                             &      + p_fld(ji+1,jj+2,jk) * zsurf(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1) &
+                             &      + p_fld(ji+2,jj+2,jk) * zsurf(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) 
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+                  DO ji = nistr, niend, nn_factx
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+                        !
+                        zflcrs  =   p_fld(ji  ,jj  ,1) * zsurf(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1) &
+                           &      + p_fld(ji+1,jj  ,1) * zsurf(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1) &
+                           &      + p_fld(ji+2,jj  ,1) * zsurf(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1) &
+                           &      + p_fld(ji  ,jj+1,1) * zsurf(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1) &
+                           &      + p_fld(ji+1,jj+1,1) * zsurf(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1) &
+                           &      + p_fld(ji+2,jj+1,1) * zsurf(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1) &
+                           &      + p_fld(ji  ,jj+2,1) * zsurf(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1) &
+                           &      + p_fld(ji+1,jj+2,1) * zsurf(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1) &
+                           &      + p_fld(ji+2,jj+2,1) * zsurf(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) 
+                        !
+                        p_fld_crs(ii,ij,1) = zflcrs
+                        !
+                     ENDDO      
+                  ENDDO
+           
+               CASE( 'V' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs  =  p_fld(ji  ,ijje,jk) * zsurf(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) &
+                             &      + p_fld(ji+1,ijje,jk) * zsurf(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) &
+                             &      + p_fld(ji+2,ijje,jk) * zsurf(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) 
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                         ENDDO      
+                     ENDDO
+                  ENDDO   
+
+            
+               CASE( 'U' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs =  p_fld(ijie,jj  ,jk) * zsurf(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk) &
+                             &     + p_fld(ijie,jj+1,jk) * zsurf(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) &
+                             &     + p_fld(ijie,jj+2,jk) * zsurf(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk)
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+              END SELECT
+
+              IF( PRESENT( p_surf_crs ) ) THEN
+                 WHERE ( p_surf_crs /= 0.0 ) p_fld_crs(:,:,:) = p_fld_crs(:,:,:) / p_surf_crs(:,:,:)
+              ENDIF
+
+              CALL wrk_dealloc( jpi, jpj, jpk, zsurf )
+
+         CASE ( 'MAX' )
+         
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+ 
+                           zflcrs =  MAX( p_fld(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
+                             &            p_fld(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
+                             &            p_fld(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  &
+                             &            p_fld(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  &
+                             &            p_fld(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  &
+                             &            p_fld(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  &
+                             &            p_fld(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  &
+                             &            p_fld(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  &
+                             &            p_fld(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk)   )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+            
+               CASE( 'W' )
+         
+                  DO jk = 2, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs =  MAX( p_fld(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  &
+                             &            p_fld(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  &
+                             &            p_fld(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  &
+                             &            p_fld(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  &
+                             &            p_fld(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  &
+                             &            p_fld(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  &
+                             &            p_fld(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  &
+                             &            p_fld(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  &
+                             &            p_fld(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+                  DO ji = nistr, niend, nn_factx
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+                        !
+                        zflcrs = MAX( p_fld(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  &
+                           &          p_fld(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  &
+                           &          p_fld(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  &
+                           &          p_fld(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  &
+                           &          p_fld(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  &
+                           &          p_fld(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  &
+                           &          p_fld(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  &
+                           &          p_fld(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  &
+                           &          p_fld(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1)  ) 
+                         !
+                         p_fld_crs(ii,ij,1) = zflcrs
+                         !
+                     ENDDO      
+                  ENDDO
+           
+               CASE( 'V' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs = MAX( p_fld(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk),  &
+                             &           p_fld(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk),  &
+                             &           p_fld(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+            
+               CASE( 'U' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           Zflcrs = MAX( p_fld(ijie,jj  ,jk) * p_mask(ijie,jj  ,jk),  &
+                             &           p_fld(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk),  &
+                             &           p_fld(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+              END SELECT
+
+         CASE ( 'MIN' )
+            !   Search the min of masked grid cells
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+                           
+                           zflcrs =  MIN( p_fld(ji  ,jj  ,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+1,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+2,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji  ,jj+1,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk) ) * zeps ),  &
+                             &            p_fld(ji  ,jj+2,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk) ) * zeps )   )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs * p_mask_crs(ii,ij,jk)
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+           
+               CASE( 'W' )
+         
+                  DO jk = 2, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+                           
+                           zflcrs =  MIN( p_fld(ji  ,jj  ,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+1,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+1,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+2,jj  ,jk) * ( 1. + ( 1. - p_mask(ji+2,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji  ,jj+1,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+1,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+2,jj+1,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk-1) ) * zeps ),  &
+                             &            p_fld(ji  ,jj+2,jk) * ( 1. + ( 1. - p_mask(ji  ,jj  ,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+1,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+1,jj+1,jk-1) ) * zeps ),  &
+                             &            p_fld(ji+2,jj+2,jk) * ( 1. + ( 1. - p_mask(ji+2,jj+2,jk-1) ) * zeps )   )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs * p_mask_crs(ii,ij,jk)
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO  
+ 
+                  DO ji = nistr, niend, nn_factx
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+                        
+                        zflcrs =  MIN( p_fld(ji  ,jj  ,1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj  ,1) * ( 1. + ( 1. - p_mask(ji+1,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj  ,1) * ( 1. + ( 1. - p_mask(ji+2,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji  ,jj+1,1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj+1,1) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj+1,1) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps ),  &
+                          &            p_fld(ji  ,jj+2,1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj+2,1) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj+2,1) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps )   )
+                        !
+                        p_fld_crs(ii,ij,1) = zflcrs * p_mask_crs(ii,ij,1)
+                        !
+                     ENDDO      
+                  ENDDO
+
+               CASE( 'V' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+                           
+                           zflcrs =  MIN( p_fld(ji  ,ijje,jk) * ( 1. + ( 1. - p_mask(ji  ,ijje,jk) ) * zeps ),  &
+                             &            p_fld(ji+1,ijje,jk) * ( 1. + ( 1. - p_mask(ji+1,ijje,jk) ) * zeps ),  &
+                             &            p_fld(ji+2,ijje,jk) * ( 1. + ( 1. - p_mask(ji+2,ijje,jk) ) * zeps )   )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs * p_mask_crs(ii,ij,jk)
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO  
+
+
+               CASE( 'U' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)                  
+                           
+                           zflcrs =  MIN( p_fld(ijie,jj  ,jk) * ( 1. + ( 1. - p_mask(ijie,jj  ,jk) ) * zeps ),  &
+                             &            p_fld(ijie,jj+1,jk) * ( 1. + ( 1. - p_mask(ijie,jj+1,jk) ) * zeps ),  &
+                             &            p_fld(ijie,jj+2,jk) * ( 1. + ( 1. - p_mask(ijie,jj+2,jk) ) * zeps )   )
+                           !
+                           p_fld_crs(ii,ij,jk) = zflcrs * p_mask_crs(ii,ij,jk)
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO  
+            END SELECT
+            !
+         END SELECT
+         !
+         CALL crs_lbc_lnk( p_fld_crs, cd_type, 1.0 )
+         !
+    END SUBROUTINE crs_dom_ope_3d
+
+    SUBROUTINE crs_dom_ope_2d( p_fld, cd_op, cd_type, p_mask, p_fld_crs, p_e12, p_e3, p_surf_crs, p_mask_crs )
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crsfun_UV ***
+      !! ** Purpose :  Average, area-weighted, of U or V on the east and north faces 
+      !!
+      !! ** Method  :  The U and V velocities (3D) are determined as the area-weighted averages
+      !!               on the east and north faces, respectively,
+      !!               of the parent grid subset comprising the coarse grid box. 
+      !!               In the case of the V and F grid, the last jrow minus 1 is spurious.
+      !! ** Inputs  : p_e1_e2     = parent grid e1 or e2 (t,u,v,f)
+      !!              cd_type     = grid type (T,U,V,F) for scale factors; for velocities (U or V)
+      !!              psgn        = sign change over north fold (See lbclnk.F90)
+      !!              p_pmask     = parent grid mask (T,U,V,F) for scale factors; 
+      !!                                       for velocities (U or V)
+      !!              p_fse3      = parent grid vertical level thickness (fse3u or fse3v)
+      !!              p_pfield    = U or V on the parent grid
+      !!              p_surf_crs  = (Optional) Coarse grid weight for averaging
+      !! ** Outputs : p_cfield3d = 3D field on coarse grid
+      !!
+      !! History.  29 May.  completed draft.
+      !!            4 Jun.  Revision for WGT
+      !!            5 Jun.  Streamline for area-weighted average only ; separate scale factor and weights.
+      !!----------------------------------------------------------------
+      !! 
+      !!  Arguments
+      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in)           :: p_fld   ! T, U, V or W on parent grid
+      CHARACTER(len=3),                         INTENT(in)           :: cd_op    ! Operation SUM, MAX or MIN
+      CHARACTER(len=1),                         INTENT(in)           :: cd_type    ! grid type U,V 
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in)           :: p_mask    ! Parent grid T,U,V mask
+      REAL(wp), DIMENSION(jpi,jpj),             INTENT(in), OPTIONAL :: p_e12    ! Parent grid T,U,V scale factors (e1 or e2)
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in), OPTIONAL :: p_e3     ! Parent grid vertical level thickness (fse3u, fse3v)
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(in), OPTIONAL :: p_surf_crs ! Coarse grid area-weighting denominator    
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in), OPTIONAL :: p_mask_crs    ! Coarse grid T,U,V mask
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs)    , INTENT(out)          :: p_fld_crs ! Coarse grid box 3D quantity 
+
+      !! Local variables
+      INTEGER  :: ji, jj, jk                 ! dummy loop indices
+      INTEGER  :: ijie, ijje, ii, ij
+      REAL(wp) :: zflcrs, zsfcrs   
+      REAL(wp) :: zeps = 1.e20    
+      REAL(wp), DIMENSION(:,:), POINTER :: zsurf   
+
+      !!----------------------------------------------------------------  
+   
+
+      SELECT CASE ( cd_op )
+      
+         CASE ( 'VOL' )
+      
+           CALL wrk_alloc( jpi, jpj, zsurf )
+           zsurf(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1)
+                    
+           DO ji = nistr, niend, nn_factx
+              DO jj = njstr, njend, nn_facty
+                 ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                 ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                 ijje = mje_crs(ij)
+                 ijie = mie_crs(ii)                  
+ 
+                 zflcrs =  p_fld(ji  ,jj  ) * zsurf(ji  ,jj  )  &
+                   &     + p_fld(ji+1,jj  ) * zsurf(ji+1,jj  )  &
+                   &     + p_fld(ji+2,jj  ) * zsurf(ji+2,jj  )  &
+                   &     + p_fld(ji  ,jj+1) * zsurf(ji  ,jj+1)  &
+                   &     + p_fld(ji+1,jj+1) * zsurf(ji+1,jj+1)  &
+                   &     + p_fld(ji+2,jj+1) * zsurf(ji+2,jj+1)  &
+                   &     + p_fld(ji  ,jj+2) * zsurf(ji  ,jj+2)  &
+                   &     + p_fld(ji+1,jj+2) * zsurf(ji+1,jj+2)  &
+                   &     + p_fld(ji+2,jj+2) * zsurf(ji+2,jj+2)  
+
+                 zsfcrs =  zsurf(ji,jj  ) + zsurf(ji+1,jj  ) + zsurf(ji+2,jj  )  &
+                   &     + zsurf(ji,jj+1) + zsurf(ji+1,jj+1) + zsurf(ji+2,jj+1)  &
+                   &     + zsurf(ji,jj+2) + zsurf(ji+1,jj+2) + zsurf(ji+2,jj+2)  
+                 !
+                 p_fld_crs(ii,ij) = zflcrs
+                 IF( zsfcrs /= 0.0 )  p_fld_crs(ii,ij) = zflcrs / zsfcrs
+
+              ENDDO      
+           ENDDO
+            
+           CALL wrk_dealloc( jpi, jpj, zsurf )
+
+         CASE ( 'SUM' )
+         
+            CALL wrk_alloc( jpi, jpj, zsurf )
+            IF( PRESENT( p_e3 ) ) THEN
+               zsurf(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1)
+            ELSE
+               zsurf(:,:) =  p_e12(:,:) * p_mask(:,:,1)
+            ENDIF
+
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T', 'W' )
+         
+                  DO ji = nistr, niend, nn_factx
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+
+                        zflcrs  =  p_fld(ji  ,jj  ) * zsurf(ji  ,jj  )  &
+                          &      + p_fld(ji+1,jj  ) * zsurf(ji+1,jj  )  &
+                          &      + p_fld(ji+2,jj  ) * zsurf(ji+2,jj  )  &
+                          &      + p_fld(ji  ,jj+1) * zsurf(ji  ,jj+1)  &
+                          &      + p_fld(ji+1,jj+1) * zsurf(ji+1,jj+1)  &
+                          &      + p_fld(ji+2,jj+1) * zsurf(ji+2,jj+1)  &
+                          &      + p_fld(ji  ,jj+2) * zsurf(ji  ,jj+2)  &
+                          &      + p_fld(ji+1,jj+2) * zsurf(ji+1,jj+2)  &
+                          &      + p_fld(ji+2,jj+2) * zsurf(ji+2,jj+2)  
+                        !
+                        p_fld_crs(ii,ij) = zflcrs
+                        !
+                     ENDDO      
+                  ENDDO
+            
+               CASE( 'V' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs  =  p_fld(ji  ,ijje) * zsurf(ji  ,ijje)  &
+                             &      + p_fld(ji+1,ijje) * zsurf(ji+1,ijje)  &
+                             &      + p_fld(ji+2,ijje) * zsurf(ji+2,ijje)  
+                           !
+                           p_fld_crs(ii,ij) = zflcrs
+                           !
+                         ENDDO      
+                     ENDDO
+                  ENDDO   
+
+            
+               CASE( 'U' )
+         
+                  DO jk = 1, jpk
+                     DO ji = nistr, niend, nn_factx
+                        DO jj = njstr, njend, nn_facty
+                           ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                           ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                           ijje = mje_crs(ij)
+                           ijie = mie_crs(ii)
+                           !                  
+                           zflcrs =  p_fld(ijie,jj  ) * zsurf(ijie,jj  )  &
+                             &     + p_fld(ijie,jj+1) * zsurf(ijie,jj+1)  &
+                             &     + p_fld(ijie,jj+2) * zsurf(ijie,jj+2) 
+                           !
+                           p_fld_crs(ii,ij) = zflcrs
+                           !
+                        ENDDO      
+                     ENDDO
+                  ENDDO   
+
+              END SELECT
+
+              IF( PRESENT( p_surf_crs ) ) THEN
+                 WHERE ( p_surf_crs /= 0.0 ) p_fld_crs(:,:) = p_fld_crs(:,:) / p_surf_crs(:,:)
+              ENDIF
+
+              CALL wrk_dealloc( jpi, jpj, zsurf )
+
+         CASE ( 'MAX' )
+         
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T', 'W' )
+         
+                  DO ji = nistr, niend, nn_factx
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+
+                        zflcrs =  MAX( p_fld(ji  ,jj  ) * p_mask(ji  ,jj  ,1),  &
+                          &            p_fld(ji+1,jj  ) * p_mask(ji+1,jj  ,1),  &
+                          &            p_fld(ji+2,jj  ) * p_mask(ji+2,jj  ,1),  &
+                          &            p_fld(ji  ,jj+1) * p_mask(ji  ,jj+1,1),  &
+                          &            p_fld(ji+1,jj+1) * p_mask(ji+1,jj+1,1),  &
+                          &            p_fld(ji+2,jj+1) * p_mask(ji+2,jj+1,1),  &
+                          &            p_fld(ji  ,jj+2) * p_mask(ji  ,jj+2,1),  &
+                          &            p_fld(ji+1,jj+2) * p_mask(ji+1,jj+2,1),  &
+                          &            p_fld(ji+2,jj+2) * p_mask(ji+2,jj+2,1)   )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs
+                        !
+                     ENDDO      
+                  ENDDO
+            
+               CASE( 'V' )
+         
+                  DO ji = nistr, niend, nn_factx
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)
+                        !                  
+                        zflcrs = MAX( p_fld(ji  ,ijje) * p_mask(ji  ,ijje,1),  &
+                          &           p_fld(ji+1,ijje) * p_mask(ji+1,ijje,1),  &
+                          &           p_fld(ji+2,ijje) * p_mask(ji+2,ijje,1) )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs
+                        !
+                     ENDDO      
+                  ENDDO
+            
+               CASE( 'U' )
+         
+                  DO ji = nistr, niend, nn_factx
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)
+                        !                  
+                        zflcrs = MAX( p_fld(ijie,jj  ) * p_mask(ijie,jj  ,1),  &
+                          &           p_fld(ijie,jj+1) * p_mask(ijie,jj+1,1),  &
+                          &           p_fld(ijie,jj+2) * p_mask(ijie,jj+2,1) )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs
+                        !
+                     ENDDO      
+                  ENDDO
+
+              END SELECT
+
+         CASE ( 'MIN' )
+            !   Search the min of masked grid cells
+            SELECT CASE ( cd_type )
+            
+               CASE( 'T', 'W' )
+         
+                  DO ji = nistr, niend, nn_factx
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+                        
+                        zflcrs =  MIN( p_fld(ji  ,jj  ) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj  ) * ( 1. + ( 1. - p_mask(ji+1,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj  ) * ( 1. + ( 1. - p_mask(ji+2,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji  ,jj+1) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj+1) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj+1) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps ),  &
+                          &            p_fld(ji  ,jj+2) * ( 1. + ( 1. - p_mask(ji  ,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ji+1,jj+2) * ( 1. + ( 1. - p_mask(ji+1,jj+1,1) ) * zeps ),  &
+                          &            p_fld(ji+2,jj+2) * ( 1. + ( 1. - p_mask(ji+2,jj+2,1) ) * zeps )   )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs * p_mask_crs(ii,ij,1)
+                        !
+                     ENDDO      
+                  ENDDO
+ 
+               CASE( 'V' )
+         
+                  DO ji = nistr, niend, nn_factx
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+                        
+                        zflcrs =  MIN( p_fld(ji  ,ijje) * ( 1. + ( 1. - p_mask(ji  ,ijje,1) ) * zeps ),  &
+                          &            p_fld(ji+1,ijje) * ( 1. + ( 1. - p_mask(ji+1,ijje,1) ) * zeps ),  &
+                          &            p_fld(ji+2,ijje) * ( 1. + ( 1. - p_mask(ji+2,ijje,1) ) * zeps )   )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs * p_mask_crs(ii,ij,1)
+                        !
+                     ENDDO      
+                  ENDDO
+
+               CASE( 'U' )
+         
+                  DO ji = nistr, niend, nn_factx
+                     DO jj = njstr, njend, nn_facty
+                        ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                        ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                        ijje = mje_crs(ij)
+                        ijie = mie_crs(ii)                  
+                        
+                        zflcrs =  MIN( p_fld(ijie,jj  ) * ( 1. + ( 1. - p_mask(ijie,jj  ,1) ) * zeps ),  &
+                          &            p_fld(ijie,jj+1) * ( 1. + ( 1. - p_mask(ijie,jj+1,1) ) * zeps ),  &
+                          &            p_fld(ijie,jj+2) * ( 1. + ( 1. - p_mask(ijie,jj+2,1) ) * zeps )   )
+                        !
+                        p_fld_crs(ii,ij) = zflcrs * p_mask_crs(ii,ij,1)
+                        !
+                     ENDDO      
+                  ENDDO
+            END SELECT
+            !
+         END SELECT
+         !
+         CALL crs_lbc_lnk( p_fld_crs, cd_type, 1.0 )
+         !
+   END SUBROUTINE crs_dom_ope_2d
+
+   SUBROUTINE crs_dom_e3( p_e1, p_e2, p_e3, p_sfc_crs, cd_type, p_mask, p_e3_crs, p_e3_max_crs)
+      !!----------------------------------------------------------------  
+      !!  Arguments
+      CHARACTER(len=1),                         INTENT(in) :: cd_type      ! grid type T, W ( U, V, F)
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in) :: p_mask       ! Parent grid T mask
+      REAL(wp), DIMENSION(jpi,jpj)    ,         INTENT(in) :: p_e1, p_e2   ! 2D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi,jpj,jpk),         INTENT(in) :: p_e3         ! 3D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(in) :: p_sfc_crs ! Coarse grid box east or north face quantity
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: p_e3_crs ! Coarse grid box east or north face quantity 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: p_e3_max_crs ! Coarse grid box east or north face quantity 
+
+      !! Local variables
+      INTEGER ::  ji, jj, jk                   ! dummy loop indices
+      INTEGER ::  ijie, ijje, ii, ij
+      REAL(wp) :: ze3crs  
+
+      !!----------------------------------------------------------------  
+   
+      SELECT CASE ( cd_type )
+      
+         CASE ('T', 'U', 'V')
+         
+            DO jk = 1 , jpk
+               DO ji = nistr, niend, nn_factx
+                  DO jj = njstr, njend, nn_facty
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                     ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                     ijje = mje_crs(ij)
+                     ijie = mie_crs(ii)
+                     ! 
+                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk) +  &
+                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk) +  &
+                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk) +  &
+                        &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk) +  &
+                        &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk) +  &
+                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk) +  &
+                        &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk) +  &
+                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk) +  &
+                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk)
+ 
+                     p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
+                     !
+                     ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk),  &
+                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk),  &
+                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk),  &
+                        &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk),  &
+                        &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk),  &
+                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk),  &
+                        &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk),  &
+                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk),  &
+                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk) )
+                    
+                     p_e3_max_crs(ii,ij,jk) = ze3crs
+                  ENDDO
+               ENDDO
+            ENDDO
+ 
+         CASE ('W')
+         
+            DO jk = 2 , jpk
+               DO ji = nistr, niend, nn_factx
+                  DO jj = njstr, njend, nn_facty
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                     ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                     ijje = mje_crs(ij)
+                     ijie = mie_crs(ii)
+                     !  
+                     ze3crs =  p_e3(ji  ,jj  ,jk) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1) +  &
+                        &      p_e3(ji+1,jj  ,jk) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1) +  &
+                        &      p_e3(ji+2,jj  ,jk) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1) +  &
+                        &      p_e3(ji  ,jj+1,jk) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,jk-1) +  &
+                        &      p_e3(ji+1,jj+1,jk) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1) +  &
+                        &      p_e3(ji+2,jj+1,jk) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1) +  &
+                        &      p_e3(ji  ,jj+2,jk) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,jk-1) +  &
+                        &      p_e3(ji+1,jj+2,jk) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1) +  &
+                        &      p_e3(ji+2,jj+2,jk) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1)
+                        
+                     p_e3_crs(ii,ij,jk) = ze3crs / p_sfc_crs(ii,ij,jk)
+                     !
+                     ze3crs = MAX( p_e3(ji  ,jj  ,jk) * p_mask(ji  ,jj  ,jk-1),  &
+                        &          p_e3(ji+1,jj  ,jk) * p_mask(ji+1,jj  ,jk-1),  &
+                        &          p_e3(ji+2,jj  ,jk) * p_mask(ji+2,jj  ,jk-1),  &
+                        &          p_e3(ji  ,jj+1,jk) * p_mask(ji  ,jj+1,jk-1),  &
+                        &          p_e3(ji+1,jj+1,jk) * p_mask(ji+1,jj+1,jk-1),  &
+                        &          p_e3(ji+2,jj+1,jk) * p_mask(ji+2,jj+1,jk-1),  &
+                        &          p_e3(ji  ,jj+2,jk) * p_mask(ji  ,jj+2,jk-1),  &
+                        &          p_e3(ji+1,jj+2,jk) * p_mask(ji+1,jj+2,jk-1),  &
+                        &          p_e3(ji+2,jj+2,jk) * p_mask(ji+2,jj+2,jk-1) )
+                    
+                     p_e3_max_crs(ii,ij,jk) = ze3crs
+                  ENDDO
+               ENDDO
+            ENDDO
+             
+            DO ji = nistr, niend, nn_factx
+               DO jj = njstr, njend, nn_facty
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                  ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                  ijje = mje_crs(ij)
+                  ijie = mie_crs(ii)
+                  !  
+                   ze3crs =  p_e3(ji  ,jj  ,1) * p_e1(ji  ,jj  ) * p_e2(ji  ,jj  ) * p_mask(ji  ,jj  ,1) +  &
+                        &    p_e3(ji+1,jj  ,1) * p_e1(ji+1,jj  ) * p_e2(ji+1,jj  ) * p_mask(ji+1,jj  ,1) +  &
+                        &    p_e3(ji+2,jj  ,1) * p_e1(ji+2,jj  ) * p_e2(ji+2,jj  ) * p_mask(ji+2,jj  ,1) +  &
+                        &    p_e3(ji  ,jj+1,1) * p_e1(ji  ,jj+1) * p_e2(ji  ,jj+1) * p_mask(ji  ,jj+1,1) +  &
+                        &    p_e3(ji+1,jj+1,1) * p_e1(ji+1,jj+1) * p_e2(ji+1,jj+1) * p_mask(ji+1,jj+1,1) +  &
+                        &    p_e3(ji+2,jj+1,1) * p_e1(ji+2,jj+1) * p_e2(ji+2,jj+1) * p_mask(ji+2,jj+1,1) +  &
+                        &    p_e3(ji  ,jj+2,1) * p_e1(ji  ,jj+2) * p_e2(ji  ,jj+2) * p_mask(ji  ,jj+2,1) +  &
+                        &    p_e3(ji+1,jj+2,1) * p_e1(ji+1,jj+2) * p_e2(ji+1,jj+2) * p_mask(ji+1,jj+2,1) +  &
+                        &    p_e3(ji+2,jj+2,1) * p_e1(ji+2,jj+2) * p_e2(ji+2,jj+2) * p_mask(ji+2,jj+2,1)
+                        
+                  p_e3_crs(ii,ij,1) = ze3crs / p_sfc_crs(ii,ij,1)
+                  !
+                  ze3crs = MAX( p_e3(ji  ,jj  ,1) * p_mask(ji  ,jj  ,1),  &
+                     &          p_e3(ji+1,jj  ,1) * p_mask(ji+1,jj  ,1),  &
+                     &          p_e3(ji+2,jj  ,1) * p_mask(ji+2,jj  ,1),  &
+                     &          p_e3(ji  ,jj+1,1) * p_mask(ji  ,jj+1,1),  &
+                     &          p_e3(ji+1,jj+1,1) * p_mask(ji+1,jj+1,1),  &
+                     &          p_e3(ji+2,jj+1,1) * p_mask(ji+2,jj+1,1),  &
+                     &          p_e3(ji  ,jj+2,1) * p_mask(ji  ,jj+2,1),  &
+                     &          p_e3(ji+1,jj+2,1) * p_mask(ji+1,jj+2,1),  &
+                     &          p_e3(ji+2,jj+2,1) * p_mask(ji+2,jj+2,1) )
+                 
+                  p_e3_max_crs(ii,ij,1) = ze3crs
+               ENDDO
+            ENDDO
+            
+         END SELECT 
+         !              
+         CALL crs_lbc_lnk( p_e3_crs    , cd_type, 1.0, pval=1.0 )  
+         CALL crs_lbc_lnk( p_e3_max_crs, cd_type, 1.0, pval=1.0 )  
+         !              
+   END SUBROUTINE crs_dom_e3
+
+   SUBROUTINE crs_dom_sfc( p_mask, cd_type, p_surf_crs, p_surf_crs_msk,  p_e1, p_e2, p_e3 )
+
+      !!  Arguments
+      CHARACTER(len=1),                 INTENT(in) :: cd_type      ! grid type T, W ( U, V, F)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: p_mask       ! Parent grid T mask
+      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in), OPTIONAL :: p_e1, p_e2         ! 3D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: p_e3         ! 3D tracer T or W on parent grid
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out):: p_surf_crs ! Coarse grid box east or north face quantity 
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(out):: p_surf_crs_msk ! Coarse grid box east or north face quantity 
+
+      !! Local variables
+      INTEGER  :: ji, jj, jk                   ! dummy loop indices
+      INTEGER  :: ijie, ijje, ii, ij
+      REAL(wp), DIMENSION(:,:)  , POINTER :: zsurf   
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zsurf3d   
+      REAL(wp) :: zsfcrs, zsfcrs_msk
+      !!----------------------------------------------------------------  
+      ! Initialize
+
+
+      !
+      SELECT CASE ( cd_type )
+      
+         CASE ('W')
+      
+           CALL wrk_alloc( jpi, jpj, zsurf )
+           zsurf(:,:) =  p_e1(:,:) * p_e2(:,:)
+        
+            DO ji = nistr, niend, nn_factx
+               DO jj   = njstr, njend, nn_facty
+                  ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                  ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                  ijje = mje_crs(ij)
+                  ijie = mie_crs(ii)
+                  !
+                  zsfcrs     =  zsurf(ji,jj  ) + zsurf(ji+1,jj  ) + zsurf(ji+2,jj  )  &
+                    &         + zsurf(ji,jj+1) + zsurf(ji+1,jj+1) + zsurf(ji+2,jj+1)  &
+                    &         + zsurf(ji,jj+2) + zsurf(ji+1,jj+2) + zsurf(ji+2,jj+2)  
+                  !
+                  zsfcrs_msk =  zsurf(ji  ,jj  ) * p_mask(ji  ,jj  ,1)  &
+                    &         + zsurf(ji+1,jj  ) * p_mask(ji+1,jj  ,1)  &
+                    &         + zsurf(ji+2,jj  ) * p_mask(ji+2,jj  ,1)  &
+                    &         + zsurf(ji  ,jj+1) * p_mask(ji  ,jj+1,1)  &
+                    &         + zsurf(ji+1,jj+1) * p_mask(ji+1,jj+1,1)  &
+                    &         + zsurf(ji+2,jj+1) * p_mask(ji+2,jj+1,1)  &
+                    &         + zsurf(ji  ,jj+2) * p_mask(ji  ,jj+2,1)  &
+                    &         + zsurf(ji+1,jj+2) * p_mask(ji+1,jj+2,1)  &
+                    &         + zsurf(ji+2,jj+2) * p_mask(ji+2,jj+2,1)
+                  !
+                  p_surf_crs    (ii,ij,1) = zsfcrs
+                  p_surf_crs_msk(ii,ij,1) = zsfcrs_msk
+                  !
+               ENDDO
+            ENDDO
+            DO jk = 2, jpk
+               !
+               p_surf_crs(:,:,jk) = p_surf_crs(:,:,1)
+               !
+               DO ji = nistr, niend, nn_factx
+                  DO jj   = njstr, njend, nn_facty
+                     ii   = ( ji - mis_crs(2) ) * rfactx_r + 2                 ! cordinate in parent grid
+                     ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                     ijje = mje_crs(ij)
+                     ijie = mie_crs(ii)
+                     !
+                     zsfcrs_msk =  zsurf(ji  ,jj  ) * p_mask(ji  ,jj  ,jk-1)  &
+                       &         + zsurf(ji+1,jj  ) * p_mask(ji+1,jj  ,jk-1)  &
+                       &         + zsurf(ji+2,jj  ) * p_mask(ji+2,jj  ,jk-1)  &
+                       &         + zsurf(ji  ,jj+1) * p_mask(ji  ,jj+1,jk-1)  &
+                       &         + zsurf(ji+1,jj+1) * p_mask(ji+1,jj+1,jk-1)  &
+                       &         + zsurf(ji+2,jj+1) * p_mask(ji+2,jj+1,jk-1)  &
+                       &         + zsurf(ji  ,jj+2) * p_mask(ji  ,jj+2,jk-1)  &
+                       &         + zsurf(ji+1,jj+2) * p_mask(ji+1,jj+2,jk-1)  &
+                       &         + zsurf(ji+2,jj+2) * p_mask(ji+2,jj+2,jk-1)
+                       !
+                       p_surf_crs_msk(ii,ij,jk) = zsfcrs_msk
+                       !
+                   ENDDO
+                ENDDO
+            ENDDO
+                        
+            CALL wrk_dealloc( jpi, jpj, zsurf )
+          
+         CASE( 'V' )
+           
+           CALL wrk_alloc( jpi, jpj, jpk, zsurf3d )
+           DO jk = 1, jpk
+              zsurf3d(:,:,jk) =  p_e1(:,:) * p_e3(:,:,jk)
+           ENDDO
+         
+           DO jk = 1, jpk
+              DO ji = nistr, niend, nn_factx
+                 DO jj = njstr, njend, nn_facty
+                    ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                    ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                    ijje = mje_crs(ij)
+                    ijie = mie_crs(ii)
+                    !                  
+                    zsfcrs      =  zsurf3d(ji,ijje,jk) + zsurf3d(ji+1,ijje,jk) + zsurf3d(ji+2,ijje,jk)
+                    !
+                    zsfcrs_msk  =  zsurf3d(ji  ,ijje,jk) * p_mask(ji  ,ijje,jk) &
+                      &          + zsurf3d(ji+1,ijje,jk) * p_mask(ji+1,ijje,jk) &
+                      &          + zsurf3d(ji+2,ijje,jk) * p_mask(ji+2,ijje,jk) 
+                    !
+                    p_surf_crs    (ii,ij,jk) = zsfcrs
+                    p_surf_crs_msk(ii,ij,jk) = zsfcrs_msk
+                    !
+                  ENDDO      
+              ENDDO
+           ENDDO   
+
+           CALL wrk_dealloc( jpi, jpj, jpk, zsurf3d )
+            
+         CASE( 'U' )
+         
+           CALL wrk_alloc( jpi, jpj, jpk, zsurf3d )
+           DO jk = 1, jpk
+              zsurf3d(:,:,jk) =  p_e2(:,:) * p_e3(:,:,jk)
+           ENDDO
+         
+           DO jk = 1, jpk
+              DO ji = nistr, niend, nn_factx
+                 DO jj = njstr, njend, nn_facty
+                    ii   = ( ji - mis_crs(2) ) * rfactx_r + 2     
+                    ij   = ( jj - mjs_crs(2) ) * rfacty_r + 2
+                    ijje = mje_crs(ij)
+                    ijie = mie_crs(ii)
+                    !                  
+                    zsfcrs      =  zsurf3d(ijie,jj,jk) + zsurf3d(ijie,jj+1,jk) + zsurf3d(ijie,jj+2,jk)
+                    !
+                    zsfcrs_msk  =  zsurf3d(ijie  ,jj,jk) * p_mask(ijie,jj  ,jk) &
+                      &          + zsurf3d(ijie,jj+1,jk) * p_mask(ijie,jj+1,jk) &
+                      &          + zsurf3d(ijie,jj+2,jk) * p_mask(ijie,jj+2,jk) 
+                    !
+                    p_surf_crs    (ii,ij,jk) = zsfcrs
+                    p_surf_crs_msk(ii,ij,jk) = zsfcrs_msk
+                    !
+                  ENDDO      
+              ENDDO
+           ENDDO  
+ 
+           CALL wrk_dealloc( jpi, jpj, jpk, zsurf3d )
+
+      END SELECT
+      
+      CALL crs_lbc_lnk( p_surf_crs    , cd_type, 1.0, pval=1.0 )
+      CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 )
+
+
+   END SUBROUTINE crs_dom_sfc
+   
+   SUBROUTINE crs_dom_def
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crs_dom_def ***
+      !! ** Purpose :  Three applications.
+      !!               1) Define global domain indice of the croasening grid
+      !!               2) Define local domain indice of the croasening grid
+      !!               3) Define the processor domain indice for a croasening grid
+      !!----------------------------------------------------------------
+      !! 
+      !!  local variables
+   
+      INTEGER  :: ji,jj,jk,ijjgloT,ijis,ijie,ijjs,ijje,jn      ! dummy indices
+      INTEGER  :: ierr                                ! allocation error status
+   
+     ! 1.a. Define global domain indices
+      jpiglo_crs   = INT( (jpiglo - 2) / nn_factx ) + 2
+      jpjglo_crs   = INT( (jpjglo - 2) / nn_facty ) + 2  ! the -2 removes j=1, j=jpj
+      jpiglo_crsm1 = jpiglo_crs - 1
+      jpjglo_crsm1 = jpjglo_crs - 1  
+
+     ! 1.b. Define local domain indices
+      jpi_crs = ( jpiglo_crs-2 * jpreci + (jpni-1) ) / jpni + 2*jpreci
+      jpj_crs = ( jpjglo_crs-2 * jprecj + (jpnj-1) ) / jpnj + 2*jprecj
+       
+      jpi_crsm1   = jpi_crs - 1
+      jpj_crsm1   = jpj_crs - 1
+      nperio_crs  = jperio
+      npolj_crs   = npolj
+      
+      ierr = crs_dom_alloc()          ! allocate most coarse grid arrays
+     ! 2.a Define processor domain
+      IF( .NOT. lk_mpp ) THEN
+         nimpp_crs  = 1
+         njmpp_crs  = 1
+         nlci_crs   = jpi_crs
+         nlcj_crs   = jpj_crs
+         nldi_crs   = 1
+         nldj_crs   = 1
+         nlei_crs   = jpi_crs
+         nlej_crs   = jpj_crs
+
+      ELSE
+         ! Initialisation of most local variables -
+         nimpp_crs  = 1
+         njmpp_crs  = 1
+         nlci_crs   = jpi_crs
+         nlcj_crs   = jpj_crs
+         nldi_crs   = 1
+         nldj_crs   = 1
+         nlei_crs   = jpi_crs
+         nlej_crs   = jpj_crs
+         
+        ! Calculs suivant une découpage en j
+        DO jn = 1, jpnij, jpni
+           IF( jn < (jpnij-jpni + 1)) THEN
+              nlejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn     ) - 1) ) / nn_facty, wp ) ) &
+                       &    - AINT( REAL( ( jpjglo - (njmppt(jn+jpni) - 1) ) / nn_facty, wp ) )
+           ELSE                                             
+              nlejt_crs(jn) = AINT( REAL(  nlejt(jn) / nn_facty, wp ) ) + 1            
+           ENDIF
+           
+           SELECT CASE( ibonjt(jn) )
+              CASE ( -1 )
+                IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )    nlejt_crs(jn) = nlejt_crs(jn) + 1
+                nlcjt_crs(jn) = nlejt_crs(jn) + jprecj
+                nldjt_crs(jn) = nldjt(jn)
+              
+              CASE ( 0 )
+              
+                nlejt_crs(jn) = nlejt_crs(jn) + jprecj
+                nlcjt_crs(jn) = nlejt_crs(jn) + jprecj
+                nldjt_crs(jn) = nldjt(jn)
+                
+              CASE ( 1, 2 )
+              
+                nlejt_crs(jn) = nlejt_crs(jn) + jprecj
+                nlcjt_crs(jn) = nlejt_crs(jn)
+                nldjt_crs(jn) = nldjt(jn)
+                
+              CASE DEFAULT
+                 STOP
+           END SELECT
+         
+           njmppt_crs(jn) = ANINT(REAL((njmppt(jn) + 1 + MOD( jpjglo - njmppt(jn) + 1, nn_facty )) / nn_facty, wp ) )
+           
+           DO jj = jn + 1, jn + jpni - 1
+              nlejt_crs(jj) = nlejt_crs(jn) 
+              nlcjt_crs(jj) = nlcjt_crs(jn)
+              nldjt_crs(jj) = nldjt_crs(jn)
+              njmppt_crs(jj)= njmppt_crs(jn)
+           ENDDO
+        ENDDO 
+        nlej_crs  = nlejt_crs(nproc + 1) 
+        nlcj_crs  = nlcjt_crs(nproc + 1)
+        nldj_crs  = nldjt_crs(nproc + 1)
+        njmpp_crs = njmppt_crs(nproc + 1)
+
+         !!!! Calcul suivant un decoupage en i
+           DO jn = 1, jpni
+              IF( jn < jpni ) THEN
+         
+                 nleit_crs(jn) = AINT( REAL( ( jpiglo - (nimppt(jn  ) - 1) ) / nn_factx, wp ) ) &
+                         &     - AINT( REAL( ( jpiglo - (nimppt(jn+1) - 1) ) / nn_factx, wp ) )
+              ELSE
+                 nleit_crs(jn) = AINT( REAL( ( jpiglo - (nimppt(jn  ) - 1) ) / nn_factx, wp ) )
+              ENDIF
+              SELECT CASE( ibonit(jn) )
+           
+                 CASE ( -1 )
+                   nleit_crs(jn) = nleit_crs(jn) + jpreci           
+                   nlcit_crs(jn) = nleit_crs(jn) + jpreci
+                   nldit_crs(jn) = nldit(jn) 
+              
+                 CASE ( 0 )
+                   nleit_crs(jn) = nleit_crs(jn) + jpreci
+                   nlcit_crs(jn) = nleit_crs(jn) + jpreci
+                   nldit_crs(jn) = nldit(jn) 
+                
+                 CASE ( 1, 2 )
+                   IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )    nleit_crs(jn) = nleit_crs(jn) + 1
+                   nleit_crs(jn) = nleit_crs(jn) + jpreci
+                   nlcit_crs(jn) = nleit_crs(jn)
+                   nldit_crs(jn) = nldit(jn) 
+                
+                 CASE DEFAULT
+                    STOP
+              END SELECT
+
+              nimppt_crs(jn) =ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1
+              DO jj = jn+jpni , jpnij, jpni
+                 nleit_crs(jj) = nleit_crs(jn) 
+                 nlcit_crs(jj) = nlcit_crs(jn)
+                 nldit_crs(jj) = nldit_crs(jn)
+                 nimppt_crs(jj)= nimppt_crs(jn)
+              ENDDO
+           ENDDO 
+        
+         nlei_crs  = nleit_crs(nproc + 1) 
+         nlci_crs  = nlcit_crs(nproc + 1)
+         nldi_crs  = nldit_crs(nproc + 1)
+         nimpp_crs = nimppt_crs(nproc + 1)
+
+         ! rajouter la condition stop
+         IF( jpizoom /= 1 .OR. jpjzoom /= 1)    STOP 
+         DO ji = 1, jpi_crs
+            mig_crs(ji) = ji + nimpp_crs - 1
+         ENDDO
+         DO jj = 1, jpj_crs
+            mjg_crs(jj) = jj + njmpp_crs - 1!
+         ENDDO
+
+      ENDIF
+      
+      !                         Save the parent grid information
+      jpi_full    = jpi
+      jpj_full    = jpj
+      jpim1_full  = jpim1
+      jpjm1_full  = jpjm1
+      nperio_full = nperio
+
+      npolj_full  = npolj
+      jpiglo_full = jpiglo
+      jpjglo_full = jpjglo
+
+      nlcj_full   = nlcj
+      nlci_full   = nlci
+      nldi_full   = nldi
+      nldj_full   = nldj
+      nlei_full   = nlei
+      nlej_full   = nlej
+      nimpp_full  = nimpp     
+      njmpp_full  = njmpp
+      
+      nlcit_full(:)  = nlcit(:)
+      nldit_full(:)  = nldit(:)
+      nleit_full(:)  = nleit(:)
+      nimppt_full(:) = nimppt(:)
+      nlcjt_full(:)  = nlcjt(:)
+      nldjt_full(:)  = nldjt(:)
+      nlejt_full(:)  = nlejt(:)
+      njmppt_full(:) = njmppt(:)
+      
+      CALL dom_grid_crs  !swich de grille
+     
+
+      IF (lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'crs_init : coarse grid dimensions'
+         WRITE(numout,*) '~~~~~~~   coarse domain global j-dimension           jpjglo = ', jpjglo
+         WRITE(numout,*) '~~~~~~~   coarse domain global i-dimension           jpiglo = ', jpiglo
+         WRITE(numout,*) '~~~~~~~   coarse domain local  i-dimension              jpi = ', jpi
+         WRITE(numout,*) '~~~~~~~   coarse domain local  j-dimension              jpj = ', jpj
+         WRITE(numout,*)
+         WRITE(numout,*) ' nproc  = '     , nproc
+         WRITE(numout,*) ' nlci   = '     , nlci
+         WRITE(numout,*) ' nlcj   = '     , nlcj
+         WRITE(numout,*) ' nldi   = '     , nldi
+         WRITE(numout,*) ' nldj   = '     , nldj
+         WRITE(numout,*) ' nlei   = '     , nlei
+         WRITE(numout,*) ' nlej   = '     , nlej
+         WRITE(numout,*) ' nlei_full='    , nlei_full
+         WRITE(numout,*) ' nldi_full='    , nldi_full
+         WRITE(numout,*) ' nimpp  = '     , nimpp
+         WRITE(numout,*) ' njmpp  = '     , njmpp
+         WRITE(numout,*) ' njmpp_full  = ', njmpp_full
+         WRITE(numout,*) ' nreci'         , nreci 
+   !      WRITE(numout,*) ' nlejt'         , nlejt
+   !      WRITE(numout,*) ' nldjt'         , nldjt
+   !      WRITE(numout,*) ' nlcjt'         , nlcjt
+   !      WRITE(numout,*) ' njmppt'        , njmppt
+   !      WRITE(numout,*) ' nleit'         , nleit
+   !      WRITE(numout,*) ' nldit'         , nldit
+   !      WRITE(numout,*) ' nlcit'         , nlcit         
+   !      WRITE(numout,*) ' nimppt'        , nimppt
+   !      WRITE(numout,*) ' nleit_full'    , nleit_full
+         WRITE(numout,*)
+      ENDIF
+      
+
+      CALL dom_grid_glo
+      
+      mxbinctr   = INT( nn_factx * 0.5 )
+      mybinctr   = INT( nn_facty * 0.5 )
+
+      nrestx = MOD( nn_factx, 2 )   ! check if even- or odd- numbered reduction factor
+      nresty = MOD( nn_facty, 2 )
+
+      IF ( nrestx == 0 ) THEN
+         mxbinctr = mxbinctr - 1
+      ENDIF
+
+      IF ( nresty == 0 ) THEN
+         mybinctr = mybinctr - 1
+         IF ( jperio == 3 .OR. jperio == 4 )  nperio_crs = jperio + 2
+         IF ( jperio == 5 .OR. jperio == 6 )  nperio_crs = jperio - 2 
+
+         IF ( npolj == 3 ) npolj_crs = 5
+         IF ( npolj == 5 ) npolj_crs = 3
+      ENDIF     
+      
+      rfactxy = nn_factx * nn_facty
+      
+      ! 2.b. Set up bins for coarse grid, horizontal only.
+      ierr = crs_dom_alloc2()
+     
+      mis2_crs(:) = 0      ;      mie2_crs(:) = 0
+      mjs2_crs(:) = 0      ;      mje2_crs(:) = 0
+
+      
+      SELECT CASE ( nn_binref )
+
+      CASE ( 0 ) 
+
+         SELECT CASE ( nperio )
+     
+ 
+        CASE ( 0, 1, 3, 4 )    !   3, 4 : T-Pivot at North Fold
+        
+            DO ji = 2, jpiglo_crsm1
+               ijie = (ji*nn_factx)-nn_factx   !cc
+               ijis = ijie-nn_factx+1
+               mis2_crs(ji) = ijis
+               mie2_crs(ji) = ijie
+            ENDDO
+            IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie2_crs(jpiglo_crsm1)  = jpiglo-2  
+
+            ! Handle first the northernmost bin
+            IF ( nn_facty == 2 ) THEN   ;    ijjgloT = jpjglo - 1 
+            ELSE                        ;    ijjgloT = jpjglo
+            ENDIF
+
+            DO jj = 2, jpjglo_crsm1
+                ijje = ijjgloT-nn_facty*(jj-2)
+                ijjs = ijje-nn_facty+1                   
+                mjs2_crs(jpjglo_crs-jj+1) = ijjs
+                mje2_crs(jpjglo_crs-jj+1) = ijje
+            ENDDO
+
+         CASE ( 2 ) 
+            WRITE(numout,*)  'crs_init, jperio=2 not supported' 
+        
+         CASE ( 5, 6 )    ! F-pivot at North Fold
+
+            DO ji = 2, jpiglo_crsm1
+               ijie = (ji*nn_factx)-nn_factx 
+               ijis = ijie-nn_factx+1
+               mis2_crs(ji) = ijis
+               mie2_crs(ji) = ijie
+            ENDDO
+            IF ( jpiglo - 1 - mie2_crs(jpiglo_crsm1) <= nn_factx ) mie_crs(jpiglo_crsm1)  = jpiglo-2 
+
+            ! Treat the northernmost bin separately.
+            jj = 2
+            ijje = jpj-nn_facty*(jj-2)
+            IF ( nn_facty == 3 ) THEN   ;  ijjs = ijje - 1 
+            ELSE                        ;  ijjs = ijje - nn_facty + 1
+            ENDIF
+            mjs2_crs(jpj_crs-jj+1) = ijjs
+            mje2_crs(jpj_crs-jj+1) = ijje
+
+            ! Now bin the rest, any remainder at the south is lumped in the southern bin
+            DO jj = 3, jpjglo_crsm1
+                ijje = jpjglo-nn_facty*(jj-2)
+                ijjs = ijje-nn_facty+1                  
+                IF ( ijjs <= nn_facty )   ijjs = 2
+                mjs2_crs(jpj_crs-jj+1) = ijjs
+                mje2_crs(jpj_crs-jj+1) = ijje
+            ENDDO
+
+         CASE DEFAULT
+            WRITE(numout,*) 'crs_init. Only jperio = 0, 1, 3, 4, 5, 6 supported' 
+ 
+         END SELECT
+
+      CASE (1 )
+         WRITE(numout,*) 'crs_init.  Equator-centered bins option not yet available' 
+
+      END SELECT
+
+     ! Pad the boundaries, do not know if it is necessary
+      mis2_crs(1) = 1             ; mis2_crs(jpiglo_crs) = mie2_crs(jpiglo_crs - 1) + 1   
+      mie2_crs(1) = nn_factx      ; mie2_crs(jpiglo_crs) = jpiglo                         
+      mje2_crs(1) = mjs2_crs(2)-1 ; mje2_crs(jpjglo_crs) = jpjglo
+      mjs2_crs(1) = 1             ; mjs2_crs(jpjglo_crs) = mje2_crs(jpjglo_crs) - nn_facty + 1 
+ 
+      IF( .NOT. lk_mpp ) THEN     
+        mis_crs(:) = mis2_crs(:) 
+        mie_crs(:) = mie2_crs(:)
+        mjs_crs(:) = mjs2_crs(:) 
+        mje_crs(:) = mje2_crs(:) 
+      ELSE
+        DO jj = 1, nlej_crs
+           mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1
+           mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1
+        ENDDO
+        DO ji = 1, nlei_crs
+           mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1
+           mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1
+        ENDDO
+      ENDIF
+      njstr = mjs_crs(2)  ;   njend = mjs_crs(nlcj_crs - 1)
+      nistr = mis_crs(2)  ;   niend = mis_crs(nlci_crs - 1)
+      !
+   END SUBROUTINE crs_dom_def
+   
+   SUBROUTINE crs_dom_bat
+      !!----------------------------------------------------------------
+      !!               *** SUBROUTINE crs_dom_bat ***
+      !! ** Purpose :  coarsenig bathy
+      !!----------------------------------------------------------------
+      !! 
+      !!  local variables
+      INTEGER  :: ji,jj,jk      ! dummy indices
+      REAL(wp), DIMENSION(:,:)  , POINTER :: zmbk
+      !!----------------------------------------------------------------
+   
+      CALL wrk_alloc( jpi_crs, jpj_crs, zmbk )
+   
+      mbathy_crs(:,:) = jpkm1
+      mbkt_crs(:,:) = 1
+      mbku_crs(:,:) = 1
+      mbkv_crs(:,:) = 1
+
+
+      DO jj = 1, jpj_crs
+         DO ji = 1, jpi_crs
+            jk = 0
+            DO WHILE( tmask_crs(ji,jj,jk+1) > 0.)
+               jk = jk + 1
+            ENDDO
+            mbathy_crs(ji,jj) = float( jk )
+         ENDDO
+      ENDDO
+     
+      CALL wrk_alloc( jpi_crs, jpj_crs, zmbk )
+
+      zmbk(:,:) = 0.0
+      zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ;   CALL crs_lbc_lnk(zmbk,'T',1.0)   ;   mbathy_crs(:,:) = INT( zmbk(:,:) )
+
+
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    crsini : mbkt is ocean bottom k-index of T-, U-, V- and W-levels '
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~'
+      !
+      mbkt_crs(:,:) = MAX( mbathy_crs(:,:) , 1 )    ! bottom k-index of T-level (=1 over land)
+      !                                     ! bottom k-index of W-level = mbkt+1
+
+      DO jj = 1, jpj_crsm1                      ! bottom k-index of u- (v-) level
+         DO ji = 1, jpi_crsm1
+            mbku_crs(ji,jj) = MIN(  mbkt_crs(ji+1,jj  ) , mbkt_crs(ji,jj)  )
+            mbkv_crs(ji,jj) = MIN(  mbkt_crs(ji  ,jj+1) , mbkt_crs(ji,jj)  )
+         END DO
+      END DO
+
+      ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk
+      zmbk(:,:) = 1.e0;    
+      zmbk(:,:) = REAL( mbku_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'U',1.0) ; mbku_crs  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
+      zmbk(:,:) = REAL( mbkv_crs(:,:), wp )   ;   CALL crs_lbc_lnk(zmbk,'V',1.0) ; mbkv_crs  (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 
+      !
+      CALL wrk_dealloc( jpi_crs, jpj_crs, zmbk )
+      !
+   END SUBROUTINE crs_dom_bat
+
+
+END MODULE crsdom
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90	(revision 4015)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90	(revision 4015)
@@ -0,0 +1,361 @@
+MODULE crsdomwri
+   !!======================================================================
+   !! Coarse Ocean initialization : write the coarse ocean domain mesh and mask files
+   !!======================================================================
+   !! History :  OPA  ! 1997-02  (G. Madec)  Original code
+   !!            8.1  ! 1999-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file
+   !!            3.0  ! 2008-01  (S. Masson) add dom_uniq
+   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!                 ! 2012-06  (J. Simeon, C. Calone, C Ethe )  Reduced and modified for coarse grid
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   crs_dom_wri    : create and write mesh and mask file(s)
+   !!----------------------------------------------------------------------
+   USE timing          ! Timing
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE par_kind, ONLY: wp
+   USE lib_mpp         ! MPP library
+   USE iom_def
+   USE iom
+   USE crs         ! coarse grid domain
+   USE crsdom         ! coarse grid domain
+   USE crslbclnk       ! crs mediator to lbclnk
+
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC crs_dom_wri        ! routine called by crsini.F90
+
+CONTAINS
+
+   SUBROUTINE crs_dom_wri
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE crs_dom_wri  ***
+      !!
+      !! ** Purpose :   Create the NetCDF file(s) which contain(s) all the
+      !!      ocean domain informations (mesh and mask arrays). This (these)
+      !!      file(s) is (are) used for visualisation (SAXO software) and
+      !!      diagnostic computation.
+      !!
+      !! ** Method  :   Write in a file all the arrays generated in routines
+      !!      crsini for meshes and mask. In three separate files: 
+      !!      domain size, horizontal grid-point position,
+      !!      masks, depth and vertical scale factors
+      !!      
+      !! ** Output files :   mesh_hgr_crs.nc, mesh_zgr_crs.nc, mesh_mask.nc
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file
+      INTEGER           ::   inum1    ! temprary units for 'mesh.nc'      file
+      INTEGER           ::   inum2    ! temprary units for 'mask.nc'      file
+      INTEGER           ::   inum3    ! temprary units for 'mesh_hgr.nc'  file
+      INTEGER           ::   inum4    ! temprary units for 'mesh_zgr.nc'  file
+      INTEGER           ::   iif, iil, ijf, ijl
+      CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations)
+      CHARACTER(len=21) ::   clnam1   ! filename (mesh informations)
+      CHARACTER(len=21) ::   clnam2   ! filename (mask informations)
+      CHARACTER(len=21) ::   clnam3   ! filename (horizontal mesh informations)
+      CHARACTER(len=21) ::   clnam4   ! filename (vertical   mesh informations)
+      INTEGER           ::   ji, jj, jk   ! dummy loop indices
+      !                                   !  workspaces
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zprt, zprw 
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zdepu, zdepv
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: ze3tp, ze3wp
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('crs_dom_wri')
+      !
+      ALLOCATE( zprt  (jpi_crs,jpj_crs)   , zprw(jpi_crs,jpj_crs) )
+      ALLOCATE( zdepu(jpi_crs,jpj_crs,jpk), zdepv(jpi_crs,jpj_crs,jpk) )
+      ALLOCATE( ze3tp(jpi_crs,jpj_crs)    , ze3wp(jpi_crs,jpj_crs) )
+
+      ze3tp(:,:) = 0.0
+      ze3wp(:,:) = 0.0
+
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'crs_dom_wri : create NetCDF mesh and mask information file(s)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+      
+      clnam0 = 'mesh_mask_crs'  ! filename (mesh and mask informations)
+      clnam1 = 'mesh_crs'       ! filename (mesh informations)
+      clnam2 = 'mask_crs'       ! filename (mask informations)
+      clnam3 = 'mesh_hgr_crs'   ! filename (horizontal mesh informations)
+      clnam4 = 'mesh_zgr_crs'   ! filename (vertical   mesh informations)
+      
+
+      SELECT CASE ( MOD(nn_msh_crs, 3) )
+         !                                  ! ============================
+      CASE ( 1 )                            !  create 'mesh_mask.nc' file
+         !                                  ! ============================
+         CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib )
+         inum2 = inum0                                            ! put all the informations
+         inum3 = inum0                                            ! in unit inum0
+         inum4 = inum0
+         
+         !                                  ! ============================
+      CASE ( 2 )                            !  create 'mesh.nc' and 
+         !                                  !         'mask.nc' files
+         !                                  ! ============================
+         CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
+         inum3 = inum1                                            ! put mesh informations 
+         inum4 = inum1                                            ! in unit inum1 
+         !                                  ! ============================
+      CASE ( 0 )                            !  create 'mesh_hgr.nc'
+         !                                  !         'mesh_zgr.nc' and
+         !                                  !         'mask.nc'     files
+         !                                  ! ============================
+         CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib )
+         !
+      END SELECT
+ 
+      !========================================================
+      !                                                         ! masks (inum2) 
+      CALL iom_rstput( 0, 0, inum2, 'tmask', tmask_crs, ktype = jp_i1 )     !    ! land-sea mask
+      CALL iom_rstput( 0, 0, inum2, 'umask', umask_crs, ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum2, 'vmask', vmask_crs, ktype = jp_i1 )
+      CALL iom_rstput( 0, 0, inum2, 'fmask', fmask_crs, ktype = jp_i1 )
+      
+      
+      tmask_i_crs(:,:) = tmask_crs(:,:,1)
+      iif = jpreci
+      iil = nlci_crs - jpreci + 1
+      ijf = jpreci
+      ijl = nlcj_crs - jprecj + 1
+     
+      tmask_i_crs( 1:iif ,    :  ) = 0._wp
+      tmask_i_crs(iil:jpi_crs,    :  ) = 0._wp
+      tmask_i_crs(   :   , 1:ijf ) = 0._wp
+      tmask_i_crs(   :   ,ijl:jpj_crs) = 0._wp
+      
+      
+      tpol_crs(1:jpiglo_crs,:) = 1._wp
+      fpol_crs(1:jpiglo_crs,:) = 1._wp
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         tpol_crs(jpiglo_crs/2+1:jpiglo_crs,:) = 0._wp
+         fpol_crs(       1      :jpiglo_crs,:) = 0._wp
+         IF( mjg_crs(nlej_crs) == jpiglo_crs ) THEN
+            DO ji = iif+1, iil-1
+               tmask_i_crs(ji,nlej_crs-1) = tmask_i_crs(ji,nlej_crs-1) &
+               & * tpol_crs(mig_crs(ji),1)
+            ENDDO
+         ENDIF
+      ENDIF
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+         tpol_crs(      1       :jpiglo_crs,:)=0._wp
+         fpol_crs(jpiglo_crs/2+1:jpiglo_crs,:)=0._wp
+      ENDIF
+      
+ !     CALL iom_rstput( 0, 0, inum2, 'tpol', pv_r2d=tpol_crs, ktype = jp_i1 )  
+ !     CALL iom_rstput( 0, 0, inum2, 'fpol', pv_r2d=fpol_crs, ktype = jp_i1 )  
+
+      !!!
+      CALL iom_rstput( 0, 0, inum2, 'tmaskutil', tmask_i_crs, ktype = jp_i1 )
+                                   !    ! unique point mask
+      CALL dom_uniq( zprw, 'U' )
+      zprt = umask_crs(:,:,1) * zprw
+      CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'V' )
+      zprt = vmask_crs(:,:,1) * zprw
+      CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'F' )
+      zprt = fmask_crs(:,:,1) * zprw
+      CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 )  
+      !========================================================
+      !                                                         ! horizontal mesh (inum3)
+      CALL iom_rstput( 0, 0, inum3, 'glamt', glamt_crs, ktype = jp_r4 )     !    ! latitude
+      CALL iom_rstput( 0, 0, inum3, 'glamu', glamu_crs, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum3, 'glamv', glamv_crs, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum3, 'glamf', glamf_crs, ktype = jp_r4 )
+      
+      CALL iom_rstput( 0, 0, inum3, 'gphit', gphit_crs, ktype = jp_r4 )     !    ! longitude
+      CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu_crs, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv_crs, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum3, 'gphif', gphif_crs, ktype = jp_r4 )
+      
+      CALL iom_rstput( 0, 0, inum3, 'e1t', e1t_crs, ktype = jp_r8 )         !    ! e1 scale factors
+      CALL iom_rstput( 0, 0, inum3, 'e1u', e1u_crs, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'e1v', e1v_crs, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'e1f', e1f_crs, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum3, 'e2t', e2t_crs, ktype = jp_r8 )         !    ! e2 scale factors
+      CALL iom_rstput( 0, 0, inum3, 'e2u', e2u_crs, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'e2v', e2v_crs, ktype = jp_r8 )
+      CALL iom_rstput( 0, 0, inum3, 'e2f', e2f_crs, ktype = jp_r8 )
+      
+      CALL iom_rstput( 0, 0, inum3, 'ff', ff_crs, ktype = jp_r8 )           !    ! coriolis factor
+
+      !========================================================
+      !                                                         ! vertical mesh (inum4) 
+!     ! note that mbkt is set to 1 over land ==> use surface tmask_crs
+      zprt(:,:) = tmask_crs(:,:,1) * REAL( mbkt_crs(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 )     !    ! nb of ocean T-points
+
+      IF( ln_zps ) THEN                       ! z-coordinate - partial steps
+
+            
+         IF ( nn_msh_crs <= 6 ) THEN
+            CALL iom_rstput( 0, 0, inum4, 'e3t', e3t_crs )      
+            CALL iom_rstput( 0, 0, inum4, 'e3w', e3w_crs )      
+            CALL iom_rstput( 0, 0, inum4, 'e3u', e3u_crs )      
+            CALL iom_rstput( 0, 0, inum4, 'e3v', e3v_crs )      
+         ELSE
+            DO jj = 1,jpj_crs   
+               DO ji = 1,jpi_crs
+                  ze3tp(ji,jj) = fse3t_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1)
+                  ze3wp(ji,jj) = fse3w_crs(ji,jj,mbkt_crs(ji,jj)) * tmask_crs(ji,jj,1)
+               END DO
+            END DO
+
+            CALL crs_lbc_lnk( ze3tp,'T', 1.0 )
+            CALL crs_lbc_lnk( ze3wp,'W', 1.0 )
+  
+            CALL iom_rstput( 0, 0, inum4, 'e3t_ps', ze3tp )      
+            CALL iom_rstput( 0, 0, inum4, 'e3w_ps', ze3wp )
+         ENDIF
+
+         IF ( nn_msh_crs <= 3 ) THEN
+            CALL iom_rstput( 0, 0, inum4, 'gdept', gdept_crs, ktype = jp_r4 ) 
+            DO jk = 1,jpk   
+               DO jj = 1, jpj_crsm1   
+                  DO ji = 1, jpi_crsm1  ! jes what to do for fs_jpim1??vector opt.
+                     zdepu(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji+1,jj  ,jk) ) * umask_crs(ji,jj,jk)
+                     zdepv(ji,jj,jk) = MIN( gdept_crs(ji,jj,jk) , gdept_crs(ji  ,jj+1,jk) ) * vmask_crs(ji,jj,jk)
+                  END DO   
+               END DO   
+            END DO
+
+            CALL crs_lbc_lnk( zdepu,'U', 1. )   ;   CALL crs_lbc_lnk( zdepv,'V', 1. ) 
+            CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r4 )
+            CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r4 )
+            CALL iom_rstput( 0, 0, inum4, 'gdepw', gdepw_crs, ktype = jp_r4 )
+         ELSE
+            DO jj = 1,jpj_crs   
+               DO ji = 1,jpi_crs
+                  zprt(ji,jj) = gdept(ji,jj,mbkt(ji,jj)  ) * tmask(ji,jj,1)
+                  zprw(ji,jj) = gdepw(ji,jj,mbkt(ji,jj)+1) * tmask(ji,jj,1)
+               END DO
+            END DO
+            CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r4 )     
+            CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r4 ) 
+         ENDIF
+
+         CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 )     !    ! reference z-coord.
+         CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 )
+         CALL iom_rstput( 0, 0, inum4, 'e3t_0'  , e3t_0   )
+         CALL iom_rstput( 0, 0, inum4, 'e3w_0'  , e3w_0   )
+
+         CALL iom_rstput(  0, 0, inum4, 'ocean_volume_t', ocean_volume_crs_t ) 
+         CALL iom_rstput(  0, 0, inum4, 'facvol_t' , facvol_t  ) 
+         CALL iom_rstput(  0, 0, inum4, 'facvol_w' , facvol_w  ) 
+         CALL iom_rstput(  0, 0, inum4, 'facsurfu' , facsurfu  ) 
+         CALL iom_rstput(  0, 0, inum4, 'facsurfv' , facsurfv  ) 
+         CALL iom_rstput(  0, 0, inum4, 'e1e2w_msk', e1e2w_msk ) 
+         CALL iom_rstput(  0, 0, inum4, 'e2e3u_msk', e2e3u_msk ) 
+         CALL iom_rstput(  0, 0, inum4, 'e1e3v_msk', e1e3v_msk )
+         CALL iom_rstput(  0, 0, inum4, 'e1e2w'    , e1e2w_crs ) 
+         CALL iom_rstput(  0, 0, inum4, 'e2e3u'    , e2e3u_crs ) 
+         CALL iom_rstput(  0, 0, inum4, 'e1e3v'    , e1e3v_crs )
+         CALL iom_rstput(  0, 0, inum4, 'bt'       , bt_crs    )
+         CALL iom_rstput(  0, 0, inum4, 'r1_bt'    , r1_bt_crs )
+
+         CALL iom_rstput(  0, 0, inum4, 'crs_surfu_wgt', crs_surfu_wgt ) 
+         CALL iom_rstput(  0, 0, inum4, 'crs_surfv_wgt', crs_surfv_wgt ) 
+         CALL iom_rstput(  0, 0, inum4, 'crs_volt_wgt' , crs_volt_wgt  ) 
+
+      ENDIF
+      
+     IF( ln_zco ) THEN
+         !                                                      ! z-coordinate - full steps
+        CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 )     !    ! depth
+        CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 )
+        CALL iom_rstput( 0, 0, inum4, 'e3t_0'  , e3t_0   )     !    ! scale factors
+        CALL iom_rstput( 0, 0, inum4, 'e3w_0'  , e3w_0   )
+     ENDIF
+      !                                     ! ============================
+      !                                     !        close the files 
+      !                                     ! ============================
+      SELECT CASE ( MOD(nn_msh_crs, 3) )
+      CASE ( 1 )                
+         CALL iom_close( inum0 )
+      CASE ( 2 )
+         CALL iom_close( inum1 )
+         CALL iom_close( inum2 )
+      CASE ( 0 )
+         CALL iom_close( inum2 )
+         CALL iom_close( inum3 )
+         CALL iom_close( inum4 )
+      END SELECT
+      !
+      !
+      DEALLOCATE( zprt  , zprw )
+      DEALLOCATE( zdepu , zdepv )
+      DEALLOCATE( ze3tp , ze3wp )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('crs_dom_wri')
+      !
+      
+   END SUBROUTINE crs_dom_wri
+
+
+   SUBROUTINE dom_uniq( puniq, cdgrd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE crs_dom_uniq  ***
+      !!                   
+      !! ** Purpose :   identify unique point of a grid (TUVF)
+      !!
+      !! ** Method  :   1) apply crs_lbc_lnk on an array with different values for each element
+      !!                2) check which elements have been changed
+      !!----------------------------------------------------------------------
+      !
+      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   ! 
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   ! 
+      !
+      REAL(wp) ::  zshift   ! shift value link to the process number
+      INTEGER  ::  ji       ! dummy loop indices
+      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not
+!      REAL(wp), POINTER, DIMENSION(:,:) :: ztstref
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztstref
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('crs_dom_uniq')
+      !
+!      CALL wrk_alloc( jpi_crs, jpj_crs, ztstref )
+      ALLOCATE( ztstref(jpi_crs,jpj_crs) )
+      !
+      ! build an array with different values for each element 
+      ! in mpp: make sure that these values are different even between process
+      ! -> apply a shift value according to the process number
+      zshift = jpi_crs * jpj_crs * ( narea - 1 )
+      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi_crs*jpj_crs) /), (/ jpi_crs, jpj_crs /) )
+      !
+      puniq(:,:) = ztstref(:,:)                   ! default definition
+      CALL crs_lbc_lnk( puniq,cdgrd, 1. )            ! apply boundary conditions
+      lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed 
+      !
+      puniq(:,:) = 1.                             ! default definition
+      ! fill only the inner part of the cpu with llbl converted into real 
+      puniq(nldi_crs:nlei_crs,nldj_crs:nlej_crs) = REAL( COUNT( lldbl(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:), dim = 3 ) , wp )
+      !
+!      CALL wrk_dealloc( jpi_crs, jpj_crs, ztstref )
+
+      DEALLOCATE( ztstref )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('crs_dom_uniq')
+      !
+      
+   END SUBROUTINE dom_uniq
+
+   !!======================================================================
+
+END MODULE crsdomwri
+
+
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 4015)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90	(revision 4015)
@@ -0,0 +1,249 @@
+MODULE crsfld
+   !!======================================================================
+   !!                     ***  MODULE  crsdfld  ***
+   !!  Ocean coarsening :  coarse ocean fields
+   !!=====================================================================
+   !!   2012-07  (J. Simeon, C. Calone, G. Madec, C. Ethe)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   crs_fld       : create the standard output files for coarse grid and prep
+   !!                       other variables needed to be passed to TOP
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE zdf_oce         ! vertical  physics: ocean fields
+   USE zdfddm          ! vertical  physics: double diffusion
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE timing          ! preformance summary
+   USE wrk_nemo        ! working array
+   USE crs
+   USE crsdom
+   USE crslbclnk
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   crs_fld                 ! routines called by step.F90
+
+
+   !! * Substitutions
+#  include "zdfddm_substitute.h90"
+#  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 crs_fld( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE crs_fld  ***
+      !!                   
+      !! ** Purpose :   Basic output of coarsened dynamics and tracer fields 
+      !!      NETCDF format is used by default 
+      !!      1. Accumulate in time the dimensionally-weighted fields
+      !!      2. At time of output, rescale [1] by dimension and time
+      !!         to yield the spatial and temporal average.
+      !!  See. diawri_dimg.h90, sbcmod.F90
+      !!
+      !! ** Method  :  
+      !!----------------------------------------------------------------------
+      !!
+      
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!
+      INTEGER               ::   ji, jj, jk              ! dummy loop indices
+      !!
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs 
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs !
+      REAL(wp)       :: z2dcrsu, z2dcrsv
+      !!
+       !!----------------------------------------------------------------------
+      ! 
+
+      IF( nn_timing == 1 )   CALL timing_start('crs_fld')
+
+      !  Initialize arrays
+      CALL wrk_alloc( jpi, jpj, jpk, zfse3t, zfse3w )
+      CALL wrk_alloc( jpi, jpj, jpk, zfse3u, zfse3v )
+      CALL wrk_alloc( jpi, jpj, jpk, zt, zs       )
+      !
+      CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs )
+
+      ! Depth work arrrays
+      zfse3t(:,:,:) = fse3t(:,:,:)
+      zfse3u(:,:,:) = fse3u(:,:,:)
+      zfse3v(:,:,:) = fse3v(:,:,:)
+      zfse3w(:,:,:) = fse3w(:,:,:)
+
+      IF( kt == nit000  ) THEN
+         tsn_crs  (:,:,:,:) = 0._wp    ! temp/sal  array, now 
+         un_crs   (:,:,:  ) = 0._wp    ! u-velocity
+         vn_crs   (:,:,:  ) = 0._wp    ! v-velocity
+         wn_crs   (:,:,:  ) = 0._wp    ! w
+         avs_crs  (:,:,:  ) = 0._wp    ! avt
+         hdivn_crs(:,:,:  ) = 0._wp    ! hdiv
+         rke_crs  (:,:,:  ) = 0._wp    ! rke
+         sshn_crs (:,:    ) = 0._wp    ! ssh
+         utau_crs (:,:    ) = 0._wp    ! taux
+         vtau_crs (:,:    ) = 0._wp    ! tauy
+         wndm_crs (:,:    ) = 0._wp    ! wind speed
+         qsr_crs  (:,:    ) = 0._wp    ! qsr
+         emp_crs  (:,:    ) = 0._wp    ! emp
+         emp_b_crs(:,:    ) = 0._wp    ! emp
+         rnf_crs  (:,:    ) = 0._wp    ! runoff
+         fr_i_crs (:,:    ) = 0._wp    ! ice cover
+      ENDIF
+
+      CALL iom_swap( "nemo_crs" )    ! swap on the coarse grid
+
+      ! 2. Coarsen fields at each time step
+      ! --------------------------------------------------------
+
+      !  Temperature
+      zt(:,:,:) = tsn(:,:,:,jp_tem)  ;      zt_crs(:,:,:) = 0._wp
+      CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=zfse3t )
+      tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:)
+
+      CALL iom_put( "toce", tsn_crs(:,:,:,jp_tem) )    ! temp
+      CALL iom_put( "sst" , tsn_crs(:,:,1,jp_tem) )    ! sst
+
+      
+      !  Salinity
+      zs(:,:,:) = tsn(:,:,:,jp_sal)  ;      zs_crs(:,:,:) = 0._wp
+      CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=zfse3t )
+      tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:)
+
+      CALL iom_put( "soce" , tsn_crs(:,:,:,jp_sal) )    ! sal
+      CALL iom_put( "sss"  , tsn_crs(:,:,1,jp_sal) )    ! sss
+
+      !  U-velocity
+      CALL crs_dom_ope( un, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk )
+      !
+      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   
+               zt(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
+               zs(ji,jj,jk)  = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
+            END DO
+         END DO
+      END DO
+      CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk )
+      CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=zfse3u, p_surf_crs=e2e3u_msk )
+
+      CALL iom_put( "uoce"  , un_crs )   ! i-current 
+      CALL iom_put( "uocet" , zt_crs )   ! uT
+      CALL iom_put( "uoces" , zs_crs )   ! uS
+
+      !  V-velocity
+      CALL crs_dom_ope( vn, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk )
+      !                                                                                 
+      zt(:,:,:) = 0._wp     ;    zs(:,:,:) = 0._wp  ;   zt_crs(:,:,:) = 0._wp   ;    zs_crs(:,:,:) = 0._wp
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   
+               zt(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
+               zs(ji,jj,jk)  = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 
+            END DO
+         END DO
+      END DO
+      CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk )
+      CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=zfse3v, p_surf_crs=e1e3v_msk )
+ 
+      CALL iom_put( "voce"  , vn_crs )   ! i-current 
+      CALL iom_put( "vocet" , zt_crs )   ! vT
+      CALL iom_put( "voces" , zs_crs )   ! vS
+
+     
+      !  Kinetic energy
+      CALL crs_dom_ope( rke, 'VOL', 'T', tmask, rke_crs, p_e12=e1e2t, p_e3=zfse3t )
+      CALL iom_put( "eken", rke_crs )
+
+      !  Horizontal divergence ( following OPA_SRC/DYN/divcur.F90 ) 
+      DO jk = 1, jpkm1
+         DO ji = 2, jpi_crsm1
+            DO jj = 2, jpj_crsm1
+               IF( tmask_crs(ji,jj,jk ) > 0 ) THEN
+                   z2dcrsu =  ( un_crs(ji  ,jj  ,jk) * crs_surfu_wgt(ji  ,jj  ,jk) ) &
+                      &     - ( un_crs(ji-1,jj  ,jk) * crs_surfu_wgt(ji-1,jj  ,jk) )
+                   z2dcrsv =  ( vn_crs(ji  ,jj  ,jk) * crs_surfv_wgt(ji  ,jj  ,jk) ) &
+                      &     - ( vn_crs(ji  ,jj-1,jk) * crs_surfv_wgt(ji  ,jj-1,jk) )
+                   !
+                   hdivn_crs(ji,jj,jk) = ( z2dcrsu + z2dcrsv ) / crs_volt_wgt(ji,jj,jk) 
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDDO
+      CALL crs_lbc_lnk( hdivn_crs, 'T', 1.0  )
+      !
+      CALL iom_put( "hdiv", hdivn_crs )  
+
+
+      !  W-velocity
+      IF( ln_crs_wn ) THEN
+         CALL crs_dom_ope( wn, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk )
+       !  CALL crs_dom_ope( wn, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=zfse3w )
+      ELSE
+        wn_crs(:,:,jpk) = 0._wp
+        DO jk = jpkm1, 1, -1
+           wn_crs(:,:,jk) = wn_crs(:,:,jk+1) - e3t_crs(:,:,jk) * hdivn_crs(:,:,jk)
+        ENDDO
+      ENDIF
+      CALL iom_put( "woce", wn_crs  )   ! vertical velocity
+      !  free memory
+
+      !  avt, avs
+      SELECT CASE ( nn_crs_kz )
+         CASE ( 0 )
+            CALL crs_dom_ope( fsavs(:,:,:), 'VOL', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=zfse3w )
+         CASE ( 1 )
+            CALL crs_dom_ope( fsavs(:,:,:), 'MAX', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=zfse3w )
+         CASE ( 2 )
+            CALL crs_dom_ope( fsavs(:,:,:), 'MIN', 'W', tmask, avs_crs, p_e12=e1e2t, p_e3=zfse3w )
+      END SELECT
+      !
+      CALL iom_put( "avs", avs_crs )   !  Kz
+      
+      !  sbc fields  
+      CALL crs_dom_ope( sshn , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=zfse3t          )  
+      CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u  , p_surf_crs=e2u_crs   )
+      CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v  , p_surf_crs=e1v_crs   )
+      CALL crs_dom_ope( wndm , 'SUM', 'T', tmask, wndm_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs )
+      CALL crs_dom_ope( rnf  , 'MAX', 'T', tmask, rnf_crs                                      )
+      CALL crs_dom_ope( qsr  , 'SUM', 'T', tmask, qsr_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs )
+      CALL crs_dom_ope( emp_b, 'SUM', 'T', tmask, emp_b_crs, p_e12=e1e2t, p_surf_crs=e1e2t_crs )
+      CALL crs_dom_ope( emp  , 'SUM', 'T', tmask, emp_crs  , p_e12=e1e2t, p_surf_crs=e1e2t_crs )
+      CALL crs_dom_ope( fr_i , 'SUM', 'T', tmask, fr_i_crs , p_e12=e1e2t, p_surf_crs=e1e2t_crs )
+
+      CALL iom_put( "ssh"      , sshn_crs )   ! ssh output 
+      CALL iom_put( "utau"     , utau_crs )   ! i-tau output 
+      CALL iom_put( "vtau"     , vtau_crs )   ! j-tau output 
+      CALL iom_put( "wspd"     , wndm_crs )   ! wind speed output 
+      CALL iom_put( "runoffs"  , rnf_crs  )   ! runoff output 
+      CALL iom_put( "qsr"      , qsr_crs  )   ! qsr output 
+      CALL iom_put( "empmr"    , emp_crs  )   ! water flux output 
+      CALL iom_put( "ice_cover", fr_i_crs )   ! ice cover output 
+
+      !  free memory
+      CALL wrk_dealloc( jpi, jpj, jpk, zfse3t, zfse3w )
+      CALL wrk_dealloc( jpi, jpj, jpk, zfse3u, zfse3v )
+      CALL wrk_dealloc( jpi, jpj, jpk, zt, zs       )
+      CALL wrk_dealloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs )
+      !
+      CALL iom_swap( "nemo" )     ! return back on high-resolution grid
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('crs_fld')
+      !
+   END SUBROUTINE crs_fld
+
+   !!======================================================================
+END MODULE crsfld
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 4015)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90	(revision 4015)
@@ -0,0 +1,251 @@
+MODULE crsini   
+   !!======================================================================
+   !!                         ***  MODULE crsini  ***
+   !!            Manage the grid coarsening module initialization
+   !!======================================================================
+   !!  History     2012-05   (J. Simeon, G. Madec, C. Ethe, C. Calone) Original code
+   !!----------------------------------------------------------------------
+
+   USE timing                   ! Timing
+   USE par_oce                  ! For parameter jpi,jpj,jphgr_msh
+   USE dom_oce                  ! For parameters in par_oce (jperio, lk_vvl)
+   USE crs                  ! Coarse grid domain
+   USE phycst, ONLY: omega, rad ! physical constants
+   USE wrk_nemo 
+   USE in_out_manager
+   USE par_kind, ONLY: wp
+   USE iom
+   USE crsdom
+   USE crsdomwri
+   USE crslbclnk
+   USE lib_mpp
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  crs_init
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+
+CONTAINS
+   
+   SUBROUTINE crs_init 
+      !!-------------------------------------------------------------------
+      !!                     *** SUBROUTINE crs_init
+      !!  ** Purpose : Initialization of the grid coarsening module  
+      !!               1. Read namelist
+      !!               X2. MOVE TO crs_dom.F90 Set the domain definitions for coarse grid
+      !!                 a. Define the coarse grid starting/ending indices on parent grid
+      !!                    Here is where the T-pivot or F-pivot grids are discerned
+      !!                 b. TODO.  Include option for north-centric or equator-centric binning.
+      !!                 (centered only for odd reduction factors; even reduction bins bias equator to the south)
+      !!               3. Mask and mesh creation. => calls to crsfun
+      !!                  a. Use crsfun_mask to generate tmask,umask, vmask, fmask.
+      !!                  b. Use crsfun_coordinates to get coordinates
+      !!                  c. Use crsfun_UV to get horizontal scale factors
+      !!                  d. Use crsfun_TW to get initial vertical scale factors   
+      !!               4. Volumes and weights jes.... TODO. Updates for vvl? Where to do this? crsstp.F90?
+      !!                  a. Calculate initial coarse grid box volumes: pvol_T, pvol_W
+      !!                  b. Calculate initial coarse grid surface-averaging weights
+      !!                  c. Calculate initial coarse grid volume-averaging weights
+      !!                  
+      !!               X5. MOVE TO crs_dom_wri.F90 Using iom_rstput output the initial meshmask.
+      !!               ?. Another set of "masks" to generate
+      !!                  are the u- and v- surface areas for U- and V- area-weighted means.
+      !!                  Need to put this somewhere in section 3?
+      !! jes. What do to about the vvl?  GM.  could separate the weighting (denominator), so
+      !! output C*dA or C*dV as summation not mran, then do mean (division) at moment of output.
+      !! As is, crsfun takes into account vvl.   
+      !!      Talked about pre-setting the surface array to avoid IF/ENDIFS and division.
+      !!      But have then to make that preset array here and elsewhere.
+      !!      that is called every timestep...
+      !! 
+      !!               - Read in pertinent data ?
+      !!-------------------------------------------------------------------
+      !! Local variables
+      INTEGER  :: ji,jj,jk      ! dummy indices
+      INTEGER  :: ierr                                ! allocation error status
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zfse3t, zfse3u, zfse3v, zfse3w
+
+      NAMELIST/namcrs/ nn_factx, nn_facty, nn_binref, nn_msh_crs, nn_crs_kz, ln_crs_wn
+
+
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('crs_init')
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'crs_init : Initializing the grid coarsening module '
+      ENDIF
+
+     !---------------------------------------------------------
+     ! 1. Read Namelist file
+     !---------------------------------------------------------
+     !
+     REWIND( numnam )            ! Read Namelist namtra_qsr : ratio and length of penetration
+     READ  ( numnam, namcrs )        ! Namelist namcrs : Grid-coarsening utility namelist
+     IF(lwp) THEN
+        WRITE(numout,*)
+        WRITE(numout,*) 'crs_init: Namelist namcrs '
+        WRITE(numout,*) '   coarsening factor in i-direction      nn_factx   = ', nn_factx
+        WRITE(numout,*) '   coarsening factor in j-direction      nn_facty   = ', nn_facty
+        WRITE(numout,*) '   bin centering preference              nn_binref  = ', nn_binref
+        WRITE(numout,*) '   create (=1) a mesh file or not (=0)   nn_msh_crs = ', nn_msh_crs
+        WRITE(numout,*) '   type of Kz coarsening (0,1,2)         nn_crs_kz  = ', nn_crs_kz
+        WRITE(numout,*) '   wn coarsened or computed using hdivn  ln_crs_wn  = ', ln_crs_wn
+     ENDIF
+              
+     rfactx_r = 1. / nn_factx
+     rfacty_r = 1. / nn_facty
+
+     !---------------------------------------------------------
+     ! 2. Define Global Dimensions of the coarsened grid
+     !---------------------------------------------------------
+     CALL crs_dom_def      
+
+     !---------------------------------------------------------
+     ! 3. Mask and Mesh
+     !---------------------------------------------------------
+
+     !     Set up the masks and meshes     
+
+     !  3.a. Get the masks   
+ 
+     CALL crs_dom_msk
+
+
+     !  3.b. Get the coordinates
+     !      Odd-numbered reduction factor, center coordinate on T-cell
+     !      Even-numbered reduction factor, center coordinate on U-,V- faces or f-corner.
+     !      
+     IF ( nresty /= 0 .AND. nrestx /= 0 ) THEN
+        CALL crs_dom_coordinates( gphit, glamt, 'T', gphit_crs, glamt_crs ) 
+        CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )       
+        CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs ) 
+        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs ) 
+     ELSEIF ( nresty /= 0 .AND. nrestx == 0 ) THEN
+        CALL crs_dom_coordinates( gphiu, glamu, 'T', gphit_crs, glamt_crs )
+        CALL crs_dom_coordinates( gphiu, glamu, 'U', gphiu_crs, glamu_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+     ELSEIF ( nresty == 0 .AND. nrestx /= 0 ) THEN
+        CALL crs_dom_coordinates( gphiv, glamv, 'T', gphit_crs, glamt_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
+        CALL crs_dom_coordinates( gphiv, glamv, 'V', gphiv_crs, glamv_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+     ELSE 
+        CALL crs_dom_coordinates( gphif, glamf, 'T', gphit_crs, glamt_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'U', gphiu_crs, glamu_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'V', gphiv_crs, glamv_crs )
+        CALL crs_dom_coordinates( gphif, glamf, 'F', gphif_crs, glamf_crs )
+     ENDIF
+
+
+     !  3.c. Get the horizontal mesh
+
+     !      3.c.1 Horizontal scale factors
+
+     CALL crs_dom_hgr( e1t, e2t, 'T', e1t_crs, e2t_crs )
+     CALL crs_dom_hgr( e1u, e2u, 'U', e1u_crs, e2u_crs )
+     CALL crs_dom_hgr( e1v, e2v, 'V', e1v_crs, e2v_crs )
+     CALL crs_dom_hgr( e1f, e2f, 'F', e1f_crs, e2f_crs )
+
+     e1e2t_crs(:,:) = e1t_crs(:,:) * e2t_crs(:,:)
+     
+     
+     !      3.c.2 Coriolis factor  
+
+      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
+
+      CASE ( 0, 1, 4 )           ! mesh on the sphere
+
+         ff_crs(:,:) = 2. * omega * SIN( rad * gphif_crs(:,:) )
+
+      CASE DEFAULT 
+
+       IF(lwp)    WRITE(numout,*) 'crsini.F90. crs_init. Only jphgr_msh = 0, 1 or 4 supported' 
+ 
+      END SELECT 
+
+     !    3.d.1 mbathy ( vertical k-levels of bathymetry )     
+
+     CALL crs_dom_bat
+     
+     !
+     CALL wrk_alloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w )
+     !
+     zfse3t(:,:,:) = fse3t(:,:,:)
+     zfse3u(:,:,:) = fse3u(:,:,:)
+     zfse3v(:,:,:) = fse3v(:,:,:)
+     zfse3w(:,:,:) = fse3w(:,:,:)
+
+     !    3.d.2   Surfaces 
+     CALL crs_dom_sfc( tmask, 'W', e1e2w_crs, e1e2w_msk, p_e1=e1t, p_e2=e2t    )
+     CALL crs_dom_sfc( umask, 'U', e2e3u_crs, e2e3u_msk, p_e2=e2u, p_e3=zfse3u )
+     CALL crs_dom_sfc( vmask, 'V', e1e3v_crs, e1e3v_msk, p_e1=e1v, p_e3=zfse3v )
+   
+     facsurfu(:,:,:) = umask_crs(:,:,:) * e2e3u_msk(:,:,:) / e2e3u_crs(:,:,:)
+     facsurfv(:,:,:) = vmask_crs(:,:,:) * e1e3v_msk(:,:,:) / e1e3v_crs(:,:,:)
+
+     !    3.d.3   Vertical scale factors
+     !
+   
+  
+     CALL crs_dom_e3( e1t, e2t, zfse3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs)
+     CALL crs_dom_e3( e1u, e2u, zfse3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs)
+     CALL crs_dom_e3( e1v, e2v, zfse3v, e1e3v_crs, 'V', vmask, e3v_crs, e3v_max_crs)
+     CALL crs_dom_e3( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs)
+
+     ! Reset 0 to e3t_0 or e3w_0
+     DO jk = 1, jpk
+        DO ji = 1, jpi_crs
+           DO jj = 1, jpj_crs
+              IF( e3t_crs(ji,jj,jk) == 0._wp ) e3t_crs(ji,jj,jk) = e3t_0(jk)
+              IF( e3w_crs(ji,jj,jk) == 0._wp ) e3w_crs(ji,jj,jk) = e3w_0(jk)
+              IF( e3u_crs(ji,jj,jk) == 0._wp ) e3u_crs(ji,jj,jk) = e3t_0(jk)
+              IF( e3v_crs(ji,jj,jk) == 0._wp ) e3v_crs(ji,jj,jk) = e3t_0(jk)
+           ENDDO
+        ENDDO
+     ENDDO
+
+     !    3.d.3   Vertical depth (meters)
+     CALL crs_dom_ope( gdept, 'MAX', 'T', tmask, gdept_crs, p_e3=zfse3t ) 
+     CALL crs_dom_ope( gdepw, 'MAX', 'W', tmask, gdepw_crs, p_e3=zfse3w )
+
+
+     !---------------------------------------------------------
+     ! 4.  Coarse grid ocean volume and averaging weights
+     !---------------------------------------------------------
+     ! 4.a. Ocean volume or area unmasked and masked
+     CALL crs_dom_facvol( tmask, 'T', e1t, e2t, zfse3t, ocean_volume_crs_t, facvol_t )
+     !
+     bt_crs(:,:,:) = ocean_volume_crs_t(:,:,:) * facvol_t(:,:,:)
+     !
+     r1_bt_crs(:,:,:) = 0._wp 
+     WHERE( bt_crs /= 0._wp ) r1_bt_crs(:,:,:) = 1._wp / bt_crs(:,:,:)
+
+     CALL crs_dom_facvol( tmask, 'W', e1t, e2t, zfse3w, ocean_volume_crs_w, facvol_w )
+     !
+     !---------------------------------------------------------
+     ! 5.  Write out coarse meshmask  (see OPA_SRC/DOM/domwri.F90 for ideas later)
+     !---------------------------------------------------------
+
+     IF( nn_msh_crs > 0 ) THEN 
+        CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+        CALL crs_dom_wri     
+        CALL dom_grid_glo   ! Return to parent grid domain
+     ENDIF
+     
+     !---------------------------------------------------------
+     ! 7. Finish and clean-up
+     !---------------------------------------------------------
+     CALL wrk_dealloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w )
+
+
+   END SUBROUTINE crs_init
+    
+   !!======================================================================
+
+END MODULE crsini
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 4015)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90	(revision 4015)
@@ -0,0 +1,139 @@
+MODULE crslbclnk
+
+   !!======================================================================
+   !!                       ***  MODULE  crslbclnk  ***
+   !!               A temporary solution for lbclnk for coarsened grid.
+   !! Ocean        : lateral boundary conditions for grid coarsening
+   !!=====================================================================
+   !! History :   ! 2012-06  (J. Simeon, G. Madec, C. Ethe, C. Calone)     Original code
+
+   USE dom_oce
+   USE crs
+   USE lbclnk
+   USE par_kind, ONLY: wp
+   USE in_out_manager
+
+   
+   
+   INTERFACE crs_lbc_lnk
+      MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_3d_gather, crs_lbc_lnk_2d
+   END INTERFACE
+   
+   PUBLIC crs_lbc_lnk
+   
+CONTAINS
+
+   SUBROUTINE crs_lbc_lnk_3d( pt3d1, cd_type1, psgn, cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      !!                  ***  SUBROUTINE crs_lbc_lnk  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions for coarsened grid
+      !!
+      !! ** Method  :   Swap domain indices from full to coarse domain
+      !!                before arguments are passed directly to lbc_lnk.
+      !!                Upon exiting, switch back to full domain indices.
+      !!----------------------------------------------------------------------
+      !! Arguments
+      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1 ! grid type
+      REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)   ::   pt3d1 ! 3D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo
+      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      
+      !! local vairables
+      LOGICAL                                                   ::   ll_grid_crs
+      REAL(wp)                                                  ::   zval     ! valeur sur les halo
+
+      !!----------------------------------------------------------------------
+      
+      ll_grid_crs = ( jpi == jpi_crs )
+      
+      IF( PRESENT(pval) ) THEN  ;  zval = pval
+      ELSE                      ;  zval = 0.0
+      ENDIF
+      
+      IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+
+      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  )
+      ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval  )
+      ENDIF
+
+      IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
+
+   END SUBROUTINE crs_lbc_lnk_3d
+   
+   SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
+      !!---------------------------------------------------------------------
+      !!                  ***  SUBROUTINE crs_lbc_lnk  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions for coarsened grid
+      !!
+      !! ** Method  :   Swap domain indices from full to coarse domain
+      !!                before arguments are passed directly to lbc_lnk.
+      !!                Upon exiting, switch back to full domain indices.
+      !!----------------------------------------------------------------------
+      !! Arguments
+      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1,cd_type2 ! grid type
+      REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)   ::   pt3d1,pt3d2 ! 3D array on which the lbc is applied
+      
+      !! local vairables
+      LOGICAL                                                   ::   ll_grid_crs
+      !!----------------------------------------------------------------------
+      
+      ll_grid_crs = ( jpi == jpi_crs )
+      
+      IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+
+      CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn  )
+
+      IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
+
+   END SUBROUTINE crs_lbc_lnk_3d_gather
+
+   
+   
+   SUBROUTINE crs_lbc_lnk_2d(pt2d, cd_type, psgn, cd_mpp, pval)
+      !!---------------------------------------------------------------------
+      !!                  ***  SUBROUTINE crs_lbc_lnk  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions for coarsened grid
+      !!
+      !! ** Method  :   Swap domain indices from full to coarse domain
+      !!                before arguments are passed directly to lbc_lnk.
+      !!                Upon exiting, switch back to full domain indices.
+      !!----------------------------------------------------------------------
+      !! Arguments
+      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type  ! grid type
+      REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign
+
+      REAL(wp), DIMENSION(jpi_crs,jpj_crs),     INTENT(inout)   ::   pt2d     ! 2D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo
+      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp   ! MPP only (here do nothing)
+      !! local variables
+      
+      LOGICAL                                                   ::   ll_grid_crs
+      REAL(wp)                                                  ::   zval     ! valeur sur les halo
+
+      !!----------------------------------------------------------------------
+      
+      ll_grid_crs = ( jpi == jpi_crs )
+      
+      IF( PRESENT(pval) ) THEN  ;  zval = pval
+      ELSE                      ;  zval = 0.0
+      ENDIF
+      
+      IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+
+      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  )
+      ELSE                         ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval  )
+      ENDIF
+
+      IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
+
+   END SUBROUTINE crs_lbc_lnk_2d
+
+
+END MODULE crslbclnk
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 4015)
@@ -10,4 +10,5 @@
    !!            3.5  ! 2012     (S. Mocavero, I. Epicoco) Add arrays associated
    !!                             to the optimization of BDY communications
+   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
    !!----------------------------------------------------------------------
 
@@ -42,4 +43,5 @@
    INTEGER , PUBLIC ::   nn_baro      =   64       !: number of barotropic time steps (key_dynspg_ts)
    INTEGER , PUBLIC ::   nn_closea    =    0       !: =0 suppress closed sea/lake from the ORCA domain or not (=1)
+   LOGICAL , PUBLIC ::   ln_crs       = .FALSE.    !: Apply grid coarsening to dynamical model output or online passive tracers
 
    !                                    !! old non-DOCTOR names still used in the model
@@ -195,5 +197,5 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts
 
-   REAL(wp), PUBLIC, DIMENSION(jpiglo) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     :: tpol, fpol          !: north fold mask (jperio= 3 or 4)
 
 #if defined key_noslip_accurate
@@ -264,5 +266,5 @@
    INTEGER FUNCTION dom_oce_alloc()
       !!----------------------------------------------------------------------
-      INTEGER, DIMENSION(11) :: ierr
+      INTEGER, DIMENSION(12) :: ierr
       !!----------------------------------------------------------------------
       ierr(:) = 0
@@ -311,6 +313,8 @@
          &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(10) )
 
+      ALLOCATE( tpol(jpiglo)       , fpol(jpiglo)      , STAT=ierr(11) )
+
 #if defined key_noslip_accurate
-      ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(11) )
+      ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(12) )
 #endif
       !
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 4015)
@@ -12,4 +12,5 @@
    !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
    !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
+   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
    !!----------------------------------------------------------------------
    
@@ -126,5 +127,5 @@
       NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
          &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
-         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
+         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea , ln_crs
       NAMELIST/namcla/ nn_cla
 #if defined key_netcdf4
@@ -202,5 +203,6 @@
       REWIND( numnam )              ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
       READ  ( numnam, namdom )
-
+  
+      !
       IF(lwp) THEN
          WRITE(numout,*)
@@ -216,12 +218,13 @@
          WRITE(numout,*) '           = 2   mesh and mask             '
          WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
-         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
-         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
-         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
-         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
-         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
-         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
-         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
-         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
+         WRITE(numout,*) '      ocean time step                       rn_rdt    = ', rn_rdt
+         WRITE(numout,*) '      asselin time filter parameter         rn_atfp   = ', rn_atfp
+         WRITE(numout,*) '      time-splitting: nb of sub time-step   nn_baro   = ', nn_baro
+         WRITE(numout,*) '      acceleration of converge              nn_acc    = ', nn_acc
+         WRITE(numout,*) '        nn_acc=1: surface tracer rdt        rn_rdtmin = ', rn_rdtmin
+         WRITE(numout,*) '                  bottom  tracer rdt        rdtmax    = ', rn_rdtmax
+         WRITE(numout,*) '                  depth of transition       rn_rdth   = ', rn_rdth
+         WRITE(numout,*) '      suppression of closed seas (=0)       nn_closea = ', nn_closea
+         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs    = ', ln_crs
       ENDIF
 
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 4015)
@@ -37,4 +37,5 @@
 # endif
    USE ioipsl, ONLY :  ju2ymds    ! for calendar
+   USE crs             ! Grid coarsening
 
    IMPLICIT NONE
@@ -47,5 +48,5 @@
 #endif
    PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put
-   PUBLIC iom_getatt
+   PUBLIC iom_getatt, iom_context_finalize
 
    PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
@@ -69,9 +70,4 @@
      MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d
   END INTERFACE
-#if defined key_iomput
-   INTERFACE iom_setkt
-      MODULE PROCEDURE xios_update_calendar
-   END INTERFACE
-# endif
 
    !!----------------------------------------------------------------------
@@ -83,5 +79,5 @@
 CONTAINS
 
-   SUBROUTINE iom_init
+   SUBROUTINE iom_init( cdname ) 
       !!----------------------------------------------------------------------
       !!                     ***  ROUTINE   ***
@@ -90,4 +86,5 @@
       !!
       !!----------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)  :: cdname
 #if defined key_iomput
       TYPE(xios_time)   :: dtime    = xios_time(0, 0, 0, 0, 0, 0)
@@ -97,8 +94,8 @@
       !!----------------------------------------------------------------------
 
-      clname = "nemo"
-      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
+      clname = cdname
+      IF( TRIM(Agrif_CFixed()) /= '0' )   clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
       CALL xios_context_initialize(TRIM(clname), mpi_comm_opa)
-      CALL iom_swap
+      CALL iom_swap( cdname )
 
       ! calendar parameters
@@ -113,8 +110,23 @@
       ! horizontal grid definition
       CALL set_scalar
-      CALL set_grid( "T", glamt, gphit ) 
-      CALL set_grid( "U", glamu, gphiu )
-      CALL set_grid( "V", glamv, gphiv )
-      CALL set_grid( "W", glamt, gphit )
+
+      IF( TRIM(cdname) == "nemo" ) THEN  
+         CALL set_grid( "T", glamt, gphit ) 
+         CALL set_grid( "U", glamu, gphiu )
+         CALL set_grid( "V", glamv, gphiv )
+         CALL set_grid( "W", glamt, gphit )
+      ENDIF
+
+      IF( TRIM(cdname) == "nemo_crs" ) THEN  
+         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
+         !
+         CALL set_grid( "T", glamt_crs, gphit_crs ) 
+         CALL set_grid( "U", glamu_crs, gphiu_crs ) 
+         CALL set_grid( "V", glamv_crs, gphiv_crs ) 
+         CALL set_grid( "W", glamt_crs, gphit_crs ) 
+          !
+         CALL dom_grid_glo   ! Return to parent grid domain
+      ENDIF
+
 
       ! vertical grid definition
@@ -141,5 +153,5 @@
 
 
-   SUBROUTINE iom_swap
+   SUBROUTINE iom_swap( cdname )
       !!---------------------------------------------------------------------
       !!                   ***  SUBROUTINE  iom_swap  ***
@@ -147,15 +159,17 @@
       !! ** Purpose :  swap context between different agrif grid for xmlio_server
       !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in) :: cdname
 #if defined key_iomput
       TYPE(xios_context) :: nemo_hdl
 
-     IF( TRIM(Agrif_CFixed()) == '0' ) THEN
-        CALL xios_get_handle("nemo",nemo_hdl)
-     ELSE
-        CALL xios_get_handle(TRIM(Agrif_CFixed())//"_nemo",nemo_hdl)
-     ENDIF
-     CALL xios_set_current_context(nemo_hdl)
-
+      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+        CALL xios_get_handle(TRIM(cdname),nemo_hdl)
+      ELSE
+        CALL xios_get_handle(TRIM(Agrif_CFixed())//"_"//TRIM(cdname),nemo_hdl)
+      ENDIF
+      !
+      CALL xios_set_current_context(nemo_hdl)
 #endif
+      !
    END SUBROUTINE iom_swap
 
@@ -1100,4 +1114,23 @@
       CALL xios_solve_inheritance()
    END SUBROUTINE iom_set_grid_attr
+
+   SUBROUTINE iom_setkt( kt, cdname )
+      INTEGER         , INTENT(in) ::   kt 
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      !     
+      CALL iom_swap( cdname )   ! swap to cdname context
+      CALL xios_update_calendar(kt)
+      IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context
+      !
+   END SUBROUTINE iom_setkt
+
+   SUBROUTINE iom_context_finalize( cdname )
+      CHARACTER(LEN=*), INTENT(in) :: cdname
+      !     
+      CALL iom_swap( cdname )   ! swap to cdname context
+      CALL xios_context_finalize() ! finalize the context
+      IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context
+      !
+   END SUBROUTINE iom_context_finalize
 
 
@@ -1424,8 +1457,15 @@
 #else
 
-   SUBROUTINE iom_setkt( kt )
-      INTEGER, INTENT(in   )::   kt 
-      IF( .FALSE. )   WRITE(numout,*) kt   ! useless test to avoid compilation warnings
+
+   SUBROUTINE iom_setkt( kt, cdname )
+      INTEGER         , INTENT(in)::   kt 
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      IF( .FALSE. )   WRITE(numout,*) kt, cdname   ! useless test to avoid compilation warnings
    END SUBROUTINE iom_setkt
+
+   SUBROUTINE iom_context_finalize( cdname )
+      CHARACTER(LEN=*), INTENT(in) ::   cdname
+      IF( .FALSE. )   WRITE(numout,*)  cdname   ! useless test to avoid compilation warnings
+   END SUBROUTINE iom_context_finalize
 
 #endif
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 4015)
@@ -264,6 +264,4 @@
             END SELECT
             !                                          ! North fold
-            pt3d( 1 ,jpj,:) = zland
-            pt3d(jpi,jpj,:) = zland
             CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
             !
@@ -386,7 +384,4 @@
             END SELECT
             !                                          ! North fold
-            pt2d( 1 ,1  ) = zland 
-            pt2d( 1 ,jpj) = zland 
-            pt2d(jpi,jpj) = zland
             CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
             !
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 4015)
@@ -71,4 +71,5 @@
                   pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
                END DO
+               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-2,jk)
                DO ji = jpiglo/2+1, jpiglo
                   ijt = jpiglo-ji+2
@@ -80,4 +81,6 @@
                   pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
                END DO
+               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-2,jk)
+               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-2,jk) 
                DO ji = jpiglo/2, jpiglo-1
                   iju = jpiglo-ji+1
@@ -90,4 +93,5 @@
                   pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
                END DO
+               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-3,jk) 
             CASE ( 'F' )                               ! F-point
                DO ji = 1, jpiglo-1
@@ -96,4 +100,6 @@
                   pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
                END DO
+               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-3,jk)
+               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-3,jk) 
             END SELECT
             !
@@ -111,4 +117,5 @@
                   pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
                END DO
+               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-1,jk)
             CASE ( 'V' )                               ! V-point
                DO ji = 1, jpiglo
@@ -125,4 +132,5 @@
                   pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
                END DO
+               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-2,jk)
                DO ji = jpiglo/2+1, jpiglo-1
                   iju = jpiglo-ji
@@ -199,4 +207,5 @@
                END DO
             END DO
+            pt2d(1,ijpj)   = psgn * pt2d(3,ijpj-2)
             DO ji = jpiglo/2+1, jpiglo
                ijt=jpiglo-ji+2
@@ -210,4 +219,7 @@
                END DO
             END DO
+            pt2d(   1  ,ijpj  ) = psgn * pt2d(    2   ,ijpj-2)
+            pt2d(jpiglo,ijpj  ) = psgn * pt2d(jpiglo-1,ijpj-2)
+            pt2d(1     ,ijpj-1) = psgn * pt2d(jpiglo  ,ijpj-1)   
             DO ji = jpiglo/2, jpiglo-1
                iju = jpiglo-ji+1
@@ -221,4 +233,5 @@
                END DO
             END DO
+            pt2d( 1 ,ijpj)   = psgn * pt2d( 3 ,ijpj-3) 
          CASE ( 'F' )                                     ! F-point
             DO jl = -1, ipr2dj
@@ -228,4 +241,8 @@
                END DO
             END DO
+            pt2d(   1  ,ijpj)   = psgn * pt2d(    2   ,ijpj-3)
+            pt2d(jpiglo,ijpj)   = psgn * pt2d(jpiglo-1,ijpj-3)
+            pt2d(jpiglo,ijpj-1) = psgn * pt2d(jpiglo-1,ijpj-2)      
+            pt2d(   1  ,ijpj-1) = psgn * pt2d(    2   ,ijpj-2)      
          CASE ( 'I' )                                     ! ice U-V point (I-point)
             DO jl = 0, ipr2dj
@@ -271,4 +288,5 @@
                END DO
             END DO
+            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-1)
          CASE ( 'V' )                                     ! V-point
             DO jl = 0, ipr2dj
@@ -289,4 +307,5 @@
                END DO
             END DO
+            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-2)
             DO ji = jpiglo/2+1, jpiglo-1
                iju = jpiglo-ji
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 4015)
@@ -22,4 +22,5 @@
    !!                          'mpp_lnk_bdy_2d' and 'mpp_lnk_obc_2d' routines and update
    !!                          the mppobc routine to optimize the BDY and OBC communications
+   !!            3.6  !  2013  ( C. Ethe, G. Madec ) message passing arrays as local variables 
    !!----------------------------------------------------------------------
 
@@ -71,5 +72,4 @@
    PUBLIC   mppsize
    PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines
-   PUBLIC   lib_mpp_alloc   ! Called in nemogcm.F90
    PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
    PUBLIC   mpp_lnk_obc_2d, mpp_lnk_obc_3d
@@ -150,29 +150,4 @@
    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend
 
-   ! message passing arrays
-   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4ns, t4sn   ! 2 x 3d for north-south & south-north
-   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4ew, t4we   ! 2 x 3d for east-west & west-east
-   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4p1, t4p2   ! 2 x 3d for north fold
-   REAL(wp), DIMENSION(:,:,:,:)  , ALLOCATABLE, SAVE ::   t3ns, t3sn   ! 3d for north-south & south-north
-   REAL(wp), DIMENSION(:,:,:,:)  , ALLOCATABLE, SAVE ::   t3ew, t3we   ! 3d for east-west & west-east
-   REAL(wp), DIMENSION(:,:,:,:)  , ALLOCATABLE, SAVE ::   t3p1, t3p2   ! 3d for north fold
-   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2ns, t2sn   ! 2d for north-south & south-north
-   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2ew, t2we   ! 2d for east-west & west-east
-   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2p1, t2p2   ! 2d for north fold
-
-   ! Arrays used in mpp_lbc_north_3d()
-   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   tab_3d, xnorthloc
-   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE   ::   xnorthgloio
-   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   foldwk      ! Workspace for message transfers avoiding mpi_allgather
-
-   ! Arrays used in mpp_lbc_north_2d()
-   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   tab_2d, xnorthloc_2d
-   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   xnorthgloio_2d
-   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   foldwk_2d    ! Workspace for message transfers avoiding mpi_allgather
-
-   ! Arrays used in mpp_lbc_north_e()
-   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   tab_e, xnorthloc_e
-   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   xnorthgloio_e
-
    ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public
    INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 8                 ! Assumed maximum number of active neighbours
@@ -189,38 +164,4 @@
    !!----------------------------------------------------------------------
 CONTAINS
-
-   INTEGER FUNCTION lib_mpp_alloc( kumout )
-      !!----------------------------------------------------------------------
-      !!              ***  routine lib_mpp_alloc  ***
-      !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical unit
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( t4ns(jpi,jprecj,jpk,2,2) , t4sn(jpi,jprecj,jpk,2,2) ,                                            &
-         &      t4ew(jpj,jpreci,jpk,2,2) , t4we(jpj,jpreci,jpk,2,2) ,                                            &
-         &      t4p1(jpi,jprecj,jpk,2,2) , t4p2(jpi,jprecj,jpk,2,2) ,                                            &
-         &      t3ns(jpi,jprecj,jpk,2)   , t3sn(jpi,jprecj,jpk,2)   ,                                            &
-         &      t3ew(jpj,jpreci,jpk,2)   , t3we(jpj,jpreci,jpk,2)   ,                                            &
-         &      t3p1(jpi,jprecj,jpk,2)   , t3p2(jpi,jprecj,jpk,2)   ,                                            &
-         &      t2ns(jpi,jprecj    ,2)   , t2sn(jpi,jprecj    ,2)   ,                                            &
-         &      t2ew(jpj,jpreci    ,2)   , t2we(jpj,jpreci    ,2)   ,                                            &
-         &      t2p1(jpi,jprecj    ,2)   , t2p2(jpi,jprecj    ,2)   ,                                            &
-         !
-         &      tab_3d(jpiglo,4,jpk) , xnorthloc(jpi,4,jpk) , xnorthgloio(jpi,4,jpk,jpni) ,                        &
-         &      foldwk(jpi,4,jpk) ,                                                                             &
-         !
-         &      tab_2d(jpiglo,4)  , xnorthloc_2d(jpi,4)  , xnorthgloio_2d(jpi,4,jpni)  ,                        &
-         &      foldwk_2d(jpi,4)  ,                                                                             &
-         !
-         &      tab_e(jpiglo,4+2*jpr2dj) , xnorthloc_e(jpi,4+2*jpr2dj) , xnorthgloio_e(jpi,4+2*jpr2dj,jpni) ,   &
-         !
-         &      STAT=lib_mpp_alloc )
-         !
-      IF( lib_mpp_alloc /= 0 ) THEN
-         WRITE(kumout,cform_war)
-         WRITE(kumout,*) 'lib_mpp_alloc : failed to allocate arrays'
-      ENDIF
-      !
-   END FUNCTION lib_mpp_alloc
 
 
@@ -385,5 +326,12 @@
       REAL(wp) ::   zland
       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
+      !
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
+         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
 
       zland = 0.e0      ! zero by default
@@ -420,6 +368,6 @@
          iihom = nlci-nreci
          DO jl = 1, jpreci
-            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
          END DO
       END SELECT  
@@ -430,17 +378,17 @@
       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, noea )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
          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, noea )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
          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, nowe )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       END SELECT
@@ -452,14 +400,14 @@
       CASE ( -1 )
          DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
          END DO
       CASE ( 0 )
          DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
          END DO
       END SELECT
@@ -475,6 +423,6 @@
          ijhom = nlcj-nrecj
          DO jl = 1, jprecj
-            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
          END DO
       ENDIF
@@ -485,17 +433,17 @@
       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, nono )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
          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, nono )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
          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, noso )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       END SELECT
@@ -507,14 +455,14 @@
       CASE ( -1 )
          DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
          END DO
       CASE ( 0 )
          DO jl = 1, jprecj
-            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jprecj
-            ptab(:,jl,:) = t3sn(:,jl,:,2)
+            ptab(:,jl,:) = zt3sn(:,jl,:,2)
          END DO
       END SELECT
@@ -533,4 +481,6 @@
          !
       ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
       !
    END SUBROUTINE mpp_lnk_obc_3d
@@ -567,5 +517,12 @@
       REAL(wp) ::   zland
       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
+      !
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
+         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
 
       zland = 0.e0      ! zero by default
@@ -602,6 +559,6 @@
          iihom = nlci-nreci
          DO jl = 1, jpreci
-            t2ew(:,jl,1) = pt2d(jpreci+jl,:)
-            t2we(:,jl,1) = pt2d(iihom +jl,:)
+            zt2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            zt2we(:,jl,1) = pt2d(iihom +jl,:)
          END DO
       END SELECT
@@ -612,17 +569,17 @@
       SELECT CASE ( nbondi )
       CASE ( -1 )
-         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
          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, noea )
-         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
          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, nowe )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
@@ -634,14 +591,14 @@
       CASE ( -1 )
          DO jl = 1, jpreci
-            pt2d(iihom+jl,:) = t2ew(:,jl,2)
+            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
          END DO
       CASE ( 0 )
          DO jl = 1, jpreci
-            pt2d(jl      ,:) = t2we(:,jl,2)
-            pt2d(iihom+jl,:) = t2ew(:,jl,2)
+            pt2d(jl      ,:) = zt2we(:,jl,2)
+            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jpreci
-            pt2d(jl      ,:) = t2we(:,jl,2)
+            pt2d(jl      ,:) = zt2we(:,jl,2)
          END DO
       END SELECT
@@ -655,6 +612,6 @@
          ijhom = nlcj-nrecj
          DO jl = 1, jprecj
-            t2sn(:,jl,1) = pt2d(:,ijhom +jl)
-            t2ns(:,jl,1) = pt2d(:,jprecj+jl)
+            zt2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            zt2ns(:,jl,1) = pt2d(:,jprecj+jl)
          END DO
       ENDIF
@@ -665,17 +622,17 @@
       SELECT CASE ( nbondj )
       CASE ( -1 )
-         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
          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, nono )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
          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, noso )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
@@ -687,14 +644,14 @@
       CASE ( -1 )
          DO jl = 1, jprecj
-            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
          END DO
       CASE ( 0 )
          DO jl = 1, jprecj
-            pt2d(:,jl      ) = t2sn(:,jl,2)
-            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+            pt2d(:,jl      ) = zt2sn(:,jl,2)
+            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
          END DO
       CASE ( 1 ) 
          DO jl = 1, jprecj
-            pt2d(:,jl      ) = t2sn(:,jl,2)
+            pt2d(:,jl      ) = zt2sn(:,jl,2)
          END DO
       END SELECT
@@ -712,4 +669,6 @@
          !
       ENDIF
+      !
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
       !
    END SUBROUTINE mpp_lnk_obc_2d
@@ -749,6 +708,14 @@
       REAL(wp) ::   zland
       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-
+      !
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+      
+      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
+         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
+
+      !
       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
       ELSE                         ;   zland = 0.e0      ! zero by default
@@ -798,6 +765,6 @@
          iihom = nlci-nreci
          DO jl = 1, jpreci
-            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
          END DO
       END SELECT
@@ -808,17 +775,17 @@
       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, noea )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
          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, noea )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
          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, nowe )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       END SELECT
@@ -830,14 +797,14 @@
       CASE ( -1 )
          DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
          END DO
       CASE ( 0 )
          DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
          END DO
       END SELECT
@@ -851,6 +818,6 @@
          ijhom = nlcj-nrecj
          DO jl = 1, jprecj
-            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
          END DO
       ENDIF
@@ -861,17 +828,17 @@
       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, nono )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
          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, nono )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
          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, noso )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       END SELECT
@@ -883,14 +850,14 @@
       CASE ( -1 )
          DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
          END DO
       CASE ( 0 )
          DO jl = 1, jprecj
-            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jprecj
-            ptab(:,jl,:) = t3sn(:,jl,:,2)
+            ptab(:,jl,:) = zt3sn(:,jl,:,2)
          END DO
       END SELECT
@@ -908,4 +875,6 @@
          !
       ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
       !
    END SUBROUTINE mpp_lnk_3d
@@ -944,6 +913,14 @@
       REAL(wp) ::   zland
       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
-
+      !
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
+         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
+
+      !
       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
       ELSE                         ;   zland = 0.e0      ! zero by default
@@ -992,6 +969,6 @@
          iihom = nlci-nreci
          DO jl = 1, jpreci
-            t2ew(:,jl,1) = pt2d(jpreci+jl,:)
-            t2we(:,jl,1) = pt2d(iihom +jl,:)
+            zt2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            zt2we(:,jl,1) = pt2d(iihom +jl,:)
          END DO
       END SELECT
@@ -1002,17 +979,17 @@
       SELECT CASE ( nbondi )
       CASE ( -1 )
-         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
          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, noea )
-         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
          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, nowe )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
@@ -1024,14 +1001,14 @@
       CASE ( -1 )
          DO jl = 1, jpreci
-            pt2d(iihom+jl,:) = t2ew(:,jl,2)
+            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
          END DO
       CASE ( 0 )
          DO jl = 1, jpreci
-            pt2d(jl      ,:) = t2we(:,jl,2)
-            pt2d(iihom+jl,:) = t2ew(:,jl,2)
+            pt2d(jl      ,:) = zt2we(:,jl,2)
+            pt2d(iihom+jl,:) = zt2ew(:,jl,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jpreci
-            pt2d(jl      ,:) = t2we(:,jl,2)
+            pt2d(jl      ,:) = zt2we(:,jl,2)
          END DO
       END SELECT
@@ -1045,6 +1022,6 @@
          ijhom = nlcj-nrecj
          DO jl = 1, jprecj
-            t2sn(:,jl,1) = pt2d(:,ijhom +jl)
-            t2ns(:,jl,1) = pt2d(:,jprecj+jl)
+            zt2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            zt2ns(:,jl,1) = pt2d(:,jprecj+jl)
          END DO
       ENDIF
@@ -1055,17 +1032,17 @@
       SELECT CASE ( nbondj )
       CASE ( -1 )
-         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
          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, nono )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
          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, noso )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
       END SELECT
@@ -1077,14 +1054,14 @@
       CASE ( -1 )
          DO jl = 1, jprecj
-            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
          END DO
       CASE ( 0 )
          DO jl = 1, jprecj
-            pt2d(:,jl      ) = t2sn(:,jl,2)
-            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+            pt2d(:,jl      ) = zt2sn(:,jl,2)
+            pt2d(:,ijhom+jl) = zt2ns(:,jl,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jprecj
-            pt2d(:,jl      ) = t2sn(:,jl,2)
+            pt2d(:,jl      ) = zt2sn(:,jl,2)
          END DO
       END SELECT
@@ -1102,4 +1079,6 @@
          !
       ENDIF
+      !
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
       !
    END SUBROUTINE mpp_lnk_2d
@@ -1137,5 +1116,12 @@
       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
+      !
+      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ns, zt4sn   ! 2 x 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zt4ew, zt4we   ! 2 x 3d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+      ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) ,    &
+         &      zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) )
+
 
       ! 1. standard boundary treatment
@@ -1171,8 +1157,8 @@
          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,:,:)
+            zt4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
+            zt4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
+            zt4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
+            zt4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
          END DO
       END SELECT
@@ -1183,17 +1169,17 @@
       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, noea )
+         CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea )
          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, noea )
-         CALL mpprecv( 2, t4we(1,1,1,1,2), imigr, nowe )
+         CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe )
          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, nowe )
+         CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       END SELECT
@@ -1205,18 +1191,18 @@
       CASE ( -1 )
          DO jl = 1, jpreci
-            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
-            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
+            ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2)
+            ptab2(iihom+jl,:,:) = zt4ew(:,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)
+            ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2)
+            ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = zt4we(:,jl,:,2,2)
+            ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jpreci
-            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
-            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
+            ptab1(jl      ,:,:) = zt4we(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = zt4we(:,jl,:,2,2)
          END DO
       END SELECT
@@ -1230,8 +1216,8 @@
          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,:)
+            zt4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)
+            zt4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)
+            zt4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)
+            zt4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)
          END DO
       ENDIF
@@ -1242,17 +1228,17 @@
       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, nono )
+         CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono )
          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, nono )
-         CALL mpprecv( 4, t4sn(1,1,1,1,2), imigr, noso )
+         CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso )
          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, noso )
+         CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso )
          IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
       END SELECT
@@ -1264,18 +1250,18 @@
       CASE ( -1 )
          DO jl = 1, jprecj
-            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)
-            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
+            ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2)
+            ptab2(:,ijhom+jl,:) = zt4ns(:,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)
+            ptab1(:,jl      ,:) = zt4sn(:,jl,:,1,2)
+            ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2)
+            ptab2(:,jl      ,:) = zt4sn(:,jl,:,2,2)
+            ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jprecj
-            ptab1(:,jl,:) = t4sn(:,jl,:,1,2)
-            ptab2(:,jl,:) = t4sn(:,jl,:,2,2)
+            ptab1(:,jl,:) = zt4sn(:,jl,:,1,2)
+            ptab2(:,jl,:) = zt4sn(:,jl,:,2,2)
          END DO
       END SELECT
@@ -1296,4 +1282,6 @@
          !
       ENDIF
+      !
+      DEALLOCATE( zt4ns, zt4sn, zt4ew, zt4we )
       !
    END SUBROUTINE mpp_lnk_3d_gather
@@ -2148,6 +2136,13 @@
       INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend
       REAL(wp), POINTER, DIMENSION(:,:) ::   ztab   ! temporary workspace
+      !
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
       LOGICAL :: lmigr ! is true for those processors that have to migrate the OB
-      !!----------------------------------------------------------------------
+
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),   &
+         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
 
       CALL wrk_alloc( jpi,jpj, ztab )
@@ -2213,6 +2208,6 @@
          IF( nbondi /= 2 ) THEN         ! Read Dirichlet lateral conditions
             iihom = nlci-nreci
-            t2ew(1:jpreci,1,1) = ztab(jpreci+1:nreci, ijpt0)
-            t2we(1:jpreci,1,1) = ztab(iihom+1:iihom+jpreci, ijpt0)
+            zt2ew(1:jpreci,1,1) = ztab(jpreci+1:nreci, ijpt0)
+            zt2we(1:jpreci,1,1) = ztab(iihom+1:iihom+jpreci, ijpt0)
          ENDIF
          !
@@ -2221,17 +2216,17 @@
          !
          IF( nbondi == -1 ) THEN
-            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-            CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
+            CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
+            CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
             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, noea )
-            CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )
+            CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+            CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
+            CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+            CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
             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, nowe )
+            CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+            CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
             IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
          ENDIF
@@ -2241,8 +2236,8 @@
          !
          IF( nbondi == 0 .OR. nbondi == 1 ) THEN
-            ztab(1:jpreci, ijpt0) = t2we(1:jpreci,1,2)
+            ztab(1:jpreci, ijpt0) = zt2we(1:jpreci,1,2)
          ENDIF
          IF( nbondi == -1 .OR. nbondi == 0 ) THEN
-            ztab(iihom+1:iihom+jpreci, ijpt0) = t2ew(1:jpreci,1,2)
+            ztab(iihom+1:iihom+jpreci, ijpt0) = zt2ew(1:jpreci,1,2)
          ENDIF
        ENDIF  ! (ktype == 1)
@@ -2254,6 +2249,6 @@
          IF( nbondj /= 2 ) THEN         ! Read Dirichlet lateral conditions
             ijhom = nlcj-nrecj
-            t2sn(1:jprecj,1,1) = ztab(iipt0, ijhom+1:ijhom+jprecj)
-            t2ns(1:jprecj,1,1) = ztab(iipt0, jprecj+1:nrecj)
+            zt2sn(1:jprecj,1,1) = ztab(iipt0, ijhom+1:ijhom+jprecj)
+            zt2ns(1:jprecj,1,1) = ztab(iipt0, jprecj+1:nrecj)
          ENDIF
          !
@@ -2262,17 +2257,17 @@
          !
          IF( nbondj == -1 ) THEN
-            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
-            CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
+            CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
+            CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
             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, nono )
-            CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )
+            CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+            CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
+            CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+            CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
             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, noso)
+            CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+            CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso)
             IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err )
          ENDIF
@@ -2281,8 +2276,8 @@
          ijhom = nlcj - jprecj
          IF( nbondj == 0 .OR. nbondj == 1 ) THEN
-            ztab(iipt0,1:jprecj) = t2sn(1:jprecj,1,2)
+            ztab(iipt0,1:jprecj) = zt2sn(1:jprecj,1,2)
          ENDIF
          IF( nbondj == 0 .OR. nbondj == -1 ) THEN
-            ztab(iipt0, ijhom+1:ijhom+jprecj) = t2ns(1:jprecj,1,2)
+            ztab(iipt0, ijhom+1:ijhom+jprecj) = zt2ns(1:jprecj,1,2)
          ENDIF
          ENDIF    ! (ktype == 2)
@@ -2304,4 +2299,6 @@
       !
       ENDIF ! ( lmigr )
+      !
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )
       CALL wrk_dealloc( jpi,jpj, ztab )
       !
@@ -2593,17 +2590,24 @@
       INTEGER                                ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
       INTEGER, DIMENSION(MPI_STATUS_SIZE)    ::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
-      !!----------------------------------------------------------------------
-      !
+      !                                                              ! Workspace for message transfers avoiding mpi_allgather
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: ztab
+      REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk      
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE   :: znorthgloio
+
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab(jpiglo,4,jpk), znorthloc(jpi,4,jpk), zfoldwk(jpi,4,jpk), znorthgloio(jpi,4,jpk,jpni) )
+
       ijpj   = 4
       ityp = -1
       ijpjm1 = 3
-      tab_3d(:,:,:) = 0.e0
-      !
-      DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d
+      ztab(:,:,:) = 0.e0
+      !
+      DO jj = nlcj - ijpj +1, nlcj          ! put in znorthloc the last 4 jlines of pt3d
          ij = jj - nlcj + ijpj
-         xnorthloc(:,ij,:) = pt3d(:,jj,:)
+         znorthloc(:,ij,:) = pt3d(:,jj,:)
       END DO
       !
-      !                                     ! Build in procs of ncomm_north the xnorthgloio
+      !                                     ! Build in procs of ncomm_north the znorthgloio
       itaille = jpi * jpk * ijpj
       IF ( l_north_nogather ) THEN
@@ -2615,5 +2619,5 @@
             ij = jj - nlcj + ijpj
             DO ji = 1, nlci
-               tab_3d(ji+nimpp-1,ij,:) = pt3d(ji,jj,:)
+               ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:)
             END DO
          END DO
@@ -2640,8 +2644,8 @@
 
             DO jr = 1,nsndto(ityp)
-               CALL mppsend(5, xnorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) )
+               CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) )
             END DO
             DO jr = 1,nsndto(ityp)
-               CALL mpprecv(5, foldwk, itaille, isendto(jr,ityp))
+               CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp))
                iproc = isendto(jr,ityp) + 1
                ildi = nldit (iproc)
@@ -2650,5 +2654,5 @@
                DO jj = 1, ijpj
                   DO ji = ildi, ilei
-                     tab_3d(ji+iilb-1,jj,:) = foldwk(ji,jj,:)
+                     ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:)
                   END DO
                END DO
@@ -2665,6 +2669,6 @@
 
       IF ( ityp .lt. 0 ) THEN
-         CALL MPI_ALLGATHER( xnorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
-            &                xnorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         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
@@ -2675,5 +2679,5 @@
             DO jj = 1, ijpj
                DO ji = ildi, ilei
-                  tab_3d(ji+iilb-1,jj,:) = xnorthgloio(ji,jj,:,jr)
+                  ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr)
                END DO
             END DO
@@ -2681,5 +2685,5 @@
       ENDIF
       !
-      ! The tab_3d array has been either:
+      ! The ztab array has been either:
       !  a. Fully populated by the mpi_allgather operation or
       !  b. Had the active points for this domain and northern neighbours populated
@@ -2688,12 +2692,14 @@
       ! this domain will be identical.
       !
-      CALL lbc_nfd( tab_3d, cd_type, psgn )   ! North fold boundary condition
+      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,:) = tab_3d(ji+nimpp-1,ij,:)
+            pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:)
          END DO
       END DO
+      !
+      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
       !
    END SUBROUTINE mpp_lbc_north_3d
@@ -2725,17 +2731,23 @@
       INTEGER                            ::   ml_err             ! for mpi_isend when avoiding mpi_allgather
       INTEGER, DIMENSION(MPI_STATUS_SIZE)::   ml_stat            ! for mpi_isend when avoiding mpi_allgather
-      !!----------------------------------------------------------------------
+      !                                                              ! Workspace for message transfers avoiding mpi_allgather
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: ztab
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE   :: znorthloc, zfoldwk      
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   :: znorthgloio
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab(jpiglo,4), znorthloc(jpi,4), zfoldwk(jpi,4), znorthgloio(jpi,4,jpni) )
       !
       ijpj   = 4
       ityp = -1
       ijpjm1 = 3
-      tab_2d(:,:) = 0.e0
-      !
-      DO jj = nlcj-ijpj+1, nlcj             ! put in xnorthloc_2d the last 4 jlines of pt2d
+      ztab(:,:) = 0.e0
+      !
+      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d
          ij = jj - nlcj + ijpj
-         xnorthloc_2d(:,ij) = pt2d(:,jj)
+         znorthloc(:,ij) = pt2d(:,jj)
       END DO
 
-      !                                     ! Build in procs of ncomm_north the xnorthgloio_2d
+      !                                     ! Build in procs of ncomm_north the znorthgloio
       itaille = jpi * ijpj
       IF ( l_north_nogather ) THEN
@@ -2747,5 +2759,5 @@
             ij = jj - nlcj + ijpj
             DO ji = 1, nlci
-               tab_2d(ji+nimpp-1,ij) = pt2d(ji,jj)
+               ztab(ji+nimpp-1,ij) = pt2d(ji,jj)
             END DO
          END DO
@@ -2773,8 +2785,8 @@
 
             DO jr = 1,nsndto(ityp)
-               CALL mppsend(5, xnorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) )
+               CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) )
             END DO
             DO jr = 1,nsndto(ityp)
-               CALL mpprecv(5, foldwk_2d, itaille, isendto(jr,ityp))
+               CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp))
                iproc = isendto(jr,ityp) + 1
                ildi = nldit (iproc)
@@ -2783,5 +2795,5 @@
                DO jj = 1, ijpj
                   DO ji = ildi, ilei
-                     tab_2d(ji+iilb-1,jj) = foldwk_2d(ji,jj)
+                     ztab(ji+iilb-1,jj) = zfoldwk(ji,jj)
                   END DO
                END DO
@@ -2798,6 +2810,6 @@
 
       IF ( ityp .lt. 0 ) THEN
-         CALL MPI_ALLGATHER( xnorthloc_2d  , itaille, MPI_DOUBLE_PRECISION,        &
-            &                xnorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         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
@@ -2808,5 +2820,5 @@
             DO jj = 1, ijpj
                DO ji = ildi, ilei
-                  tab_2d(ji+iilb-1,jj) = xnorthgloio_2d(ji,jj,jr)
+                  ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)
                END DO
             END DO
@@ -2814,5 +2826,5 @@
       ENDIF
       !
-      ! The tab array has been either:
+      ! The ztab array has been either:
       !  a. Fully populated by the mpi_allgather operation or
       !  b. Had the active points for this domain and northern neighbours populated
@@ -2821,5 +2833,5 @@
       ! this domain will be identical.
       !
-      CALL lbc_nfd( tab_2d, cd_type, psgn )   ! North fold boundary condition
+      CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
       !
       !
@@ -2827,7 +2839,9 @@
          ij = jj - nlcj + ijpj
          DO ji = 1, nlci
-            pt2d(ji,jj) = tab_2d(ji+nimpp-1,ij)
+            pt2d(ji,jj) = ztab(ji+nimpp-1,ij)
          END DO
       END DO
+      !
+      DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )
       !
    END SUBROUTINE mpp_lbc_north_2d
@@ -2857,21 +2871,28 @@
       INTEGER ::   ierr, itaille, ildi, ilei, iilb
       INTEGER ::   ijpj, ij, iproc
-      !!----------------------------------------------------------------------
+      !
+      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e
+
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) )
+
       !
       ijpj=4
-      tab_e(:,:) = 0.e0
+      ztab_e(:,:) = 0.e0
 
       ij=0
-      ! put in xnorthloc_e the last 4 jlines of pt2d
+      ! put in znorthloc_e the last 4 jlines of pt2d
       DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj
          ij = ij + 1
          DO ji = 1, jpi
-            xnorthloc_e(ji,ij)=pt2d(ji,jj)
+            znorthloc_e(ji,ij)=pt2d(ji,jj)
          END DO
       END DO
       !
       itaille = jpi * ( ijpj + 2 * jpr2dj )
-      CALL MPI_ALLGATHER( xnorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    &
-         &                xnorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    &
+         &                znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
       !
       DO jr = 1, ndim_rank_north            ! recover the global north array
@@ -2882,5 +2903,5 @@
          DO jj = 1, ijpj+2*jpr2dj
             DO ji = ildi, ilei
-               tab_e(ji+iilb-1,jj) = xnorthgloio_e(ji,jj,jr)
+               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)
             END DO
          END DO
@@ -2890,5 +2911,5 @@
       ! 2. North-Fold boundary conditions
       ! ----------------------------------
-      CALL lbc_nfd( tab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )
+      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )
 
       ij = jpr2dj
@@ -2897,7 +2918,9 @@
       ij  = ij +1
          DO ji= 1, nlci
-            pt2d(ji,jj) = tab_e(ji+nimpp-1,ij)
+            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)
          END DO
       END DO
+      !
+      DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e )
       !
    END SUBROUTINE mpp_lbc_north_e
@@ -2940,5 +2963,12 @@
       REAL(wp) ::   zland
       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
+      !
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+      
+      ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2),   &
+         &      zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2)  )
 
       zland = 0.e0
@@ -2980,6 +3010,6 @@
          iihom = nlci-nreci
          DO jl = 1, jpreci
-            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
-            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)
          END DO
       END SELECT
@@ -2990,20 +3020,20 @@
       SELECT CASE ( nbondi_bdy(ib_bdy) )
       CASE ( -1 )
-         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
-      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 mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )
+      CASE ( 0 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )
       CASE ( 1 )
-         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )
       END SELECT
       !
       SELECT CASE ( nbondi_bdy_b(ib_bdy) )
       CASE ( -1 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )
-      CASE ( 0 )
-         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+      CASE ( 0 )
+         CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
       CASE ( 1 )
-         CALL mpprecv( 2, t3we(1,1,1,2), imigr, nowe )
+         CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )
       END SELECT
       !
@@ -3024,14 +3054,14 @@
       CASE ( -1 )
          DO jl = 1, jpreci
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
          END DO
       CASE ( 0 )
          DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
-            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jpreci
-            ptab(jl      ,:,:) = t3we(:,jl,:,2)
+            ptab(jl      ,:,:) = zt3we(:,jl,:,2)
          END DO
       END SELECT
@@ -3045,6 +3075,6 @@
          ijhom = nlcj-nrecj
          DO jl = 1, jprecj
-            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
-            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
          END DO
       ENDIF
@@ -3055,20 +3085,20 @@
       SELECT CASE ( nbondj_bdy(ib_bdy) )
       CASE ( -1 )
-         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )
-      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 mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )
+      CASE ( 0 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )
       CASE ( 1 )
-         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )
       END SELECT
       !
       SELECT CASE ( nbondj_bdy_b(ib_bdy) )
       CASE ( -1 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )
-      CASE ( 0 )
-         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+      CASE ( 0 )
+         CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
       CASE ( 1 )
-         CALL mpprecv( 4, t3sn(1,1,1,2), imigr, noso )
+         CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )
       END SELECT
       !
@@ -3089,14 +3119,14 @@
       CASE ( -1 )
          DO jl = 1, jprecj
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
          END DO
       CASE ( 0 )
          DO jl = 1, jprecj
-            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
-            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+            ptab(:,jl      ,:) = zt3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jprecj
-            ptab(:,jl,:) = t3sn(:,jl,:,2)
+            ptab(:,jl,:) = zt3sn(:,jl,:,2)
          END DO
       END SELECT
@@ -3114,4 +3144,6 @@
          !
       ENDIF
+      !
+      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we  )
       !
    END SUBROUTINE mpp_lnk_bdy_3d
@@ -3154,5 +3186,12 @@
       REAL(wp) ::   zland
       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
-      !!----------------------------------------------------------------------
+      !
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ns, zt2sn   ! 2d for north-south & south-north
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  zt2ew, zt2we   ! 2d for east-west & west-east
+
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2),  &
+         &      zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2)   )
 
       zland = 0.e0
@@ -3194,6 +3233,6 @@
          iihom = nlci-nreci
          DO jl = 1, jpreci
-            t2ew(:,jl,1) = ptab(jpreci+jl,:)
-            t2we(:,jl,1) = ptab(iihom +jl,:)
+            zt2ew(:,jl,1) = ptab(jpreci+jl,:)
+            zt2we(:,jl,1) = ptab(iihom +jl,:)
          END DO
       END SELECT
@@ -3204,20 +3243,20 @@
       SELECT CASE ( nbondi_bdy(ib_bdy) )
       CASE ( -1 )
-         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
-      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 mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )
+      CASE ( 0 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )
       CASE ( 1 )
-         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )
       END SELECT
       !
       SELECT CASE ( nbondi_bdy_b(ib_bdy) )
       CASE ( -1 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
-      CASE ( 0 )
-         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
-         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+      CASE ( 0 )
+         CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
       CASE ( 1 )
-         CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )
+         CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )
       END SELECT
       !
@@ -3238,14 +3277,14 @@
       CASE ( -1 )
          DO jl = 1, jpreci
-            ptab(iihom+jl,:) = t2ew(:,jl,2)
+            ptab(iihom+jl,:) = zt2ew(:,jl,2)
          END DO
       CASE ( 0 )
          DO jl = 1, jpreci
-            ptab(jl      ,:) = t2we(:,jl,2)
-            ptab(iihom+jl,:) = t2ew(:,jl,2)
+            ptab(jl      ,:) = zt2we(:,jl,2)
+            ptab(iihom+jl,:) = zt2ew(:,jl,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jpreci
-            ptab(jl      ,:) = t2we(:,jl,2)
+            ptab(jl      ,:) = zt2we(:,jl,2)
          END DO
       END SELECT
@@ -3259,6 +3298,6 @@
          ijhom = nlcj-nrecj
          DO jl = 1, jprecj
-            t2sn(:,jl,1) = ptab(:,ijhom +jl)
-            t2ns(:,jl,1) = ptab(:,jprecj+jl)
+            zt2sn(:,jl,1) = ptab(:,ijhom +jl)
+            zt2ns(:,jl,1) = ptab(:,jprecj+jl)
          END DO
       ENDIF
@@ -3269,20 +3308,20 @@
       SELECT CASE ( nbondj_bdy(ib_bdy) )
       CASE ( -1 )
-         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
-      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 mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )
+      CASE ( 0 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )
       CASE ( 1 )
-         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )
       END SELECT
       !
       SELECT CASE ( nbondj_bdy_b(ib_bdy) )
       CASE ( -1 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
-      CASE ( 0 )
-         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+      CASE ( 0 )
+         CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
       CASE ( 1 )
-         CALL mpprecv( 4, t2sn(1,1,2), imigr, noso )
+         CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )
       END SELECT
       !
@@ -3303,14 +3342,14 @@
       CASE ( -1 )
          DO jl = 1, jprecj
-            ptab(:,ijhom+jl) = t2ns(:,jl,2)
+            ptab(:,ijhom+jl) = zt2ns(:,jl,2)
          END DO
       CASE ( 0 )
          DO jl = 1, jprecj
-            ptab(:,jl      ) = t2sn(:,jl,2)
-            ptab(:,ijhom+jl) = t2ns(:,jl,2)
+            ptab(:,jl      ) = zt2sn(:,jl,2)
+            ptab(:,ijhom+jl) = zt2ns(:,jl,2)
          END DO
       CASE ( 1 )
          DO jl = 1, jprecj
-            ptab(:,jl) = t2sn(:,jl,2)
+            ptab(:,jl) = zt2sn(:,jl,2)
          END DO
       END SELECT
@@ -3328,4 +3367,6 @@
          !
       ENDIF
+      !
+      DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we  )
       !
    END SUBROUTINE mpp_lnk_bdy_2d
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 4015)
@@ -29,4 +29,5 @@
    !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
    !!            3.4  ! 2011-11  (C. Harris) decomposition changes for running with CICE
+   !!                 ! 2012-05  (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 
    !!----------------------------------------------------------------------
 
@@ -84,4 +85,5 @@
 #endif
    USE sbctide, ONLY: lk_tide
+   USE crsini          ! initialise grid coarsening utility
 
    IMPLICIT NONE
@@ -347,5 +349,8 @@
                             CALL dyn_nept_init  ! simplified form of Neptune effect
 
-      !                                     ! Ocean physics
+      !     
+      IF( ln_crs        )   CALL     crs_init   ! Domain initialization of coarsened grid
+      !
+                                ! Ocean physics
                             CALL     sbc_init   ! Forcings : surface module
       !                                         ! Vertical physics
@@ -553,5 +558,4 @@
       ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
       !
-      ierr = ierr + lib_mpp_alloc   (numout)    ! mpp exchanges
       ierr = ierr + trc_oce_alloc   ()          ! shared TRC / TRA arrays
       !
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/oce.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 4015)
@@ -47,4 +47,6 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gru , grv    !: horizontal gradient of rd at bottom u-point
 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rke          !: kinetic energy
+
    !! arrays relating to embedding ice in the ocean. These arrays need to be declared 
    !! even if no ice model is required. In the no ice model or traditional levitating 
@@ -79,4 +81,5 @@
       ALLOCATE( rhd (jpi,jpj,jpk) ,                                         &
          &      rhop(jpi,jpj,jpk) ,                                         &
+         &      rke (jpi,jpj,jpk) ,                                         &
          &      sshb  (jpi,jpj)   , sshn  (jpi,jpj) , ssha  (jpi,jpj) ,     &
          &      sshu_b(jpi,jpj)   , sshu_n(jpi,jpj) , sshu_a(jpi,jpj) ,     &
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_AMM_12km.h90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_AMM_12km.h90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_AMM_12km.h90	(revision 4015)
@@ -4,20 +4,12 @@
    !!                  (AMM_12km configuration VN3.3)
    !!---------------------------------------------------------------------
-   CHARACTER (len=16)        &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      ::    &  
-      cp_cfg = "amm"         !: name of the configuration
-   INTEGER                   &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      ::    &  
-      jp_cfg = 011  ,        &  !: resolution of the configuration (degrees)
+   CHARACTER (len=16) :: cp_cfg = "amm"  !: name of the configuration
+   INTEGER            :: jp_cfg = 011    !: resolution of the configuration (degrees)
+   INTEGER, PARAMETER ::     &
       ! Original data size
       jpidta  = 198,        &  !: first horizontal dimension > or = to jpi
       jpjdta  = 224,        &  !: second                     > or = to jpj
-      jpkdta  = 51,         &  !: number of levels           > or = to jpk
+      jpkdta  = 33             !: number of levels           > or = to jpk
+   INTEGER            ::     &
       ! total domain matrix size
       jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R2.h90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R2.h90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R2.h90	(revision 4015)
@@ -8,17 +8,7 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-   CHARACTER (len=16)      &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      ::    &  
-      cp_cfg = "eel"            !: name of the configuration
-   INTEGER     &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
-      jp_cfg = 2   ,         &  !: resolution of the configuration (km)
-
+   CHARACTER (len=16) :: cp_cfg = "eel"  !: name of the configuration
+   INTEGER            :: jp_cfg = 2    !: resolution of the configuration (km)
+   INTEGER, PARAMETER ::     &
       ! data size              !!! * size of all the input files *
       jpidta  = 83,          &  !: 1st horizontal dimension ( >= jpi )
@@ -26,4 +16,5 @@
       jpkdta  = 30,          &  !: number of levels         ( >= jpk )
 
+   INTEGER            ::     &
       ! global domain size     !!! * full domain *
       jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R5.h90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R5.h90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R5.h90	(revision 4015)
@@ -8,22 +8,13 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-   CHARACTER (len=16)      &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      ::    &  
-      cp_cfg = "eel"            !: name of the configuration
-   INTEGER     &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
-      jp_cfg = 5      ,      &  !: resolution of the configuration (km)
-
+   CHARACTER (len=16) :: cp_cfg = "eel"  !: name of the configuration
+   INTEGER            :: jp_cfg = 5    !: resolution of the configuration (km)
+   INTEGER, PARAMETER ::     &
       ! data size              !!! * size of all the input files
       jpidta  =  66   ,      &  !: first horizontal dimension > or = to jpi
       jpjdta  =  66   ,      &  !: second                     > or = to jpj
-      jpkdta  =  31   ,      &  !: number of levels           > or = to jpk
+      jpkdta  =  31             !: number of levels           > or = to jpk
 
+   INTEGER ::     &
       ! total domain size      !!! * full domain *
       jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R6.h90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R6.h90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R6.h90	(revision 4015)
@@ -8,17 +8,7 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-   CHARACTER (len=16)      &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      ::    &  
-      cp_cfg = "eel"            !: name of the configuration
-   INTEGER     &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      ::     &
-      jp_cfg = 6      ,      &  !: resolution of the configuration (km)
-
+   CHARACTER (len=16) :: cp_cfg = "eel"  !: name of the configuration
+   INTEGER            :: jp_cfg = 6      !: resolution of the configuration (km)
+   INTEGER, PARAMETER ::     &
       ! data size              !!! * size of all the input files *
       jpidta  = 29,          &  !: 1st lateral dimension ( >= jpi )
@@ -26,4 +16,5 @@
       jpkdta  = 30,          &  !: number of levels      ( >= jpk )
 
+   INTEGER            ::     &
       ! global domain size     !!! * full domain *
       jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_GYRE.h90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_GYRE.h90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_GYRE.h90	(revision 4015)
@@ -8,22 +8,13 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-   CHARACTER (len=16)      &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      ::    &  
-      cp_cfg = "gyre"           !: name of the configuration
-   INTEGER     &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
-      jp_cfg =  1   ,        &  !: 
-
+   CHARACTER (len=16) :: cp_cfg = "gyre"  !: name of the configuration
+   INTEGER            :: jp_cfg = 1       !: resolution of the configuration 
+   INTEGER, PARAMETER ::     &
       ! data size              !!! * size of all the input files *
       jpidta  = 30*jp_cfg+2, &  !: 1st horizontal dimension ( >= jpi )
       jpjdta  = 20*jp_cfg+2, &  !: 2nd    "            "    ( >= jpj )
-      jpkdta  = 31,          &  !: number of levels         ( >= jpk )
+      jpkdta  = 31              !: number of levels         ( >= jpk )
 
+   INTEGER            ::     &
       ! global domain size     !!! * full domain *
       jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R025.h90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R025.h90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R025.h90	(revision 4015)
@@ -9,24 +9,16 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-   CHARACTER (len=16)      &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      ::    &  
-      cp_cfg = "orca"           !: name of the configuration
-   INTEGER     &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
-      jp_cfg = 025  ,        &  !: resolution of the configuration (degrees)
+   CHARACTER (len=16) :: cp_cfg = "orca"  !: name of the configuration
+   INTEGER            :: jp_cfg = 025       !: resolution of the configuration (degrees)
+   INTEGER, PARAMETER ::     &
       ! Original data size
       jpidta  = 1442,        &  !: first horizontal dimension > or = to jpi
       jpjdta  = 1021,        &  !: second                     > or = to jpj
 #if key_orca_r025==75
-      jpkdta  = 75 ,         &  !: number of levels           > or = to jpk
+      jpkdta  = 75              !: number of levels           > or = to jpk
 #else
-      jpkdta  = 46 ,         &  !: number of levels           > or = to jpk
+      jpkdta  = 46              !: number of levels           > or = to jpk
 #endif
+   INTEGER  ::     &
       ! total domain matrix size
       jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R05.h90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R05.h90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R05.h90	(revision 4015)
@@ -9,18 +9,8 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-   CHARACTER (len=16)      &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      ::    &  
-      cp_cfg = "orca"           !: name of the configuration
-   INTEGER     &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
-      jp_cfg = 05  ,         &  !: resolution of the configuration (degrees)
-
-      ! data size              !!! * size of all the input files *
+   CHARACTER (len=16) :: cp_cfg = "orca"  !: name of the configuration
+   INTEGER            :: jp_cfg = 05       !: resolution of the configuration (degrees)
+   INTEGER, PARAMETER ::     &
+      ! data size              !!! * size of all input files *
       jpidta  = 722,         &  !: 1st lateral dimension > or = to jpiglo
       jpjdta  = 511,         &  !: 2nd   "         "     > or = to jpjglo
@@ -29,9 +19,5 @@
 #if defined key_antarctic
       ! zoom domain size       !!! *  antarctic zoom  * 
-   INTEGER     &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
+   INTEGER   ::   &
       jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
       jpjglo  = 187   ,      &  !: 2nd     "                 "    --> j 
@@ -44,9 +30,5 @@
 #elif defined key_arctic
       ! zoom domain size       !!! *  arctic zoom  *
-   INTEGER    &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
+   INTEGER   ::  
       ! zoom domain size       !!! *  arctic zoom  *
       jpiglo  = 562,         &  !: 1st dimension of global domain --> i
@@ -60,9 +42,5 @@
 #else
       ! global domain size     !!! *  global domain  *
-   INTEGER    &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
+   INTEGER    ::  &
       jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
       jpjglo  = jpjdta,      &  !: 2nd     "                 "    --> j
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R1.h90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R1.h90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R1.h90	(revision 4015)
@@ -12,24 +12,17 @@
    !! Use: key_orca_r1=75 to set 75 levels
    !!----------------------------------------------------------------------
-   CHARACTER (len=16)      &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      ::    &  
-      cp_cfg = "orca"           !: name of the configuration
-   INTEGER     &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
-      jp_cfg = 1    ,        &  !: resolution of the configuration (degrees)
+   CHARACTER (len=16) :: cp_cfg = "orca"  !: name of the configuration
+   INTEGER            :: jp_cfg = 1       !: resolution of the configuration (degrees)
+   INTEGER, PARAMETER ::     &
       ! Original data size
       jpidta  =  362,        &  !: first horizontal dimension > or = to jpi
       jpjdta  =  292,        &  !: second                     > or = to jpj
 #if key_orca_r1==75
-      jpkdta  = 75 ,         &  !: number of levels           > or = to jpk
+      jpkdta  = 75              !: number of levels           > or = to jpk
 #else
-      jpkdta  = 46 ,         &  !: number of levels           > or = to jpk
+      jpkdta  = 46              !: number of levels           > or = to jpk
 #endif
+
+   INTEGER ::     &
       ! total domain matrix size
       jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R2.h90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R2.h90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R2.h90	(revision 4015)
@@ -9,17 +9,7 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-   CHARACTER (len=16)      &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      ::    &  
-      cp_cfg = "orca"           !: name of the configuration 
-   INTEGER     &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
-      jp_cfg = 2,            &  !: resolution of the configuration (degrees)
-
+   CHARACTER (len=16) :: cp_cfg = "orca"  !: name of the configuration
+   INTEGER            :: jp_cfg = 2       !: resolution of the configuration (degrees)
+   INTEGER, PARAMETER ::     &
       ! data size              !!! * size of all input files *
       jpidta  = 182,         &  !: 1st lateral dimension ( >= jpiglo )
@@ -29,9 +19,5 @@
 #if defined key_antarctic
       ! zoom domain size       !!! *  antarctic zoom  * 
-   INTEGER     &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
+   INTEGER  ::   &
       jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
       jpjglo  = 50,          &  !: 2nd    "                  "    --> j
@@ -44,9 +30,5 @@
 #elif defined key_arctic
       ! zoom domain size       !!! *  arctic zoom  *
-   INTEGER    &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
+   INTEGER  ::  &
       jpiglo  = 142   ,      &  !: 1st dimension of global domain --> i
       jpjglo  = jpjdta-97+1, &  !: 2nd    "                  "    --> j
@@ -59,9 +41,5 @@
 #elif defined key_c1d
       ! global domain size     !!! *  global domain  *
-   INTEGER    &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
+   INTEGER  ::   &
       jpiglo  = 3     ,      &  !: 1st dimension of global domain --> i
       jpjglo  = 3     ,      &  !: 2nd    "                  "    --> j
@@ -87,9 +65,5 @@
 #else
       ! global domain size     !!! *  global domain  *
-   INTEGER    &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
+   INTEGER   ::  &
       jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
       jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R4.h90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R4.h90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R4.h90	(revision 4015)
@@ -9,20 +9,13 @@
    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
-   CHARACTER (len=16)      &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-       ::    &  
-     cp_cfg = "orca"           !: name of the configuration
-   INTEGER     &
-#if !defined key_agrif
-      , PARAMETER  &
-#endif
-      :: &
-      jp_cfg = 4      ,      &  !: resolution of the configuration (degrees)
-      ! Original data size
+   CHARACTER (len=16) :: cp_cfg = "orca"  !: name of the configuration
+   INTEGER            :: jp_cfg = 4       !: resolution of the configuration (degrees)
+   INTEGER, PARAMETER ::     &
+      ! data size              !!! * size of all input files *
       jpidta  =  92   ,      &  !: first horizontal dimension > or = to jpi
       jpjdta  =  76   ,      &  !: second                     > or = to jpj
-      jpkdta  =  31   ,      &  !: number of levels           > or = to jpk
+      jpkdta  =  31             !: number of levels           > or = to jpk
+   
+   INTEGER           ::     &
       ! global domain matrix size
       jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 4015)
@@ -7,4 +7,6 @@
    !!   NEMO     1.0  !  2004-01  (G. Madec, J.-M. Molines)  Free form and module
    !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add jpts, jp_tem & jp_sal
+   !!            3.5  !  2012-07  (J. Simeon) online coarsening of outputs
+   !!                             renounced parameter status for jpiglo, jpjglo 
    !!----------------------------------------------------------------------
    USE par_kind          ! kind parameters
@@ -90,6 +92,6 @@
    !!   default option  :                               small closed basin
    !!---------------------------------------------------------------------
-   CHARACTER(len=16), PUBLIC, PARAMETER ::   cp_cfg = "default"   !: name of the configuration
-   INTEGER          , PUBLIC, PARAMETER ::   jp_cfg = 0           !: resolution of the configuration
+   CHARACTER(len=16), PUBLIC ::   cp_cfg = "default"   !: name of the configuration
+   INTEGER          , PUBLIC ::   jp_cfg = 0           !: resolution of the configuration
 
    ! data size                                       !!! * size of all input files *
@@ -98,14 +100,14 @@
    INTEGER, PUBLIC, PARAMETER ::   jpkdta  = 31       !: number of levels      ( >= jpk )
 
-   ! global or zoom domain size                      !!! * computational domain *
-   INTEGER, PUBLIC, PARAMETER ::   jpiglo  = jpidta   !: 1st dimension of global domain --> i
-   INTEGER, PUBLIC, PARAMETER ::   jpjglo  = jpjdta   !: 2nd    -                  -    --> j
+   ! global or zoom domain size (formerly parameters) !!! * computational domain *
+   INTEGER, PUBLIC            ::   jpiglo  = jpidta   !: 1st dimension of global domain --> i
+   INTEGER, PUBLIC            ::   jpjglo  = jpjdta   !: 2nd    -                  -    --> j
 
    ! zoom starting position 
-   INTEGER, PUBLIC, PARAMETER ::   jpizoom =   1      !: left bottom (i,j) indices of the zoom
-   INTEGER, PUBLIC, PARAMETER ::   jpjzoom =   1      !: in data domain indices
+   INTEGER, PUBLIC ::   jpizoom =   1      !: left bottom (i,j) indices of the zoom
+   INTEGER, PUBLIC ::   jpjzoom =   1      !: in data domain indices
 
    ! Domain characteristics
-   INTEGER, PUBLIC, PARAMETER ::   jperio  =  0       !: lateral cond. type (between 0 and 6)
+   INTEGER, PUBLIC ::   jperio  =  0       !: lateral cond. type (between 0 and 6)
    !                                                  !  = 0 closed                 ;   = 1 cyclic East-West
    !                                                  !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 4015)
@@ -24,4 +24,5 @@
    !!             -   !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
    !!            3.4  !  2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal
+   !!                 !  2012-07  (J. Simeon, G. Madec. C. Ethe) Online coarsening of outputs
    !!----------------------------------------------------------------------
 
@@ -78,11 +79,15 @@
 !      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp
 # if defined key_iomput
-      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap
+      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap( "nemo" )
 # endif
 #endif
-                             indic = 0                ! reset to no error condition
-      IF( kstp == nit000 )   CALL iom_init            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
+                             indic = 0           ! reset to no error condition
+      IF( kstp == nit000 ) THEN
+                      CALL iom_init( "nemo" )      ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
+         IF( ln_crs ) CALL iom_init( "nemo_crs" )  ! initialize context for coarse grid
+      ENDIF
       IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
-                             CALL iom_setkt( kstp - nit000 + 1 )   ! say to iom that we are at time step kstp
+                             CALL iom_setkt( kstp - nit000 + 1, "nemo"     )   ! say to iom that we are at time step kstp
+      IF( ln_crs     )       CALL iom_setkt( kstp - nit000 + 1, "nemo_crs" )   ! say to iom that we are at time step kstp
 
       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -170,4 +175,7 @@
       IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis
                          CALL dia_wri( kstp )         ! ocean model: outputs
+      !
+      IF( ln_crs     )   CALL crs_fld( kstp )         ! ocean model: online field coarsening & output
+
 
 #if defined key_top
@@ -270,7 +278,8 @@
       IF( lk_cpl           )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges
       !
-#if defined key_iomput
-      IF( kstp == nitend   )   CALL xios_context_finalize() ! needed for XIOS+AGRIF
-#endif
+      IF( kstp == nitend   )  THEN
+                      CALL iom_context_finalize( "nemo"     ) ! needed for XIOS+AGRIF
+         IF( ln_crs ) CALL iom_context_finalize( "nemo_crs" ) ! 
+      ENDIF
       !
       IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset
Index: /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 4014)
+++ /branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 4015)
@@ -100,4 +100,6 @@
    USE floats           ! floats computation               (flo_stp routine)
 
+   USE crsfld           ! Standard output on coarse grid   (crs_fld routine)
+
    USE asminc           ! assimilation increments      (tra_asm_inc routine)
    !                                                   (dyn_asm_inc routine)
