Index: /branches/nemo/NEMO/LIM_SRC/dom_ice.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/dom_ice.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/dom_ice.F90	(revision 4)
@@ -0,0 +1,49 @@
+MODULE dom_ice
+   !!======================================================================
+   !!             ***  MODULE  dom_ice  ***
+   !!                   Sea Ice Domain  
+   !!======================================================================
+   !!
+   !! ** Purpose :
+   !!       - Define in memory coefficients of Sea Ice model
+   !!
+   !! History :
+   !!   2.0  !  03-08  (C. Ethe)  Free form and module
+   !! * Modules used
+   USE par_ice
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !!  LIM 2.0, UCL-LODYC-IPSL (2002)
+   !!----------------------------------------------------------------------
+
+   REAL(wp),DIMENSION(jpi,jpj) ::  &  
+      area          ! Surface of a grid square
+ 
+
+   REAL(wp),DIMENSION(jpi,jpj,2,2) ::  &
+      wght   ,   &  ! weight of the 4 neighbours to compute averages
+      akappa ,   &  ! first group of metric coefficients
+      bkappa        ! third group of metric coefficients
+
+   REAL(wp),DIMENSION(jpi,jpj) :: &
+      tms  ,tmu     ! masks arrays
+
+   REAL(wp),DIMENSION(jpi,jpj,2,2,2,2) ::  &
+      alambd        ! second group of metric coefficients
+
+   REAL(wp) ::  &
+      dz            ! depht of the 1st ocean level
+
+   REAL(wp),DIMENSION(jpi,jpj) ::  &  
+      fs2cor ,   &  !  coriolis factor
+      fcor   ,   &  !  coriolis coefficient
+      covrai ,   &  !  sine of geographic latitude
+      aire          !  total area 
+
+   INTEGER  :: &
+      jeq , jeqm1
+
+   !!======================================================================
+END MODULE dom_ice
Index: /branches/nemo/NEMO/LIM_SRC/ice.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/ice.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/ice.F90	(revision 4)
@@ -0,0 +1,138 @@
+MODULE ice
+   !!======================================================================
+   !!                        ***  MODULE ice  ***
+   !! Sea Ice physics:  diagnostics variables of ice defined in memory
+   !!=====================================================================
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim' :                                   LIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!
+   !! ** Purpose :   Define in memory diagnostics Sea Ice variables
+   !!
+   !! History :
+   !!   2.0  !  03-08  (C. Ethe)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   !!  LIM 2.0, UCL-LODYC-IPSL (2002)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_ice          ! LIM sea-ice parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !! * Share Module variables
+   INTEGER , PUBLIC ::   & !!! ** ice-dynamic namelist (namicedyn) **
+      nlminn = 103    ,  & ! minimum index for computation of ice drift(NH)
+      nlmaxs = 45     ,  & ! maximum index for computation of ice drift(SH)
+      nbiter = 1      ,  & ! number of sub-time steps for relaxation
+      nbitdr = 250         ! maximum number of iterations for relaxation
+
+   REAL(wp), PUBLIC ::   & !!! ** ice-dynamic namelist (namicedyn) **
+      epsd   = 1.0e-20,  & ! tolerance parameter for dynamic
+      alpha  = 0.5    ,  & ! coefficient for semi-implicit coriolis
+      dm     = 0.6e+03,  & ! diffusion constant for dynamics
+      om     = 0.5    ,  & ! relaxation constant
+      resl   = 5.0e-05,  & ! maximum value for the residual of relaxation
+      cw     = 5.0e-03,  & ! drag coefficient for oceanic stress
+      angvg  = 0.0    ,  & ! turning angle for oceanic stress
+      pstar  = 1.0e+04,  & ! first bulk-rheology parameter
+      c_rhg  = 20.0   ,  & ! second bulk-rhelogy parameter
+      etamn  = 0.0e+07,  & ! minimun value for viscosity
+      creepl = 2.0e-08,  & ! creep limit
+      ecc    = 2.0    ,  & ! eccentricity of the elliptical yield curve
+      ahi0   = 350.e0      ! sea-ice hor. eddy diffusivity coeff. (m2/s)
+
+   INTEGER , PUBLIC ::   &
+      nlmaxn = jpjm1  ,  & ! maximum index for computation of ice drift(NH)
+#if defined key_mpp
+      nlmins = 2           ! minimum index for computation of ice drift(SH)
+#else
+      nlmins = 3           ! minimum index for computation of ice drift(SH)
+#endif
+
+   REAL(wp), PUBLIC ::   &
+      usecc2          ,  & !  = 1.0 / ( ecc * ecc )
+      rhoco           ,  & ! = rau0 * cw
+      sangvg, cangvg  ,  & ! sin and cos of the turning angle for ocean stress
+      pstarh               ! pstar / 2.0
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  &
+      u_oce, v_oce,      & ! surface ocean velocity used in ice dynamics
+      ahiu , ahiv ,      & ! hor. diffusivity coeff. at ocean U- and V-points (m2/s)
+      pahu , pahv ,      & ! ice hor. eddy diffusivity coef. at ocean U- and V-points
+      hsnm , hicm ,      & ! mean snow and ice thicknesses
+      ust2s                ! friction velocity
+
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      firic  ,   &  ! IR flux over the ice (only used for outputs)
+      fcsic  ,   &  ! Sensible heat flux over the ice (only used for outputs)
+      fleic  ,   &  ! Latent heat flux over the ice (only used for outputs)
+      qlatic ,   &  ! latent flux
+      rdvosif,   &  ! Variation of volume at surface (only used for outputs)
+      rdvobif,   &  ! Variation of ice volume at the bottom ice (only used for outputs)
+      fdvolif,   &  ! Total variation of ice volume (only used for outputs)
+      rdvonif,   &  ! Lateral Variation of ice volume (only used for outputs)
+      sist   ,   &  ! Sea-Ice Surface Temperature (Kelvin ??? degree ??? I don't know)
+      tfu    ,   &  ! Melting point temperature of sea water
+      hsnif  ,   &  ! Snow thickness
+      hicif  ,   &  ! Ice thickness
+      hicifp ,   &  ! Ice production/melting
+      frld   ,   &  ! Leads fraction = 1-a/totalarea
+      phicif ,   &  ! ice thickness  at previous time 
+      pfrld  ,   &  ! Leads fraction at previous time  
+      qstoif ,   &  ! Energy stored in the brine pockets
+      fbif   ,   &  ! Heat flux at the ice base
+      rdmsnif,   &  ! Variation of snow mass
+      rdmicif,   &  ! Variation of ice mass
+      qldif  ,   &  ! heat balance of the lead (or of the open ocean)
+      qcmif  ,   &  ! Energy needed to bring the ocean surface layer until its freezing 
+      fdtcn  ,   &  ! net downward heat flux from the ice to the ocean
+      qdtcn  ,   &  ! energy from the ice to the ocean
+                    ! point (at a factor 2)
+      thcm   ,   &  ! part of the solar energy used in the lead heat budget
+      fstric ,   &  ! Solar flux transmitted trough the ice
+      ffltbif,   &  ! Array linked with the max heat contained in brine pockets (?)
+      fscmbq ,   &  ! Linked with the solar flux below the ice (?)
+      fsbbq  ,   &  ! Also linked with the solar flux below the ice (?)
+      qfvbq  ,   &  ! Array used to store energy in case of toral lateral ablation (?)
+      dmgwi         ! Variation of the mass of snow ice
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      albege ,   &  ! Albedo of the snow or ice (only for outputs)
+      albecn ,   &  ! Albedo of the ocean (only for outputs)
+      tauc   ,   &  ! Cloud optical depth
+      sdvt          ! u*^2/(Stress/density)
+
+
+   REAL(wp),DIMENSION(jpi,jpj) ::  &  
+      u_ice, v_ice,   &  ! two components of the ice velocity (m/s)
+      tio_u, tio_v       ! two components of the ice-ocean stress (N/m2)
+
+   REAL(wp),DIMENSION(jpi,jpj,nsmax) :: &
+      scal0
+
+   REAL(wp), DIMENSION(jpi,jpj,nlayersp1) ::   &
+      tbif          ! Temperature inside the ice/snow layer
+
+   REAL(wp), DIMENSION(jpi,jpj,0:kmax+1) ::    &
+      reslum        ! Relative absorption of solar radiation in each ocean level
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+         sxice, syice, sxxice, syyice, sxyice,      &  ! moments for advection
+         sxsn,  sysn,  sxxsn,  syysn,  sxysn,       &
+         sxa,   sya,   sxxa,   syya,   sxya,        &
+         sxc0,  syc0,  sxxc0,  syyc0,  sxyc0,       &
+         sxc1,  syc1,  sxxc1,  syyc1,  sxyc1,       &
+         sxc2,  syc2,  sxxc2,  syyc2,  sxyc2,       &
+         sxst,  syst,  sxxst,  syyst,  sxyst      
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty module            NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE ice
Index: /branches/nemo/NEMO/LIM_SRC/iceini.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/iceini.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/iceini.F90	(revision 4)
@@ -0,0 +1,147 @@
+MODULE iceini
+   !!======================================================================
+   !!                       ***  MODULE iceini   ***
+   !!   Sea-ice model : LIM Sea ice model Initialization
+   !!======================================================================
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim' :                                   LIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_init       : sea-ice model initialization
+   !!----------------------------------------------------------------------
+   USE dom_oce
+   USE in_out_manager
+   USE ice_oce         ! ice variables
+   USE flx_oce
+   USE phycst          ! Define parameters for the routines
+   USE ocfzpt
+   USE ice
+   USE limmsh
+   USE limistate
+   USE limrst
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC ice_init                 ! called by opa.F90
+
+   !! * Share Module variables
+   LOGICAL , PUBLIC  ::  & !!! ** init namelist (namicerun) **
+      ldyn   = .TRUE.       ! flag for ice dynamics (T) or not (F)
+
+   REAL(wp), PUBLIC  ::  &
+      hsndif = 0.0     , & ! computation of temp. in snow (0) or not (9999)
+      hicdif = 0.0         ! computation of temp. in ice (0) or not (9999)
+
+   !! * Module variables
+   REAL(wp), PUBLIC, DIMENSION(2)  ::  &   
+      acrit  = (/ 1.0e-06 , 1.0e-06 /)   ! minimum fraction for leads in 
+      !                                  ! north and south hemisphere
+
+   INTEGER, PUBLIC   ::   &
+      nstart ,   &  ! iteration number of the begining of the run 
+      nlast  ,   &  ! iteration number of the end of the run 
+      nitrun ,   &  ! number of iteration
+      numit         ! iteration number
+ 
+  REAL(wp), PUBLIC ::   &
+      tpstot         ! time of the run in seconds
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0   UCL-LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE ice_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_init  ***
+      !!
+      !! ** purpose :   
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and modules
+      !!----------------------------------------------------------------------
+
+      ! Open the namelist file 
+      OPEN( numnam_ice, FILE= 'namelist_ice', FORM='formatted', STATUS = 'old') 
+
+      CALL ice_run                    !  read in namelist some run parameters
+                 
+      ! Louvain la Neuve Ice model
+      IF( nacc == 1 ) THEN
+          dtsd2   = nfice * rdtmin * 0.5
+          rdt_ice = nfice * rdtmin
+      ELSE
+          dtsd2   = nfice * rdt * 0.5
+          rdt_ice = nfice * rdt
+      ENDIF
+
+      CALL lim_msh                    ! ice mesh initialization
+     
+      ! Initial sea-ice state
+      IF( .NOT.ln_rstart ) THEN
+         numit = 0
+         CALL lim_istate              ! start from rest: sea-ice deduced from sst
+      ELSE
+         CALL lim_rst_read( numit )   ! start from a restart file
+      ENDIF
+      
+      tn_ice(:,:) = sist(:,:)         ! initialisation of ice temperature   
+      freeze(:,:) = 1.0 - frld(:,:)   ! initialisation of sea/ice cover    
+# if defined key_coupled
+      alb_ice(:,:) = albege(:,:)      ! sea-ice albedo
+# endif
+      
+      nstart = numit  + nfice      
+      nitrun = nitend - nit000 + 1 
+      nlast  = numit  + nitrun 
+
+      IF( nstock == 0  )  nstock = nlast + 1
+
+   END SUBROUTINE ice_init
+
+
+   SUBROUTINE ice_run
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_run ***
+      !!                 
+      !! ** Purpose :   Definition some run parameter for ice model
+      !!
+      !! ** Method  :   Read the namicerun namelist and check the parameter 
+      !!       values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicerun
+      !!
+      !! history :
+      !!   2.0  !  03-08 (C. Ethe)  Original code
+      !!-------------------------------------------------------------------
+      NAMELIST/namicerun/ ldyn, acrit, hsndif, hicdif
+      !!-------------------------------------------------------------------
+
+      !                                           ! Read Namelist namicerun 
+      REWIND ( numnam_ice )
+      READ   ( numnam_ice , namicerun )
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice'
+         WRITE(numout,*) ' ~~~~~~'
+         WRITE(numout,*) '   switch for ice dynamics (1) or not (0)           ldyn   = ', ldyn
+         WRITE(numout,*) '   minimum fraction for leads in the NH (SH)  acrit(1/2)   = ', acrit
+         WRITE(numout,*) '   computation of temp. in snow (=0) or not (=9999) hsndif = ', hsndif
+         WRITE(numout,*) '   computation of temp. in ice  (=0) or not (=9999) hicdif = ', hicdif
+      ENDIF
+      
+   END SUBROUTINE ice_run
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :        Empty module           NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE ice_init        ! Empty routine
+   END SUBROUTINE ice_init
+#endif
+
+   !!======================================================================
+END MODULE iceini
Index: /branches/nemo/NEMO/LIM_SRC/icestp.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/icestp.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/icestp.F90	(revision 4)
@@ -0,0 +1,292 @@
+MODULE icestp
+   !!======================================================================
+   !!                       ***  MODULE icestp   ***
+   !!   Sea-Ice model : LIM Sea ice model time-stepping
+   !!======================================================================
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim' :                                   Lim sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_stp       : sea-ice model time-stepping
+   !!----------------------------------------------------------------------
+   USE dom_oce
+   USE oce  ! dynamics and tracers variables
+   USE in_out_manager
+   USE ice_oce         ! ice variables
+   USE flx_oce         ! forcings variables
+   USE dom_ice
+   USE daymod
+   USE phycst          ! Define parameters for the routines
+   USE taumod
+   USE ice
+   USE iceini
+   USE ocesbc
+   USE lbclnk
+   USE limdyn
+   USE limtrp
+   USE limthd
+   USE limflx
+   USE limdia
+   USE limwri
+   USE limrst
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC ice_stp  ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!-----------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!-----------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE ice_stp ( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_stp  ***
+      !!                   
+      !! ** Purpose :   Louvain la Neuve Sea Ice Model time stepping 
+      !!
+      !! ** Action  : - call the ice dynamics routine 
+      !!              - call the ice advection/diffusion routine 
+      !!              - call the ice thermodynamics routine 
+      !!              - call the routine that computes mass and 
+      !!                heat fluxes at the ice/ocean interface
+      !!              - save the outputs 
+      !!              - save the outputs for restart when necessary
+      !!
+      !! History :
+      !!   1.0  !  99-11  (M. Imbard)  Original code
+      !!        !  01-03  (D. Ludicone, E. Durand, G. Madec) free surf.
+      !!   2.0  !  02-09  (G. Madec, C. Ethe)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER   ::   ji, jj   ! dummy loop indices
+
+      REAL(wp) , DIMENSION(jpi,jpj)    :: &
+         zsss_io, zsss2_io, zsss3_io          ! tempory workspaces
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+# if defined key_coupled
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ice_stp : Louvain la Neuve Ice Model (LIM)'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   coupled case'
+#else
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ice_stp : Louvain la Neuve Ice Model (LIM)' 
+         IF(lwp) WRITE(numout,*) '~~~~~~~   forced case using bulk formulea'
+#endif
+         !  Initialize fluxes fields
+         gtaux(:,:) = 0.e0
+         gtauy(:,:) = 0.e0
+      ENDIF
+
+      ! Temperature , salinity and horizonta wind
+      ! sst_io  and sss_io, u_io and v_io  are initialized at nit000 in limistate.F90 (or limrst.F90) with :
+      !              sst_io = sst_io + (nfice - 1) * (tn(:,:,1)+rt0 )
+      !              sss_io = sss_io + (nfice - 1) * sn(:,:,1)
+      !              u_io  = u_io  + (nfice - 1) * 0.5 * ( un(ji-1,jj  ,1) + un(ji-1,jj-1,1) )
+      !              v_io  = v_io  + (nfice - 1) * 0.5 * ( vn(ji  ,jj-1,1) + vn(ji-1,jj-1,1) )
+      !    cumulate fields
+      !
+      sst_io(:,:) = sst_io(:,:) + tn(:,:,1) + rt0
+      sss_io(:,:) = sss_io(:,:) + sn(:,:,1)
+
+ 
+      ! vectors at F-point
+      DO jj = 2, jpj
+         DO ji = fs_2, jpi   ! vector opt.
+            u_io(ji,jj) = u_io(ji,jj) + 0.5 * ( un(ji-1,jj  ,1) + un(ji-1,jj-1,1) )
+            v_io(ji,jj) = v_io(ji,jj) + 0.5 * ( vn(ji  ,jj-1,1) + vn(ji-1,jj-1,1) )
+         END DO
+      END DO
+      
+      
+      IF( MOD( kt-1, nfice ) == 0 ) THEN
+         
+         ! The LIM model is going to be call
+         sst_io(:,:) = sst_io(:,:) / FLOAT( nfice ) * tmask(:,:,1)
+         sss_io(:,:) = sss_io(:,:) / FLOAT( nfice )
+
+         ! stress from ocean U- and V-points to ice U,V point
+         DO jj = 2, jpj
+            DO ji = fs_2, jpi   ! vector opt.
+               gtaux(ji,jj) = 0.5 * ( taux(ji-1,jj  ) + taux(ji-1,jj-1) )
+               gtauy(ji,jj) = 0.5 * ( tauy(ji  ,jj-1) + tauy(ji-1,jj-1) )
+               u_io  (ji,jj) = u_io(ji,jj) / FLOAT( nfice )
+               v_io  (ji,jj) = v_io(ji,jj) / FLOAT( nfice )
+            END DO
+         END DO
+
+         ! lateral boundary condition
+         CALL lbc_lnk( gtaux(:,:), 'I', -1. )   ! I-point (i.e. ice U-V point)
+         CALL lbc_lnk( gtauy(:,:), 'I', -1. )   ! I-point (i.e. ice U-V point)
+         CALL lbc_lnk( u_io (:,:), 'I', -1. )   ! I-point (i.e. ice U-V point)
+         CALL lbc_lnk( v_io (:,:), 'I', -1. )   ! I-point (i.e. ice U-V point)
+
+!!gmbug  in the ocean freezing point computed as :
+!!gm           fzptn (ji,jj) = ( -0.0575 + 1.710523e-3 * SQRT( sn(ji,jj,1) )   &
+!!gm                                     - 2.154996e-4 *       sn(ji,jj,1)   ) * sn(ji,jj,1)   !!   &
+!!gm           !!                        - 7.53e-4 * pressure
+!!gm
+!!gm!bug this is much more accurate and efficient computation
+!!gm       **************************************************
+!!gm freezing point from unesco:
+!!gm     real function tf(s,p)
+!!gm   function to compute the freezing point of seawater
+!!gm
+!!gm   reference: unesco tech. papers in the marine science no. 28. 1978
+!!gm   eighth report jpots
+!!gm   annex 6 freezing point of seawater f.j. millero pp.29-35.
+!!gm
+!!gm  units:
+!!gm         pressure      p          decibars
+!!gm         salinity      s          pss-78
+!!gm         temperature   tf         degrees celsius
+!!gm         freezing pt.
+!!gm************************************************************
+!!gm  checkvalue: tf= -2.588567 deg. c for s=40.0, p=500. decibars
+!!gm     tf=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p
+!!gm     return
+!!gm     end
+!!gm!bug
+
+
+!!gm      DO jj = 1, jpj
+!!gm         DO ji = 1, jpi
+!!gm            tfu(ji,jj)  = (  rt0 + ( - 0.0575                              &
+!!gm               &                     + 1.710523e-3 * SQRT( sss_io(ji,jj) )   &
+!!gm               &                     - 2.154996e-4 *       sss_io(ji,jj)   ) * sss_io(ji,jj)  ) * tms(ji,jj)
+!!gm         END DO
+!!gm      END DO
+!!gm
+      zsss_io (:,:) = SQRT( sss_io(:,:) ) 
+      zsss2_io(:,:) =  sss_io(:,:) *  sss_io(:,:)
+      zsss3_io(:,:) = zsss_io(:,:) * zsss_io(:,:) * zsss_io(:,:)
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            tfu(ji,jj)  = ABS ( rt0 - 0.0575       *   sss_io(ji,jj)   &
+               &                    + 1.710523e-03 * zsss3_io(ji,jj)   &
+               &                    - 2.154996e-04 * zsss2_io(ji,jj) ) * tms(ji,jj)
+         END DO
+      END DO
+   
+         
+
+         IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging)
+            WRITE(numout,*) 'Ice Forcings '
+            WRITE(numout,*) ' qsr_oce  : ', SUM( qsr_oce (:,:) ), ' qsr_ice  : ', SUM( qsr_ice (:,:) )
+            WRITE(numout,*) ' qnsr_oce : ', SUM( qnsr_oce(:,:) ), ' qnsr_ice : ', SUM( qnsr_ice(:,:) )
+            WRITE(numout,*) ' evap     : ', SUM( evap (:,:) )
+            WRITE(numout,*) ' precip   : ', SUM( tprecip(:,:)  ), ' Snow     : ', SUM( sprecip (:,:) )
+            WRITE(numout,*) ' u-stress : ', SUM( gtaux  (:,:)  ), ' v-stress : ', SUM( gtauy  (:,:) )
+            WRITE(numout,*) ' sst      : ', SUM( sst_io (:,:)  ), ' sss      : ', SUM( sss_io (:,:) )
+            WRITE(numout,*) ' u_io     : ', SUM( u_io   (:,:)  ), ' v_io     : ', SUM( v_io   (:,:) )
+            WRITE(numout,*) ' hsnif  1 : ', SUM( hsnif  (:,:)  ), ' hicnif   : ', SUM( hicif  (:,:) )
+            WRITE(numout,*) ' frld   1 : ', SUM( frld   (:,:)  ), ' sist     : ', SUM( sist   (:,:) )
+         ENDIF
+
+         ! Ice model call
+         numit = numit + nfice 
+
+         !                                                           !--------------!
+         CALL lim_dyn                                                ! Ice dynamics !   ( rheology/dynamics )
+         !                                                           !--------------!
+         IF( l_ctl .AND. lwp ) THEN
+            WRITE(numout,*) ' hsnif  2 : ', SUM( hsnif  (:,:) ), ' hicnif   : ', SUM( hicif  (:,:) )
+            WRITE(numout,*) ' frld   2 : ', SUM( frld   (:,:) ), ' sist     : ', SUM( sist   (:,:) )
+         ENDIF
+
+
+         !                                                           !---------------!
+         CALL lim_trp                                                ! Ice transport !  ( Advection/diffusion )
+         !                                                           !---------------!
+         IF( l_ctl .AND. lwp ) THEN
+            WRITE(numout,*) ' hsnif  3 : ', SUM( hsnif  (:,:) ), ' hicnif   : ', SUM( hicif  (:,:) )
+            WRITE(numout,*) ' frld   3 : ', SUM( frld   (:,:) ), ' sist     : ', SUM( sist   (:,:) )
+         ENDIF
+
+
+         !                                                           !--------------------!
+         CALL lim_thd                                                ! Ice thermodynamics !
+         !                                                           !--------------------!
+         IF( l_ctl .AND. lwp ) THEN
+            WRITE(numout,*) ' hsnif  4 : ', SUM( hsnif  (:,:) ), ' hicnif   : ', SUM( hicif  (:,:) )
+            WRITE(numout,*) ' frld   4 : ', SUM( frld   (:,:) ), ' sist     : ', SUM( sist   (:,:) )
+         ENDIF
+
+
+         ! Mass and heat fluxes from ice to ocean
+         !                                                           !------------------------------!
+         CALL lim_flx                                                ! Ice/Ocean Mass & Heat fluxes !
+         !                                                           !------------------------------!
+
+         IF( MOD( numit, ninfo ) == 0 .OR. ntmoy == 1 )  THEN        !-----------------!
+            CALL lim_dia                                             ! Ice Diagnostics !
+         ENDIF                                                       !-----------------!
+
+         !                                                           !-------------!
+         CALL lim_wri                                                ! Ice outputs !
+         !                                                           !-------------!
+
+         IF( MOD( numit, nstock ) == 0 .OR. numit == nlast ) THEN
+            !                                                        !------------------!
+            CALL lim_rst_write( numit )                              ! Ice restart file !
+            !                                                        !------------------!
+         ENDIF
+
+         ! Re-initialization of forcings
+         qsr_oce (:,:) = 0.e0
+         qsr_ice (:,:) = 0.e0
+         qnsr_oce(:,:) = 0.e0
+         qnsr_ice(:,:) = 0.e0 
+         dqns_ice(:,:) = 0.e0 
+         tprecip (:,:) = 0.e0 
+         sprecip (:,:) = 0.e0
+#if defined key_coupled 
+         rrunoff (:,:) = 0.e0
+         calving (:,:) = 0.e0
+#else
+         qla_ice (:,:) = 0.e0
+         dqla_ice(:,:) = 0.e0
+         fr1_i0  (:,:) = 0.e0
+         fr2_i0  (:,:) = 0.e0
+         evap    (:,:) = 0.e0
+#endif
+
+      ENDIF
+
+   END SUBROUTINE ice_stp
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                 NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+   USE in_out_manager
+
+CONTAINS
+
+   SUBROUTINE ice_stp ( kt )            ! Empty routine
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'No Sea Ice Model'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+   END SUBROUTINE ice_stp
+
+#endif
+
+   !!======================================================================
+END MODULE icestp
Index: /branches/nemo/NEMO/LIM_SRC/limadv.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limadv.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limadv.F90	(revision 4)
@@ -0,0 +1,446 @@
+MODULE limadv 
+#if defined key_ice_lim
+   !!======================================================================
+   !!                       ***  MODULE limadv   ***
+   !! LIM sea-ice model : sea-ice advection
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   lim_adv_x  : advection of sea ice on x axis
+   !!   lim_adv_y  : advection of sea ice on y axis
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce
+   USE dom_ice
+   USE ice_oce         ! ice variables
+   USE in_out_manager  ! I/O manager
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC lim_adv_x    ! called by lim_trp
+   PUBLIC lim_adv_y    ! called by lim_trp
+
+   !! * Module variables
+   REAL(wp)  ::            &  ! constant values
+      epsi20 = 1e-20    ,  &
+      rzero  = 0.e0     ,  &
+      rone   = 1.e0
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_adv_x( pdf, put , pcrh, psm , ps0 ,   &
+      &                  psx, psxx, psy , psyy, psxy )
+      !!---------------------------------------------------------------------
+      !!                **  routine lim_adv_x  **
+      !!  
+      !! ** purpose :   Computes and adds the advection trend to sea-ice
+      !!      variable on x axis
+      !!
+      !! ** method  :   Uses Prather second order scheme that advects
+      !!      tracers but also theirquadratic forms. The method preserves
+      !!      tracer structures by conserving second order moments.
+      !!      Ref.: "Numerical Advection by Conservation of Second Order
+      !!      Moments", JGR, VOL. 91. NO. D6. PAGES 6671-6681. MAY 20, 1986
+      !!     
+      !! History :
+      !!        !  00-01 (LIM)
+      !!        !  01-05 (G. Madec, R. Hordoir) opa norm
+      !!        !  03-10 (C. Ethe) F90, module
+      !!        !  03-12 (R. Hordoir, G. Madec) mpp
+      !!--------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp)                    , INTENT(in)  ::  &
+         pdf ,       &  ! ???
+         pcrh           ! = 1. : lim_adv_x is called before lim_adv_y
+         !              ! = 0. : lim_adv_x is called after  lim_adv_y
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  ::  &
+         put            ! i-direction ice velocity at ocean U-point (m/s)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::  & 
+         ps0 , psm , &  ! ???
+         psx , psy , &  ! ??? 
+         psxx, psyy, psxy
+
+      !! * Local declarations
+      INTEGER ::   ji, jj      ! dummy loop indices
+      REAL(wp)       ::  &
+         zrdt, zslpmax, ztemp, zin0,     &  ! temporary scalars
+         zs1max, zs1new, zs2new,         &  !    "         "
+         zalf, zalfq, zalf1, zalf1q,     &  !    "         "
+         zbt , zbt1                         !    "         "
+      REAL(wp), DIMENSION(jpi,jpj)  ::   &  ! temporary workspace
+         zf0 , zfx , zfy , zbet,         &  !    "           "
+         zfxx, zfyy, zfxy,               &  !    "           "
+         zfm, zalg, zalg1, zalg1q           !    "           "
+      !---------------------------------------------------------------------
+
+      ! Limitation of moments.                                           
+
+      zrdt      = rdt_ice * pdf   ! If ice drift field is too fast, use an appropriate time step for advection.
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zslpmax = MAX( rzero, ps0(ji,jj) )
+            zs1max  = 1.5 * zslpmax
+            zs1new  = MIN( zs1max, MAX( -zs1max, psx(ji,jj) ) )
+            zs2new  = MIN(  2.0 * zslpmax - 0.3334 * ABS( zs1new ),      &
+               &            MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj) )  )
+            zin0    = ( 1.0 - MAX( rzero, sign ( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask
+
+            ps0 (ji,jj) = zslpmax  
+            psx (ji,jj) = zs1new      * zin0
+            psxx(ji,jj) = zs2new      * zin0
+            psy (ji,jj) = psy (ji,jj) * zin0
+            psyy(ji,jj) = psyy(ji,jj) * zin0
+            psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0
+         END DO
+      END DO
+
+      !  Initialize volumes of boxes  (=area if adv_x first called, =psm otherwise)                                     
+      psm (:,:)  = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
+
+      !  Calculate fluxes and moments between boxes i<-->i+1              
+      DO jj = 2, jpjm1                    !  Flux from i to i+1 WHEN u GT 0 
+!i bug   DO ji = 1, jpim1 
+!i    DO jj = 1, jpj                      !  Flux from i to i+1 WHEN u GT 0 
+         DO ji = 1, jpi
+            zbet(ji,jj)  =  MAX( rzero, SIGN( rone, put(ji,jj) ) )
+            zalf         =  MAX( rzero, put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji,jj)
+            zalfq        =  zalf * zalf
+            zalf1        =  1.0 - zalf
+            zalf1q       =  zalf1 * zalf1
+            zfm (ji,jj)  =  zalf  * psm(ji,jj)
+            zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj) + zalf1 * ( psx(ji,jj) + (zalf1 - zalf) * psxx(ji,jj)  ) )
+            zfx (ji,jj)  =  zalfq * ( psx(ji,jj) + 3.0 * zalf1 * psxx(ji,jj) )
+            zfxx(ji,jj)  =  zalf  * zalfq * psxx(ji,jj)
+            zfy (ji,jj)  =  zalf  * ( psy(ji,jj) + zalf1 * psxy(ji,jj) )
+            zfxy(ji,jj)  =  zalfq * psxy(ji,jj)
+            zfyy(ji,jj)  =  zalf  * psyy(ji,jj)
+
+            !  Readjust moments remaining in the box.
+            psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj)
+            ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj)
+            psx (ji,jj)  =  zalf1q * ( psx(ji,jj) - 3.0 * zalf * psxx(ji,jj) )
+            psxx(ji,jj)  =  zalf1  * zalf1q * psxx(ji,jj)
+            psy (ji,jj)  =  psy (ji,jj) - zfy(ji,jj)
+            psyy(ji,jj)  =  psyy(ji,jj) - zfyy(ji,jj)
+            psxy(ji,jj)  =  zalf1q * psxy(ji,jj)
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1                      !  Flux from i+1 to i when u LT 0.
+!i    DO jj = 1, jpjm1                      !  Flux from i+1 to i when u LT 0.
+         DO ji = 1, jpim1
+            zalf          = MAX( rzero, -put(ji,jj) ) * zrdt * e2u(ji,jj) / psm(ji+1,jj) 
+            zalg  (ji,jj) = zalf
+            zalfq         = zalf * zalf
+            zalf1         = 1.0 - zalf
+            zalg1 (ji,jj) = zalf1
+            zalf1q        = zalf1 * zalf1
+            zalg1q(ji,jj) = zalf1q
+            zfm   (ji,jj) = zfm (ji,jj) + zalf  * psm(ji+1,jj)
+            zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0(ji+1,jj) - zalf1 * ( psx(ji+1,jj) - (zalf1 - zalf ) * psxx(ji+1,jj) ) )
+            zfx   (ji,jj) = zfx (ji,jj) + zalfq * ( psx(ji+1,jj) - 3.0 * zalf1 * psxx(ji+1,jj) )
+            zfxx  (ji,jj) = zfxx(ji,jj) + zalf  * zalfq * psxx(ji+1,jj)
+            zfy   (ji,jj) = zfy (ji,jj) + zalf  * ( psy(ji+1,jj) - zalf1 * psxy(ji+1,jj) )
+            zfxy  (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji+1,jj)
+            zfyy  (ji,jj) = zfyy(ji,jj) + zalf  * psyy(ji+1,jj)
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1                     !  Readjust moments remaining in the box. 
+         DO ji = 2, jpim1
+            zbt  =       zbet(ji-1,jj)
+            zbt1 = 1.0 - zbet(ji-1,jj)
+            psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji-1,jj) )
+            ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji-1,jj) )
+            psx (ji,jj) = zalg1q(ji-1,jj) * ( psx(ji,jj) + 3.0 * zalg(ji-1,jj) * psxx(ji,jj) )
+            psxx(ji,jj) = zalg1 (ji-1,jj) * zalg1q(ji-1,jj) * psxx(ji,jj)
+            psy (ji,jj) = zbt * psy (ji,jj) + zbt1 * ( psy (ji,jj) - zfy (ji-1,jj) )
+            psyy(ji,jj) = zbt * psyy(ji,jj) + zbt1 * ( psyy(ji,jj) - zfyy(ji-1,jj) )
+            psxy(ji,jj) = zalg1q(ji-1,jj) * psxy(ji,jj)
+         END DO
+      END DO
+
+      !   Put the temporary moments into appropriate neighboring boxes.    
+      DO jj = 2, jpjm1                     !   Flux from i to i+1 IF u GT 0.
+         DO ji = 2, jpim1
+            zbt  =       zbet(ji-1,jj)
+            zbt1 = 1.0 - zbet(ji-1,jj)
+            psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji-1,jj) ) + zbt1 * psm(ji,jj)
+            zalf        = zbt * zfm(ji-1,jj) / psm(ji,jj)
+            zalf1       = 1.0 - zalf
+            ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji-1,jj)
+            ps0(ji,jj)  = zbt * (ps0(ji,jj) + zf0(ji-1,jj)) + zbt1 * ps0(ji,jj)
+            psx(ji,jj)  = zbt * ( zalf * zfx(ji-1,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp ) + zbt1 * psx(ji,jj)
+            psxx(ji,jj) = zbt * ( zalf * zalf * zfxx(ji-1,jj) + zalf1 * zalf1 * psxx(ji,jj)   &
+               &                + 5.0 * ( zalf * zalf1 * ( psx (ji,jj) - zfx(ji-1,jj) ) - ( zalf1 - zalf ) * ztemp )  )   &
+               &        + zbt1 * psxx(ji,jj)
+            psxy(ji,jj) = zbt * ( zalf * zfxy(ji-1,jj) + zalf1 * psxy(ji,jj)             &
+               &                + 3.0 * (- zalf1*zfy(ji-1,jj)  + zalf * psy(ji,jj) ) )   &
+               &         + zbt1 * psxy(ji,jj)
+            psy (ji,jj) = zbt * ( psy (ji,jj) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj)
+            psyy(ji,jj) = zbt * ( psyy(ji,jj) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj)
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1                     !  Flux from i+1 to i IF u LT 0.
+         DO ji = 2, jpim1
+            zbt  =       zbet(ji,jj)
+            zbt1 = 1.0 - zbet(ji,jj)
+            psm(ji,jj)  = zbt * psm(ji,jj)  + zbt1 * ( psm(ji,jj) + zfm(ji,jj) )
+            zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj)
+            zalf1       = 1.0 - zalf
+            ztemp       = -zalf * ps0(ji,jj) + zalf1 * zf0(ji,jj)
+            ps0(ji,jj)  = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) )
+            psx(ji,jj)  = zbt  * psx(ji,jj)   &
+               &        + zbt1 * ( zalf * zfx(ji,jj) + zalf1 * psx(ji,jj) + 3.0 * ztemp )
+            psxx(ji,jj) = zbt  * psxx(ji,jj)   &
+               &        + zbt1 * (  zalf * zalf * zfxx(ji,jj)  + zalf1 * zalf1 * psxx(ji,jj)  &
+               &                 + 5.0 *( zalf * zalf1 * ( - psx(ji,jj) + zfx(ji,jj) ) + ( zalf1 - zalf ) * ztemp ) )
+            psxy(ji,jj) = zbt  * psxy(ji,jj)   &
+               &        + zbt1 * (  zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)  &
+               &                 + 3.0 * ( zalf1 * zfy(ji,jj) - zalf * psy(ji,jj) )  )
+            psy(ji,jj)  = zbt * psy (ji,jj)  + zbt1 * ( psy (ji,jj) + zfy (ji,jj) )
+            psyy(ji,jj) = zbt * psyy(ji,jj)  + zbt1 * ( psyy(ji,jj) + zfyy(ji,jj) )
+         END DO
+      END DO
+
+      !-- Lateral boundary conditions
+      CALL lbc_lnk( psm , 'T', 1. )
+      CALL lbc_lnk( ps0 , 'T', 1. )
+      CALL lbc_lnk( psx , 'T', 1. )
+      CALL lbc_lnk( psxx, 'T', 1. )
+      CALL lbc_lnk( psy , 'T', 1. )
+      CALL lbc_lnk( psyy, 'T', 1. )
+      CALL lbc_lnk( psxy, 'T', 1. )
+
+      IF( l_ctl .AND. lwp ) THEN
+         WRITE(numout,*) ' lim_adv_x: psm  ', SUM( psm  ), ' ps0  ', SUM( ps0  )
+         WRITE(numout,*) ' lim_adv_x: psx  ', SUM( psx  ), ' psxx ', SUM( psxx )
+         WRITE(numout,*) ' lim_adv_x: psy  ', SUM( psy  ), ' psyy ', SUM( psyy )
+         WRITE(numout,*) ' lim_adv_x: psxy ', SUM( psxy )
+      ENDIF
+
+   END SUBROUTINE lim_adv_x
+
+
+   SUBROUTINE lim_adv_y( pdf, pvt , pcrh, psm , ps0 ,   &
+      &                  psx, psxx, psy , psyy, psxy )
+      !!---------------------------------------------------------------------
+      !!                **  routine lim_adv_y  **
+      !!            
+      !! ** purpose :   Computes and adds the advection trend to sea-ice 
+      !!      variable on y axis
+      !!
+      !! ** method  :   Uses Prather second order scheme that advects tracers
+      !!      but also their quadratic forms. The method preserves tracer
+      !!      structures by conserving second order moments.
+      !!
+      !! History :
+      !!   1.0  !  00-01 (LIM)
+      !!        !  01-05 (G. Madec, R. Hordoir) opa norm
+      !!   2.0  !  03-10 (C. Ethe) F90, module
+      !!        !  03-12 (R. Hordoir, G. Madec) mpp
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp),                     INTENT(in)  :: &
+         pdf,        &  ! ???
+         pcrh           ! = 1. : lim_adv_x is called before lim_adv_y
+         !              ! = 0. : lim_adv_x is called after  lim_adv_y
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in)  :: &
+         pvt            ! j-direction ice velocity at ocean V-point (m/s)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: &
+         psm , ps0 , psx , psy,   &
+         psxx, psyy, psxy
+
+      !! * Local Variables
+      INTEGER  ::   ji, jj                ! dummy loop indices
+      REAL(wp) ::   &
+         zrdt, zslpmax, zin0, ztemp,  &   ! temporary scalars
+         zs1max, zs1new, zs2new,      &   !    "         "
+         zalf, zalfq, zalf1, zalf1q,  &   !    "         "
+         zbt , zbt1                       !
+      REAL(wp), DIMENSION(jpi,jpj)  :: &
+         zf0 , zfx , zfy ,             &  ! temporary workspace
+         zfxx, zfyy, zfxy,             &  !    "           "
+         zfm , zbet,                   &  !    "           "
+         zalg, zalg1, zalg1q              !    "           "
+      !---------------------------------------------------------------------
+
+      ! Limitation of moments.
+
+      zrdt = rdt_ice * pdf ! If ice drift field is too fast, use an appropriate time step for advection.
+
+       DO jj = 1, jpj
+          DO ji = 1, jpi
+             zslpmax = MAX( rzero, ps0(ji,jj) )
+             zs1max  = 1.5 * zslpmax
+             zs1new  = MIN( zs1max, MAX( -zs1max, psy(ji,jj) ) )
+             zs2new  = MIN(  ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ),   &
+                &             MAX( ABS( zs1new )-zslpmax, psyy(ji,jj) )  )
+             zin0    = ( 1.0 - MAX( rzero, sign ( rone, -zslpmax) ) ) * tms(ji,jj)   ! Case of empty boxes & Apply mask
+             ps0 (ji,jj) = zslpmax  
+             psx (ji,jj)  = psx (ji,jj) * zin0
+             psxx(ji,jj)  = psxx(ji,jj) * zin0
+             psy (ji,jj) = zs1new * zin0
+             psyy(ji,jj) = zs2new * zin0
+             psxy(ji,jj) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj) ) ) * zin0
+          END DO
+       END DO
+
+       !  Initialize volumes of boxes (=area if adv_x first called, =psm otherwise)
+       psm (:,:)  = MAX( pcrh * area(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )
+
+       !  Calculate fluxes and moments between boxes j<-->j+1              
+!!bug  DO jj = 2, jpjm1
+       DO jj = 1, jpj
+          DO ji = 2, jpim1
+!!bug     DO ji = 1, jpim1
+             !  Flux from j to j+1 WHEN v GT 0   
+             zbet(ji,jj)  =  MAX( rzero, SIGN( rone, pvt(ji,jj) ) )
+             zalf         =  MAX( rzero, pvt(ji,jj) ) * zrdt * e1v(ji,jj) / psm(ji,jj)
+             zalfq        =  zalf * zalf
+             zalf1        =  1.0 - zalf
+             zalf1q       =  zalf1 * zalf1
+             zfm (ji,jj)  =  zalf  * psm(ji,jj)
+             zf0 (ji,jj)  =  zalf  * ( ps0(ji,jj) + zalf1 * ( psy(ji,jj)  + (zalf1-zalf) * psyy(ji,jj)  ) ) 
+             zfy (ji,jj)  =  zalfq *( psy(ji,jj) + 3.0*zalf1*psyy(ji,jj) )
+             zfyy(ji,jj)  =  zalf  * zalfq * psyy(ji,jj)
+             zfx (ji,jj)  =  zalf  * ( psx(ji,jj) + zalf1 * psxy(ji,jj) )
+             zfxy(ji,jj)  =  zalfq * psxy(ji,jj)
+             zfxx(ji,jj)  =  zalf  * psxx(ji,jj)
+
+             !  Readjust moments remaining in the box.
+             psm (ji,jj)  =  psm (ji,jj) - zfm(ji,jj)
+             ps0 (ji,jj)  =  ps0 (ji,jj) - zf0(ji,jj)
+             psy (ji,jj)  =  zalf1q * ( psy(ji,jj) -3.0 * zalf * psyy(ji,jj) )
+             psyy(ji,jj)  =  zalf1 * zalf1q * psyy(ji,jj)
+             psx (ji,jj)  =  psx (ji,jj) - zfx(ji,jj)
+             psxx(ji,jj)  =  psxx(ji,jj) - zfxx(ji,jj)
+             psxy(ji,jj)  =  zalf1q * psxy(ji,jj)
+          END DO
+       END DO
+
+       DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0.
+          DO ji = 2, jpim1
+!i     DO jj = 1, jpjm1                   !  Flux from j+1 to j when v LT 0.
+!i        DO ji = 2, jpim1
+             zalf          = ( MAX(rzero, -pvt(ji,jj) ) * zrdt * e1v(ji,jj) ) / psm(ji,jj+1) 
+             zalg  (ji,jj) = zalf
+             zalfq         = zalf * zalf
+             zalf1         = 1.0 - zalf
+             zalg1 (ji,jj) = zalf1
+             zalf1q        = zalf1 * zalf1
+             zalg1q(ji,jj) = zalf1q
+             zfm   (ji,jj) = zfm (ji,jj) + zalf  * psm(ji,jj+1)
+             zf0   (ji,jj) = zf0 (ji,jj) + zalf  * ( ps0(ji,jj+1) - zalf1 * (psy(ji,jj+1) - (zalf1 - zalf ) * psyy(ji,jj+1) ) )
+             zfy   (ji,jj) = zfy (ji,jj) + zalfq * ( psy(ji,jj+1) - 3.0 * zalf1 * psyy(ji,jj+1) )
+             zfyy  (ji,jj) = zfyy(ji,jj) + zalf  * zalfq * psyy(ji,jj+1)
+             zfx   (ji,jj) = zfx (ji,jj) + zalf  * ( psx(ji,jj+1) - zalf1 * psxy(ji,jj+1) )
+             zfxy  (ji,jj) = zfxy(ji,jj) + zalfq * psxy(ji,jj+1)
+             zfxx  (ji,jj) = zfxx(ji,jj) + zalf  * psxx(ji,jj+1)
+          END DO
+       END DO
+ 
+       !  Readjust moments remaining in the box. 
+       DO jj = 2, jpjm1
+          DO ji = 2, jpim1
+             zbt  =         zbet(ji,jj-1)
+             zbt1 = ( 1.0 - zbet(ji,jj-1) )
+             psm (ji,jj) = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) - zfm(ji,jj-1) )
+             ps0 (ji,jj) = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) - zf0(ji,jj-1) )
+             psy (ji,jj) = zalg1q(ji,jj-1) * ( psy(ji,jj) + 3.0 * zalg(ji,jj-1) * psyy(ji,jj) )
+             psyy(ji,jj) = zalg1 (ji,jj-1)  * zalg1q(ji,jj-1) * psyy(ji,jj)
+             psx (ji,jj) = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) - zfx (ji,jj-1) )
+             psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) - zfxx(ji,jj-1) )
+             psxy(ji,jj) = zalg1q(ji,jj-1) * psxy(ji,jj)
+          END DO
+       END DO
+
+       !   Put the temporary moments into appropriate neighboring boxes.    
+       DO jj = 2, jpjm1                    !   Flux from j to j+1 IF v GT 0.
+          DO ji = 2, jpim1
+             zbt  =         zbet(ji,jj-1)
+             zbt1 = ( 1.0 - zbet(ji,jj-1) )
+             psm(ji,jj)  = zbt * ( psm(ji,jj) + zfm(ji,jj-1) ) + zbt1 * psm(ji,jj) 
+             zalf        = zbt * zfm(ji,jj-1) / psm(ji,jj) 
+             zalf1       = 1.0 - zalf
+             ztemp       = zalf * ps0(ji,jj) - zalf1 * zf0(ji,jj-1)
+             ps0(ji,jj)  = zbt * (ps0(ji,jj) + zf0(ji,jj-1)) + zbt1 * ps0(ji,jj)
+
+             psy(ji,jj)  = zbt  * ( zalf * zfy(ji,jj-1) + zalf1 * psy(ji,jj) + 3.0 * ztemp )   &
+                &        + zbt1 * psy(ji,jj)  
+
+             psyy(ji,jj) = zbt  * ( zalf * zalf * zfyy(ji,jj-1) + zalf1 * zalf1 * psyy(ji,jj)                             &
+                &                 + 5.0 * ( zalf * zalf1 * ( psy(ji,jj) - zfy(ji,jj-1) ) - ( zalf1 - zalf ) * ztemp ) )   & 
+                &        + zbt1 * psyy(ji,jj)
+
+             psxy(ji,jj) = zbt  * ( zalf * zfxy(ji,jj-1) + zalf1 * psxy(ji,jj)              &
+                                  + 3.0 * (- zalf1 * zfx(ji,jj-1) + zalf * psx(ji,jj) ) )   &
+                         + zbt1 * psxy(ji,jj)
+             psx (ji,jj) = zbt * ( psx (ji,jj) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj)
+             psxx(ji,jj) = zbt * ( psxx(ji,jj) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj)
+          END DO
+       END DO
+
+       DO jj = 2, jpjm1                   !  Flux from j+1 to j IF v LT 0.
+          DO ji = 2, jpim1
+             zbt  =         zbet(ji,jj)
+             zbt1 = ( 1.0 - zbet(ji,jj) )
+             psm(ji,jj)  = zbt * psm(ji,jj) + zbt1 * ( psm(ji,jj) + zfm(ji,jj) )
+             zalf        = zbt1 * zfm(ji,jj) / psm(ji,jj)
+             zalf1       = 1.0 - zalf
+             ztemp       = -zalf * ps0(ji,jj) + zalf1 * zf0(ji,jj)
+             ps0(ji,jj)  = zbt * ps0(ji,jj) + zbt1 * ( ps0(ji,jj) + zf0(ji,jj) )
+             psy(ji,jj)  = zbt  * psy(ji,jj)  &
+                &        + zbt1 * ( zalf*zfy(ji,jj) + zalf1 * psy(ji,jj) + 3.0 * ztemp )
+             psyy(ji,jj) = zbt  * psyy(ji,jj)  &
+                &        + zbt1 * ( zalf * zalf * zfyy(ji,jj) + zalf1 * zalf1 * psyy(ji,jj)   &
+                &                 + 5.0 *( zalf *zalf1 *( -psy(ji,jj) + zfy(ji,jj) ) + ( zalf1 - zalf ) * ztemp ) )
+             psxy(ji,jj) = zbt  * psxy(ji,jj)   &
+                &        + zbt1 * ( zalf * zfxy(ji,jj) + zalf1 * psxy(ji,jj)   &
+                &                 + 3.0 * ( zalf1 * zfx(ji,jj) - zalf * psx(ji,jj) ) )
+             psx(ji,jj)  = zbt * psx (ji,jj) + zbt1 * ( psx (ji,jj) + zfx (ji,jj) )
+             psxx(ji,jj) = zbt * psxx(ji,jj) + zbt1 * ( psxx(ji,jj) + zfxx(ji,jj) )
+          END DO
+       END DO
+
+      !-- Lateral boundary conditions
+      CALL lbc_lnk( psm , 'T', 1. )
+      CALL lbc_lnk( ps0 , 'T', 1. )
+      CALL lbc_lnk( psx , 'T', 1. )
+      CALL lbc_lnk( psxx, 'T', 1. )
+      CALL lbc_lnk( psy , 'T', 1. )
+      CALL lbc_lnk( psyy, 'T', 1. )
+      CALL lbc_lnk( psxy, 'T', 1. )
+
+      IF( l_ctl .AND. lwp ) THEN
+         WRITE(numout,*) ' lim_adv_y: psm  ', SUM( psm  ), ' ps0  ', SUM( ps0  )
+         WRITE(numout,*) ' lim_adv_y: psx  ', SUM( psx  ), ' psxx ', SUM( psxx )
+         WRITE(numout,*) ' lim_adv_y: psy  ', SUM( psy  ), ' psyy ', SUM( psyy )
+         WRITE(numout,*) ' lim_adv_y: psxy ', SUM( psxy )
+      ENDIF
+
+   END SUBROUTINE lim_adv_y
+
+   !!======================================================================
+#else
+   !!==============================================================================
+   !!                       ***  MODULE limadv   ***
+   !!                              No sea ice
+   !!==============================================================================
+CONTAINS
+   SUBROUTINE lim_adv_x         ! Empty routine
+   END SUBROUTINE lim_adv_x
+   SUBROUTINE lim_adv_y           ! Empty routine
+   END SUBROUTINE lim_adv_y
+
+#endif
+
+END MODULE limadv
Index: /branches/nemo/NEMO/LIM_SRC/limdia.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limdia.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limdia.F90	(revision 4)
@@ -0,0 +1,315 @@
+MODULE limdia
+   !!======================================================================
+   !!                       ***  MODULE limdia   ***
+   !!                      diagnostics of ice model 
+   !!======================================================================
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim' :                                   LIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_dia      : computation of the time evolution of keys var.
+   !!   lim_dia_init : initialization and namelist read
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE phycst
+   USE in_out_manager
+   USE ice_oce         ! ice variables
+   USE daymod
+   USE dom_ice
+   USE ice
+   USE iceini
+   USE limistate
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC lim_dia       ! called by ice_step
+
+   !! * Module variables
+   INTEGER, PUBLIC  ::  &
+      ntmoy   = 1 ,     &  !  instantaneous values of ice evolution or averaging ntmoy
+      ninfo   = 1          !  frequency of ouputs on file ice_evolu in case of averaging
+
+   INTEGER          ::  &
+      nfrinf  = 4          ! number of variables written in one line 
+ 
+   INTEGER          ::  &
+      nferme ,          &  ! last time step at which the var. are written on file
+      nvinfo ,          &  ! number of total variables 
+      nbvt   ,          &  ! number of time variables
+      naveg                ! number of step for accumulation before averaging
+ 
+   REAL(wp), DIMENSION(ninfmx) ::  &
+      vinfom               ! temporary working space
+
+   CHARACTER(len=8) ::  &
+      fmtinf  = '1PE13.5 ' ! format of the output values  
+
+   CHARACTER(len=30) :: &
+      fmtw  ,           &  !  formats
+      fmtr  ,           &  ! 
+      fmtitr               ! 
+
+   CHARACTER(len=nchsep), DIMENSION(ninfmx) ::   &
+      titvar               ! title of key variables
+
+   REAL(wp) :: &
+      epsi06 = 1.e-06
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_dia
+      !!--------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_dia  ***
+      !!   
+      !! ** Purpose : Computation and outputs on file ice.evolu 
+      !!      the temporal evolution of some key variables
+      !!
+      !! History :
+      !!   8.0  !  97-06  (Louvain-La-Neuve)  Original code
+      !!   8.5  !  02-09  (C. Ethe , G. Madec )  F90: Free form and module
+      !!-------------------------------------------------------------------
+      !! * Local variables
+       INTEGER ::   jv,ji, jj    ! dummy loop indices
+       INTEGER ::   nv           ! indice of variable 
+       REAL(wp), DIMENSION(ninfmx) ::  & 
+          vinfor        ! temporary working space 
+       REAL(wp)  ::    &
+          area    ,    &  ! sea ice area
+          ldarea  ,    &  ! leads area
+          extent15,    &  ! sea ice extent (15%)
+          extent85,    &  ! sea ice extent (85%)
+          icevol  ,    &  ! sea ice volume
+          snwvol  ,    &  ! snow volume over sea ice
+          icespd          ! sea ice velocity
+       !!-------------------------------------------------------------------
+
+       IF( numit == nstart )   CALL lim_dia_init   ! initialisation of ice_evolu file      
+
+       ! computation of key variables at each time step   
+
+       nv = 1 
+       vinfor(nv) = REAL(numit)
+       nv = nv + 1
+       vinfor(nv) = nyear
+ 
+       DO  jv = nbvt + 1, nvinfo
+          vinfor(jv) = 0.0
+       END DO
+
+       extent15 = 0.e0
+       extent85 = 0.e0
+       ! variables in northern Hemis
+       DO  jj = jeq , jpjm1
+          DO  ji = fs_2 , fs_jpim1
+             IF( tms(ji,jj) == 1 ) THEN
+                area = ( 1.0 - frld(ji,jj) ) * aire(ji,jj)
+                IF (frld(ji,jj) <= 0.15 ) extent15 = aire(ji,jj)    
+                IF (frld(ji,jj) <= 0.85 ) extent85 = aire(ji,jj)   
+                ldarea = area   / MAX( ( 1 - frld(ji,jj) ) , epsi06 )
+                icevol = area   * hicif(ji,jj)
+                snwvol = area   * hsnif(ji,jj)
+                icespd = icevol * ( u_ice(ji,jj) * u_ice(ji,jj) + v_ice(ji,jj) * v_ice(ji,jj) )
+
+                vinfor(nv +  1) = vinfor(nv +  1) + area
+                vinfor(nv +  3) = vinfor(nv +  3) + extent15
+                vinfor(nv +  5) = vinfor(nv +  5) + extent85
+                vinfor(nv +  7) = vinfor(nv +  7) + ldarea
+                vinfor(nv +  9) = vinfor(nv +  9) + icevol
+                vinfor(nv + 11) = vinfor(nv + 11) + snwvol
+                vinfor(nv + 13) = vinfor(nv + 13) + icespd
+             ENDIF
+          END DO
+       END DO
+       vinfor(nv + 13) = SQRT( vinfor(nv + 13) / MAX( vinfor(nv + 9 ) , epsi06 ) )
+
+
+      ! variables in southern Hemis
+       nv = nv + 1
+       DO  jj = 2 , jeqm1
+          DO  ji = fs_2 , fs_jpim1
+             IF( tms(ji,jj) == 1 ) THEN
+                area = ( 1.0 - frld(ji,jj) ) * aire(ji,jj)
+                IF (frld(ji,jj) <= 0.15 ) extent15 = aire(ji,jj)    
+                IF (frld(ji,jj) <= 0.85 ) extent85 = aire(ji,jj)   
+                ldarea = area   / MAX( ( 1 - frld(ji,jj) ) , epsi06 )
+                icevol = area   * hicif(ji,jj)
+                snwvol = area   * hsnif(ji,jj)
+                icespd = icevol * ( u_ice(ji,jj) * u_ice(ji,jj) + v_ice(ji,jj) * v_ice(ji,jj) )
+
+                vinfor(nv + 1)  = vinfor(nv + 1)  + area
+                vinfor(nv + 3)  = vinfor(nv + 3)  + extent15
+                vinfor(nv + 5)  = vinfor(nv + 5)  + extent85
+                vinfor(nv + 7)  = vinfor(nv + 7)  + ldarea
+                vinfor(nv + 9)  = vinfor(nv + 9)  + icevol
+                vinfor(nv + 11) = vinfor(nv + 11) + snwvol
+                vinfor(nv + 13) = vinfor(nv + 13) + icespd
+             ENDIF
+          END DO
+       END DO
+       vinfor(nv + 13) = SQRT( vinfor(nv + 13) / MAX( vinfor(nv + 9 ) , epsi06 ) )    
+
+       !  Accumulation before averaging 
+       DO jv = 1 , nvinfo
+          vinfom(jv) = vinfom(jv) + vinfor(jv)
+       END DO
+       naveg = naveg + 1  
+    
+       ! oututs on file ice_evolu    
+       IF( MOD( numit , ninfo ) == 0 ) THEN
+          WRITE(90,fmtw) ( titvar(jv), vinfom(jv)/naveg, jv = 1, nvinfo )
+          naveg = 0
+          DO  jv = 1, nvinfo
+             vinfom(jv)=0.0
+          END DO
+       ENDIF
+  
+    END SUBROUTINE lim_dia
+ 
+
+    SUBROUTINE lim_dia_init
+       !!-------------------------------------------------------------------
+       !!                  ***  ROUTINE lim_dia_init  ***
+       !!             
+       !! ** Purpose : Preparation of the file ice_evolu for the output of
+       !!      the temporal evolution of key variables
+       !!
+       !! ** input   : Namelist namicedia
+       !!
+       !! history :
+       !!  8.5  ! 03-08 (C. Ethe) original code
+       !!-------------------------------------------------------------------
+       NAMELIST/namicedia/fmtinf, nfrinf, ninfo, ntmoy
+
+       INTEGER  ::   jv   ,     &  ! dummy loop indice
+          &          ntot ,     &
+          &          ndeb ,     &
+          &          irecl
+
+       INTEGER  ::   nv            ! indice of variable 
+
+       REAL(wp) ::   zxx0, zxx1    ! temporary scalars
+
+       CHARACTER(len=nchinf) ::   titinf
+       !!-------------------------------------------------------------------
+
+
+       ! Read Namelist namicedia
+       REWIND ( numnam_ice )
+       READ   ( numnam_ice  , namicedia )
+       IF(lwp) THEN
+          WRITE(numout,*)
+          WRITE(numout,*) 'lim_dia_init : ice parameters for ice diagnostics '
+          WRITE(numout,*) '~~~~~~~~~~~~'
+          WRITE(numout,*) '   format of the output values                                 fmtinf = ', fmtinf
+          WRITE(numout,*) '   number of variables written in one line                     nfrinf = ', nfrinf 
+          WRITE(numout,*) '   Instantaneous values of ice evolution or averaging          ntmoy  = ', ntmoy
+          WRITE(numout,*) '   frequency of ouputs on file ice_evolu in case of averaging  ninfo  = ', ninfo
+       ENDIF
+
+       ! Titles of ice key variables :
+       nv = 1
+       titvar(nv) = 'NoIt'  ! iteration number
+       nv = nv + 1
+       titvar(nv) = 'T yr'  ! time step in years
+       nv = nv + 1
+
+       nbvt = nv - 1
+
+       titvar(nv) = 'AEFN' ! sea ice area in the northern Hemisp.(10^12 km2)
+       nv = nv + 1
+       titvar(nv) = 'AEFS' ! sea ice area in the southern Hemisp.(10^12 km2)
+       nv = nv + 1
+       titvar(nv) = 'A15N'  ! sea ice extent (15%) in the northern Hemisp.(10^12 km2)
+       nv = nv + 1
+       titvar(nv) = 'A15S'  ! sea ice extent (15%) in the southern Hemisp.(10^12 km2)
+       nv = nv + 1
+       titvar(nv) = 'A85N'  ! sea ice extent (85%) in the northern Hemisp.(10^12 km2)
+       nv = nv + 1
+       titvar(nv) = 'A85S'  ! sea ice extent (85%) in the southern Hemisp.(10^12 km2)
+       nv = nv + 1
+       titvar(nv) = 'ALEN'  ! leads area in the northern Hemisp.(10^12 km2)
+       nv = nv + 1
+       titvar(nv) = 'ALES'  ! leads area in the southern Hemisp.(10^12 km2)
+       nv = nv + 1
+       titvar(nv) = 'VOLN'  ! sea ice volume in the northern Hemisp.(10^3 km3)
+       nv = nv + 1
+       titvar(nv) = 'VOLS'  ! sea ice volume in the southern Hemisp.(10^3 km3)
+       nv = nv + 1
+       titvar(nv) = 'VONN'  ! snow volume over sea ice in the northern Hemisp.(10^3 km3)
+       nv = nv + 1
+       titvar(nv) = 'VONS'  ! snow volume over sea ice in the southern Hemisp.(10^3 km3)
+       nv = nv + 1
+       titvar(nv) = 'ECGN'  ! mean sea ice velocity in the northern Hemisp.(m/s)
+       nv = nv + 1
+       titvar(nv) = 'ECGS'  ! mean sea ice velocity in the southern Hemisp.(m/s)
+
+       nvinfo = nv
+
+       ! Definition et Ecriture de l'entete : nombre d'enregistrements 
+       ndeb   = ( nstart - 1 ) / ninfo
+       IF( nstart == 1 ) ndeb = -1
+
+       nferme = ( nstart - 1 + nitrun) / ninfo
+       ntot   = nferme - ndeb
+       ndeb   = ninfo * ( 1 + ndeb )
+       nferme = ninfo * nferme
+
+       ! definition of formats 
+       WRITE( fmtw  , '(A,I3,A2,I1,A)' )  '(', nfrinf, '(A', nchsep, ','//fmtinf//'))'
+       WRITE( fmtr  , '(A,I3,A,I1,A)'  )  '(', nfrinf, '(', nchsep, 'X,'//fmtinf//'))'
+       WRITE( fmtitr, '(A,I3,A,I1,A)'  )  '(', nvinfo, 'A', nchinf, ')'
+
+       ! opening  "ice_evolu" file
+       irecl = ( nchinf + 1 ) * nvinfo 
+       OPEN( numevo_ice, file='ice.evolu', status='unknown', RECL = irecl)
+       OPEN( numevo_ice, file='ice.evolu', status='unknown')
+
+       !- ecriture de 2 lignes d''entete :
+       WRITE(numevo_ice,1000) fmtr, fmtw, fmtitr, nvinfo, ntot, 0, nfrinf
+       zxx0 = 0.001 * REAL(ninfo)
+       zxx1 = 0.001 * REAL(ndeb)
+       WRITE(numevo_ice,1111) REAL(nchinf), 0., zxx1, zxx0, 0., 0., 0
+
+       !- ecriture de 2 lignes de titre :
+       WRITE(numevo_ice,'(A,I8,A,I8,A,I5)')                                      &
+          'Evolution chronologique - Experience '//cexper   &
+          //'   de', ndeb, ' a', nferme, ' pas', ninfo
+       WRITE(numevo_ice,fmtitr) ( titvar(jv), jv = 1, nvinfo )
+
+
+       !--preparation de "titvar" pour l''ecriture parmi les valeurs numeriques :
+       DO  jv = 2 , nvinfo
+          titinf     = titvar(jv)(:nchinf)
+          titvar(jv) = '  '//titinf
+       END DO
+
+       !--Initialisation of the arrays for the accumulation
+       DO  jv = 1, nvinfo
+          vinfom(jv) = 0.
+       END DO
+       naveg = 0
+
+1000   FORMAT( 3(A20),4(1x,I6) )
+1111   FORMAT( 3(F7.1,1X,F7.3,1X),I3,A )  
+
+    END SUBROUTINE lim_dia_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                               NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_dia         ! Empty routine
+   END SUBROUTINE lim_dia
+#endif
+
+   !!======================================================================
+END MODULE limdia
Index: /branches/nemo/NEMO/LIM_SRC/limdyn.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limdyn.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limdyn.F90	(revision 4)
@@ -0,0 +1,263 @@
+MODULE limdyn
+   !!======================================================================
+   !!                     ***  MODULE  limdyn  ***
+   !!   Sea-Ice dynamics :  
+   !!======================================================================
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim' :                                   LIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!    lim_dyn      : computes ice velocities
+   !!    lim_dyn_init : initialization and namelist read
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE phycst
+   USE in_out_manager  ! I/O manager
+   USE dom_ice
+   USE dom_oce         ! ocean space and time domain
+   USE ice
+   USE ice_oce
+   USE iceini
+   USE limistate
+   USE limrhg     ! ice rheology
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC lim_dyn  ! routine called by ice_step
+
+   !! * Module variables
+   REAL(wp)  ::  rone    = 1.0   ! constant value
+
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_dyn
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE lim_dyn  ***
+      !!               
+      !! ** Purpose :   compute ice velocity and ocean-ice stress
+      !!                
+      !! ** Method  : 
+      !!
+      !! ** Action  : - Initialisation
+      !!              - Call of the dynamic routine for each hemisphere
+      !!              - computation of the stress at the ocean surface         
+      !!              - treatment of the case if no ice dynamic
+      !! History :
+      !!   1.0  !  01-04  (LIM)  Original code
+      !!   2.0  !  02-08  (C. Ethe, G. Madec)  F90, mpp
+      !!---------------------------------------------------------------------
+      !! * Loal variables
+      INTEGER ::   ji, jj,        &  ! dummy loop indices
+         jhemis                      ! jhemis = 1 (NH) ; jhemis = -1 (SH)
+      REAL(wp) ::   &
+         ztairx, ztairy,          &  ! tempory scalars
+         zsang , zmod,            &
+         ztglx , ztgly ,          &
+         zt11, zt12, zt21, zt22 , &
+         zustm, zsfrld, zsfrldm4, &
+         zu_ice, zv_ice, ztair2
+
+      !!---------------------------------------------------------------------
+
+
+      IF( numit == nstart  )   CALL lim_dyn_init   ! Initialization (first time-step only)
+      
+      IF ( ldyn ) THEN
+
+         ! Mean ice and snow thicknesses.          
+         hsnm(:,:)  = ( 1.0 - frld(:,:) ) * hsnif(:,:)
+         hicm(:,:)  = ( 1.0 - frld(:,:) ) * hicif(:,:)
+
+         u_oce(:,:)  = u_io(:,:) * tmu(:,:)
+         v_oce(:,:)  = v_io(:,:) * tmu(:,:)
+       
+         !                                         ! Rheology (ice dynamics)
+         !--  Northern hemisphere                  ! ========
+         jhemis = +1
+         CALL lim_rhg( jhemis )
+
+         !--  Southern hemisphere.
+         jhemis = -1
+         CALL lim_rhg( jhemis )
+
+         u_ice(:,1) = 0.0       !ibug  est-ce vraiment necessaire?
+         v_ice(:,1) = 0.0
+
+         IF( l_ctl .AND. lwp ) THEN 
+            WRITE(numout,*) ' lim_dyn  : u_oce ', SUM( u_oce ), ' v_oce ', SUM( v_oce )
+            WRITE(numout,*) ' lim_dyn  : u_ice ', SUM( u_ice ), ' v_ice ', SUM( v_ice )
+         ENDIF
+         
+         !                                         ! Ice-Ocean stress
+         !                                         ! ================
+         DO jj = 2, jpjm1
+            jhemis = SIGN(1, jj - jeq )
+            zsang  = REAL(jhemis) * sangvg
+            DO ji = 2, jpim1
+               ! computation of wind stress over ocean in X and Y direction
+#if defined key_coupled && defined key_lim_cp1
+               ztairx =  frld(ji-1,jj  ) * gtaux(ji-1,jj  ) + frld(ji,jj  ) * gtaux(ji,jj  )      &
+                  &    + frld(ji-1,jj-1) * gtaux(ji-1,jj-1) + frld(ji,jj-1) * gtaux(ji,jj-1)
+
+               ztairy =  frld(ji-1,jj  ) * gtauy(ji-1,jj  ) + frld(ji,jj  ) * gtauy(ji,jj  )      &
+                  &    + frld(ji-1,jj-1) * gtauy(ji-1,jj-1) + frld(ji,jj-1) * gtauy(ji,jj-1)
+#else
+               zsfrld  = frld(ji,jj) + frld(ji-1,jj) + frld(ji-1,jj-1) + frld(ji,jj-1)
+               ztairx  = zsfrld * gtaux(ji,jj)
+               ztairy  = zsfrld * gtauy(ji,jj)
+#endif
+               zsfrldm4 = 4 - frld(ji,jj) - frld(ji-1,jj) - frld(ji-1,jj-1) - frld(ji,jj-1)
+               zu_ice   = u_ice(ji,jj) - u_oce(ji,jj)
+               zv_ice   = v_ice(ji,jj) - v_oce(ji,jj)
+               zmod     = SQRT( zu_ice * zu_ice + zv_ice * zv_ice ) 
+               ztglx   = zsfrldm4 * rhoco * zmod * ( cangvg * zu_ice - zsang * zv_ice ) 
+               ztgly   = zsfrldm4 * rhoco * zmod * ( cangvg * zv_ice + zsang * zu_ice ) 
+
+               tio_u(ji,jj) = - ( ztairx + 1.0 * ztglx ) / ( 4 * rau0 )
+               tio_v(ji,jj) = - ( ztairy + 1.0 * ztgly ) / ( 4 * rau0 )
+            END DO
+         END DO
+         
+         ! computation of friction velocity
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+
+               zu_ice   = u_ice(ji-1,jj-1) - u_oce(ji-1,jj-1)
+               zv_ice   = v_ice(ji-1,jj-1) - v_oce(ji-1,jj-1)
+               zt11  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice )
+
+               zu_ice   = u_ice(ji-1,jj) - u_oce(ji-1,jj)
+               zv_ice   = v_ice(ji-1,jj) - v_oce(ji-1,jj)
+               zt12  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice ) 
+
+               zu_ice   = u_ice(ji,jj-1) - u_oce(ji,jj-1)
+               zv_ice   = v_ice(ji,jj-1) - v_oce(ji,jj-1)
+               zt21  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice ) 
+
+               zu_ice   = u_ice(ji,jj) - u_oce(ji,jj)
+               zv_ice   = v_ice(ji,jj) - v_oce(ji,jj)
+               zt22  = rhoco * ( zu_ice * zu_ice + zv_ice * zv_ice ) 
+
+               ztair2 = gtaux(ji,jj) * gtaux(ji,jj) + gtauy(ji,jj) * gtauy(ji,jj)
+
+               zustm =  ( 1 - frld(ji,jj) ) * 0.25 * ( zt11 + zt12 + zt21 + zt22 )        &
+                  &  +        frld(ji,jj)   * SQRT( ztair2 )
+
+               ust2s(ji,jj) = ( zustm / rau0 ) * ( rone + sdvt(ji,jj) ) * tms(ji,jj)
+            END DO
+         END DO
+
+       ELSE      ! If no ice dynamics  
+                    
+          DO jj = 2, jpjm1
+             DO ji = 2, jpim1
+#if defined key_coupled && defined key_lim_cp1
+                tio_u(ji,jj) = - (  gtaux(ji  ,jj  ) + gtaux(ji-1,jj  )       &
+                   &              + gtaux(ji-1,jj-1) + gtaux(ji  ,jj-1) ) / ( 4 * rau0 )
+
+                tio_v(ji,jj) = - (  gtauy(ji  ,jj )  + gtauy(ji-1,jj  )       &
+                   &              + gtauy(ji-1,jj-1) + gtauy(ji  ,jj-1) ) / ( 4 * rau0 )
+#else
+                tio_u(ji,jj) = - gtaux(ji,jj) / rau0
+                tio_v(ji,jj) = - gtauy(ji,jj) / rau0 
+#endif
+                ztair2       = gtaux(ji,jj) * gtaux(ji,jj) + gtauy(ji,jj) * gtauy(ji,jj)
+                zustm        = SQRT( ztair2  )
+
+                ust2s(ji,jj) = ( zustm / rau0 ) * ( rone + sdvt(ji,jj) ) * tms(ji,jj)
+            END DO
+         END DO
+
+      ENDIF
+
+      CALL lbc_lnk( ust2s, 'T',  1. )   ! T-point
+      CALL lbc_lnk( tio_u, 'I', -1. )   ! I-point (i.e. ice U-V point)
+      CALL lbc_lnk( tio_v, 'I', -1. )   ! I-point (i.e. ice U-V point)
+
+      IF( l_ctl .AND. lwp ) THEN 
+         WRITE(numout,*) ' lim_dyn  : tio_u ', SUM( tio_u ), ' tio_v ', SUM( tio_v )
+         WRITE(numout,*) ' lim_dyn  : ust2s ', SUM( ust2s )
+      ENDIF
+
+   END SUBROUTINE lim_dyn
+
+    SUBROUTINE lim_dyn_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_dyn_init  ***
+      !!
+      !! ** Purpose : Physical constants and parameters linked to the ice
+      !!      dynamics
+      !!
+      !! ** Method  :  Read the namicedyn namelist and check the ice-dynamic
+      !!       parameter values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicedyn
+      !!
+      !! history :
+      !!  8.5  ! 03-08 (C. Ethe) original code
+      !!-------------------------------------------------------------------
+      NAMELIST/namicedyn/ epsd, nlminn, nlmaxs, alpha,     &
+         &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   &
+         &                c_rhg, etamn, creepl, ecc, ahi0
+      !!-------------------------------------------------------------------
+
+      ! Define the initial parameters
+      ! -------------------------
+
+      ! Read Namelist namicedyn
+      REWIND ( numnam_ice )
+      READ   ( numnam_ice  , namicedyn )
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics '
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   tolerance parameter                              epsd   = ', epsd
+         WRITE(numout,*) '   northern minimum index for ice drift             nlminn = ', nlminn
+         WRITE(numout,*) '   southern minimum index for ice drift             nlmaxs = ', nlmaxs
+         WRITE(numout,*) '   coefficient for semi-implicit coriolis           alpha  = ', alpha
+         WRITE(numout,*) '   diffusion constant for dynamics                  dm     = ', dm
+         WRITE(numout,*) '   number of sub-time steps for relaxation          nbiter = ', nbiter
+         WRITE(numout,*) '   maximum number of iterations for relaxation      nbitdr = ', nbitdr
+         WRITE(numout,*) '   relaxation constant                              om     = ', om
+         WRITE(numout,*) '   maximum value for the residual of relaxation     resl   = ', resl
+         WRITE(numout,*) '   drag coefficient for oceanic stress              cw     = ', cw
+         WRITE(numout,*) '   turning angle for oceanic stress                 angvg  = ', angvg
+         WRITE(numout,*) '   first bulk-rheology parameter                    pstar  = ', pstar
+         WRITE(numout,*) '   second bulk-rhelogy parameter                    c_rhg  = ', c_rhg
+         WRITE(numout,*) '   minimun value for viscosity                      etamn  = ', etamn
+         WRITE(numout,*) '   creep limit                                      creepl = ', creepl
+         WRITE(numout,*) '   eccentricity of the elliptical yield curve       ecc    = ', ecc
+         WRITE(numout,*) '   horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0
+      ENDIF
+
+      usecc2 = 1.0 / ( ecc * ecc )
+      rhoco  = rau0 * cw
+      angvg  = angvg * rad
+      sangvg = SIN( angvg )
+      cangvg = COS( angvg )
+      pstarh = pstar / 2.0
+
+      !  Diffusion coefficients.
+      ahiu(:,:) = ahi0 * umask(:,:,1)
+      ahiv(:,:) = ahi0 * vmask(:,:,1)
+
+   END SUBROUTINE lim_dyn_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Empty module           NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_dyn         ! Empty routine
+   END SUBROUTINE lim_dyn
+#endif 
+
+   !!======================================================================
+END MODULE limdyn
Index: /branches/nemo/NEMO/LIM_SRC/limflx.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limflx.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limflx.F90	(revision 4)
@@ -0,0 +1,222 @@
+MODULE limflx
+   !!======================================================================
+   !!                       ***  MODULE limflx   ***
+   !!           computation of the flux at the sea ice/ocean interface
+   !!======================================================================
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim'                                     LIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_flx  : flux at the ice / ocean interface
+   !! * Modules used
+   USE phycst
+   USE ocfzpt
+   USE ice_oce
+   USE flx_oce
+   USE ice
+   USE flxblk
+   USE lbclnk
+   USE in_out_manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC lim_flx       ! called by lim_step
+
+  !! * Module variables
+     REAL(wp)  ::            &  ! constant values
+         epsi16 = 1e-16   ,  &
+         rzero  = 0.0    ,  &
+         rone   = 1.0
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_flx
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE lim_flx ***
+      !!                
+      !!  
+      !! ** Purpose : Computes the mass and heat fluxes to the ocean
+      !!         
+      !! ** Action  : - Initialisation of some variables
+      !!              - comput. of the fluxes at the sea ice/ocean interface
+      !!     
+      !! ** Outputs : - fsolar  : solar heat flux at sea ice/ocean interface
+      !!              - fnsolar : non solar heat flux 
+      !!              - fsalt   : salt flux at sea ice/ocean interface
+      !!              - fmass   : freshwater flux at sea ice/ocean interface
+      !!
+      !!
+      !! ** References :
+      !!       H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90
+      !!         original    : 00-01 (LIM)
+      !!         addition    : 02-07 (C. Ethe, G. Madec)
+      !!---------------------------------------------------------------------
+      !! * Modules used
+      !! * Local variables
+      INTEGER ::   ji, jj         ! dummy loop indices
+
+      INTEGER ::   &
+         ifvt, i1mfr, idfr ,   &  ! some switches
+         iflt, ial, iadv, ifral, ifrdv
+      
+      REAL(wp) ::   &
+         zinda  ,              &  ! switch for testing the values of ice concentration
+         z1mthcm,              &  ! 1 - thcm
+!!         zfcm1  ,              &  ! solar  heat fluxes
+!!         zfcm2  ,              &  !  non solar heat fluxes
+#if defined key_lim_fdd   
+         zfons,                &  ! salt exchanges at the ice/ocean interface
+         zpme                     ! freshwater exchanges at the ice/ocean interface
+#else
+         zprs  , zfons,        &  ! salt exchanges at the ice/ocean interface
+         zpmess                   ! freshwater exchanges at the ice/ocean interface
+#endif
+      REAL(wp), DIMENSION(jpi,jpj) ::  &
+         zfcm1  ,              &  ! solar  heat fluxes
+         zfcm2                    !  non solar heat fluxes      
+#if defined key_coupled    
+      REAL(wp), DIMENSION(jpi,jpj) ::  &
+         zalb  ,               &  ! albedo of ice under overcast sky
+         zalcn ,               &  ! albedo of ocean under overcast sky
+         zalbp ,               &  ! albedo of ice under clear sky
+         zaldum                   ! albedo of ocean under clear sky
+#endif
+      !!---------------------------------------------------------------------
+     
+      !---------------------------------!
+      !      Sea ice/ocean interface    !
+      !---------------------------------!
+       
+       
+      !      heat flux at the ocean surface
+      !-------------------------------------------------------
+       
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zinda   = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) )
+            ifvt    = zinda  *  MAX( rzero , SIGN( rone, -phicif(ji,jj) ) )
+            i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - ( 1.0 - frld(ji,jj) ) ) )
+            idfr    = 1.0 - MAX( rzero , SIGN( rone , frld(ji,jj) - pfrld(ji,jj) ) )
+            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt )
+            ial     = ifvt   * i1mfr + ( 1 - ifvt ) * idfr
+            iadv    = ( 1  - i1mfr ) * zinda
+            ifral   = ( 1  - i1mfr * ( 1 - ial ) )   
+            ifrdv   = ( 1  - ifral * ( 1 - ial ) ) * iadv 
+            z1mthcm =   1. - thcm(ji,jj)       
+            !   computation the solar flux at ocean surface
+            zfcm1(ji,jj)   = pfrld(ji,jj) * qsr_oce(ji,jj)  + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj)
+            !  computation the non solar heat flux at ocean surface
+            zfcm2(ji,jj) =  - z1mthcm * zfcm1(ji,jj)   &
+               &           + iflt    * ( fscmbq(ji,jj) + ffltbif(ji,jj) )                            &
+               &           + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) / rdt_ice   &
+               &           + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) / rdt_ice
+
+            fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)     ! ???
+            
+            fsolar (ji,jj) = zfcm1(ji,jj)                                       ! solar heat flux 
+
+            fnsolar(ji,jj) = zfcm2(ji,jj) - fdtcn(ji,jj)                        ! non solar heat flux
+         END DO
+      END DO
+  
+       
+      !      mass flux at the ocean surface
+      !-------------------------------------------------------
+       
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+#if defined key_lim_fdd
+            !  case of realistic freshwater flux (Tartinville et al., 2001)
+            
+            !  computing freshwater exchanges at the ice/ocean interface
+            zpme = - evap(ji,jj) * frld(ji,jj)            &   !  evaporation over oceanic fraction
+               &   + tprecip(ji,jj)                            &   !  total precipitation
+               &   - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )  &   !  remov. snow precip over ice
+               &   - rdmsnif(ji,jj) / rdt_ice                   !  freshwaterflux due to snow melting 
+            
+            !  computing salt exchanges at the ice/ocean interface
+            zfons =  ( soce - sice ) * ( rdmicif(ji,jj) / rdt_ice ) 
+            
+            !  converting the salt flux from ice to a freshwater flux from ocean
+            fsalt(ji,jj) = zfons / ( sss_io(ji,jj) + epsi16 )
+            
+            !  freshwater masses
+            fmass(ji,jj) = - zpme 
+#else
+            !  case of freshwater flux equivalent as salt flux
+            !  dilution effect due to evaporation and precipitation
+            zprs  = ( tprecip(ji,jj) - sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) ) * soce  
+            !  freshwater flux
+            zfons = rdmicif(ji,jj) * ( soce - sice )  &  !  fwf : ice formation and melting
+               &   -  dmgwi(ji,jj) * sice             &  !  fwf : salt flx needed to bring the fresh snow to sea/ice salinity
+               &   + rdmsnif(ji,jj) * soce               !  fwf to ocean due to snow melting 
+            !  salt exchanges at the ice/ocean interface
+            zpmess         =  zprs - zfons / rdt_ice - evap(ji,jj) * soce * frld(ji,jj)
+            fsalt(ji,jj) =  - zpmess
+#endif
+         END DO
+      END DO
+
+
+      !-------------------------------------------------------------------!
+      !  computation of others transmitting variables from ice to ocean   !
+      !------------------------------------------ ------------------------!
+
+      !-----------------------------------------------!
+      !   Storing the transmitted variables           !
+      !-----------------------------------------------!
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ftaux (ji,jj) = - tio_u(ji,jj) * rau0   ! taux ( ice: N/m2/rau0, ocean: N/m2 )
+            ftauy (ji,jj) = - tio_v(ji,jj) * rau0   ! tauy ( ice: N/m2/rau0, ocean: N/m2 )                
+            freeze(ji,jj) = 1.0 - frld(ji,jj)       ! Sea ice cover            
+            tn_ice(ji,jj) = sist(ji,jj)             ! Ice surface temperature                      
+         END DO
+      END DO
+
+#if defined key_coupled            
+      zalb  (:,:) = 0.e0
+      zalcn (:,:) = 0.e0
+      zalbp (:,:) = 0.e0
+      zaldum(:,:) = 0.e0
+
+      !------------------------------------------------!
+      !  2) Computation of snow/ice and ocean albedo   !
+      !------------------------------------------------!
+      CALL flx_blk_albedo( zalb, zalcn, zalbp, zaldum )
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            alb_ice(ji,jj) =  0.5 * zalbp(ji,jj) + 0.5 * zalb (ji,jj)  ! Ice albedo                       
+         END DO
+      END DO
+#endif
+
+      IF( l_ctl .AND. lwp ) THEN
+         WRITE(numout,*) ' lim_flx  '
+         WRITE(numout,*) ' fsolar ', SUM(fsolar), ' fnsolar', SUM( fnsolar )
+         WRITE(numout,*) ' fmass  ', SUM(fmass ), ' fsalt  ', SUM(fsalt)
+         WRITE(numout,*) ' ftaux  ', SUM(ftaux ), ' ftauy  ', SUM(ftauy)
+         WRITE(numout,*) ' freeze ', SUM(freeze), ' tn_ice ', SUM(tn_ice)
+      ENDIF 
+ 
+   
+    END SUBROUTINE lim_flx
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :        Empty module           NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_flx         ! Empty routine
+   END SUBROUTINE lim_flx
+#endif 
+
+END MODULE limflx
Index: /branches/nemo/NEMO/LIM_SRC/limhdf.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limhdf.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limhdf.F90	(revision 4)
@@ -0,0 +1,183 @@
+MODULE limhdf
+#if defined key_ice_lim
+   !!======================================================================
+   !!                    ***  MODULE limhdf   ***
+   !! LIM diffusion ice model : sea-ice variables horizontal diffusion
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   lim_hdf  : diffusion trend on sea-ice variable
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce
+   USE ice_oce         ! ice variables
+   USE in_out_manager
+   USE ice
+!  USE limdyn
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC lim_hdf    ! called by lim_tra
+
+   !! * Module variables
+   LOGICAL  ::   linit = .TRUE.              ! ???
+   REAL(wp) ::   epsi04 = 1e-04              ! constant
+   REAL(wp), DIMENSION(jpi,jpj) ::   zfact   ! ???
+
+   !! * Substitution 
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_hdf( ptab )
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_hdf  ***
+      !!
+      !! ** purpose :   Compute and add the diffusive trend on sea-ice
+      !!      variables
+      !!
+      !! ** method  :   Second order diffusive operator evaluated using a
+      !!      Cranck-Nicholson time Scheme.
+      !!
+      !! ** Action  :    update ptab with the diffusive contribution
+      !!
+      !! History :
+      !!        !  00-01 (LIM) Original code
+      !!        !  01-05 (G. Madec, R. Hordoir) opa norm
+      !!        !  02-08 (C. Ethe)  F90, free form
+      !!-------------------------------------------------------------------
+      ! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
+         ptab                 ! Field on which the diffusion is applied  
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         ptab0                ! ???
+
+      ! * Local variables
+      INTEGER ::  ji, jj      ! dummy loop indices
+      INTEGER ::  &
+         its, iter            ! temporary integers
+      REAL(wp) ::  &
+         zalfa, zrlxint, zconv, zeps   ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::  & 
+         zrlx, zflu, zflv, &  ! temporary workspaces
+         zdiv0, zdiv          !    "           "
+      !!-------------------------------------------------------------------
+
+      ! Initialisation
+      ! ---------------   
+      ! Time integration parameters
+      zalfa = 0.5       ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit
+      its   = 100       ! Maximum number of iteration
+      zeps  =  2. * epsi04
+
+      ! Arrays initialization
+      ptab0 (:, : ) = ptab(:,:)
+!bug  zflu (:,jpj) = 0.e0
+!bug  zflv (:,jpj) = 0.e0
+      zdiv0(:, 1 ) = 0.e0
+      zdiv0(:,jpj) = 0.e0
+#if ! defined key_vectopt_loop
+      zflu (jpi,:) = 0.e0   
+      zflv (jpi,:) = 0.e0
+      zdiv0(1,  :) = 0.e0
+      zdiv0(jpi,:) = 0.e0
+#endif
+
+      ! Metric coefficient (compute at the first call and saved in
+      IF( linit ) THEN
+         DO jj = 2, jpjm1  
+            DO ji = fs_2 , fs_jpim1   ! vector opt.
+               zfact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj  ) + e1v(ji,jj) + e1v(ji,jj-1) ) &
+                             / ( e1t(ji,jj) * e2t(ji,jj) )
+            END DO
+         END DO
+         linit = .FALSE.
+      ENDIF
+
+
+      ! Sub-time step loop
+      zconv = 1.e0
+      iter  = 0
+
+      !                                                   !===================
+      DO WHILE ( ( zconv > zeps ) .AND. (iter <= its) )   ! Sub-time step loop
+         !                                                !===================
+         ! incrementation of the sub-time step number
+         iter = iter + 1
+
+         ! diffusive fluxes in U- and V- direction
+         DO jj = 1, jpjm1
+            DO ji = 1 , fs_jpim1   ! vector opt.
+               zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) / e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )
+               zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) / e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )
+            END DO
+         END DO
+
+         ! diffusive trend : divergence of the fluxes
+         DO jj= 2, jpjm1
+            DO ji = fs_2 , fs_jpim1   ! vector opt. 
+               zdiv (ji,jj) = (  zflu(ji,jj) - zflu(ji-1,jj  )   &
+                  &            + zflv(ji,jj) - zflv(ji  ,jj-1)  ) / ( e1t (ji,jj) * e2t (ji,jj) )
+            END DO
+         END DO
+
+         ! save the first evaluation of the diffusive trend in zdiv0
+         IF( iter == 1 )   zdiv0(:,:) = zdiv(:,:)       
+
+         ! XXXX iterative evaluation?????
+         DO jj = 2, jpjm1
+            DO ji = fs_2 , fs_jpim1   ! vector opt.
+               zrlxint = (   ptab0(ji,jj)    &
+                  &       +  rdt_ice * (           zalfa   * ( zdiv(ji,jj) + zfact(ji,jj) * ptab(ji,jj) )   &
+                  &                      + ( 1.0 - zalfa ) *   zdiv0(ji,jj) )  )                             & 
+                  &    / ( 1.0 + zalfa * rdt_ice * zfact(ji,jj) )
+               zrlx(ji,jj) = ptab(ji,jj) + om * ( zrlxint - ptab(ji,jj) )
+            END DO
+         END DO
+
+         ! convergence test
+         zconv = 0.0
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) )  )
+            END DO
+         END DO
+#if defined key_mpp
+         CALL mpp_max( zconv )
+#endif
+         DO jj = 2, jpjm1
+            DO ji = 2 , jpim1
+               ptab(ji,jj) = zrlx(ji,jj)
+            END DO
+         END DO
+
+         ! lateral boundary condition on ptab
+         CALL lbc_lnk( ptab, 'T', 1. )
+         !                                         !==========================
+      END DO                                       ! end of sub-time step loop
+      !                                            !==========================
+
+      ptab(:,:) = ptab(:,:)
+      IF( l_ctl .AND. lwp ) THEN
+         WRITE(numout,*) ' lim_hdf  : ', SUM( ptab-ptab0 ), ' zconv= ', zconv, ' iter= ', iter
+      ENDIF
+
+   END SUBROUTINE lim_hdf
+#else
+   !!======================================================================
+   !!                       ***  MODULE limhdf   ***
+   !!                          no sea ice model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE lim_hdf         ! Empty routine
+   END SUBROUTINE lim_hdf
+#endif
+
+   !!======================================================================
+END MODULE limhdf
Index: /branches/nemo/NEMO/LIM_SRC/limistate.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limistate.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limistate.F90	(revision 4)
@@ -0,0 +1,222 @@
+MODULE limistate
+   !!======================================================================
+   !!                     ***  MODULE  limistate  ***
+   !!              Initialisation of diagnostics ice variables
+   !!======================================================================
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim' :                                   LIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_istate      :  Initialisation of diagnostics ice variables
+   !!   lim_istate_init :  initialization of ice state and namelist read
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE phycst
+   USE ocfzpt
+   USE oce             ! dynamics and tracers variables
+   USE dom_oce
+   USE ice_oce         ! ice variables
+   USE in_out_manager
+   USE dom_ice
+   USE ice
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC lim_istate      ! routine called by lim_init.F90
+
+   !! * Module variables
+   REAL(wp) ::           & !!! ** init namelist (namiceini) **
+      ttest  = 2.0  ,    &  ! threshold water temperature for initial sea ice
+      hninn  = 0.5  ,    &  ! initial snow thickness in the north
+      hginn  = 3.0  ,    &  ! initial ice thickness in the north
+      alinn  = 0.05 ,    &  ! initial leads area in the north
+      hnins  = 0.1  ,    &  ! initial snow thickness in the south
+      hgins  = 1.0  ,    &  ! initial ice thickness in the south
+      alins  = 0.1          ! initial leads area in the south
+
+   REAL(wp)  ::            &  ! constant values
+      zzero   = 0.0     ,  &
+      zone    = 1.0
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_istate
+      !!-------------------------------------------------------------------
+      !!                    ***  ROUTINE lim_istate  ***
+      !!  Purpose  :   
+      !!  restart from a state defined in a binary file and arbitrary sea
+      !!  ice conditions
+      !!
+      !! History :
+      !!   2.0  !  01-04  (C. Ethe, G. Madec)  Original code
+      !!--------------------------------------------------------------------
+      !! * Local variables
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+
+      REAL(wp) ::   zidto,    &  ! temporary scalar
+         zs0, ztf, zbin
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         ztn
+      !--------------------------------------------------------------------
+
+ 
+      CALL lim_istate_init     !  reading the initials parameters of the ice
+
+      !-- Initialisation of sst,sss,u,v do i=1,jpi
+      u_io(:,:)  = 0.e0       ! ice velocity in x direction
+      v_io(:,:)  = 0.e0       ! ice velocity in y direction
+
+      ! Initialisation at tn or -2 if ice
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zbin = MAX( 0., SIGN( 1., fzptn(ji,jj) - tn(ji,jj,1) ) )
+            ztn(ji,jj) = ( (1.-zbin) * tn(ji,jj,1) - 2. * zbin + rt0 ) * tmask(ji,jj,1)
+         END DO
+      END DO
+
+
+      u_io  (:,:) = 0.
+      v_io  (:,:) = 0.
+      sst_io(:,:) = ( nfice - 1 ) * ( tn(:,:,1) + rt0 )   ! use the ocean initial values
+      sss_io(:,:) = ( nfice - 1 ) *   sn(:,:,1)           ! tricky trick *(nfice-1) !
+
+      ! reference salinity 34psu
+      zs0 = 34.e0
+      ztf = ABS ( rt0 - 0.0575       * zs0                               &
+               &                    + 1.710523e-03 * zs0 * SQRT( zs0 )   &
+               &                    - 2.154996e-04 * zs0 *zs0          )
+
+      !  tfu: Melting point of sea water
+      tfu(:,:)  = ztf   
+   
+      !--  Northern hemisphere.
+      DO jj = jeq , jpj
+         DO ji = 1 , jpi
+            !--- Criterion for presence (zidto=1) or absence (zidto=0) of ice
+            zidto  = tms(ji,jj) * ( 1.0 - MAX(zzero, SIGN( zone, ztn(ji,jj) - tfu(ji,jj) - ttest) ) )
+
+            hicif(ji,jj)   = zidto * hginn
+            frld(ji,jj)    = zidto * alinn + ( 1.0 - zidto ) * 1.0
+            hsnif(ji,jj)   = zidto * hninn
+         ENDDO
+      ENDDO
+
+      !---  Southern hemisphere.
+      DO jj = 1, jeqm1
+         DO ji = 1, jpi
+            !--- Criterion for presence (zidto=1) or absence (zidto=0) of ice.
+            zidto  = tms(ji,jj) * ( 1.0 - MAX(zzero, SIGN( zone, ztn(ji,jj) - tfu(ji,jj) - ttest) ) )
+
+            hicif(ji,jj)   = zidto * hgins
+            frld(ji,jj)    = zidto * alins + ( 1.0 - zidto ) * 1.0
+            hsnif(ji,jj)   = zidto * hnins
+         ENDDO
+      ENDDO
+
+      sist  (:,:)   = tfu(:,:)
+      tbif  (:,:,1) = tfu(:,:)
+      tbif  (:,:,2) = tfu(:,:)
+      tbif  (:,:,3) = tfu(:,:)
+      fsbbq (:,:)   = 0.e0
+      qstoif(:,:)   = 0.e0
+      u_ice (:,:)   = 0.e0
+      v_ice (:,:)   = 0.e0
+# if defined key_coupled
+      albege(:,:)   = 0.8 * tms(:,:)
+# endif
+
+
+         !---  Moments for advection.             
+
+         sxice (:,:)  = 0.e0   ;   sxsn (:,:)  = 0.e0   ;   sxa  (:,:)  = 0.e0
+         syice (:,:)  = 0.e0   ;   sysn (:,:)  = 0.e0   ;   sya  (:,:)  = 0.e0
+         sxxice(:,:)  = 0.e0   ;   sxxsn(:,:)  = 0.e0   ;   sxxa (:,:)  = 0.e0
+         syyice(:,:)  = 0.e0   ;   syysn(:,:)  = 0.e0   ;   syya (:,:)  = 0.e0
+         sxyice(:,:)  = 0.e0   ;   sxysn(:,:)  = 0.e0   ;   sxya (:,:)  = 0.e0
+
+         sxc0  (:,:)  = 0.e0   ;   sxc1 (:,:)  = 0.e0   ;   sxc2 (:,:)  = 0.e0
+         syc0  (:,:)  = 0.e0   ;   syc1 (:,:)  = 0.e0   ;   syc2 (:,:)  = 0.e0
+         sxxc0 (:,:)  = 0.e0   ;   sxxc1(:,:)  = 0.e0   ;   sxxc2(:,:)  = 0.e0
+         syyc0 (:,:)  = 0.e0   ;   syyc1(:,:)  = 0.e0   ;   syyc2(:,:)  = 0.e0
+         sxyc0 (:,:)  = 0.e0   ;   sxyc1(:,:)  = 0.e0   ;   sxyc2(:,:)  = 0.e0
+
+         sxst  (:,:)  = 0.e0
+         syst  (:,:)  = 0.e0
+         sxxst (:,:)  = 0.e0
+         syyst (:,:)  = 0.e0
+         sxyst (:,:)  = 0.e0
+
+         !-- lateral boundary conditions
+         CALL lbc_lnk( hicif, 'T', 1. )
+         CALL lbc_lnk( frld , 'T', 1. )
+!i bug frld = 1 over land
+         frld(:,:) = tms(:,:) * frld(:,:) + ( 1. - tms(:,:) )   ! put 1 over land
+!i
+         CALL lbc_lnk( hsnif, 'T', 1. )
+         CALL lbc_lnk( sist , 'T', 1. )
+         DO jk = 1, nlayersp1
+            CALL lbc_lnk(tbif(:,:,jk), 'T', 1. )
+         END DO
+         CALL lbc_lnk( fsbbq  , 'T', 1. )
+         CALL lbc_lnk( qstoif , 'T', 1. )
+         CALL lbc_lnk( sss_io , 'T', 1. )
+
+   END SUBROUTINE lim_istate
+
+   
+   SUBROUTINE lim_istate_init
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_istate_init  ***
+      !!        
+      !! ** Purpose : Definition of initial state of the ice 
+      !!
+      !! ** Method : Read the namiceini namelist and check the parameter 
+      !!       values called at the first timestep (nit000)
+      !!
+      !! ** input : 
+      !!        Namelist namiceini
+      !!
+      !! history :
+      !!  8.5  ! 03-08 (C. Ethe) original code
+      !!-------------------------------------------------------------------
+      NAMELIST/namiceini/ ttest, hninn, hginn, alinn, hnins, hgins, alins
+      !!-------------------------------------------------------------------
+
+      ! Define the initial parameters
+      ! -------------------------
+
+      ! Read Namelist namiceini 
+      REWIND ( numnam_ice )
+      READ   ( numnam_ice , namiceini )
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_istate_init : ice parameters inititialisation '
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '   threshold water temp. for initial sea-ice    ttest      = ', ttest
+         WRITE(numout,*) '   initial snow thickness in the north          hninn      = ', hninn
+         WRITE(numout,*) '   initial ice thickness in the north           hginn      = ', hginn 
+         WRITE(numout,*) '   initial leads area in the north              alinn      = ', alinn            
+         WRITE(numout,*) '   initial snow thickness in the south          hnins      = ', hnins 
+         WRITE(numout,*) '   initial ice thickness in the south           hgins      = ', hgins
+         WRITE(numout,*) '   initial leads area in the south              alins      = ', alins
+      ENDIF
+            
+   END SUBROUTINE lim_istate_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module          NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_istate          ! Empty routine
+   END SUBROUTINE lim_istate
+#endif
+
+   !!======================================================================
+END MODULE limistate
Index: /branches/nemo/NEMO/LIM_SRC/limmsh.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limmsh.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limmsh.F90	(revision 4)
@@ -0,0 +1,237 @@
+MODULE limmsh
+#if defined key_ice_lim
+   !!======================================================================
+   !!                     ***  MODULE  limmsh  ***
+   !!                    definition of the ice mesh
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   lim_msh   : definition of the ice mesh
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE phycst
+   USE dom_oce
+   USE dom_ice
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC lim_msh      ! routine called by ice_ini.F90
+
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_msh
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_msh  ***
+      !!              
+      !! ** Purpose : Definition of the charact. of the numerical grid
+      !!       
+      !! ** Action  : - Initialisation of some variables
+      !!              - Definition of some constants linked with the grid
+      !!              - Definition of the metric coef. for the sea/ice
+      !!              - Initialization of the ice masks (tmsk, umsk)
+      !! 
+      !! ** Refer.  : Deleersnijder et al. Ocean Modelling 100, 7-10 
+      !!
+      !! ** History :
+      !!         original    : 01-04 (LIM)
+      !!         addition    : 02-08 (C. Ethe, G. Madec)
+      !!--------------------------------------------------------------------- 
+      !! * Local variables
+      INTEGER :: ji, jj     ! dummy loop indices
+
+      REAL(wp), DIMENSION(jpi,jpj) ::  &
+         zd2d1 , zd1d2      !  Derivative of zh2 (resp. zh1) in the x direction (defined at the center)
+
+      REAL(wp) ::         &
+         zh1p  , zh2p  ,  & !  Idem zh1, zh2 for the bottom left corner of the grid
+         zd2d1p, zd1d2p,  & !  Idem zd2d1, zd1d2 for the bottom left corner of the grid
+         zusden, zusden2, zaire4  !  tempory scalars
+      !!---------------------------------------------------------------------
+      !!  LIM 2.0, UCL-LODYC-IPSL (2002)
+      !!---------------------------------------------------------------------
+      
+      !----------------------------------------------------------                          
+      !    Initialization of local and some global (common) variables 
+      !------------------------------------------------------------------ 
+      
+      jeq   = INT( jpj / 2 )   !i bug mpp potentiel
+      jeqm1 = jeq - 1 
+
+      fcor(:,:) = 2. * omega * SIN( gphit(:,:) * rad )   !  coriolis factor
+ 
+
+      !   For each grid, definition of geometric tables 
+      !------------------------------------------------------------------
+      
+      !-------------------
+      ! Conventions :    |
+      !-------------------
+      !  indices 1 \ 2 <-> localisation in the 2 direction x \ y
+      !  3rd indice <-> localisation on the mesh :
+      !  0 = Centre ;  1 = corner W x(i-1/2) ; 2 = corner S y(j-1/2) ;
+      !  3 = corner SW x(i-1/2),y(j-1/2)
+      !-------------------
+      
+      
+      ! metric coefficients for sea ice dynamic
+      !----------------------------------------
+      
+      !                                                       ! akappa
+      DO jj = 2 , jpj
+         DO ji = 1 , jpi
+            zd1d2(ji,jj) = e1v(ji,jj) - e1v(ji,jj-1)
+         END DO
+      END DO
+      CALL lbc_lnk( zd1d2 , 'T', -1. )
+
+      DO jj = 1 , jpj
+         DO ji = 2 , jpi
+            zd2d1(ji,jj) = e2u(ji,jj) - e2u(ji-1,jj)
+         END DO
+      END DO
+      CALL lbc_lnk( zd2d1 , 'T', -1. )
+
+      DO jj = 1 , jpj
+         DO ji = 1 , jpi
+            zaire4            = 4.0 * e1t(ji,jj) * e2t(ji,jj)
+            akappa(ji,jj,1,1) =          1.0 / ( 2.0 * e1t(ji,jj) )
+            akappa(ji,jj,1,2) = zd1d2(ji,jj) / zaire4
+            akappa(ji,jj,2,1) = zd2d1(ji,jj) / zaire4
+            akappa(ji,jj,2,2) =          1.0 / ( 2.0 * e2t(ji,jj) )
+         END DO
+      END DO
+      
+      !                                                      ! weights (wght)
+      DO jj = 2 , jpj
+         DO ji = 2 , jpi
+            zusden = 1. / (  ( e1t(ji,jj) + e1t(ji-1,jj  ) )   &
+               &           * ( e2t(ji,jj) + e2t(ji  ,jj-1) ) )
+            wght(ji,jj,1,1) = zusden * e1t(ji  ,jj) * e2t(ji,jj  )
+            wght(ji,jj,1,2) = zusden * e1t(ji  ,jj) * e2t(ji,jj-1)
+            wght(ji,jj,2,1) = zusden * e1t(ji-1,jj) * e2t(ji,jj  )
+            wght(ji,jj,2,2) = zusden * e1t(ji-1,jj) * e2t(ji,jj-1)
+         END DO
+      END DO
+      CALL lbc_lnk( wght(:,:,1,1), 'I', 1. )      ! CAUTION: even with the lbc_lnk at ice U-V-point
+      CALL lbc_lnk( wght(:,:,1,2), 'I', 1. )      ! the value of wght at jpj is wrong
+      CALL lbc_lnk( wght(:,:,2,1), 'I', 1. )      ! but it is never used
+      CALL lbc_lnk( wght(:,:,2,2), 'I', 1. )
+    
+      ! Coefficients for divergence of the stress tensor
+      !-------------------------------------------------
+
+      DO jj = 2,jpj
+         DO ji = 2 , jpi
+            zh1p  =  e1t(ji  ,jj  ) * wght(ji,jj,2,2)   &
+               &   + e1t(ji-1,jj  ) * wght(ji,jj,1,2)   &
+               &   + e1t(ji  ,jj-1) * wght(ji,jj,2,1)   &
+               &   + e1t(ji-1,jj-1) * wght(ji,jj,1,1)
+
+            zh2p  =  e2t(ji  ,jj  ) * wght(ji,jj,2,2)   &
+               &   + e2t(ji-1,jj  ) * wght(ji,jj,1,2)   &
+               &   + e2t(ji  ,jj-1) * wght(ji,jj,2,1)   &
+               &   + e2t(ji-1,jj-1) * wght(ji,jj,1,1)
+
+! better writen but change the last digit and thus solver in less than 100 timestep
+!           zh1p  = e1t(ji-1,jj  ) * wght(ji,jj,1,2) + e1t(ji,jj  ) * wght(ji,jj,2,2)   &
+!              &  + e1t(ji-1,jj-1) * wght(ji,jj,1,1) + e1t(ji,jj-1) * wght(ji,jj,2,1) 
+
+!           zh2p  = e2t(ji-1,jj  ) * wght(ji,jj,1,2) + e2t(ji,jj  ) * wght(ji,jj,2,2)   &
+!              &  + e2t(ji-1,jj-1) * wght(ji,jj,1,1) + e2t(ji,jj-1) * wght(ji,jj,2,1)
+
+            zusden = 1.0 / ( zh1p * zh2p * 4.e0 )
+            zusden2 = zusden * 2.0 
+
+            zd1d2p = zusden * 0.5 * ( -e1t(ji-1,jj-1) + e1t(ji-1,jj  ) - e1t(ji,jj-1) + e1t(ji  ,jj)   )
+            zd2d1p = zusden * 0.5 * (  e2t(ji  ,jj-1) - e2t(ji-1,jj-1) + e2t(ji,jj  ) - e2t(ji-1,jj)   )
+
+            alambd(ji,jj,2,2,2,1) = zusden2 * e2t(ji  ,jj-1)
+            alambd(ji,jj,2,2,2,2) = zusden2 * e2t(ji  ,jj  )
+            alambd(ji,jj,2,2,1,1) = zusden2 * e2t(ji-1,jj-1)
+            alambd(ji,jj,2,2,1,2) = zusden2 * e2t(ji-1,jj  )
+
+            alambd(ji,jj,1,1,2,1) = zusden2 * e1t(ji  ,jj-1)
+            alambd(ji,jj,1,1,2,2) = zusden2 * e1t(ji  ,jj  )
+            alambd(ji,jj,1,1,1,1) = zusden2 * e1t(ji-1,jj-1)
+            alambd(ji,jj,1,1,1,2) = zusden2 * e1t(ji-1,jj  )
+
+            alambd(ji,jj,1,2,2,1) = zd1d2p
+            alambd(ji,jj,1,2,2,2) = zd1d2p
+            alambd(ji,jj,1,2,1,1) = zd1d2p
+            alambd(ji,jj,1,2,1,2) = zd1d2p
+
+            alambd(ji,jj,2,1,2,1) = zd2d1p
+            alambd(ji,jj,2,1,2,2) = zd2d1p
+            alambd(ji,jj,2,1,1,1) = zd2d1p
+            alambd(ji,jj,2,1,1,2) = zd2d1p
+         END DO
+      END DO
+
+      CALL lbc_lnk( alambd(:,:,2,2,2,1), 'I', 1. )      ! CAUTION: even with the lbc_lnk at ice U-V point
+      CALL lbc_lnk( alambd(:,:,2,2,2,2), 'I', 1. )      ! the value of wght at jpj is wrong
+      CALL lbc_lnk( alambd(:,:,2,2,1,1), 'I', 1. )      ! but it is never used
+      CALL lbc_lnk( alambd(:,:,2,2,1,2), 'I', 1. )      ! 
+
+      CALL lbc_lnk( alambd(:,:,1,1,2,1), 'I', 1. )      ! CAUTION: idem
+      CALL lbc_lnk( alambd(:,:,1,1,2,2), 'I', 1. )      ! 
+      CALL lbc_lnk( alambd(:,:,1,1,1,1), 'I', 1. )      !
+      CALL lbc_lnk( alambd(:,:,1,1,1,2), 'I', 1. )      !
+
+      CALL lbc_lnk( alambd(:,:,1,2,2,1), 'I', 1. )      ! CAUTION: idem
+      CALL lbc_lnk( alambd(:,:,1,2,2,2), 'I', 1. )      !
+      CALL lbc_lnk( alambd(:,:,1,2,1,1), 'I', 1. )      !
+      CALL lbc_lnk( alambd(:,:,1,2,1,2), 'I', 1. )      !
+
+      CALL lbc_lnk( alambd(:,:,2,1,2,1), 'I', 1. )      ! CAUTION: idem
+      CALL lbc_lnk( alambd(:,:,2,1,2,2), 'I', 1. )      !
+      CALL lbc_lnk( alambd(:,:,2,1,1,1), 'I', 1. )      !
+      CALL lbc_lnk( alambd(:,:,2,1,1,2), 'I', 1. )      !
+            
+      ! Definition of scale dephts : bathymetry               
+      !-------------------------------------------
+!i bug  dz forced to 10 meters
+      dz = 10                  !!bug   potential bug if first level not equal to 10 m
+!!!      dz = gdept(1)
+
+      
+      ! Initialization of ice masks
+      !----------------------------
+      
+      tms(:,:) = tmask(:,:,1)      ! ice T-point  : use surface tmask
+
+!i here we can use umask with a i and j shift of -1,-1
+      tmu(:,1) = 0.e0
+      tmu(1,:) = 0.e0
+      DO jj = 2, jpj               ! ice U.V-point: computed from ice T-point mask
+         DO ji = 2 , jpim1
+            tmu(ji,jj) =  tms(ji,jj) * tms(ji-1,jj) * tms(ji,jj-1) * tms(ji-1,jj-1)            
+         END DO
+      END DO
+      
+      !--lateral boundary conditions    
+      CALL lbc_lnk( tmu(:,:), 'I', 1. )
+      
+      ! unmasked and masked area of T-grid cell
+      area(:,:) = e1t(:,:) * e2t(:,:)
+      aire(:,:) = area(:,:) * tms(:,:)
+      
+   END SUBROUTINE lim_msh
+#else
+   !!==============================================================================
+   !!                       ***  MODULE limmsh   ***
+   !!                            No sea ice
+   !!==============================================================================
+CONTAINS
+   SUBROUTINE lim_msh           ! Empty routine
+   END SUBROUTINE lim_msh
+
+#endif
+   !!======================================================================
+END MODULE limmsh
Index: /branches/nemo/NEMO/LIM_SRC/limrhg.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limrhg.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limrhg.F90	(revision 4)
@@ -0,0 +1,690 @@
+MODULE limrhg
+#if defined key_ice_lim
+   !!======================================================================
+   !!                     ***  MODULE  limrhg  ***
+   !!   Ice rheology :  performs sea ice rheology
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   lim_rhg   : computes ice velocities
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE phycst
+   USE ice_oce         ! ice variables
+   USE dom_ice
+   USE ice
+   USE lbclnk
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC lim_rhg  ! routine called by lim_dyn
+
+   !! * Module variables
+     REAL(wp)  ::            &  ! constant values
+         rzero   = 0.e0   ,  &
+         rone    = 1.e0
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_rhg( khemi )
+      !!-------------------------------------------------------------------
+      !!
+      !!  This routine determines the velocity field of sea ice
+      !!  by using atmospheric (wind stress) and oceanic (water
+      !!  stress and surface tilt) forcings. Ice-ice interaction
+      !!  is described by a non-linear viscous-plastic law inclu-
+      !!  ding shear strength and a bulk rheology.	
+      !!
+      !! ** Action  : - compute u_ice, v_ice the sea-ice velocity
+      !!
+      !! History :
+      !!   0.0  !  93-12  (M.A. Morales Maqueda.)  Original code
+      !!   1.0  !  94-12  (H. Goosse) 
+      !!   2.0  !  03-12  (C. Ethe, G. Madec)  F90, mpp
+      !!-------------------------------------------------------------------
+      ! * Arguments
+      INTEGER, INTENT(in) ::   khemi   ! -1/1 = South/North hemisphere flag
+
+      ! * Local variables
+      INTEGER ::   ji, jj,          &  ! dummy loop indices
+         iim1, ijm1, iip1, ijp1,    &  ! ???
+         njmin, njmax, njmm1,       &
+         iter, jter
+
+      REAL(wp),DIMENSION(jpi,jpj) ::   &
+         zpresh, zfrld, zmass, zcorl,     &
+         zu0, zv0, zviszeta, zviseta,     &
+         zc1u, zc1v, zc2u, zc2v, za1ct, za2ct, za1, za2, zb1, zb2,  &
+         zc1, zc2, zd1, zd2, zden, zu_ice, zv_ice, zresr
+
+      REAL(wp),DIMENSION(jpi,jpj,2,2) :: &
+         zsigm11, zsigm12, zsigm22, zsigm21
+
+      REAL(wp) :: &
+         ze11, ze12, ze22, ze21,  &
+         zvis11, zvis21, zvis12, zvis22 ,   &
+         zgphsx, zgphsy, zusw, ztagnx, ztagny,   &
+         zt11, zt12, zt21, zt22
+
+      REAL(wp) :: &
+         zresm, zunw, zvnw, zur, zvr, zmod, za, zac, &
+         zmpzas, zstms, zindu, zindu1, zusdtp, zmassdt, zcorlal,  &
+         ztrace2, zdeter, zdelta, zsang, zmask, zdgp, zdgi, zdiag,   &
+         zind
+      INTEGER  :: &
+         i_j1, i_j2, i_jpj, i_jpjm1
+      !!-------------------------------------------------------------------
+      
+
+      ! Numerical characteristics.                                       
+      ! --------------------------
+
+      !  Define the limits where ice dynamics is computed
+      IF( khemi ==  1 )  THEN      ! Northern hemisphere
+         njmin = nlminn
+         njmax = nlmaxn
+      ELSE                         ! Southern hemisphere
+         njmin = nlmins
+         njmax = nlmaxs
+      ENDIF
+      njmm1 = njmin - 1
+
+      !  Store initial velocities.
+      zu0(:,:) = u_ice(:,:)
+      zv0(:,:) = v_ice(:,:)
+
+      IF( l_ctl .AND. lwp )   WRITE(numout,*) 'lim_rhg :  njmin = ', njmin, ' njmax = ', njmax
+!i essai control zone de calcul
+      IF( l_ctl .AND. lwp ) THEN
+      IF( khemi ==  1 )  THEN      ! Northern hemisphere
+      i_j1  = jeq
+      i_jpj = jpj
+      DO jj = jpj, jeq, -1
+         zind = INT( SUM( frld(:,jj) ) )
+            IF( zind < jpi ) i_j1 = jj
+      END DO
+      WRITE(numout,*) 'lim_rhg : NH i_j1 = ', i_j1, ' ij_pj = ', i_jpj
+      i_j1 = MAX( 1, i_j1-2)
+!        njmin = nlminn
+!        njmax = nlmaxn
+      ELSE                         ! Southern hemisphere
+      i_j1  = 2
+      i_jpj = jpj
+      DO jj = 1, jeq
+         zind = INT( SUM( frld(:,jj) ) )
+            IF( zind < jpi ) i_jpj = jj
+      END DO
+      WRITE(numout,*) 'lim_rhg : SH i_j1 = ', i_j1, ' ij_pj = ', i_jpj
+      i_j1 = MAX( jpj, i_jpj+2)
+!        njmin = nlmins
+!        njmax = nlmaxs
+      ENDIF
+      i_j2    = i_j1  + 1
+      i_jpjm1 = i_jpj - 1
+      ENDIF
+
+      !  2) Sign of turning angle for oceanic drag.                          |
+      !-----------------------------------------------------------------------
+
+      zsang = REAL( khemi ) * sangvg   ! only the sinus changes its sign with the hemisphere
+
+
+      !  3) Ice mass, ice strength, and wind stress at the center            |
+      !     of the grid squares.                                             |
+      !-----------------------------------------------------------------------
+
+      DO jj = njmm1 , njmax
+         DO ji = 1 , jpi
+            za1(ji,jj)    = tms(ji,jj) * ( rhosn * hsnm(ji,jj) + rhoic * hicm(ji,jj) )
+            zpresh(ji,jj) = tms(ji,jj) *  pstarh * hicm(ji,jj) * EXP( -c_rhg * frld(ji,jj) )
+#if defined key_lim_cp1 && defined key_coupled
+            zb1(ji,jj)    = tms(ji,jj) * gtaux(ji,jj) * ( 1.0 - frld(ji,jj) )
+            zb2(ji,jj)    = tms(ji,jj) * gtauy(ji,jj) * ( 1.0 - frld(ji,jj) )
+#else
+            zb1(ji,jj)    = tms(ji,jj) * ( 1.0 - frld(ji,jj) )
+            zb2(ji,jj)    = tms(ji,jj) * ( 1.0 - frld(ji,jj) )
+#endif
+         END DO
+      END DO
+
+
+      !---------------------------------------------------------------------------
+      !  Wind stress, coriolis and mass terms at the corners of the grid squares |
+      !  Gradient of ice strenght.                                               |
+      !---------------------------------------------------------------------------
+         
+      DO jj = njmin, njmax
+         DO ji = 2, jpi
+            zstms = tms(ji,jj  ) * wght(ji,jj,2,2) + tms(ji-1,jj  ) * wght(ji,jj,1,2)   &
+               &  + tms(ji,jj-1) * wght(ji,jj,2,1) + tms(ji-1,jj-1) * wght(ji,jj,1,1)
+            zusw  = 1.0 / MAX( zstms, epsd )
+
+            zt11 = tms(ji  ,jj  ) * frld(ji  ,jj  ) 
+            zt12 = tms(ji-1,jj  ) * frld(ji-1,jj  ) 
+            zt21 = tms(ji  ,jj-1) * frld(ji  ,jj-1) 
+            zt22 = tms(ji-1,jj-1) * frld(ji-1,jj-1)
+
+            ! Leads area.
+            zfrld(ji,jj) =  (  zt11 * wght(ji,jj,2,2) + zt12 * wght(ji,jj,1,2)   &
+               &             + zt21 * wght(ji,jj,2,1) + zt22 * wght(ji,jj,1,1) ) * zusw
+
+            ! Mass and coriolis coeff.
+            zmass(ji,jj) = ( za1(ji,jj  ) * wght(ji,jj,2,2) + za1(ji-1,jj  ) * wght(ji,jj,1,2)   &
+               &           + za1(ji,jj-1) * wght(ji,jj,2,1) + za1(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw
+            zcorl(ji,jj) = zmass(ji,jj) * fcor(ji,jj)
+
+            ! Wind stress.
+#if defined key_lim_cp1 && defined key_coupled
+            ztagnx = ( zb1(ji,jj  ) * wght(ji,jj,2,2) + zb1(ji-1,jj  ) * wght(ji,jj,1,2)   &
+               &     + zb1(ji,jj-1) * wght(ji,jj,2,1) + zb1(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw
+            ztagny = ( zb2(ji,jj  ) * wght(ji,jj,2,2) + zb2(ji-1,jj  ) * wght(ji,jj,1,2)   &
+               &     + zb2(ji,jj-1) * wght(ji,jj,2,1) + zb2(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw
+#else
+            ztagnx = ( zb1(ji,jj  ) * wght(ji,jj,2,2) + zb1(ji-1,jj  ) * wght(ji,jj,1,2)   &
+               &     + zb1(ji,jj-1) * wght(ji,jj,2,1) + zb1(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw * gtaux(ji,jj)
+            ztagny = ( zb2(ji,jj  ) * wght(ji,jj,2,2) + zb2(ji-1,jj  ) * wght(ji,jj,1,2)   &
+               &     + zb2(ji,jj-1) * wght(ji,jj,2,1) + zb2(ji-1,jj-1) * wght(ji,jj,1,1) ) * zusw * gtauy(ji,jj)
+#endif
+
+            ! Gradient of ice strength
+            zgphsx =   ( alambd(ji,jj,2,2,2,1) - alambd(ji,jj,2,1,2,1) ) * zpresh(ji  ,jj-1)   &
+               &     + ( alambd(ji,jj,2,2,2,2) - alambd(ji,jj,2,1,2,2) ) * zpresh(ji  ,jj  )   &
+               &     - ( alambd(ji,jj,2,2,1,1) + alambd(ji,jj,2,1,1,1) ) * zpresh(ji-1,jj-1)   &
+               &     - ( alambd(ji,jj,2,2,1,2) + alambd(ji,jj,2,1,1,2) ) * zpresh(ji-1,jj  )
+
+            zgphsy = - ( alambd(ji,jj,1,1,2,1) + alambd(ji,jj,1,2,2,1) ) * zpresh(ji  ,jj-1)   &
+               &     - ( alambd(ji,jj,1,1,1,1) + alambd(ji,jj,1,2,1,1) ) * zpresh(ji-1,jj-1)   &
+               &     + ( alambd(ji,jj,1,1,2,2) - alambd(ji,jj,1,2,2,2) ) * zpresh(ji  ,jj  )   &
+               &     + ( alambd(ji,jj,1,1,1,2) - alambd(ji,jj,1,2,1,2) ) * zpresh(ji-1,jj  )
+
+            ! Computation of the velocity field taking into account the ice-ice interaction.                                 
+            ! Terms that are independent of the velocity field.
+            za1ct(ji,jj) = ztagnx - zcorl(ji,jj) * v_oce(ji,jj) - zgphsx
+            za2ct(ji,jj) = ztagny + zcorl(ji,jj) * u_oce(ji,jj) - zgphsy
+         END DO
+      END DO
+
+!! inutile!!
+!!??    CALL lbc_lnk( za1ct, 'I', -1. )
+!!??    CALL lbc_lnk( za2ct, 'I', -1. )
+
+
+      ! SOLUTION OF THE MOMENTUM EQUATION.
+      !------------------------------------------
+      !                                                   ! ==================== !
+      DO iter = 1 , 2 * nbiter                            !    loop over iter    !
+         !                                                ! ==================== !        
+         zindu = MOD( iter , 2 )
+         zusdtp = ( zindu * 2.0 + ( 1.0 - zindu ) * 1.0 )  * REAL( nbiter ) / rdt_ice
+
+         ! Computation of free drift field for free slip boundary conditions.
+
+           DO jj = njmm1, njmax
+              DO ji = 1, jpim1
+                 !- Rate of strain tensor.
+                 zt11 =   akappa(ji,jj,1,1) * ( u_ice(ji+1,jj) + u_ice(ji+1,jj+1) - u_ice(ji,jj  ) - u_ice(ji  ,jj+1) )  &
+                    &   + akappa(ji,jj,1,2) * ( v_ice(ji+1,jj) + v_ice(ji+1,jj+1) + v_ice(ji,jj  ) + v_ice(ji  ,jj+1) )
+                 zt12 = - akappa(ji,jj,2,2) * ( u_ice(ji  ,jj) + u_ice(ji+1,jj  ) - u_ice(ji,jj+1) - u_ice(ji+1,jj+1) )  &
+                    &   - akappa(ji,jj,2,1) * ( v_ice(ji  ,jj) + v_ice(ji+1,jj  ) + v_ice(ji,jj+1) + v_ice(ji+1,jj+1) )
+                 zt22 = - akappa(ji,jj,2,2) * ( v_ice(ji  ,jj) + v_ice(ji+1,jj  ) - v_ice(ji,jj+1) - v_ice(ji+1,jj+1) )  &
+                    &   + akappa(ji,jj,2,1) * ( u_ice(ji  ,jj) + u_ice(ji+1,jj  ) + u_ice(ji,jj+1) + u_ice(ji+1,jj+1) )
+                 zt21 =   akappa(ji,jj,1,1) * ( v_ice(ji+1,jj) + v_ice(ji+1,jj+1) - v_ice(ji,jj  ) - v_ice(ji  ,jj+1) )  &
+                    &   - akappa(ji,jj,1,2) * ( u_ice(ji+1,jj) + u_ice(ji+1,jj+1) + u_ice(ji,jj  ) + u_ice(ji  ,jj+1) )
+
+                 !- Rate of strain tensor. 
+                 zdgp = zt11 + zt22
+                 zdgi = zt12 + zt21
+                 ztrace2 = zdgp * zdgp 
+                 zdeter  = zt11 * zt22 - 0.25 * zdgi * zdgi
+
+                 !  Creep limit depends on the size of the grid.
+                 zdelta = MAX( SQRT( ztrace2 + ( ztrace2 - 4.0 * zdeter ) * usecc2),  creepl)
+
+                 !-  Computation of viscosities.
+                 zviszeta(ji,jj) = MAX( zpresh(ji,jj) / zdelta, etamn )
+                 zviseta (ji,jj) = zviszeta(ji,jj) * usecc2
+              END DO
+           END DO
+!!??       CALL lbc_lnk( zviszeta, 'I', -1. )  ! or T point???   semble reellement inutile
+!!??       CALL lbc_lnk( zviseta , 'I', -1. )
+
+
+           !-  Determination of zc1u, zc2u, zc1v and zc2v.
+           DO jj = njmin, njmax
+              DO ji = 2, jpim1
+                 ze11   =  akappa(ji-1,jj-1,1,1)
+                 ze12   = +akappa(ji-1,jj-1,2,2)
+                 ze22   =  akappa(ji-1,jj-1,2,1)
+                 ze21   = -akappa(ji-1,jj-1,1,2)
+                 zvis11 = 2.0 * zviseta (ji-1,jj-1) + dm
+                 zvis22 =       zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1)
+                 zvis12 =       zviseta (ji-1,jj-1) + dm
+                 zvis21 =       zviseta (ji-1,jj-1)
+
+                 zdiag = zvis22 * ( ze11 + ze22 )
+                 zsigm11(ji,jj,1,1) =  zvis11 * ze11 + zdiag
+                 zsigm12(ji,jj,1,1) =  zvis12 * ze12 + zvis21 * ze21
+                 zsigm22(ji,jj,1,1) =  zvis11 * ze22 + zdiag
+                 zsigm21(ji,jj,1,1) =  zvis12 * ze21 + zvis21 * ze12
+
+                 ze11   = -akappa(ji,jj-1,1,1)
+                 ze12   = +akappa(ji,jj-1,2,2)
+                 ze22   =  akappa(ji,jj-1,2,1)
+                 ze21   = -akappa(ji,jj-1,1,2)
+                 zvis11 = 2.0 * zviseta (ji,jj-1) + dm
+                 zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1)
+                 zvis12 =       zviseta (ji,jj-1) + dm
+                 zvis21 =       zviseta (ji,jj-1)
+
+                 zdiag = zvis22 * ( ze11 + ze22 )
+                 zsigm11(ji,jj,2,1) =  zvis11 * ze11 + zdiag
+                 zsigm12(ji,jj,2,1) =  zvis12 * ze12 + zvis21 * ze21
+                 zsigm22(ji,jj,2,1) =  zvis11 * ze22 + zdiag
+                 zsigm21(ji,jj,2,1) =  zvis12 * ze21 + zvis21 * ze12
+
+                 ze11   =  akappa(ji-1,jj,1,1)
+                 ze12   = -akappa(ji-1,jj,2,2)
+                 ze22   =  akappa(ji-1,jj,2,1)
+                 ze21   = -akappa(ji-1,jj,1,2)
+                 zvis11 = 2.0 * zviseta (ji-1,jj) + dm
+                 zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj)
+                 zvis12 =       zviseta (ji-1,jj) + dm
+                 zvis21 =       zviseta (ji-1,jj)
+
+                 zdiag = zvis22 * ( ze11 + ze22 ) 
+                 zsigm11(ji,jj,1,2) =  zvis11 * ze11 + zdiag
+                 zsigm12(ji,jj,1,2) =  zvis12 * ze12 + zvis21 * ze21
+                 zsigm22(ji,jj,1,2) =  zvis11 * ze22 + zdiag
+                 zsigm21(ji,jj,1,2) =  zvis12 * ze21 + zvis21 * ze12
+
+                 ze11   = -akappa(ji,jj,1,1)
+                 ze12   = -akappa(ji,jj,2,2)
+                 ze22   =  akappa(ji,jj,2,1)
+                 ze21   = -akappa(ji,jj,1,2)
+                 zvis11 = 2.0 * zviseta (ji,jj) + dm
+                 zvis22 =       zviszeta(ji,jj) - zviseta(ji,jj)
+                 zvis12 =       zviseta (ji,jj) + dm
+                 zvis21 =       zviseta (ji,jj)
+
+                 zdiag = zvis22 * ( ze11 + ze22 )
+                 zsigm11(ji,jj,2,2) =  zvis11 * ze11 + zdiag
+                 zsigm12(ji,jj,2,2) =  zvis12 * ze12 + zvis21 * ze21
+                 zsigm22(ji,jj,2,2) =  zvis11 * ze22 + zdiag 
+                 zsigm21(ji,jj,2,2) =  zvis12 * ze21 + zvis21 * ze12
+              END DO
+           END DO
+
+           DO jj = njmin, njmax
+              DO ji = 2, jpim1
+                 zc1u(ji,jj) = alambd(ji,jj,2,2,2,1) * zsigm11(ji,jj,2,1) + alambd(ji,jj,2,2,2,2) * zsigm11(ji,jj,2,2)   &
+                    &        - alambd(ji,jj,2,2,1,1) * zsigm11(ji,jj,1,1) - alambd(ji,jj,2,2,1,2) * zsigm11(ji,jj,1,2)   &
+                    &        - alambd(ji,jj,1,1,2,1) * zsigm12(ji,jj,2,1) - alambd(ji,jj,1,1,1,1) * zsigm12(ji,jj,1,1)   &
+                    &        + alambd(ji,jj,1,1,2,2) * zsigm12(ji,jj,2,2) + alambd(ji,jj,1,1,1,2) * zsigm12(ji,jj,1,2)   &
+                    &        + alambd(ji,jj,1,2,1,1) * zsigm21(ji,jj,1,1) + alambd(ji,jj,1,2,2,1) * zsigm21(ji,jj,2,1)   &
+                    &        + alambd(ji,jj,1,2,1,2) * zsigm21(ji,jj,1,2) + alambd(ji,jj,1,2,2,2) * zsigm21(ji,jj,2,2)   &
+                    &        - alambd(ji,jj,2,1,1,1) * zsigm22(ji,jj,1,1) - alambd(ji,jj,2,1,2,1) * zsigm22(ji,jj,2,1)   &
+                    &        - alambd(ji,jj,2,1,1,2) * zsigm22(ji,jj,1,2) - alambd(ji,jj,2,1,2,2) * zsigm22(ji,jj,2,2)
+                 
+                 zc2u(ji,jj) = alambd(ji,jj,2,2,2,1) * zsigm21(ji,jj,2,1) + alambd(ji,jj,2,2,2,2) * zsigm21(ji,jj,2,2)   &
+                    &        - alambd(ji,jj,2,2,1,1) * zsigm21(ji,jj,1,1) - alambd(ji,jj,2,2,1,2) * zsigm21(ji,jj,1,2)   &
+                    &        - alambd(ji,jj,1,1,2,1) * zsigm22(ji,jj,2,1) - alambd(ji,jj,1,1,1,1) * zsigm22(ji,jj,1,1)   &
+                    &        + alambd(ji,jj,1,1,2,2) * zsigm22(ji,jj,2,2) + alambd(ji,jj,1,1,1,2) * zsigm22(ji,jj,1,2)   &
+                    &        - alambd(ji,jj,1,2,1,1) * zsigm11(ji,jj,1,1) - alambd(ji,jj,1,2,2,1) * zsigm11(ji,jj,2,1)   &
+                    &        - alambd(ji,jj,1,2,1,2) * zsigm11(ji,jj,1,2) - alambd(ji,jj,1,2,2,2) * zsigm11(ji,jj,2,2)   &
+                    &        + alambd(ji,jj,2,1,1,1) * zsigm12(ji,jj,1,1) + alambd(ji,jj,2,1,2,1) * zsigm12(ji,jj,2,1)   &
+                    &        + alambd(ji,jj,2,1,1,2) * zsigm12(ji,jj,1,2) + alambd(ji,jj,2,1,2,2) * zsigm12(ji,jj,2,2)
+             END DO
+           END DO
+
+           DO jj = njmin, njmax
+              DO ji = 2, jpim1
+                 !  zc1v , zc2v.
+                 ze11   =  akappa(ji-1,jj-1,1,2)
+                 ze12   = -akappa(ji-1,jj-1,2,1)
+                 ze22   = +akappa(ji-1,jj-1,2,2)
+                 ze21   =  akappa(ji-1,jj-1,1,1)
+                 zvis11 = 2.0 * zviseta (ji-1,jj-1) + dm
+                 zvis22 =       zviszeta(ji-1,jj-1) - zviseta(ji-1,jj-1)
+                 zvis12 =       zviseta (ji-1,jj-1) + dm
+                 zvis21 =       zviseta (ji-1,jj-1)
+
+                 zdiag = zvis22 * ( ze11 + ze22 )
+                 zsigm11(ji,jj,1,1) =  zvis11 * ze11 + zdiag
+                 zsigm12(ji,jj,1,1) =  zvis12 * ze12 + zvis21 * ze21
+                 zsigm22(ji,jj,1,1) =  zvis11 * ze22 + zdiag
+                 zsigm21(ji,jj,1,1) =  zvis12 * ze21 + zvis21 * ze12
+ 
+                 ze11   =  akappa(ji,jj-1,1,2)
+                 ze12   = -akappa(ji,jj-1,2,1)
+                 ze22   = +akappa(ji,jj-1,2,2)
+                 ze21   = -akappa(ji,jj-1,1,1)
+                 zvis11 = 2.0 * zviseta (ji,jj-1) + dm
+                 zvis22 =       zviszeta(ji,jj-1) - zviseta(ji,jj-1)
+                 zvis12 =       zviseta (ji,jj-1) + dm
+                 zvis21 =       zviseta (ji,jj-1)
+
+                 zdiag = zvis22 * ( ze11 + ze22 )
+                 zsigm11(ji,jj,2,1) =  zvis11 * ze11 + zdiag
+                 zsigm12(ji,jj,2,1) =  zvis12 * ze12 + zvis21 * ze21
+                 zsigm22(ji,jj,2,1) =  zvis11 * ze22 + zdiag
+                 zsigm21(ji,jj,2,1) =  zvis12 * ze21 + zvis21 * ze12
+
+                 ze11   =  akappa(ji-1,jj,1,2)
+                 ze12   = -akappa(ji-1,jj,2,1)
+                 ze22   = -akappa(ji-1,jj,2,2)
+                 ze21   =  akappa(ji-1,jj,1,1)
+                 zvis11 = 2.0 * zviseta (ji-1,jj) + dm
+                 zvis22 =       zviszeta(ji-1,jj) - zviseta(ji-1,jj)
+                 zvis12 =       zviseta (ji-1,jj) + dm
+                 zvis21 =       zviseta (ji-1,jj)
+
+                 zdiag = zvis22 * ( ze11 + ze22 )
+                 zsigm11(ji,jj,1,2) =  zvis11 * ze11 + zdiag
+                 zsigm12(ji,jj,1,2) =  zvis12 * ze12 + zvis21 * ze21
+                 zsigm22(ji,jj,1,2) =  zvis11 * ze22 + zdiag
+                 zsigm21(ji,jj,1,2) =  zvis12 * ze21 + zvis21 * ze12
+
+                 ze11   =  akappa(ji,jj,1,2)
+                 ze12   = -akappa(ji,jj,2,1)
+                 ze22   = -akappa(ji,jj,2,2)
+                 ze21   = -akappa(ji,jj,1,1)
+                 zvis11 = 2.0 * zviseta (ji,jj) + dm
+                 zvis22 =       zviszeta(ji,jj) - zviseta(ji,jj)
+                 zvis12 =       zviseta (ji,jj) + dm
+                 zvis21 =       zviseta (ji,jj)
+
+                 zdiag = zvis22 * ( ze11 + ze22 )
+                 zsigm11(ji,jj,2,2) =  zvis11 * ze11 + zdiag
+                 zsigm12(ji,jj,2,2) =  zvis12 * ze12 + zvis21 * ze21
+                 zsigm22(ji,jj,2,2) =  zvis11 * ze22 + zdiag
+                 zsigm21(ji,jj,2,2) =  zvis12 * ze21 + zvis21 * ze12
+
+              END DO
+           END DO
+
+           DO jj = njmin, njmax
+              DO ji = 2, jpim1
+                 zc1v(ji,jj) = alambd(ji,jj,2,2,2,1) * zsigm11(ji,jj,2,1) + alambd(ji,jj,2,2,2,2) * zsigm11(ji,jj,2,2)   &
+                    &        - alambd(ji,jj,2,2,1,1) * zsigm11(ji,jj,1,1) - alambd(ji,jj,2,2,1,2) * zsigm11(ji,jj,1,2)   &
+                    &        - alambd(ji,jj,1,1,2,1) * zsigm12(ji,jj,2,1) - alambd(ji,jj,1,1,1,1) * zsigm12(ji,jj,1,1)   &
+                    &        + alambd(ji,jj,1,1,2,2) * zsigm12(ji,jj,2,2) + alambd(ji,jj,1,1,1,2) * zsigm12(ji,jj,1,2)   &
+                    &        + alambd(ji,jj,1,2,1,1) * zsigm21(ji,jj,1,1) + alambd(ji,jj,1,2,2,1) * zsigm21(ji,jj,2,1)   &
+                    &        + alambd(ji,jj,1,2,1,2) * zsigm21(ji,jj,1,2) + alambd(ji,jj,1,2,2,2) * zsigm21(ji,jj,2,2)   &
+                    &        - alambd(ji,jj,2,1,1,1) * zsigm22(ji,jj,1,1) - alambd(ji,jj,2,1,2,1) * zsigm22(ji,jj,2,1)   &
+                    &        - alambd(ji,jj,2,1,1,2) * zsigm22(ji,jj,1,2) - alambd(ji,jj,2,1,2,2) * zsigm22(ji,jj,2,2)
+                 zc2v(ji,jj) = alambd(ji,jj,2,2,2,1) * zsigm21(ji,jj,2,1) + alambd(ji,jj,2,2,2,2) * zsigm21(ji,jj,2,2)   &
+                    &        - alambd(ji,jj,2,2,1,1) * zsigm21(ji,jj,1,1) - alambd(ji,jj,2,2,1,2) * zsigm21(ji,jj,1,2)   &
+                    &        - alambd(ji,jj,1,1,2,1) * zsigm22(ji,jj,2,1) - alambd(ji,jj,1,1,1,1) * zsigm22(ji,jj,1,1)   &
+                    &        + alambd(ji,jj,1,1,2,2) * zsigm22(ji,jj,2,2) + alambd(ji,jj,1,1,1,2) * zsigm22(ji,jj,1,2)   &
+                    &        - alambd(ji,jj,1,2,1,1) * zsigm11(ji,jj,1,1) - alambd(ji,jj,1,2,2,1) * zsigm11(ji,jj,2,1)   &
+                    &        - alambd(ji,jj,1,2,1,2) * zsigm11(ji,jj,1,2) - alambd(ji,jj,1,2,2,2) * zsigm11(ji,jj,2,2)   &
+                    &        + alambd(ji,jj,2,1,1,1) * zsigm12(ji,jj,1,1) + alambd(ji,jj,2,1,2,1) * zsigm12(ji,jj,2,1)   &
+                    &        + alambd(ji,jj,2,1,1,2) * zsigm12(ji,jj,1,2) + alambd(ji,jj,2,1,2,2) * zsigm12(ji,jj,2,2)
+              END DO
+           END DO
+
+         ! Relaxation.
+           
+iflag:   DO jter = 1 , nbitdr
+
+            !  Store previous drift field.   
+            DO jj = njmm1, njmax
+               zu_ice(:,jj) = u_ice(:,jj)
+               zv_ice(:,jj) = v_ice(:,jj)
+            END DO
+
+            DO jj = njmin, njmax
+                DO ji = 2, jpim1
+                  zur     = u_ice(ji,jj) - u_oce(ji,jj)
+                  zvr     = v_ice(ji,jj) - v_oce(ji,jj)
+                  zmod    = SQRT( zur * zur + zvr * zvr) * ( 1.0 - zfrld(ji,jj) )
+                  za      = rhoco * zmod
+                  zac     = za * cangvg
+                  zmpzas  = alpha * zcorl(ji,jj) + za * zsang
+                  zmassdt = zusdtp * zmass(ji,jj)
+                  zcorlal = ( 1.0 - alpha ) * zcorl(ji,jj)
+
+                  za1(ji,jj) =  zmassdt * zu0(ji,jj) + zcorlal * zv0(ji,jj) + za1ct(ji,jj)   &
+                     &        + za * ( cangvg * u_oce(ji,jj) - zsang * v_oce(ji,jj) )
+
+                  za2(ji,jj) =  zmassdt * zv0(ji,jj) - zcorlal * zu0(ji,jj) + za2ct(ji,jj)   &
+                     &        + za * ( cangvg * v_oce(ji,jj) + zsang * u_oce(ji,jj) )
+
+                  zb1(ji,jj)  = zmassdt + zac - zc1u(ji,jj)
+                  zb2(ji,jj)  = zmpzas  - zc2u(ji,jj)
+                  zc1(ji,jj)  = zmpzas  + zc1v(ji,jj)
+                  zc2(ji,jj)  = zmassdt + zac  - zc2v(ji,jj) 
+                  zdeter      = zc1(ji,jj) * zb2(ji,jj) + zc2(ji,jj) * zb1(ji,jj)
+                  zden(ji,jj) = SIGN( rone, zdeter) / MAX( epsd , ABS( zdeter ) )
+               END DO
+            END DO
+
+            ! The computation of ice interaction term is splitted into two parts
+            !-------------------------------------------------------------------------
+
+            ! Terms that do not involve already up-dated velocities.
+         
+            DO jj = njmin, njmax
+               DO ji = 2, jpim1
+                  iim1 = ji
+                  ijm1 = jj - 1
+                  iip1 = ji + 1
+                  ijp1 = jj
+                  ze11 =   akappa(iim1,ijm1,1,1) * u_ice(iip1,ijp1) + akappa(iim1,ijm1,1,2) * v_ice(iip1,ijp1)
+                  ze12 = + akappa(iim1,ijm1,2,2) * u_ice(iip1,ijp1) - akappa(iim1,ijm1,2,1) * v_ice(iip1,ijp1)
+                  ze22 = + akappa(iim1,ijm1,2,2) * v_ice(iip1,ijp1) + akappa(iim1,ijm1,2,1) * u_ice(iip1,ijp1)
+                  ze21 =   akappa(iim1,ijm1,1,1) * v_ice(iip1,ijp1) - akappa(iim1,ijm1,1,2) * u_ice(iip1,ijp1)
+                  zvis11 = 2.0 * zviseta (iim1,ijm1) + dm
+                  zvis22 =       zviszeta(iim1,ijm1) - zviseta(iim1,ijm1)
+                  zvis12 =       zviseta (iim1,ijm1) + dm
+                  zvis21 =       zviseta (iim1,ijm1)
+                  zdiag = zvis22 * ( ze11 + ze22 )
+                  zsigm11(ji,jj,2,1) =  zvis11 * ze11 + zdiag
+                  zsigm12(ji,jj,2,1) =  zvis12 * ze12 + zvis21 * ze21
+                  zsigm22(ji,jj,2,1) =  zvis11 * ze22 + zdiag
+                  zsigm21(ji,jj,2,1) =  zvis12 * ze21 + zvis21 * ze12
+
+
+                  iim1 = ji - 1
+                  ijm1 = jj
+                  iip1 = ji
+                  ijp1 = jj + 1                   
+                  ze11 =   akappa(iim1,ijm1,1,1) * ( u_ice(iip1,ijp1) - u_ice(iim1,ijp1) )   &
+                     &   + akappa(iim1,ijm1,1,2) * ( v_ice(iip1,ijp1) + v_ice(iim1,ijp1) )
+                  ze12 = + akappa(iim1,ijm1,2,2) * ( u_ice(iim1,ijp1) + u_ice(iip1,ijp1) )   &
+                     &   - akappa(iim1,ijm1,2,1) * ( v_ice(iim1,ijp1) + v_ice(iip1,ijp1) )
+                  ze22 = + akappa(iim1,ijm1,2,2) * ( v_ice(iim1,ijp1) + v_ice(iip1,ijp1) )   &
+                     &   + akappa(iim1,ijm1,2,1) * ( u_ice(iim1,ijp1) + u_ice(iip1,ijp1) )
+                  ze21 =   akappa(iim1,ijm1,1,1) * ( v_ice(iip1,ijp1) - v_ice(iim1,ijp1) )   &
+                     &   - akappa(iim1,ijm1,1,2) * ( u_ice(iip1,ijp1) + u_ice(iim1,ijp1) )
+                  zvis11 = 2.0 * zviseta (iim1,ijm1) + dm
+                  zvis22 =       zviszeta(iim1,ijm1) - zviseta(iim1,ijm1)
+                  zvis12 =       zviseta (iim1,ijm1) + dm
+                  zvis21 =       zviseta (iim1,ijm1)
+                  zdiag = zvis22 * ( ze11 + ze22 )
+                  zsigm11(ji,jj,1,2) =  zvis11 * ze11 + zdiag
+                  zsigm12(ji,jj,1,2) =  zvis12 * ze12 + zvis21 * ze21
+                  zsigm22(ji,jj,1,2) =  zvis11 * ze22 + zdiag
+                  zsigm21(ji,jj,1,2) =  zvis12 * ze21 + zvis21 * ze12
+
+                  iim1 = ji
+                  ijm1 = jj
+                  iip1 = ji + 1
+                  ijp1 = jj + 1
+                  ze11 =   akappa(iim1,ijm1,1,1) * ( u_ice(iip1,ijm1) + u_ice(iip1,ijp1) - u_ice(iim1,ijp1) )   &
+                     &   + akappa(iim1,ijm1,1,2) * ( v_ice(iip1,ijm1) + v_ice(iip1,ijp1) + v_ice(iim1,ijp1) )
+                  ze12 = - akappa(iim1,ijm1,2,2) * ( u_ice(iip1,ijm1) - u_ice(iim1,ijp1) - u_ice(iip1,ijp1) )   &
+                     &   - akappa(iim1,ijm1,2,1) * ( v_ice(iip1,ijm1) + v_ice(iim1,ijp1) + v_ice(iip1,ijp1) )
+                  ze22 = - akappa(iim1,ijm1,2,2) * ( v_ice(iip1,ijm1) - v_ice(iim1,ijp1) - v_ice(iip1,ijp1) )   &
+                     &   + akappa(iim1,ijm1,2,1) * ( u_ice(iip1,ijm1) + u_ice(iim1,ijp1) + u_ice(iip1,ijp1) )
+                  ze21 =   akappa(iim1,ijm1,1,1) * ( v_ice(iip1,ijm1) + v_ice(iip1,ijp1) - v_ice(iim1,ijp1) )   &
+                     &   - akappa(iim1,ijm1,1,2) * ( u_ice(iip1,ijm1) + u_ice(iip1,ijp1) + u_ice(iim1,ijp1) ) 
+                  zvis11 = 2.0 * zviseta (iim1,ijm1) + dm
+                  zvis22 =       zviszeta(iim1,ijm1) - zviseta(iim1,ijm1)
+                  zvis12 =       zviseta (iim1,ijm1) + dm
+                  zvis21 =       zviseta (iim1,ijm1)
+
+                  zdiag = zvis22 * ( ze11 + ze22 )
+                  zsigm11(ji,jj,2,2) =  zvis11 * ze11 + zdiag
+                  zsigm12(ji,jj,2,2) =  zvis12 * ze12 + zvis21 * ze21
+                  zsigm22(ji,jj,2,2) =  zvis11 * ze22 + zdiag
+                  zsigm21(ji,jj,2,2) =  zvis12 * ze21 + zvis21 * ze12
+
+               END DO
+            END DO
+
+            ! Terms involving already up-dated velocities.		
+            !-Using the arrays zu_ice and zv_ice in the computation of the terms ze leads to JACOBI's method; 
+            ! Using arrays u and v in the computation of the terms ze leads to GAUSS-SEIDEL method.	
+             
+            DO jj = njmin, njmax
+               DO ji = 2, jpim1
+                  iim1 = ji - 1
+                  ijm1 = jj - 1
+                  iip1 = ji
+                  ijp1 = jj
+                  ze11 =   akappa(iim1,ijm1,1,1) * ( zu_ice(iip1,ijm1) - zu_ice(iim1,ijm1) - zu_ice(iim1,ijp1) )   &
+                     &   + akappa(iim1,ijm1,1,2) * ( zv_ice(iip1,ijm1) + zv_ice(iim1,ijm1) + zv_ice(iim1,ijp1) )
+                  ze12 = - akappa(iim1,ijm1,2,2) * ( zu_ice(iim1,ijm1) + zu_ice(iip1,ijm1) - zu_ice(iim1,ijp1) )   &
+                     &   - akappa(iim1,ijm1,2,1) * ( zv_ice(iim1,ijm1) + zv_ice(iip1,ijm1) + zv_ice(iim1,ijp1) )
+                  ze22 = - akappa(iim1,ijm1,2,2) * ( zv_ice(iim1,ijm1) + zv_ice(iip1,ijm1) - zv_ice(iim1,ijp1) )   &
+                     &   + akappa(iim1,ijm1,2,1) * ( zu_ice(iim1,ijm1) + zu_ice(iip1,ijm1) + zu_ice(iim1,ijp1) )
+                  ze21 =   akappa(iim1,ijm1,1,1) * ( zv_ice(iip1,ijm1) - zv_ice(iim1,ijm1) - zv_ice(iim1,ijp1) )   &
+                     &  -  akappa(iim1,ijm1,1,2) * ( zu_ice(iip1,ijm1) + zu_ice(iim1,ijm1) + zu_ice(iim1,ijp1) )
+                  zvis11 = 2.0 * zviseta (iim1,ijm1) + dm
+                  zvis22 =       zviszeta(iim1,ijm1) - zviseta(iim1,ijm1)
+                  zvis12 =       zviseta (iim1,ijm1) + dm
+                  zvis21 =       zviseta (iim1,ijm1)
+
+                  zdiag = zvis22 * ( ze11 + ze22 )
+                  zsigm11(ji,jj,1,1) =  zvis11 * ze11 + zdiag
+                  zsigm12(ji,jj,1,1) =  zvis12 * ze12 + zvis21 * ze21
+                  zsigm22(ji,jj,1,1) =  zvis11 * ze22 + zdiag
+                  zsigm21(ji,jj,1,1) =  zvis12 * ze21 + zvis21 * ze12
+
+
+                  iim1 = ji
+                  ijm1 = jj - 1
+                  iip1 = ji + 1
+                  ze11 =   akappa(iim1,ijm1,1,1) * ( zu_ice(iip1,ijm1) - zu_ice(iim1,ijm1) )   &
+                     &   + akappa(iim1,ijm1,1,2) * ( zv_ice(iip1,ijm1) + zv_ice(iim1,ijm1) )
+                  ze12 = - akappa(iim1,ijm1,2,2) * ( zu_ice(iim1,ijm1) + zu_ice(iip1,ijm1) )   &
+                     &   - akappa(iim1,ijm1,2,1) * ( zv_ice(iim1,ijm1) + zv_ice(iip1,ijm1) )
+                  ze22 = - akappa(iim1,ijm1,2,2) * ( zv_ice(iim1,ijm1) + zv_ice(iip1,ijm1) )   &
+                     &   + akappa(iim1,ijm1,2,1) * ( zu_ice(iim1,ijm1) + zu_ice(iip1,ijm1) )
+                  ze21 =   akappa(iim1,ijm1,1,1) * ( zv_ice(iip1,ijm1) - zv_ice(iim1,ijm1) )   &
+                     &   - akappa(iim1,ijm1,1,2) * ( zu_ice(iip1,ijm1) + zu_ice(iim1,ijm1) )
+                  zvis11 = 2.0 * zviseta (iim1,ijm1) + dm
+                  zvis22 =       zviszeta(iim1,ijm1) - zviseta(iim1,ijm1)
+                  zvis12 =       zviseta (iim1,ijm1) + dm
+                  zvis21 =       zviseta (iim1,ijm1)
+
+                  zdiag = zvis22 * ( ze11 + ze22 )
+                  zsigm11(ji,jj,2,1) =  zsigm11(ji,jj,2,1) + zvis11 * ze11 + zdiag
+                  zsigm12(ji,jj,2,1) =  zsigm12(ji,jj,2,1) + zvis12 * ze12 + zvis21 * ze21
+                  zsigm22(ji,jj,2,1) =  zsigm22(ji,jj,2,1) + zvis11 * ze22 + zdiag
+                  zsigm21(ji,jj,2,1) =  zsigm21(ji,jj,2,1) + zvis12 * ze21 + zvis21 * ze12
+
+
+                  iim1 = ji - 1
+                  ijm1 = jj 
+                  ze11 = - akappa(iim1,ijm1,1,1) * zu_ice(iim1,ijm1) + akappa(iim1,ijm1,1,2) * zv_ice(iim1,ijm1)
+                  ze12 = - akappa(iim1,ijm1,2,2) * zu_ice(iim1,ijm1) - akappa(iim1,ijm1,2,1) * zv_ice(iim1,ijm1)
+                  ze22 = - akappa(iim1,ijm1,2,2) * zv_ice(iim1,ijm1) + akappa(iim1,ijm1,2,1) * zu_ice(iim1,ijm1)
+                  ze21 = - akappa(iim1,ijm1,1,1) * zv_ice(iim1,ijm1) - akappa(iim1,ijm1,1,2) * zu_ice(iim1,ijm1)
+                  zvis11 = 2.0 * zviseta (iim1,ijm1) + dm
+                  zvis22 =       zviszeta(iim1,ijm1) - zviseta(iim1,ijm1)
+                  zvis12 =       zviseta (iim1,ijm1) + dm
+                  zvis21 =       zviseta (iim1,ijm1)
+
+                  zdiag = zvis22 * ( ze11 + ze22 )
+                  zsigm11(ji,jj,1,2) =  zsigm11(ji,jj,1,2) + zvis11 * ze11 + zdiag 
+                  zsigm12(ji,jj,1,2) =  zsigm12(ji,jj,1,2) + zvis12 * ze12 + zvis21 * ze21
+                  zsigm22(ji,jj,1,2) =  zsigm22(ji,jj,1,2) + zvis11 * ze22 + zdiag
+                  zsigm21(ji,jj,1,2) =  zsigm21(ji,jj,1,2) + zvis12 * ze21 + zvis21 * ze12
+
+!i             END DO
+!i          END DO
+
+!i          DO jj = njmin, njmax
+!i             DO ji = 2, jpim1
+                  zd1(ji,jj) = alambd(ji,jj,2,2,2,1) * zsigm11(ji,jj,2,1) + alambd(ji,jj,2,2,2,2) * zsigm11(ji,jj,2,2)  &
+                     &       - alambd(ji,jj,2,2,1,1) * zsigm11(ji,jj,1,1) - alambd(ji,jj,2,2,1,2) * zsigm11(ji,jj,1,2)  &
+                     &       - alambd(ji,jj,1,1,2,1) * zsigm12(ji,jj,2,1) - alambd(ji,jj,1,1,1,1) * zsigm12(ji,jj,1,1)  &
+                     &       + alambd(ji,jj,1,1,2,2) * zsigm12(ji,jj,2,2) + alambd(ji,jj,1,1,1,2) * zsigm12(ji,jj,1,2)  &
+                     &       + alambd(ji,jj,1,2,1,1) * zsigm21(ji,jj,1,1) + alambd(ji,jj,1,2,2,1) * zsigm21(ji,jj,2,1)  &
+                     &       + alambd(ji,jj,1,2,1,2) * zsigm21(ji,jj,1,2) + alambd(ji,jj,1,2,2,2) * zsigm21(ji,jj,2,2)  &
+                     &       - alambd(ji,jj,2,1,1,1) * zsigm22(ji,jj,1,1) - alambd(ji,jj,2,1,2,1) * zsigm22(ji,jj,2,1)  &
+                     &       - alambd(ji,jj,2,1,1,2) * zsigm22(ji,jj,1,2) - alambd(ji,jj,2,1,2,2) * zsigm22(ji,jj,2,2)
+
+                  zd2(ji,jj) = alambd(ji,jj,2,2,2,1) * zsigm21(ji,jj,2,1) + alambd(ji,jj,2,2,2,2) * zsigm21(ji,jj,2,2)  &
+                     &       - alambd(ji,jj,2,2,1,1) * zsigm21(ji,jj,1,1) - alambd(ji,jj,2,2,1,2) * zsigm21(ji,jj,1,2)  &
+                     &       - alambd(ji,jj,1,1,2,1) * zsigm22(ji,jj,2,1) - alambd(ji,jj,1,1,1,1) * zsigm22(ji,jj,1,1)  &
+                     &       + alambd(ji,jj,1,1,2,2) * zsigm22(ji,jj,2,2) + alambd(ji,jj,1,1,1,2) * zsigm22(ji,jj,1,2)  &
+                     &       - alambd(ji,jj,1,2,1,1) * zsigm11(ji,jj,1,1) - alambd(ji,jj,1,2,2,1) * zsigm11(ji,jj,2,1)  &
+                     &       - alambd(ji,jj,1,2,1,2) * zsigm11(ji,jj,1,2) - alambd(ji,jj,1,2,2,2) * zsigm11(ji,jj,2,2)  &
+                     &       + alambd(ji,jj,2,1,1,1) * zsigm12(ji,jj,1,1) + alambd(ji,jj,2,1,2,1) * zsigm12(ji,jj,2,1)  &
+                     &       + alambd(ji,jj,2,1,1,2) * zsigm12(ji,jj,1,2) + alambd(ji,jj,2,1,2,2) * zsigm12(ji,jj,2,2)
+               END DO
+            END DO
+
+            DO jj = njmin, njmax
+               DO ji = 2, jpim1
+                  zunw = (  ( za1(ji,jj) + zd1(ji,jj) ) * zc2(ji,jj)        &
+                     &    + ( za2(ji,jj) + zd2(ji,jj) ) * zc1(ji,jj) ) * zden(ji,jj)
+
+                  zvnw = (  ( za2(ji,jj) + zd2(ji,jj) ) * zb1(ji,jj)        &
+                     &    - ( za1(ji,jj) + zd1(ji,jj) ) * zb2(ji,jj) ) * zden(ji,jj)
+
+                  zmask = ( 1.0 - MAX( rzero, SIGN( rone , 1.0 - zmass(ji,jj) ) ) ) * tmu(ji,jj)
+
+                  u_ice(ji,jj) = ( u_ice(ji,jj) + om * ( zunw - u_ice(ji,jj) ) * tmu(ji,jj) ) * zmask
+                  v_ice(ji,jj) = ( v_ice(ji,jj) + om * ( zvnw - v_ice(ji,jj) ) * tmu(ji,jj) ) * zmask
+               END DO
+            END DO
+
+            CALL lbc_lnk( u_ice, 'I', -1. )
+            CALL lbc_lnk( v_ice, 'I', -1. )
+
+            !---  5.2.5.4. Convergence test.
+            DO jj = njmin , njmax
+               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ) , ABS( v_ice(:,jj) - zv_ice(:,jj) ) )
+            END DO
+            zresm = MAXVAL( zresr( 1:jpi , njmin:njmax ) )
+
+            IF ( zresm <= resl) EXIT iflag
+
+         END DO iflag
+
+         zindu1 = 1.0 - zindu
+         DO jj = njmm1 , njmax
+            zu0(:,jj) = zindu * zu0(:,jj) + zindu1 * u_ice(:,jj)
+            zv0(:,jj) = zindu * zv0(:,jj) + zindu1 * v_ice(:,jj)
+         END DO
+      !                                                   ! ==================== !
+      END DO                                              !  end loop over iter  !
+      !                                                   ! ==================== !
+
+      IF( l_ctl .AND. lwp ) THEN
+         WRITE(numout,*) ' lim_rhg  : res= ', zresm, 'iter= ', jter,' u_ice ', SUM( u_ice ) , ' v_ice ', SUM( v_ice )
+      ENDIF
+
+   END SUBROUTINE lim_rhg
+#else
+   !!==============================================================================
+   !!                       ***  MODULE limrhg   ***
+   !!                              No sea ice
+   !!==============================================================================
+CONTAINS
+   SUBROUTINE lim_rhg         ! Empty routine
+   END SUBROUTINE lim_rhg
+
+#endif
+
+END MODULE limrhg
Index: /branches/nemo/NEMO/LIM_SRC/limrst.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limrst.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limrst.F90	(revision 4)
@@ -0,0 +1,310 @@
+MODULE limrst
+   !!======================================================================
+   !!                     ***  MODULE  limrst  ***
+   !! Ice restart :  write the ice restart file
+   !!======================================================================
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim' :                                   LIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_rst_write   : write of the restart file 
+   !!   lim_rst_read    : read  the restart file 
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE in_out_manager
+   USE ice
+   USE ioipsl
+   USE dom_oce
+   USE ice_oce         ! ice variables
+   USE daymod
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC lim_rst_write  ! routine called by lim_step.F90
+   PUBLIC lim_rst_read   ! routine called by lim_init.F90
+
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+# if defined key_fdir
+   !!----------------------------------------------------------------------
+   !!   'key_fdir' :                                     direct access file
+   !!----------------------------------------------------------------------
+#  include "limrst_fdir.h90"
+
+# else
+   !!----------------------------------------------------------------------
+   !!   Default option                                          NetCDF file
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE lim_rst_write( niter )
+      !!----------------------------------------------------------------------
+      !!                    ***  lim_rst_write  ***
+      !!
+      !! ** purpose  :   output of sea-ice variable in a netcdf file
+      !!
+      !!----------------------------------------------------------------------
+      ! Arguments
+      INTEGER  ::    niter        ! number of iteration
+
+      !- dummy variables :
+      LOGICAL :: &
+         llbon
+      INTEGER :: &
+         ji, jj
+      INTEGER :: &
+         inumwrs, it0, itime
+      REAL(wp), DIMENSION(1) :: &
+         zdept
+      REAL(wp), DIMENSION(2) :: &
+         zinfo
+      REAL(wp),DIMENSION(jpi,jpj,35) :: &
+         zmoment
+      REAL(wp) :: &
+         zsec, zdate0, zdt
+
+      CHARACTER(len=45)  ::  &
+         ccfile = 'restart_ice_out.nc'
+
+      inumwrs  = 61
+      INQUIRE ( FILE = ccfile, EXIST = llbon )
+      IF( llbon ) THEN
+         OPEN ( UNIT = inumwrs , FILE = ccfile, STATUS = 'old' )
+         CLOSE( inumwrs , STATUS = 'delete' )
+      ENDIF
+
+
+      it0      = niter
+      zinfo(1) = FLOAT( nfice  )  ! coupling frequency OPA ICELLN  nfice
+      zinfo(2) = FLOAT( it0   )   ! iteration number
+
+      zsec     = 0.
+      itime    = 0
+      zdept(1) = 0.
+      zdt      = rdt_ice * nstock
+
+      ! Write in inumwrs
+
+      DO jj = 1, jpj              ! 3D array: 10 time faster than 35 restput
+         DO ji = 1, jpi
+            zmoment(ji,jj,1)  = sxice(ji,jj)
+            zmoment(ji,jj,2)  = syice(ji,jj)
+            zmoment(ji,jj,3)  = sxxice(ji,jj)
+            zmoment(ji,jj,4)  = syyice(ji,jj)
+            zmoment(ji,jj,5)  = sxyice(ji,jj)
+            zmoment(ji,jj,6)  = sxsn(ji,jj)
+            zmoment(ji,jj,7)  = sysn(ji,jj)
+            zmoment(ji,jj,8)  = sxxsn(ji,jj)
+            zmoment(ji,jj,9)  = syysn(ji,jj)
+            zmoment(ji,jj,10) = sxysn(ji,jj)
+            zmoment(ji,jj,11) = sxa(ji,jj)
+            zmoment(ji,jj,12) = sya(ji,jj)
+            zmoment(ji,jj,13) = sxxa(ji,jj)
+            zmoment(ji,jj,14) = syya(ji,jj)
+            zmoment(ji,jj,15) = sxya(ji,jj)
+            zmoment(ji,jj,16) = sxc0(ji,jj)
+            zmoment(ji,jj,17) = syc0(ji,jj)
+            zmoment(ji,jj,18) = sxxc0(ji,jj)
+            zmoment(ji,jj,19) = syyc0(ji,jj)
+            zmoment(ji,jj,20) = sxyc0(ji,jj)
+            zmoment(ji,jj,21) = sxc1(ji,jj)
+            zmoment(ji,jj,22) = syc1(ji,jj)
+            zmoment(ji,jj,23) = sxxc1(ji,jj)
+            zmoment(ji,jj,24) = syyc1(ji,jj)
+            zmoment(ji,jj,25) = sxyc1(ji,jj)
+            zmoment(ji,jj,26) = sxc2(ji,jj)
+            zmoment(ji,jj,27) = syc2(ji,jj)
+            zmoment(ji,jj,28) = sxxc2(ji,jj)
+            zmoment(ji,jj,29) = syyc2(ji,jj)
+            zmoment(ji,jj,30) = sxyc2(ji,jj)
+            zmoment(ji,jj,31) = sxst(ji,jj)
+            zmoment(ji,jj,32) = syst(ji,jj)
+            zmoment(ji,jj,33) = sxxst(ji,jj)
+            zmoment(ji,jj,34) = syyst(ji,jj)
+            zmoment(ji,jj,35) = sxyst(ji,jj)
+         END DO
+      END DO
+
+      CALL ymds2ju( nyear, nmonth, nday, zsec, zdate0 )
+      CALL restini( 'NONE', jpi, jpj, glamt, gphit, 1 , zdept, ccfile, itime, zdate0, zdt, inumwrs )
+      
+      CALL restput( inumwrs, 'info'   ,   1,   1, 2 , 0, zinfo   )  ! restart informations
+       
+      CALL restput( inumwrs, 'hicif'  , jpi, jpj, 1 , 0, hicif   )  ! prognostic variables 
+      CALL restput( inumwrs, 'hsnif'  , jpi, jpj, 1 , 0, hsnif   )
+      CALL restput( inumwrs, 'frld'   , jpi, jpj, 1 , 0, frld    )
+      CALL restput( inumwrs, 'sist'   , jpi, jpj, 1 , 0, sist    )
+# if defined key_coupled
+      CALL restput( inumwrs, 'albege' , jpi, jpj, 1 , 0, albege  )
+# endif
+      CALL restput( inumwrs, 'tbif'   , jpi, jpj, 3 , 0, tbif    )
+      CALL restput( inumwrs, 'u_ice'  , jpi, jpj, 1 , 0, u_ice   )
+      CALL restput( inumwrs, 'v_ice'  , jpi, jpj, 1 , 0, v_ice   )
+      CALL restput( inumwrs, 'gtaux'  , jpi, jpj, 1 , 0, gtaux  )
+      CALL restput( inumwrs, 'gtauy'  , jpi, jpj, 1 , 0, gtauy  )
+      CALL restput( inumwrs, 'qstoif' , jpi, jpj, 1 , 0, qstoif  )
+      CALL restput( inumwrs, 'fsbbq'  , jpi, jpj, 1 , 0, fsbbq   )
+      CALL restput( inumwrs, 'moment' , jpi, jpj, 35, 0, zmoment )
+
+      
+      CALL restclo( inumwrs )
+
+   END SUBROUTINE lim_rst_write
+
+
+   SUBROUTINE lim_rst_read( niter )
+      !-----------------------------------------------------------------------
+      !  restart from a state defined in a binary file
+      !-----------------------------------------------------------------------
+      ! Arguments
+      INTEGER  ::   niter        ! number of iteration
+
+      !- dummy variables :
+      CHARACTER(len=45)  ::  &
+         ccfile = 'restart_ice_in.nc'
+      INTEGER :: &
+        ji, jj
+      INTEGER :: &
+         inumrst, it0, it1, itime, ibvar, ifice
+      LOGICAL :: &
+         llbon, llog
+      REAL(wp),DIMENSION(jpi,jpj) :: &
+         zlamt, zphit
+      REAL(wp),DIMENSION(jpi,jpj,35) :: &
+         zmoment
+      REAL(wp),DIMENSION(1) :: &
+         zdept
+      REAL(wp),DIMENSION(2) :: &
+         zinfo
+      REAL(wp) :: &
+         zdate0, zdt
+      CHARACTER ( len = 10 ) ::  &
+         clvnames(60)       
+
+      !Read inumrst
+      INQUIRE ( FILE = ccfile , EXIST = llbon)
+      IF( .NOT. llbon ) THEN
+         IF(lwp)WRITE(numout,cform_err)
+         IF(lwp)WRITE(numout,*) 'lim_rst_read : ===>>>> : Le fichier restart ',ccfile,' n''existe pas'
+         nstop = nstop + 1
+      ENDIF
+
+      !Initialisations
+      inumrst    = 71
+      it0        = nit000
+      itime      = 0
+      llog       = .FALSE.
+      zlamt(:,:) = 0.
+      zphit(:,:) = 0.
+      zdept(1)   = 0.
+
+      CALL restini(ccfile , jpi, jpj, zlamt, zphit, 1 , zdept, ccfile, itime, zdate0, zdt, inumrst )      
+      CALL ioget_vname( inumrst, ibvar, clvnames )
+
+      CALL restget    ( inumrst,'info', 1, 1 , 2, 0, llog, zinfo )
+ 
+      ifice   = INT( zinfo(1) )
+      it1     = INT( zinfo(2) )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_rst_read : READ restart file name ', ccfile,' at time step : ', it1
+         WRITE(numout,*) '~~~~~~~~~~~~   number of variables   : ', ibvar
+         WRITE(numout,*) '               NetCDF variables      : ', clvnames(1:ibvar)
+      ENDIF
+
+      
+      !Control of date
+      
+      IF( ( it0 - it1 ) /= 1 .AND. ABS( nrstdt ) == 1 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'lim_rst_read ===>>>> : problem with nit000 for the restart'
+            WRITE(numout,*) '   we stop. verify the file or rerun with the value  0 for the'
+            WRITE(numout,*) '   control of time parameter  nrstdt'
+            nstop = nstop + 1
+         ENDIF
+      ENDIF
+
+      CALL restget( inumrst, 'hicif'  , jpi, jpj, 1 , 0, llog, hicif   )
+      CALL restget( inumrst, 'hsnif'  , jpi, jpj, 1 , 0, llog, hsnif   )
+      CALL restget( inumrst, 'frld'   , jpi, jpj, 1 , 0, llog, frld    )
+      CALL restget( inumrst, 'sist'   , jpi, jpj, 1 , 0, llog, sist    )
+# if defined key_coupled 
+      CALL restget( inumrst, 'albege' , jpi, jpj, 1 , 0, llog, albege  )
+# endif
+      CALL restget( inumrst, 'tbif'   , jpi, jpj, 3 , 0, llog, tbif    )
+      CALL restget( inumrst, 'u_ice'  , jpi, jpj, 1 , 0, llog, u_ice   )
+      CALL restget( inumrst, 'v_ice'  , jpi, jpj, 1 , 0, llog, v_ice   )
+      CALL restget( inumrst, 'gtaux'  , jpi, jpj, 1 , 0, llog, gtaux  )
+      CALL restget( inumrst, 'gtauy'  , jpi, jpj, 1 , 0, llog, gtauy  )
+      CALL restget( inumrst, 'qstoif' , jpi, jpj, 1 , 0, llog, qstoif  )
+      CALL restget( inumrst, 'fsbbq'  , jpi, jpj, 1 , 0, llog, fsbbq   )
+      CALL restget( inumrst, 'moment' , jpi, jpj, 35, 0, llog, zmoment )
+
+      CALL restclo( inumrst )
+
+      niter = it1
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            sxice(ji,jj)  = zmoment(ji,jj,1)
+            syice(ji,jj)  = zmoment(ji,jj,2)
+            sxxice(ji,jj) = zmoment(ji,jj,3)
+            syyice(ji,jj) = zmoment(ji,jj,4)
+            sxyice(ji,jj) = zmoment(ji,jj,5)
+            sxsn(ji,jj)   = zmoment(ji,jj,6)
+            sysn(ji,jj)   = zmoment(ji,jj,7)
+            sxxsn(ji,jj)  = zmoment(ji,jj,8)
+            syysn(ji,jj)  = zmoment(ji,jj,9)
+            sxysn(ji,jj)  = zmoment(ji,jj,10)
+            sxa(ji,jj)    = zmoment(ji,jj,11)
+            sya(ji,jj)    = zmoment(ji,jj,12)
+            sxxa(ji,jj)   = zmoment(ji,jj,13)
+            syya(ji,jj)   = zmoment(ji,jj,14)
+            sxya(ji,jj)   = zmoment(ji,jj,15)
+            sxc0(ji,jj)   = zmoment(ji,jj,16)
+            syc0(ji,jj)   = zmoment(ji,jj,17)
+            sxxc0(ji,jj)  = zmoment(ji,jj,18)
+            syyc0(ji,jj)  = zmoment(ji,jj,19)
+            sxyc0(ji,jj)  = zmoment(ji,jj,20)
+            sxc1(ji,jj)   = zmoment(ji,jj,21)
+            syc1(ji,jj)   = zmoment(ji,jj,22)
+            sxxc1(ji,jj)  = zmoment(ji,jj,23)
+            syyc1(ji,jj)  = zmoment(ji,jj,24)
+            sxyc1(ji,jj)  = zmoment(ji,jj,25)
+            sxc2(ji,jj)   = zmoment(ji,jj,26)
+            syc2(ji,jj)   = zmoment(ji,jj,27)
+            sxxc2(ji,jj)  = zmoment(ji,jj,28)
+            syyc2(ji,jj)  = zmoment(ji,jj,29)
+            sxyc2(ji,jj)  = zmoment(ji,jj,30)
+            sxst(ji,jj)   = zmoment(ji,jj,31)
+            syst(ji,jj)   = zmoment(ji,jj,32)
+            sxxst(ji,jj)  = zmoment(ji,jj,33)
+            syyst(ji,jj)  = zmoment(ji,jj,34)
+            sxyst(ji,jj)  = zmoment(ji,jj,35)
+         END DO
+      END DO
+
+      
+   END SUBROUTINE lim_rst_read
+
+# endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :       Empty module            NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_rst_read             ! Empty routine
+   END SUBROUTINE lim_rst_read
+   SUBROUTINE lim_rst_write            ! Empty routine
+   END SUBROUTINE lim_rst_write
+#endif
+
+   !!======================================================================
+END MODULE limrst
Index: /branches/nemo/NEMO/LIM_SRC/limrst_fdir.h90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limrst_fdir.h90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limrst_fdir.h90	(revision 4)
@@ -0,0 +1,206 @@
+   !!----------------------------------------------------------------------
+   !!                     *** limrst_fdir.h90  ***
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE lim_rst_write( niter )
+      !!-----------------------------------------------------------------------
+      !!  output of binary files
+      !!-----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER  ::   niter        ! number of iteration
+
+      !- dummy variables :
+      CHARACTER(len=45)  ::  &
+         ccfile = 'restart_ice_out'
+      INTEGER :: &
+         ji, jj
+      INTEGER :: &
+         inumwrs, it0
+      REAL(wp),DIMENSION(jpi,jpj,35) :: &
+         zmoment
+      REAL(wp),DIMENSION(2) :: &
+         zinfo
+      !!-----------------------------------------------------------------------
+           
+      inumwrs     =  61
+      OPEN ( UNIT = inumwrs , FILE = ccfile, STATUS = 'unknown', FORM='unformatted' )
+
+      it0      = niter
+      
+      zinfo(1) = FLOAT( nfice )   ! iteration number
+      zinfo(2) = FLOAT( it0 )        ! time-step in second
+
+      ! Write in inumwrs
+
+      zmoment(:,:,1)  = sxice (:,:)
+      zmoment(:,:,2)  = syice (:,:)
+      zmoment(:,:,3)  = sxxice(:,:)
+      zmoment(:,:,4)  = syyice(:,:)
+      zmoment(:,:,5)  = sxyice(:,:)
+      zmoment(:,:,6)  = sxsn  (:,:)
+      zmoment(:,:,7)  = sysn  (:,:)
+      zmoment(:,:,8)  = sxxsn (:,:)
+      zmoment(:,:,9)  = syysn (:,:)
+      zmoment(:,:,10) = sxysn (:,:)
+      zmoment(:,:,11) = sxa   (:,:)
+      zmoment(:,:,12) = sya   (:,:)
+      zmoment(:,:,13) = sxxa  (:,:)
+      zmoment(:,:,14) = syya  (:,:)
+      zmoment(:,:,15) = sxya  (:,:)
+      zmoment(:,:,16) = sxc0  (:,:)
+      zmoment(:,:,17) = syc0  (:,:)
+      zmoment(:,:,18) = sxxc0 (:,:)
+      zmoment(:,:,19) = syyc0 (:,:)
+      zmoment(:,:,20) = sxyc0 (:,:)
+      zmoment(:,:,21) = sxc1  (:,:)
+      zmoment(:,:,22) = syc1  (:,:)
+      zmoment(:,:,23) = sxxc1 (:,:)
+      zmoment(:,:,24) = syyc1 (:,:)
+      zmoment(:,:,25) = sxyc1 (:,:)
+      zmoment(:,:,26) = sxc2  (:,:)
+      zmoment(:,:,27) = syc2  (:,:)
+      zmoment(:,:,28) = sxxc2 (:,:)
+      zmoment(:,:,29) = syyc2 (:,:)
+      zmoment(:,:,30) = sxyc2 (:,:)
+      zmoment(:,:,31) = sxst  (:,:)
+      zmoment(:,:,32) = syst  (:,:)
+      zmoment(:,:,33) = sxxst (:,:)
+      zmoment(:,:,34) = syyst (:,:)
+      zmoment(:,:,35) = sxyst (:,:)
+
+      WRITE(inumwrs)  zinfo          ! restart informations
+
+      WRITE(inumwrs)  hicif          ! prognostic variables
+      WRITE(inumwrs)  hsnif
+      WRITE(inumwrs)  frld
+      WRITE(inumwrs)  sist
+# if defined key_coupled 
+      WRITE(inumwrs)  albege
+# endif
+      WRITE(inumwrs)  tbif
+      WRITE(inumwrs)  u_ice
+      WRITE(inumwrs)  v_ice
+      WRITE(inumwrs)  gtaux
+      WRITE(inumwrs)  gtauy
+      WRITE(inumwrs)  qstoif
+      WRITE(inumwrs)  fsbbq
+      WRITE(inumwrs)  zmoment
+ 
+      CLOSE(inumwrs)
+      
+   END SUBROUTINE lim_rst_write
+
+
+   SUBROUTINE lim_rst_read(niter )
+      !!-----------------------------------------------------------------------
+      !!  restart from a state defined in a binary file
+      !!-----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER  ::   niter        ! number of iteration
+
+      !- dummy variables :
+      CHARACTER(len=45)  ::  &
+         ccfile = 'restart_ice.in'
+
+      INTEGER :: &
+         ji, jj
+      INTEGER :: &
+         inumrst, it0, it1, ifice
+      REAL(wp),DIMENSION(jpi,jpj,35) :: &
+          zmoment
+      REAL(wp),DIMENSION(2) :: &
+         zinfo
+      !!-----------------------------------------------------------------------
+
+      !Initialisations
+      inumrst      = 71
+
+      !Read inumrst
+      OPEN( UNIT = inumrst, FILE = ccfile, STATUS = 'old', FORM = 'unformatted')
+
+      it0          = nit000
+
+      READ(inumrst)  zinfo          ! restart informations
+
+      ifice   = INT( zinfo(1) )
+      it1     = INT( zinfo(2) )
+
+      WRITE(numout,*)
+      WRITE(numout,*) 'lim_rst_fdir :  READ restart file name ', ccfile, ' at time step : ', it1
+      WRITE(numout,*) '~~~~~~~~~~~~'
+
+
+      !Control of date
+      
+      IF( ( it0 - it1 ) /= 1 .AND. ABS( nrstdt ) == 1 ) THEN
+         WRITE(numout,cform_err)
+         WRITE(numout,*) ' ===>>>> : problem with nit000 for the restart'
+         WRITE(numout,*) ' we stop. verify the file or rerun with the value  0 for the'
+         WRITE(numout,*) ' control of time parameter  nrstdt'
+         nstop = nstop + 1
+      ENDIF
+
+
+      READ(inumrst)  hicif    ! prognostic variables
+      READ(inumrst)  hsnif
+      READ(inumrst)  frld
+      READ(inumrst)  sist
+# if defined key_coupled
+      READ(inumrst)  albege
+# endif
+      READ(inumrst)  tbif
+      READ(inumrst)  u_ice
+      READ(inumrst)  v_ice
+      READ(inumrst)  gtaux
+      READ(inumrst)  gtauy
+      READ(inumrst)  qstoif
+      READ(inumrst)  fsbbq
+      READ(inumrst)  zmoment
+ 
+      CLOSE(inumrst)
+
+      niter = it1
+      tsec  = ztotsec 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            sxice(ji,jj)  = zmoment(ji,jj,1)
+            syice(ji,jj)  = zmoment(ji,jj,2)
+            sxxice(ji,jj) = zmoment(ji,jj,3)
+            syyice(ji,jj) = zmoment(ji,jj,4)
+            sxyice(ji,jj) = zmoment(ji,jj,5)
+            sxsn(ji,jj)   = zmoment(ji,jj,6)
+            sysn(ji,jj)   = zmoment(ji,jj,7)
+            sxxsn(ji,jj)  = zmoment(ji,jj,8)
+            syysn(ji,jj)  = zmoment(ji,jj,9)
+            sxysn(ji,jj)  = zmoment(ji,jj,10)
+            sxa(ji,jj)    = zmoment(ji,jj,11)
+            sya(ji,jj)    = zmoment(ji,jj,12)
+            sxxa(ji,jj)   = zmoment(ji,jj,13)
+            syya(ji,jj)   = zmoment(ji,jj,14)
+            sxya(ji,jj)   = zmoment(ji,jj,15)
+            sxc0(ji,jj)   = zmoment(ji,jj,16)
+            syc0(ji,jj)   = zmoment(ji,jj,17)
+            sxxc0(ji,jj)  = zmoment(ji,jj,18)
+            syyc0(ji,jj)  = zmoment(ji,jj,19)
+            sxyc0(ji,jj)  = zmoment(ji,jj,20)
+            sxc1(ji,jj)   = zmoment(ji,jj,21)
+            syc1(ji,jj)   = zmoment(ji,jj,22)
+            sxxc1(ji,jj)  = zmoment(ji,jj,23)
+            syyc1(ji,jj)  = zmoment(ji,jj,24)
+            sxyc1(ji,jj)  = zmoment(ji,jj,25)
+            sxc2(ji,jj)   = zmoment(ji,jj,26)
+            syc2(ji,jj)   = zmoment(ji,jj,27)
+            sxxc2(ji,jj)  = zmoment(ji,jj,28)
+            syyc2(ji,jj)  = zmoment(ji,jj,29)
+            sxyc2(ji,jj)  = zmoment(ji,jj,30)
+            sxst(ji,jj)   = zmoment(ji,jj,31)
+            syst(ji,jj)   = zmoment(ji,jj,32)
+            sxxst(ji,jj)  = zmoment(ji,jj,33)
+            syyst(ji,jj)  = zmoment(ji,jj,34)
+            sxyst(ji,jj)  = zmoment(ji,jj,35)
+         END DO
+      END DO
+      
+   END SUBROUTINE lim_rst_read
Index: /branches/nemo/NEMO/LIM_SRC/limtab.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limtab.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limtab.F90	(revision 4)
@@ -0,0 +1,78 @@
+MODULE limtab
+   !!======================================================================
+   !!                       ***  MODULE limtab   ***
+   !!              transform 1D (2D) array to a 2D (1D) table
+   !!======================================================================
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   tab_2d_1d  : 2-D to 1-D
+   !!   tab_1d_2d  : 1-D to 2-D
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tab_2d_1d  ! called by lim_ther
+   PUBLIC tab_1d_2d  ! called by lim_ther
+
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tab_2d_1d ( ndim1d, tab1d, tab2d, ndim2d_x, ndim2d_y, tab_ind )
+
+      INTEGER, INTENT(in) :: &
+         ndim1d, ndim2d_x, ndim2d_y
+
+      REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT(in) ::  &
+         tab2d
+
+      INTEGER, DIMENSION ( ndim1d), INTENT ( in) :: &
+         tab_ind
+
+      REAL(wp), DIMENSION(ndim1d), INTENT ( out) ::  & 
+         tab1d
+
+      INTEGER ::  &
+         jn , jid, jjd
+        
+      DO jn = 1, ndim1d
+         jid        = MOD( tab_ind(jn) - 1, ndim2d_x ) + 1
+         jjd        = ( tab_ind(jn) - 1 ) / ndim2d_x + 1
+         tab1d( jn) = tab2d( jid, jjd)
+      END DO 
+
+   END SUBROUTINE tab_2d_1d
+
+
+   SUBROUTINE tab_1d_2d ( ndim1d, tab2d, tab_ind, tab1d, ndim2d_x, ndim2d_y )
+
+      INTEGER, INTENT ( in) :: &
+         ndim1d, ndim2d_x, ndim2d_y
+
+      INTEGER, DIMENSION (ndim1d) , INTENT (in) :: &
+         tab_ind
+
+      REAL(wp), DIMENSION(ndim1d), INTENT (in) ::  &
+         tab1d  
+
+      REAL(wp), DIMENSION (ndim2d_x, ndim2d_y), INTENT ( out) :: &
+         tab2d
+
+      INTEGER :: &
+         jn, jid, jjd
+
+      DO jn = 1, ndim1d
+         jid             = MOD( tab_ind(jn) - 1, ndim2d_x) + 1
+         jjd             =    ( tab_ind(jn) - 1 ) / ndim2d_x  + 1
+         tab2d(jid, jjd) = tab1d( jn)
+      END DO
+
+   END SUBROUTINE tab_1d_2d
+
+#endif
+END MODULE limtab
Index: /branches/nemo/NEMO/LIM_SRC/limthd.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limthd.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limthd.F90	(revision 4)
@@ -0,0 +1,466 @@
+MODULE limthd
+   !!======================================================================
+   !!                  ***  MODULE limthd   ***
+   !!              LIM thermo ice model : ice thermodynamic
+   !!======================================================================
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim' :                                   LIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_thd      : thermodynamic of sea ice
+   !!   lim_thd_init : initialisation of sea-ice thermodynamic
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE phycst          ! physical constants
+   USE dom_oce         ! ocean space and time domain variables
+   USE lbclnk
+   USE in_out_manager  ! I/O manager
+
+   USE ice             ! LIM sea-ice variables
+   USE ice_oce         ! sea-ice/ocean variables
+   USE flx_oce         ! sea-ice/ocean forcings variables 
+   USE thd_ice         ! LIM thermodynamic sea-ice variables
+   USE dom_ice         ! LIM sea-ice domain
+   USE iceini
+   USE limthd_zdf
+   USE limthd_lac
+   USE limtab
+      
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC lim_thd       ! called by lim_step
+
+  !! * Module variables
+     REAL(wp)  ::            &  ! constant values
+         epsi20 = 1e-20   ,  &
+         epsi16 = 1e-16   ,  &
+         epsi04 = 1e-04   ,  &
+         zzero  = 0.0     ,  &
+         zone   = 1.0
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!-------- -------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_thd
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE lim_thd  ***       
+      !!  
+      !! ** Purpose : This routine manages the ice thermodynamic.
+      !!         
+      !! ** Action : - Initialisation of some variables
+      !!             - Some preliminary computation (oceanic heat flux
+      !!               at the ice base, snow acc.,heat budget of the leads)
+      !!             - selection of the icy points and put them in an array
+      !!             - call lim_vert_ther for vert ice thermodynamic
+      !!             - back to the geographic grid
+      !!             - selection of points for lateral accretion
+      !!             - call lim_lat_acc  for the ice accretion
+      !!             - back to the geographic grid
+      !!     
+      !!
+      !! ** References :
+      !!       H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90
+      !!
+      !! History :
+      !!   1.0  !  00-01 (LIM)
+      !!   2.0  !  02-07 (C. Ethe, G. Madec) F90
+      !!---------------------------------------------------------------------
+      !! * Local variables
+      INTEGER  ::   ji, jj,    &   ! dummy loop indices
+         nbpb  ,               &   ! nb of icy pts for thermo. cal.
+         nbpac                     ! nb of pts for lateral accretion 
+
+      REAL(wp) ::  &
+         zfric_umin = 5e-03 ,  &   ! lower bound for the friction velocity
+         zfric_umax = 2e-02        ! upper bound for the friction velocity
+      
+      REAL(wp) ::   &
+         zinda              ,  &   ! switch for test. the val. of concen.
+         zindb, zindg       ,  &   ! switches for test. the val of arg
+         za , zh, zthsnice  ,  &
+         zfric_u            ,  &   ! friction velocity 
+         zfnsol             ,  &   ! total non solar heat
+         zfontn             ,  &   ! heat flux from snow thickness
+         zfntlat, zpareff          ! test. the val. of lead heat budget
+      
+      REAL(wp), DIMENSION(jpi,jpj) :: &
+         zhicifp            ,  &   ! ice thickness for outputs
+         zqlbsbq                   ! link with lead energy budget qldif
+      !!-------------------------------------------------------------------
+
+      IF( numit == nstart  )   CALL lim_thd_init  ! Initialization (first time-step only)
+   
+      !-------------------------------------------!
+      !   Initilization of diagnostic variables   !
+      !-------------------------------------------!
+      
+!i est-ce utile?  oui au moins en partie
+      rdvosif(:,:) = 0.0   ! variation of ice volume at surface
+      rdvobif(:,:) = 0.0   ! variation of ice volume at bottom
+      fdvolif(:,:) = 0.0   ! total variation of ice volume
+      rdvonif(:,:) = 0.0   ! lateral variation of ice volume
+      fstric (:,:) = 0.0   ! part of solar radiation absorbing inside the ice
+      fscmbq (:,:) = 0.0   ! linked with fstric
+      ffltbif(:,:) = 0.0   ! linked with fstric
+      qfvbq  (:,:) = 0.0   ! linked with fstric
+      rdmsnif(:,:) = 0.0   ! variation of snow mass per unit area
+      rdmicif(:,:) = 0.0   ! variation of ice mass per unit area
+      hicifp (:,:) = 0.0   ! daily thermodynamic ice production. 
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            hsnif(ji,jj)  = hsnif(ji,jj) *  MAX( zzero, SIGN( zone , hsnif(ji,jj) - epsi04 ) )
+         END DO
+      END DO
+      IF( l_ctl .AND. lwp )   WRITE(numout,*) 'lim_thd  : ', SUM( hsnif(:,:) ) , ' hsnif'
+      
+      
+      !-----------------------------------!
+      !   Treatment of particular cases   !
+      !-----------------------------------!
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !  snow is transformed into ice if the original ice cover disappears.
+            zindg         = tms(ji,jj) *  MAX( zzero , SIGN( zone , -hicif(ji,jj) ) )
+            hicif(ji,jj)  = hicif(ji,jj) + zindg * rhosn * hsnif(ji,jj) / rau0
+            hsnif(ji,jj)  = ( zone - zindg ) * hsnif(ji,jj) + zindg * hicif(ji,jj) * ( rau0 - rhoic ) / rhosn
+            dmgwi(ji,jj)  = zindg * (1.0 - frld(ji,jj)) * rhoic * hicif(ji,jj)   ! snow/ice mass
+            
+            !  the lead fraction, frld, must be little than or equal to amax (ice ridging).
+            zthsnice      = hsnif(ji,jj) + hicif(ji,jj)
+            zindb         = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - zthsnice ) ) ) 
+            za            = zindb * MIN( zone, ( 1.0 - frld(ji,jj) ) * uscomi )
+            hsnif (ji,jj) = hsnif(ji,jj)  * za
+            hicif (ji,jj) = hicif(ji,jj)  * za
+            qstoif(ji,jj) = qstoif(ji,jj) * za
+            frld  (ji,jj) = 1.0 - zindb * ( 1.0 - frld(ji,jj) ) / MAX( za , epsi20 )
+            
+            !  the in situ ice thickness, hicif, must be equal to or greater than hiclim.
+            zh            = MAX( zone , zindb * hiclim  / MAX( hicif(ji,jj) , epsi20 ) )
+            hsnif (ji,jj) = hsnif(ji,jj)  * zh
+            hicif (ji,jj) = hicif(ji,jj)  * zh
+            qstoif(ji,jj) = qstoif(ji,jj) * zh
+            frld  (ji,jj) = ( frld(ji,jj) + ( zh - 1.0 ) ) / zh
+         END DO
+      END DO
+      IF( l_ctl .AND. lwp ) THEN
+         WRITE(numout,*) 'lim_thd: hicif : ', SUM( hicif ), ' hsnif  ', SUM( hsnif  )
+         WRITE(numout,*) 'lim_thd: dmgwi : ', SUM( dmgwi ), ' qstoif ', SUM( qstoif )
+         WRITE(numout,*) 'lim_thd: frld  : ', SUM( frld  )
+      ENDIF
+
+      
+      !-------------------------------!
+      !   Thermodynamics of sea ice   !
+      !-------------------------------!
+      
+      !      Partial computation of forcing for the thermodynamic sea ice model.
+      !--------------------------------------------------------------------------
+
+      !CDIR NOVERRCHK
+      DO jj = 1, jpj
+         !CDIR NOVERRCHK
+         DO ji = 1, jpi
+            zthsnice       = hsnif(ji,jj) + hicif(ji,jj)
+            zindb          = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - zthsnice ) ) ) 
+            pfrld(ji,jj)   = frld(ji,jj)
+            zinda          = 1.0 - MAX( zzero , SIGN( zone , - ( 1.0 - pfrld(ji,jj) ) ) )
+            
+            !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
+            thcm(ji,jj)    = 0.0 
+            
+            !  net downward heat flux from the ice to the ocean, expressed as a function of ocean 
+            !  temperature and turbulent mixing (McPhee, 1992)
+            zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin )  ! friction velocity
+            fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( sst_io(ji,jj) - tfu(ji,jj) ) 
+            qdtcn(ji,jj)  = zindb * fdtcn(ji,jj) * frld(ji,jj) * rdt_ice
+                        
+            !  partial computation of the lead energy budget (qldif)
+            zfontn         = ( sprecip(ji,jj) / rhosn ) * xlsn  !   energy for melting
+            zfnsol         = qnsr_oce(ji,jj)  !  total non solar flux
+            qldif(ji,jj)   = tms(ji,jj) * ( qsr_oce(ji,jj) * ( 1.0 - thcm(ji,jj) )   &
+               &                               + zfnsol + fdtcn(ji,jj) - zfontn     &
+               &                               + ( 1.0 - zindb ) * fsbbq(ji,jj) )   &
+               &                               * frld(ji,jj) * rdt_ice    
+            !  parlat : percentage of energy used for lateral ablation (0.0) 
+            zfntlat        = 1.0 - MAX( zzero , SIGN( zone ,  - qldif(ji,jj) ) )
+            zpareff        = 1.0 + ( parlat - 1.0 ) * zinda * zfntlat
+            zqlbsbq(ji,jj) = qldif(ji,jj) * ( 1.0 - zpareff ) / MAX( (1.0 - frld(ji,jj)) * rdt_ice , epsi16 )
+            qldif  (ji,jj) = zpareff *  qldif(ji,jj)
+            qdtcn  (ji,jj) = zpareff * qdtcn(ji,jj)
+            
+            !  energy needed to bring ocean surface layer until its freezing
+            qcmif  (ji,jj) =  rau0 * rcp * dz * ( tfu(ji,jj) - sst_io(ji,jj) ) * ( 1 - zinda )
+            
+            !  calculate oceanic heat flux.
+            fbif   (ji,jj) = zindb * (  fsbbq(ji,jj) / MAX( (1.0 - frld(ji,jj)) , epsi20 ) + fdtcn(ji,jj) )
+            
+            ! computation of the daily thermodynamic ice production (only needed for output)
+            zhicifp(ji,jj) = hicif(ji,jj) * ( 1.0 - frld(ji,jj) )
+         END DO
+      END DO
+      
+      
+      !         Select icy points and fulfill arrays for the vectorial grid.
+      !----------------------------------------------------------------------
+      nbpb = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF ( frld(ji,jj) < 1.0 ) THEN     
+               nbpb      = nbpb + 1
+               npb(nbpb) = (jj - 1) * jpi + ji
+            ENDIF
+         END DO
+      END DO
+      IF( l_ctl .AND. lwp ) THEN
+         WRITE(numout,*) 'lim_thd: pfrld ', SUM( pfrld  ), ' thcm    ', SUM( thcm    )
+         WRITE(numout,*) 'lim_thd: fdtcn ', SUM( fdtcn  ), ' qdtcn   ', SUM( qdtcn   )
+         WRITE(numout,*) 'lim_thd: qldif ', SUM( qldif  ), ' zqlbsbq ', SUM( zqlbsbq )
+         WRITE(numout,*) 'lim_thd: qcmif ', SUM( qcmif  ), ' fbif    ', SUM( fbif    )
+         WRITE(numout,*) 'lim_thd: qcmif ', SUM( qcmif*tms )
+         WRITE(numout,*) 'lim_thd: zhicifp', SUM( zhicifp )
+         WRITE(numout,*) 'limthd : nbpb = ', nbpb
+      ENDIF
+      
+      
+      ! If there is no ice, do nothing. Otherwise, compute Top and Bottom accretion/ablation 
+      !------------------------------------------------------------------------------------ 
+
+      IF ( nbpb > 0) THEN
+         
+         !  put the variable in a 1-D array for thermodynamics process
+         CALL tab_2d_1d( nbpb, frld_1d    (1:nbpb)     , frld       , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, h_ice_1d   (1:nbpb)     , hicif      , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, h_snow_1d  (1:nbpb)     , hsnif      , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sist_1d    (1:nbpb)     , sist       , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, tbif_1d    (1:nbpb , 1 ), tbif(:,:,1), jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, tbif_1d    (1:nbpb , 2 ), tbif(:,:,2), jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, tbif_1d    (1:nbpb , 3 ), tbif(:,:,3), jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb)     , qsr_ice    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb)     , fr1_i0     , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb)     , fr2_i0     , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb)     , qnsr_ice   , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb)     , qla_ice    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb)     , dqla_ice   , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb)     , dqns_ice   , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, tfu_1d     (1:nbpb)     , tfu        , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, sprecip_1d (1:nbpb)     , sprecip    , jpi, jpj, npb(1:nbpb) ) 
+         CALL tab_2d_1d( nbpb, fbif_1d    (1:nbpb)     , fbif       , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, thcm_1d    (1:nbpb)     , thcm       , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qldif_1d   (1:nbpb)     , qldif      , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qstbif_1d  (1:nbpb)     , qstoif     , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, rdmicif_1d (1:nbpb)     , rdmicif    , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, dmgwi_1d   (1:nbpb)     , dmgwi      , jpi, jpj, npb(1:nbpb) )
+         CALL tab_2d_1d( nbpb, qlbbq_1d   (1:nbpb)     , zqlbsbq    , jpi, jpj, npb(1:nbpb) )
+ 
+
+         
+         !  call the ice growth routine.
+         CALL lim_thd_zdf( 1, nbpb ) 
+         
+         !  back to the geographic grid.
+         CALL tab_1d_2d( nbpb, frld       , npb, frld_1d   (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hicif      , npb, h_ice_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, hsnif      , npb, h_snow_1d (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, sist       , npb, sist_1d   (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, tbif(:,:,1), npb, tbif_1d   (1:nbpb , 1 ), jpi, jpj )   
+         CALL tab_1d_2d( nbpb, tbif(:,:,2), npb, tbif_1d   (1:nbpb , 2 ), jpi, jpj )   
+         CALL tab_1d_2d( nbpb, tbif(:,:,3), npb, tbif_1d   (1:nbpb , 3 ), jpi, jpj )   
+         CALL tab_1d_2d( nbpb, fscmbq     , npb, fscbq_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, ffltbif    , npb, fltbif_1d (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, fstric     , npb, fstbif_1d (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, qldif      , npb, qldif_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, qfvbq      , npb, qfvbq_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, qstoif     , npb, qstbif_1d (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, rdmicif    , npb, rdmicif_1d(1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, dmgwi      , npb, dmgwi_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, rdmsnif    , npb, rdmsnif_1d(1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, rdvosif    , npb, dvsbq_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, rdvobif    , npb, dvbbq_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, fdvolif    , npb, dvlbq_1d  (1:nbpb)     , jpi, jpj )
+         CALL tab_1d_2d( nbpb, rdvonif    , npb, dvnbq_1d  (1:nbpb)     , jpi, jpj ) 
+
+ 
+      ENDIF
+
+      
+      !      Up-date sea ice thickness.
+      !---------------------------------
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            phicif(ji,jj) = hicif(ji,jj)  
+            hicif(ji,jj)  = hicif(ji,jj) *  ( zone -  MAX( zzero, SIGN( zone, - ( 1.0 - frld(ji,jj) ) ) ) )
+         END DO
+      END DO
+
+      
+      !      Tricky trick : add 2 to frld in the Southern Hemisphere.
+      !----------------------------------------------------------
+      DO jj = 1, jeqm1      !ibug in mpp
+         DO ji = 1, jpi
+            frld(ji,jj) = frld(ji,jj) + 2.0
+         END DO
+      END DO
+      
+      
+      !     Select points for lateral accretion (this occurs when heat exchange
+      !     between ice and ocean is negative; ocean losing heat) 
+      !-----------------------------------------------------------------
+      nbpac = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+!i yes!     IF ( ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.0 ) THEN
+            IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.0 ) THEN
+               nbpac = nbpac + 1
+               npac( nbpac ) = (jj - 1) * jpi + ji
+            ENDIF
+         END DO
+      END DO
+      
+      IF( l_ctl .AND. lwp ) THEN
+         WRITE(numout,*) 'lim_thd : phicif ', SUM( phicif ), ' hicif ', SUM( hicif )
+         WRITE(numout,*) 'lim_thd : nbpac = ', nbpac
+      ENDIF
+
+      
+      !
+      !     If ocean gains heat do nothing ; otherwise, one performs lateral accretion
+      !--------------------------------------------------------------------------------
+
+      IF ( nbpac > 0 ) THEN
+         
+         !...Put the variable in a 1-D array for lateral accretion
+        CALL tab_2d_1d( nbpac, frld_1d   (1:nbpac)     , frld       , jpi, jpj, npac(1:nbpac) )
+        CALL tab_2d_1d( nbpac, h_snow_1d (1:nbpac)     , hsnif      , jpi, jpj, npac(1:nbpac) )
+        CALL tab_2d_1d( nbpac, h_ice_1d  (1:nbpac)     , hicif      , jpi, jpj, npac(1:nbpac) )
+        CALL tab_2d_1d( nbpac, tbif_1d   (1:nbpac , 1 ), tbif(:,:,1), jpi, jpj, npac(1:nbpac) )   
+        CALL tab_2d_1d( nbpac, tbif_1d   (1:nbpac , 2 ), tbif(:,:,2), jpi, jpj, npac(1:nbpac) )   
+        CALL tab_2d_1d( nbpac, tbif_1d   (1:nbpac , 3 ), tbif(:,:,3), jpi, jpj, npac(1:nbpac) )   
+        CALL tab_2d_1d( nbpac, qldif_1d  (1:nbpac)     , qldif      , jpi, jpj, npac(1:nbpac) )
+        CALL tab_2d_1d( nbpac, qcmif_1d  (1:nbpac)     , qcmif      , jpi, jpj, npac(1:nbpac) )
+        CALL tab_2d_1d( nbpac, qstbif_1d (1:nbpac)     , qstoif     , jpi, jpj, npac(1:nbpac) )
+        CALL tab_2d_1d( nbpac, rdmicif_1d(1:nbpac)     , rdmicif    , jpi, jpj, npac(1:nbpac) )
+        CALL tab_2d_1d( nbpac, dvlbq_1d  (1:nbpac)     , fdvolif    , jpi, jpj, npac(1:nbpac) )
+        CALL tab_2d_1d( nbpac, tfu_1d    (1:nbpac)     , tfu        , jpi, jpj, npac(1:nbpac) )
+        
+        !  call lateral accretion routine.
+        CALL lim_thd_lac( 1 , nbpac )
+        
+        !   back to the geographic grid
+        CALL tab_1d_2d( nbpac, frld       , npac(1:nbpac), frld_1d   (1:nbpac)     , jpi, jpj )
+        CALL tab_1d_2d( nbpac, hsnif      , npac(1:nbpac), h_snow_1d (1:nbpac)     , jpi, jpj )
+        CALL tab_1d_2d( nbpac, hicif      , npac(1:nbpac), h_ice_1d  (1:nbpac)     , jpi, jpj )
+        CALL tab_1d_2d( nbpac, tbif(:,:,1), npac(1:nbpac), tbif_1d   (1:nbpac , 1 ), jpi, jpj )
+        CALL tab_1d_2d( nbpac, tbif(:,:,2), npac(1:nbpac), tbif_1d   (1:nbpac , 2 ), jpi, jpj )
+        CALL tab_1d_2d( nbpac, tbif(:,:,3), npac(1:nbpac), tbif_1d   (1:nbpac , 3 ), jpi, jpj )
+        CALL tab_1d_2d( nbpac, qstoif     , npac(1:nbpac), qstbif_1d (1:nbpac)     , jpi, jpj )
+        CALL tab_1d_2d( nbpac, rdmicif    , npac(1:nbpac), rdmicif_1d(1:nbpac)     , jpi, jpj )
+        CALL tab_1d_2d( nbpac, fdvolif    , npac(1:nbpac), dvlbq_1d  (1:nbpac)     , jpi, jpj )
+
+        
+       ENDIF
+       
+       
+       !      Recover frld values between 0 and 1 in the Southern Hemisphere (tricky trick)
+       !      Update daily thermodynamic ice production.    
+       !------------------------------------------------------------------------------
+       
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            frld  (ji,jj) = MIN( frld(ji,jj), ABS( frld(ji,jj) - 2.0 ) )
+            hicifp(ji,jj) =  hicif(ji,jj) * ( 1.0 - frld(ji,jj) ) - zhicifp(ji,jj) + hicifp(ji,jj)
+         END DO
+      END DO
+
+      IF( l_ctl .AND. lwp ) THEN
+         WRITE(numout,*) ' lim_thd  end  '
+         WRITE(numout,*) '  hicif ', SUM( hicif  ), '  hsnif ', SUM( hsnif  )
+         WRITE(numout,*) '  frld  ', SUM( frld   ), '  hicifp', SUM( hicifp )
+         WRITE(numout,*) '  phicif', SUM( phicif ), '  pfrld ', SUM( pfrld  )
+         WRITE(numout,*) '  sist  ', SUM( sist   ), '  tbif 1', SUM( tbif  (:,:,1) )
+         WRITE(numout,*) '  tbif 2', SUM( tbif(:,:,2) ), '  tbif 3', SUM( tbif  (:,:,3) )
+         WRITE(numout,*) '  fdtcn ', SUM( fdtcn  ), ' qdtcn ', SUM( qdtcn )
+         WRITE(numout,*) '  qstoif', SUM( qstoif ), '  fsbbq ', SUM( fsbbq  )
+      ENDIF
+
+    END SUBROUTINE lim_thd
+
+    SUBROUTINE lim_thd_init
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_init *** 
+      !!                 
+      !! ** Purpose :   Physical constants and parameters linked to the ice 
+      !!      thermodynamics
+      !!
+      !! ** Method  :   Read the namicethd namelist and check the ice-thermo
+      !!       parameter values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicether
+      !!
+      !! history :
+      !!  8.5  ! 03-08 (C. Ethe) original code
+      !!-------------------------------------------------------------------
+      NAMELIST/namicethd/ hmelt , hiccrit, hicmin, hiclim, amax  ,        &
+         &                swiqst, sbeta  , parlat, hakspl, hibspl, exld,  &
+         &                hakdif, hnzst  , thth  , parsub, alphs
+      !!-------------------------------------------------------------------
+      
+
+      ! Define the initial parameters
+      ! -------------------------
+      REWIND( numnam_ice )
+      READ  ( numnam_ice , namicethd )
+      IF (lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'lim_thd_init : ice parameters for ice thermodynamic computation '
+         WRITE(numout,*)'~~~~~~~~~~~~'
+         WRITE(numout,*)'   maximum melting at the bottom                           hmelt        = ', hmelt
+         WRITE(numout,*)'   ice thick. for lateral accretion in NH (SH)             hiccrit(1/2) = ', hiccrit
+         WRITE(numout,*)'   ice thick. corr. to max. energy stored in brine pocket  hicmin       = ', hicmin  
+         WRITE(numout,*)'   minimum ice thickness                                   hiclim       = ', hiclim 
+         WRITE(numout,*)'   maximum lead fraction                                   amax         = ', amax 
+         WRITE(numout,*)'   energy stored in brine pocket (=1) or not (=0)	  swiqst       = ', swiqst 
+         WRITE(numout,*)'   numerical carac. of the scheme for diffusion in ice '
+         WRITE(numout,*)'   Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)   sbeta        = ', sbeta
+         WRITE(numout,*)'   percentage of energy used for lateral ablation          parlat       = ', parlat
+         WRITE(numout,*)'   slope of distr. for Hakkinen-Mellor lateral melting     hakspl       = ', hakspl  
+         WRITE(numout,*)'   slope of distribution for Hibler lateral melting        hibspl       = ', hibspl
+         WRITE(numout,*)'   exponent for leads-closure rate                         exld         = ', exld
+         WRITE(numout,*)'   coefficient for diffusions of ice and snow              hakdif       = ', hakdif
+         WRITE(numout,*)'   threshold thick. for comp. of eq. thermal conductivity  zhth         = ', thth 
+         WRITE(numout,*)'   thickness of the surf. layer in temp. computation       hnzst        = ', hnzst
+         WRITE(numout,*)'   switch for snow sublimation  (=1) or not (=0)           parsub       = ', parsub  
+         WRITE(numout,*)'   coefficient for snow density when snow ice formation    alphs        = ', alphs
+      ENDIF
+            
+      uscomi = 1.0 / ( 1.0 - amax )   ! inverse of minimum lead fraction
+      rcdsn = hakdif * rcdsn 
+      rcdic = hakdif * rcdic
+      
+      IF ( ( hsndif > 100.0 ) .OR. ( hicdif > 100.0 ) ) THEN
+         cnscg = 0.e0
+      ELSE
+         cnscg = rcpsn / rcpic   ! ratio  rcpsn/rcpic
+      ENDIF
+ 
+   END SUBROUTINE lim_thd_init
+
+#else
+   !!======================================================================
+   !!                       ***  MODULE limthd   ***
+   !!                        No sea ice model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE lim_thd         ! Empty routine
+   END SUBROUTINE lim_thd
+#endif
+
+   !!======================================================================
+END MODULE limthd
Index: /branches/nemo/NEMO/LIM_SRC/limthd_lac.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limthd_lac.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limthd_lac.F90	(revision 4)
@@ -0,0 +1,230 @@
+MODULE limthd_lac
+#if defined key_ice_lim
+   !!======================================================================
+   !!                       ***  MODULE limthd_lac   ***
+   !!                lateral thermodynamic growth of the ice 
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   lim_lat_acr    : lateral accretion of ice
+   !! * Modules used
+   USE phycst
+   USE ice_oce         ! ice variables
+   USE thd_ice
+   USE iceini
+   USE limistate 
+     
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC lim_thd_lac     ! called by lim_thd
+
+  !! * Module variables
+     REAL(wp)  ::            &  ! constant values
+         epsi20 = 1e-20   ,  &
+         epsi13 = 1e-13   ,  &
+         zzero  = 0.0     ,  &
+         zone   = 1.0
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+CONTAINS
+    
+    SUBROUTINE lim_thd_lac( kideb , kiut)
+      !!-------------------------------------------------------------------
+      !!               ***   ROUTINE lim_thd_lac  ***
+      !!  
+      !! ** Purpose : Computation of the evolution of the ice thickness and 
+      !!      concentration as a function of the heat balance in the leads.
+      !!      It is only used for lateral accretion
+      !!       
+      !! ** Method  : Ice is formed in the open water when ocean lose heat
+      !!      (heat budget of open water Bl is negative) .
+      !!      Computation of the increase of 1-A (ice concentration) fol-
+      !!      lowing the law :
+      !!      (dA/dt)acc = F[ (1-A)/(1-a) ] * [ Bl / (Li*h0) ]
+      !!       where - h0 is the thickness of ice created in the lead
+      !!             - a is a minimum fraction for leads
+      !!             - F is a monotonic non-increasing function defined as:
+      !!                  F(X)=( 1 - X**exld )**(1.0/exld)
+      !!             - exld is the exponent closure rate (=2 default val.)
+      !! 
+      !! ** Action : - Adjustment of snow and ice thicknesses and heat
+      !!                content in brine pockets
+      !!             - Updating ice internal temperature
+      !!             - Computation of variation of ice volume and mass
+      !!             - Computation of frldb after lateral accretion and 
+      !!               update h_snow_1d, h_ice_1d and tbif_1d(:,:)      
+      !! 
+      !! ** References :
+      !!      M. Maqueda, 1995, PhD Thesis, Univesidad Complutense Madrid
+      !!      Fichefet T. and M. Maqueda 1997, J. Geo. Res., 102(C6), 
+      !!                                                12609 -12646   
+      !!
+      !! History :
+      !!   1.0  !  01-04 (LIM)  original code
+      !!   2.0  !  02-08 (C. Ethe, G. Madec)  F90, mpp
+      !!-------------------------------------------------------------------
+      !! * Arguments
+      INTEGER , INTENT(IN)::  &
+         kideb          ,   &  ! start point on which the the computation is applied
+         kiut                  ! end point on which the the computation is applied
+
+      !! * Local variables
+      INTEGER ::            &
+         ji             ,   &  !  dummy loop indices
+         iicefr         ,   &  !  1 = existing ice ; 0 = no ice
+         iiceform       ,   &  !  1 = ice formed   ; 0 = no ice formed
+         ihemis                !  dummy indice
+      REAL(wp), DIMENSION(jpij) :: &
+         zqbgow           ,  &  !  heat budget of the open water (negative)
+         zfrl_old         ,  &  !  previous sea/ice fraction
+         zhice_old        ,  &  !  previous ice thickness
+         zhice0           ,  &  !  thickness of newly formed ice in leads
+         zfrlmin          ,  &  !  minimum fraction for leads
+         zdhicbot               !  part of thickness of newly formed ice in leads which 
+                                !  has been already used in transport for example
+      REAL(wp)  ::  &
+         zhemis           ,  &  !  hemisphere (0 = North, 1 = South)
+         zhicenew         ,  &  !  new ice thickness
+         zholds2          ,  &  !  ratio of previous ice thickness and 2 
+         zhnews2          ,  &  !  ratio of new ice thickness and 2 
+         zfrlnew          ,  &  !  new sea/ice fraction
+         zfrld            ,  &  !  ratio of sea/ice fraction and minimum fraction for leads
+         zfrrate          ,  &  !  leads-closure rate
+         zdfrl                  !  sea-ice fraction increment
+      REAL(wp)  ::  &
+         zdh1 , zdh2 , zdh3 , zdh4, zdh5   , &   ! tempory scalars
+         ztint , zta1 , zta2 , zta3 , zta4 , &
+         zah, zalpha , zbeta
+      !!---------------------------------------------------------------------      
+                   
+      !--------------------------------------------------------------
+      !   Computation of the heat budget of the open water (negative)
+      !--------------------------------------------------------------
+      
+      DO ji = kideb , kiut      
+         zqbgow(ji) = qldif_1d(ji) - qcmif_1d(ji)
+      END DO
+      
+      !-----------------------------------------------------------------
+      !   Taking the appropriate values for the corresponding hemisphere
+      !-----------------------------------------------------------------
+      DO ji = kideb , kiut
+         zhemis       = MAX( zzero , SIGN( zone , frld_1d(ji) - 2.0 ) ) 
+         ihemis       = INT( 1 + zhemis )
+         zhice0  (ji) = hiccrit( ihemis ) 
+         zfrlmin (ji) = acrit  ( ihemis )   
+         frld_1d (ji) = frld_1d(ji) - 2.0 * zhemis
+         zfrl_old(ji) = frld_1d(ji)
+      END DO
+      
+      !-------------------------------------------------------------------
+      !     Lateral Accretion (modification of the fraction of open water)
+      !     The ice formed in the leads has always a thickness zhice0, but
+      !     only a fraction zfrrate of the ice formed contributes to the 
+      !     increase of the ice fraction. The remaining part (1-zfrrate)
+      !     is rather assumed to lead to an increase in the thickness of the
+      !     pre-existing ice (transport for example). 
+      !     Morales Maqueda, 1995 - Fichefet and Morales Maqueda, 1997
+      !---------------------------------------------------------------------
+      
+      !CDIR NOVERRCHK
+      DO ji = kideb , kiut
+         iicefr       = 1 - MAX( 0, INT( SIGN( 1.5 * zone , zfrl_old(ji) - 1.0 + epsi13 ) ) )
+         !---computation of the leads-closure rate
+         zfrld        = MIN( zone , ( 1.0 - frld_1d(ji) ) / ( 1.0 - zfrlmin(ji) ) )
+         zfrrate      = ( 1.0 - zfrld**exld )**( 1.0 / exld )
+         !--computation of the sea-ice fraction increment and the new fraction 
+         zdfrl        = ( zfrrate / zhice0(ji) )  * ( zqbgow(ji) / xlic )
+         zfrlnew      = zfrl_old(ji) + zdfrl
+         !--update the sea-ice fraction 
+         frld_1d   (ji) = MAX( zfrlnew , zfrlmin(ji) )
+         !--computation of the remaining part of ice thickness which has been already used
+         zdhicbot(ji) =  ( frld_1d(ji) - zfrlnew ) * zhice0(ji) / ( 1.0 - zfrlmin(ji) ) & 
+                      -  (  ( 1.0 - zfrrate ) / ( 1.0 - frld_1d(ji) ) )  * ( zqbgow(ji) / xlic ) 
+      END DO
+ 
+      !----------------------------------------------------------------------------------------
+      !      Ajustement of snow and ice thicknesses and updating the total heat stored in brine pockets  
+      !      The thickness of newly formed ice is averaged with that of the pre-existing
+      !         (1-Anew) * hinew = (1-Aold) * hiold + ((1-Anew)-(1-Aold)) * h0
+      !      Snow is distributed over the new ice-covered area 
+      !         (1-Anew) * hsnew = (1-Aold) * hsold            
+      !--------------------------------------------------------------------------------------------
+      
+      DO ji = kideb , kiut
+         iicefr       = 1 - MAX( 0, INT( SIGN( 1.5 * zone , zfrl_old(ji) - 1.0 + epsi13 ) ) )
+         zhice_old(ji) = h_ice_1d(ji)
+         zhicenew      = iicefr * zhice_old(ji) + ( 1 - iicefr ) * zhice0(ji)
+         zalpha        = ( 1. - zfrl_old(ji) ) / ( 1.- frld_1d(ji) )
+         h_snow_1d(ji) = zalpha * h_snow_1d(ji)
+         h_ice_1d (ji) = zalpha * zhicenew + ( 1.0 - zalpha ) * zhice0(ji)
+         qstbif_1d(ji) = zalpha * qstbif_1d(ji) 
+      END DO
+      
+      !-------------------------------------------------------
+      !   Ajustement of ice internal temperatures
+      !-------------------------------------------------------
+      
+      DO ji = kideb , kiut
+         iicefr      = 1 - MAX( 0, INT( SIGN( 1.5 * zone , zfrl_old(ji) - 1.0 + epsi13 ) ) )
+         iiceform    = 1 - MAX( 0 ,INT( SIGN( 1.5 * zone , zhice0(ji) - h_ice_1d(ji) ) ) )
+         zholds2     = zhice_old(ji)/ 2.
+         zhnews2     = h_ice_1d(ji) / 2.
+         zdh1        = MAX( zzero ,  zhice_old(ji)   - zhnews2 )
+         zdh2        = MAX( zzero , -zhice_old(ji)   + zhnews2 )
+         zdh3        = MAX( zzero ,  h_ice_1d(ji) - zholds2 )
+         zdh4        = MAX( zzero , -h_ice_1d(ji) + zholds2 )
+         zdh5        = MAX( zzero , zhice0(ji)      - zholds2 )
+         ztint       =       iiceform   * (  ( zholds2 - zdh3 ) * tbif_1d(ji,3) + zdh4 * tbif_1d(ji,2) )      &
+            &                           / MAX( epsi20 , h_ice_1d(ji) - zhice0(ji) )                           &
+            &                 + ( 1 - iiceform ) * tfu_1d(ji)
+         zta1        = iicefr * ( 1.  - zfrl_old(ji) ) * tbif_1d(ji,2) 
+         zta2        = iicefr * ( 1.  - zfrl_old(ji) ) * tbif_1d(ji,3)
+         zta3        = iicefr * ( 1.  - zfrl_old(ji) ) * ztint
+         zta4        = ( zfrl_old(ji) - frld_1d   (ji) ) * tfu_1d(ji)
+         zah         = ( 1. - frld_1d(ji) ) * zhnews2 
+
+         tbif_1d(ji,2) = (  MIN( zhnews2 , zholds2 )                                              * zta1   &
+            &          + ( 1 - iiceform ) * ( zholds2 - zdh1 )                                    * zta2   &
+            &          + ( iiceform * ( zhnews2 - zhice0(ji) + zdh5 ) + ( 1 - iiceform ) * zdh2 ) * zta3   & 
+            &          + MIN ( zhnews2 , zhice0(ji) )                                             * zta4   &
+            &          ) / zah
+         
+         tbif_1d(ji,3) =     (  iiceform * ( zhnews2 - zdh3 )                                          * zta1  &
+            &              + ( iiceform * zdh3 + ( 1 - iiceform ) * zdh1 )                             * zta2  &
+            &              + ( iiceform * ( zhnews2 - zdh5 ) + ( 1 - iiceform ) * ( zhnews2 - zdh1 ) ) * zta3  & 
+            &              + ( iiceform * zdh5 + ( 1 - iiceform ) * zhnews2 )                          * zta4  &
+            &            ) / zah
+         !---removing the remaining part of ice formed which has been already used
+         zbeta         = h_ice_1d(ji) / ( h_ice_1d(ji) + zdhicbot(ji) )
+         h_ice_1d(ji)  = h_ice_1d(ji) + zdhicbot(ji)
+         tbif_1d (ji,2)= zbeta * tbif_1d(ji,2) + ( 1.0 - zbeta ) * tbif_1d(ji,3)
+         tbif_1d (ji,3)= ( 2. * zbeta - 1.0 ) * tbif_1d(ji,3) + ( 2. * zdhicbot(ji) / h_ice_1d(ji) ) * tfu_1d(ji)
+         
+      END DO
+      
+      !-------------------------------------------------------------
+      !    Computation of variation of ice volume and ice mass 
+      !           Vold = (1-Aold) * hiold ; Vnew = (1-Anew) * hinew
+      !           dV = Vnew - Vold
+      !-------------------------------------------------------------
+      
+      DO ji = kideb , kiut
+         dvlbq_1d  (ji) = ( 1. - frld_1d(ji) ) * h_ice_1d(ji) - ( 1. - zfrl_old(ji) ) * zhice_old(ji)
+         rdmicif_1d(ji) = rdmicif_1d(ji) + rhoic * dvlbq_1d(ji)
+      END DO
+      
+   END SUBROUTINE lim_thd_lac
+#else
+   !!======================================================================
+   !!                       ***  MODULE limthd_lac   ***
+   !!                           no sea ice model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE lim_thd_lac           ! Empty routine
+   END SUBROUTINE lim_thd_lac
+#endif
+END MODULE limthd_lac
Index: /branches/nemo/NEMO/LIM_SRC/limthd_zdf.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limthd_zdf.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limthd_zdf.F90	(revision 4)
@@ -0,0 +1,811 @@
+MODULE limthd_zdf
+#if defined key_ice_lim
+   !!======================================================================
+   !!                       ***  MODULE limthd_zdf ***
+   !!                thermodynamic growth and decay of the ice 
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   lim_thd_zdf  : vertical accr./abl. and lateral ablation of sea ice
+   !! * Modules used
+   USE phycst
+   USE ice_oce         ! ice variables
+   USE thd_ice
+   USE iceini
+   USE limistate
+   USE in_out_manager
+      
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC lim_thd_zdf        ! called by lim_thd
+
+   !! * Module variables
+   REAL(wp)  ::           &  ! constant values
+      epsi20 = 1e-20   ,  &
+      epsi13 = 1e-13   ,  &
+      zzero  = 0.0     ,  &
+      zone   = 1.0
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_thd_zdf( kideb , kiut )
+       !!------------------------------------------------------------------
+       !!                ***  ROUTINE lim_thd_zdf  ***
+       !!              
+       !! ** Purpose : This routine determines the time evolution of snow 
+       !!      and sea-ice thicknesses, concentration and heat content 
+       !!      due to the vertical and lateral thermodynamic accretion-
+       !!      ablation processes. One only treats the case of lat. abl.
+       !!      For lateral accretion, see routine lim_lat_accr 
+       !! 
+       !! ** Method  : The representation of vertical growth and decay of 
+       !!      the sea-ice model is based upon the diffusion of heat 
+       !!      through the external and internal boundaries of a 
+       !!      three-layer system (two layers of ice and one layer and 
+       !!      one layer of snow, if present, on top of the ice).
+       !! 
+       !! ** Action  : - Calculation of some intermediates variables
+       !!              - Calculation of surface temperature
+       !!              - Calculation of available heat for surface ablation
+       !!              - Calculation of the changes in internal temperature 
+       !!                of the three-layer system, due to vertical diffusion 
+       !!                processes
+       !!              - Performs surface ablation and bottom accretion-ablation
+       !!              - Performs snow-ice formation
+       !!              - Performs lateral ablation
+       !!
+       !! References :
+       !!   Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646   
+       !!   Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268  
+       !!
+       !! History :
+       !!   original    : 01-04 (LIM)
+       !!   addition    : 02-08 (C. Ethe, G. Madec)
+       !!------------------------------------------------------------------
+       !! * Arguments
+       INTEGER , INTENT (in) ::  &
+          kideb ,  &  ! Start point on which the  the computation is applied
+          kiut        ! End point on which the  the computation is applied
+
+       !! * Local variables
+       INTEGER ::   ji       ! dummy loop indices
+
+       REAL(wp) , DIMENSION(jpij,2) ::  &
+          zqcmlt        ! energy due to surface( /1 ) and bottom melting( /2 )
+
+       REAL(wp), DIMENSION(jpij) ::  &
+          ztsmlt      &    ! snow/ice surface melting temperature
+          ,ztbif      &    ! int. temp. at the mid-point of the 1st layer of the snow/ice sys. 
+          ,zksn       &    ! effective conductivity of snow
+          ,zkic       &    ! effective conductivity of ice
+          ,zksndh     &    ! thermal cond. at the mid-point of the 1st layer of the snow/ice sys. 
+          , zfcsu     &    ! conductive heat flux at the surface of the snow/ice system 
+          , zfcsudt   &    ! = zfcsu * dt
+          , zi0       &    ! frac. of the net SW rad. which is not absorbed at the surface
+          , z1mi0     &    ! fraction of the net SW radiation absorbed at the surface
+          , zqmax     &    ! maximum energy stored in brine pockets
+          , zrcpdt    &    ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer)
+          , zts_old   &    ! previous surface temperature
+          , zidsn , z1midsn , zidsnic ! tempory variables
+
+       REAL(wp), DIMENSION(jpij) :: &
+          zfnet       &  ! net heat flux at the top surface( incl. conductive heat flux)
+          , zsprecip  &    ! snow accumulation
+          , zhsnw_old &    ! previous snow thickness
+          , zdhictop  &    ! change in ice thickness due to top surf ablation/accretion
+          , zdhicbot  &    ! change in ice thickness due to bottom surf abl/acc
+          , zqsup     &    ! energy transmitted to ocean (coming from top surf abl/acc)
+          , zqocea    &    ! energy transmitted to ocean (coming from bottom sur abl/acc)
+          , zfrl_old  &    ! previous sea/ice fraction
+          , zfrld_1d    &    ! new sea/ice fraction
+          , zep            ! internal temperature of the 2nd layer of the snow/ice system
+
+       REAL(wp), DIMENSION(3) :: & 
+          zplediag  &    ! principle diagonal, subdiag. and supdiag. of the 
+          , zsubdiag  &    ! tri-diagonal matrix coming from the computation
+          , zsupdiag  &    ! of the temperatures inside the snow-ice system
+          , zsmbr          ! second member
+
+       REAL(wp) :: & 
+          zhsu     &     ! thickness of surface layer
+          , zhe      &     ! effective thickness for compu. of equ. thermal conductivity
+          , zheshth  &     ! = zhe / thth
+          , zghe     &     ! correction factor of the thermal conductivity
+          , zumsb    &     ! parameter for numerical method to solve heat-diffusion eq.
+          , zkhsn    &     ! conductivity at the snow layer
+          , zkhic    &     ! conductivity at the ice layers
+          , zkint    &     ! equivalent conductivity at the snow-ice interface
+          , zkhsnint &     ! = zkint*dt / (hsn*rhosn*cpsn)  
+          , zkhicint &     ! = 2*zkint*dt / (hic*rhoic*cpic)
+          , zpiv1 , zpiv2  &       ! tempory scalars used to solve the tri-diagonal system
+          , zb2 , zd2 , zb3 , zd3 &
+          , ztint          ! equivalent temperature at the snow-ice interface
+
+       REAL(wp) :: & 
+          zexp      &     ! exponential function of the ice thickness
+          , zfsab     &     ! part of solar radiation stored in brine pockets
+          , zfts      &     ! value of energy balance function when the temp. equal surf. temp.
+          , zdfts     &     ! value of derivative of ztfs when the temp. equal surf. temp.
+          , zdts      &     ! surface temperature increment
+          , zqsnw_mlt &     ! energy needed to melt snow
+          , zdhsmlt   &     ! change in snow thickness due to melt
+          , zhsn      &     ! snow thickness (previous+accumulation-melt)
+          , zqsn_mlt_rem &  ! remaining heat coming from snow melting
+          , zqice_top_mlt & ! energy used to melt ice at top surface
+          , zdhssub      &  ! change in snow thick. due to sublimation or evaporation
+          , zdhisub      &  ! change in ice thick. due to sublimation or evaporation    
+          , zdhsn        &  ! snow ice thickness increment
+          , zdtsn        &  ! snow internal temp. increment
+          , zdtic        &  ! ice internal temp. increment
+          , zqnes          ! conductive energy due to ice melting in the first ice layer
+
+       REAL(wp) :: & 
+          ztbot     &      ! temperature at the bottom surface
+          , zfcbot    &      ! conductive heat flux at bottom surface
+          , zqice_bot &      ! energy used for bottom melting/growing
+          , zqice_bot_mlt &  ! energy used for bottom melting
+          , zqstbif_bot  &  ! part of energy stored in brine pockets used for bottom melting
+          , zqstbif_old  &  ! tempory var. for zqstbif_bot
+          , zdhicmlt      &  ! change in ice thickness due to bottom melting
+          , zdhicm        &  ! change in ice thickness var. 
+          , zdhsnm        &  ! change in snow thickness var. 
+          , zhsnfi        &  ! snow thickness var. 
+          , zc1, zpc1, zc2, zpc2, zp1, zp2 & ! tempory variables
+          , ztb2, ztb3
+
+       REAL(wp) :: & 
+          zdrmh         &   ! change in snow/ice thick. after snow-ice formation
+          , zhicnew       &   ! new ice thickness
+          , zhsnnew       &   ! new snow thickness
+          , zquot , ztneq &   ! tempory temp. variables
+          , zqice, zqicetot & ! total heat inside the snow/ice system
+          , zdfrl         &   ! change in ice concentration
+          , zdvsnvol      &   ! change in snow volume
+          , zdrfrl1, zdrfrl2 &  ! tempory scalars
+          , zihsn, zidhb, zihic, zihe, zihq, ziexp, ziqf, zihnf, zibmlt, ziqr, zihgnew, zind
+       !!----------------------------------------------------------------------
+
+       !-----------------------------------------------------------------------
+       !  1. Boundaries conditions for snow/ice system internal temperature
+       !       - If tbif_1d(ji,1) > rt0_snow, tbif_1d(ji,1) = rt0_snow 
+       !       - If tbif_1d(ji,2/3) > rt0_ice, tbif_1d(ji,2/3) = rt0_ice 
+       !     Computation of energies due to surface and bottom melting 
+       !-----------------------------------------------------------------------
+       
+       
+       DO ji = kideb , kiut
+          zihsn = MAX( zzero , SIGN( zone , hsndif - h_snow_1d(ji) ) )
+          zihic = MAX( zzero , SIGN( zone , hicdif - h_ice_1d(ji) ) )
+          !--computation of energy due to surface melting
+          zqcmlt(ji,1) = ( MAX ( zzero ,  &
+             &                   rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn )
+          !--computation of energy due to bottom melting
+          zqcmlt(ji,2) = ( MAX( zzero , &
+             &                  rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) &
+             &           + MAX( zzero , &
+             &                  rcpic * ( tbif_1d(ji,3) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) &
+             &           ) * ( 1.0 - zihic  )
+          !--limitation of  snow/ice system internal temperature
+          tbif_1d(ji,1)   = MIN( rt0_snow, tbif_1d(ji,1) )
+          tbif_1d(ji,2)   = MIN( rt0_ice , tbif_1d(ji,2) )
+          tbif_1d(ji,3)   = MIN( rt0_ice , tbif_1d(ji,3) )
+       END DO
+
+
+       !-------------------------------------------
+       !  2. Calculate some intermediate variables.  
+       !-------------------------------------------
+       
+       ! initialisation of the thickness of surface layer
+       zhsu = hnzst  
+
+       DO ji = kideb , kiut
+          zind   = MAX( zzero , SIGN( zone , zhsu - h_snow_1d(ji) ) )
+          zihsn  = MAX( zzero , SIGN( zone , hsndif - h_snow_1d(ji) ) )
+          zihsn  = MAX( zihsn , zind )
+          zihic  = MAX( zzero , sign( zone , hicdif - h_ice_1d(ji) ) )
+          !     2.1. Computation of surface melting temperature
+          !----------------------------------------------------
+          zind  = MAX( zzero , SIGN( zone , -h_snow_1d(ji) ) )
+          ztsmlt(ji) = ( 1.0 - zind ) * rt0_snow + zind * rt0_ice
+          !
+          !     2.2. Effective conductivity of snow and ice
+          !-----------------------------------------------
+
+          !---computation of the correction factor on the thermal conductivity
+          !-- (Morales Maqueda, 1995 ; Fichefet and Morales Maqueda, 1997)
+          zhe      =  ( rcdsn / ( rcdsn + rcdic ) ) * h_ice_1d(ji)   &
+             &     + ( rcdic / ( rcdsn + rcdic ) ) * h_snow_1d(ji) 
+          zihe     = MAX( zzero , SIGN( zone , 2.0 * zhe - thth ) )
+          zheshth  = zhe / thth
+          zghe     = ( 1.0 - zihe ) * zheshth * ( 2.0 - zheshth )   &
+             &     +         zihe   * 0.5 * ( 1.5 + LOG( 2.0 * zheshth ) )
+#if defined key_lim_cp3
+          zghe = 1.0
+#endif 
+
+          !---effective conductivities 
+          zksn(ji)  = zghe * rcdsn  
+          zkic(ji)  = zghe * rcdic
+
+          !
+          !     2.3. Computation of the conductive heat flux from the snow/ice 
+          !          system interior toward the top surface
+          !------------------------------------------------------------------
+
+          !---Thermal conductivity at the mid-point of the first snow/ice system layer
+          zksndh(ji) =   ( ( 1.0 - zihsn ) * 2.0 * zksn(ji) + zihsn * 4.0 * zkic(ji) )   &
+             &         / ( ( 1.0 - zihsn ) *  h_snow_1d(ji)                              &
+             &           +        zihsn   *  ( ( 1.0 + 3.0 * zihic ) * h_ice_1d(ji)      &
+             &           + 4.0 * zkic(ji)/zksn(ji) * h_snow_1d(ji) ) )
+
+          !---internal temperature at the mid-point of the first snow/ice system layer
+          ztbif(ji)  = ( 1.0 - zihsn ) * tbif_1d(ji,1)                       &
+             &       +         zihsn   * ( ( 1.0 - zihic ) * tbif_1d(ji,2)   &
+             &       +         zihic   * tfu_1d(ji)   )
+          !---conductive heat flux 
+          zfcsu(ji) = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
+
+       END DO
+
+       !--------------------------------------------------------------------
+       !  3. Calculate : 
+       !     - fstbif_1d, part of solar radiation absorbing inside the ice
+       !       assuming an exponential absorption (Grenfell and Maykut, 1977)
+       !     - zqmax,  maximum energy stored in brine pockets
+       !     - qstbif_1d, total energy stored in brine pockets (updating)
+       !-------------------------------------------------------------------
+
+
+       DO ji = kideb , kiut
+          zihsn  = MAX( zzero , SIGN (zone , -h_snow_1d(ji) ) )
+          zihic  = MAX( zzero , 1.0 - ( h_ice_1d(ji) / zhsu ) )     
+          zind   = MAX( zzero , SIGN (zone , hicdif - h_ice_1d(ji) ) )
+          !--Computation of the fraction of the net shortwave radiation which
+          !--penetrates inside the ice cover ( See Forcat)
+          zi0(ji)  = zihsn * ( fr1_i0_1d(ji) + zihic * fr2_i0_1d(ji) )
+          zexp     = MIN( zone , EXP( -1.5 * ( h_ice_1d(ji) - zhsu ) ) )
+          fstbif_1d(ji) = zi0(ji) * qsr_ice_1d(ji) * zexp
+          !--Computation of maximum energy stored in brine pockets zqmax and update
+          !--the total energy stored in brine pockets, if less than zqmax
+          zqmax(ji) = MAX( zzero , 0.5 * xlic * ( h_ice_1d(ji) - hicmin ) )
+          zfsab   = zi0(ji) * qsr_ice_1d(ji) * ( 1.0 - zexp )
+          zihq    = ( 1.0 - zind ) * MAX(zzero, SIGN( zone , qstbif_1d(ji) - zqmax(ji) ) ) &
+             &    +         zind   * zone
+          qstbif_1d(ji) = ( qstbif_1d(ji) + ( 1.0 - zihq ) * zfsab * rdt_ice ) * swiqst
+          !--fraction of shortwave radiation absorbed at surface
+          ziexp = zihq * zexp + ( 1.0 - zihq ) * ( swiqst + ( 1.0 - swiqst ) * zexp )
+          z1mi0(ji) = 1.0 - zi0(ji) * ziexp
+       END DO
+
+
+       !--------------------------------------------------------------------------------
+       !  4. Computation of the surface temperature : determined by considering the 
+       !     budget of a thin layer of thick. zhsu at the top surface (H. Grenier, 1995) 
+       !     and based on a surface energy balance : 
+       !     hsu * rcp * dT/dt = Fsr + Fnsr(T) + Fcs(T),
+       !     where - Fsr is the net absorbed solar radiation, 
+       !           - Fnsr is the total non solar radiation (incoming and outgoing long-wave,
+       !             sensible and latent heat fluxes)
+       !           - Fcs the conductive heat flux at the top of surface
+       !------------------------------------------------------------------------------
+
+       !     4.1. Computation of intermediate values
+       !---------------------------------------------
+       DO ji = kideb, kiut
+          zrcpdt(ji) = ( rcpsn * MIN( h_snow_1d(ji) , zhsu )    &
+             &       + rcpic * MAX( zhsu - h_snow_1d(ji) , zzero ) ) / rdt_ice
+          zts_old(ji) =  sist_1d(ji)
+       END DO
+
+       !     4.2. Computation of surface temperature by expanding the eq. of energy balance
+       !          with Ts = Tp + DT. One obtain , F(Tp) + DT * DF(Tp) = 0
+       !          where  - F(Tp) = Fsr + Fnsr(Tp) + Fcs(Tp) 
+       !                 - DF(Tp)= (dFnsr(Tp)/dT) + (dFcs(Tp)/dT) - hsu*rcp/dt
+       !---------------------------------------------------------------------------------
+
+       DO ji = kideb, kiut
+          !---computation of the derivative of energy balance function 
+#if defined key_coupled
+#   if defined key_lim_cp2
+          zdfts   =   zksndh(ji)   & ! contribution of the conductive heat flux
+             &      + zrcpdt(ji)   & ! contribution of hsu * rcp / dt
+             &      - dqns_ice_1d(ji)      ! contribution of the total non solar radiation 
+#   else
+          zdfts   =   zksndh(ji)   & ! contribution of the conductive heat flux
+             &      + zrcpdt(ji)    ! contribution of hsu * rcp / dt
+#   endif
+
+#else
+          zdfts    =  zksndh(ji)   & ! contribution of the conductive heat flux
+             &      + zrcpdt(ji)   & ! contribution of hsu * rcp / dt
+             &      - dqns_ice_1d (ji)     ! contribution of the total non solar radiation 
+#endif
+          !---computation of the energy balance function 
+          zfts    = - z1mi0 (ji) * qsr_ice_1d(ji)   & ! net absorbed solar radiation
+             &      - qnsr_ice_1d(ji)                & ! total non solar radiation
+             &      - zfcsu (ji)                  ! conductive heat flux from the surface
+          !---computation of surface temperature increment  
+          zdts    = -zfts / zdfts
+#if defined key_lim_cp3
+          zdts = zdts / 3.0
+#endif
+          !---computation of the new surface temperature 
+          sist_1d(ji) = sist_1d(ji) + zdts
+
+       END DO
+
+       !----------------------------------------------------------------------------
+       !  5. Boundary condition at the top surface
+       !--    IF Tsb < Tmelt, Fnet = Fcs (the net heat flux equal the conductive heat flux)
+       !      Otherwise Tsb = Tmelt and Qnet(Tmelt) > 0 
+       !      Fnet(Tmelt) is therefore the net surface flux needed for melting
+       !----------------------------------------------------------------------------
+       
+       
+       !     5.1.  Limitation of surface temperature and update total non solar fluxes,
+       !          latent heat flux and conductive flux at the top surface 
+       !----------------------------------------------------------------------  
+                     
+       DO ji = kideb, kiut
+          sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) )
+#if defined key_coupled
+          qnsr_ice_1d(ji) =  qnsr_ice_1d(ji) - ( emic * stefan * sist_1d(ji) * sist_1d(ji) * sist_1d(ji) * sist_1d(ji) )
+#else          
+          qnsr_ice_1d(ji) = qnsr_ice_1d(ji) + dqns_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) )
+          qla_ice_1d (ji) = qla_ice_1d (ji) + dqla_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) )
+#endif
+          zfcsu(ji)  = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
+       END DO
+
+     
+
+       !     5.2. Calculate available heat for surface ablation. 
+       !---------------------------------------------------------------------
+
+       DO ji = kideb, kiut
+          zfnet(ji) = qnsr_ice_1d(ji) + z1mi0(ji) * qsr_ice_1d(ji) + zfcsu(ji)          
+          zfnet(ji) = MAX( zzero , zfnet(ji) )
+          zfnet(ji) = zfnet(ji) * MAX( zzero , SIGN( zone , sist_1d(ji) - ztsmlt(ji) ) )
+       END DO
+
+       !-------------------------------------------------------------------------
+       !  6. Calculate changes in internal temperature due to vertical diffusion   
+       !     processes. The evolution of this temperature is governed by the one-
+       !     dimensionnal heat-diffusion equation. 
+       !     Given the temperature tbif(1/2/3), at time m we solve a set
+       !     of finite difference equations to obtain new tempe. Each tempe is coupled
+       !     to the temp. immediatly above and below by heat conduction terms. Thus 
+       !     we have a set of equations of the form A * T = B, where A is a tridiagonal
+       !     matrix, T a vector whose components are the unknown new temp.
+       !-------------------------------------------------------------------------
+       
+       !--parameter for the numerical methode use to solve the heat-diffusion equation
+       !- implicit, explicit or Crank-Nicholson
+       zumsb = 1.0 - sbeta  
+       DO ji = kideb, kiut
+          zidsn(ji)   = MAX ( zzero, SIGN( zone, hsndif - h_snow_1d(ji) ) ) 
+          z1midsn(ji) = 1.0 - zidsn(ji)
+          zihic       = MAX ( zzero, SIGN( zone, hicdif - h_ice_1d(ji) ) ) 
+          zidsnic(ji) = zidsn(ji) *  zihic 
+          zfcsudt(ji) = zfcsu(ji) * rdt_ice 
+       END DO 
+   
+       DO ji = kideb, kiut
+
+          !     6.1 Calculate intermediate variables.
+          !----------------------------------------
+
+          !--conductivity at the snow surface
+          zkhsn = 2.0 * zksn(ji) * rdt_ice / rcpsn
+          !--conductivity at the ice surface
+          zkhic = 4.0 * zkic(ji) * rdt_ice / MAX( h_ice_1d(ji) * h_ice_1d(ji) * rcpic , epsi20 )
+          !--conductivity at the snow/ice interface 
+          zkint = 4.0 * zksn(ji) * zkic(ji)  &
+             &        / ( zksn(ji) * h_ice_1d(ji) + 2.0 * zkic(ji) * h_snow_1d(ji) * z1midsn(ji)) 
+          zkhsnint = zkint * rdt_ice / rcpsn
+          zkhicint = zkint * 2.0 * rdt_ice / MAX( h_ice_1d(ji) * rcpic , epsi20 )
+          
+          !     6.2. Fulfill the linear system matrix.
+          !-----------------------------------------
+!$$$          zplediag(1) = 1 + sbeta * z1midsn(ji) * ( zkhsn + zkhsnint )       
+          zplediag(1) =   zidsn(ji) + z1midsn(ji) * h_snow_1d(ji)   &
+             &          + sbeta * z1midsn(ji) * zkhsnint 
+          zplediag(2) = 1 + sbeta * ( z1midsn(ji) * zkhicint + zkhic ) 
+          zplediag(3) = 1 + 3.0 * sbeta * zkhic   
+
+          zsubdiag(1) = 0.0              
+          zsubdiag(2) = -1.0 * z1midsn(ji) * sbeta * zkhicint
+          zsubdiag(3) = -1.0 * sbeta * zkhic 
+
+          zsupdiag(1) =  -1.0 * z1midsn(ji) * sbeta * zkhsnint 
+          zsupdiag(2) = zsubdiag(3)
+          zsupdiag(3) = 0.0
+          
+          !     6.3. Fulfill the idependent term vector.
+          !-------------------------------------------
+          
+!$$$          zsmbr(1) = zidsn(ji) * sist_1d(ji) + z1midsn(ji) *   &
+!$$$             &         ( tbif_1d(ji,1) + zkhsn * sist_1d(ji)
+!$$$             &         - zumsb * ( zkhsn * tbif_1d(ji,1)
+!$$$             &                   + zkhsnint * ( tbif_1d(ji,1) - tbif_1d(ji,2) ) ) )
+          zsmbr(1) = zidsn(ji) * sist_1d(ji) + z1midsn(ji) *    &
+             &       ( h_snow_1d(ji) * tbif_1d(ji,1) - ( zfcsudt(ji) / rcpsn )  &
+             &       - zumsb * zkhsnint * ( tbif_1d(ji,1) - tbif_1d(ji,2) ) )
+
+          zsmbr(2) =  tbif_1d(ji,2)  &
+             &      - zidsn(ji) * ( 1.0 - zidsnic(ji) ) &
+             &        * ( zfcsudt(ji) / MAX( h_ice_1d(ji) * rcpic , epsi20 ) ) &
+             &      + zumsb * ( zkhicint * ( tbif_1d(ji,1) - tbif_1d(ji,2) ) &
+             &                   - zkhic * ( tbif_1d(ji,2) - tbif_1d(ji,3) )  )
+
+          zsmbr(3) =  tbif_1d(ji,3)  &
+             &      + zkhic * ( 2.0 * tfu_1d(ji) &
+             &                + zumsb * ( tbif_1d(ji,2) - 3.0 * tbif_1d(ji,3) ) )
+          
+          !     6.4. Solve the system (Gauss elimination method).
+          !----------------------------------------------------
+          
+          zpiv1 = zsubdiag(2) / zplediag(1) 
+          zb2   = zplediag(2) - zpiv1 * zsupdiag(1)
+          zd2   = zsmbr(2) - zpiv1 * zsmbr(1)
+
+          zpiv2 = zsubdiag(3) / zb2
+          zb3   = zplediag(3) - zpiv2 * zsupdiag(2)
+          zd3   = zsmbr(3) - zpiv2 * zd2
+
+          tbif_1d(ji,3) = zd3 / zb3
+          tbif_1d(ji,2) = ( zd2 - zsupdiag(2) * tbif_1d(ji,3) ) / zb2
+          tbif_1d(ji,1) = ( zsmbr(1) - zsupdiag(1) * tbif_1d(ji,2) ) / zplediag(1)            
+
+          !--- taking into account the particular case of  zidsnic(ji) = 1
+          ztint =  (  zkic(ji) * h_snow_1d(ji) * tfu_1d (ji)    &
+             &      + zksn(ji) * h_ice_1d(ji) * sist_1d(ji) )   &
+             &   / ( zkic(ji) * h_snow_1d(ji) + zksn(ji) * h_ice_1d(ji) ) 
+
+          tbif_1d(ji,1) = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,1)   &
+             &                + zidsnic(ji)   * ( ztint + sist_1d(ji) ) / 2.0
+          tbif_1d(ji,2) = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,2)   &
+             &                + zidsnic(ji)   * ( 3.0 * ztint + tfu_1d(ji) ) / 4.0
+          tbif_1d(ji,3) = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,3)   &
+             &                + zidsnic(ji)   * ( ztint + 3.0 * tfu_1d(ji) ) / 4.0     
+       END DO
+ 
+       !----------------------------------------------------------------------
+       !  9. Take into account surface ablation and bottom accretion-ablation.|
+       !----------------------------------------------------------------------
+       
+       !---Snow accumulation in one thermodynamic time step
+       zsprecip(kideb:kiut) = sprecip_1d(kideb:kiut) * rdt_ice / rhosn
+
+
+       DO ji = kideb, kiut
+          
+          !      9.1. Surface ablation and update of snow thickness and qstbif_1d
+          !--------------------------------------------------------------------
+          
+          !--------------------------------------------------------------------------
+          !--      Melting snow processes :
+          !--      Melt at the upper surface is computed from the difference between 
+          !--      the net heat flux (including the conductive heat flux) at the upper 
+          !--      surface and the pre-existing energy due to surface melting
+          !------------------------------------------------------------------------------
+          
+          !-- store the snow thickness
+          zhsnw_old(ji) =  h_snow_1d(ji)
+          !--computation of the energy needed to melt snow
+          zqsnw_mlt  = zfnet(ji) * rdt_ice - zqcmlt(ji,1)
+          !--change in snow thickness due to melt
+          zdhsmlt = - zqsnw_mlt / xlsn
+          
+          !-- compute new snow thickness, taking into account the part of snow accumulation
+          !   (as snow precipitation) and the part of snow lost due to melt
+          zhsn =  h_snow_1d(ji) + zsprecip(ji) + zdhsmlt
+          h_snow_1d(ji) = MAX( zzero , zhsn )
+          !-- compute the volume of snow lost after surface melting and the associated mass
+          dvsbq_1d(ji) =  ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnw_old(ji) - zsprecip(ji) )
+          dvsbq_1d(ji) =  MIN( zzero , dvsbq_1d(ji) )
+          rdmsnif_1d(ji) =  rhosn * dvsbq_1d(ji)
+          !-- If the snow is completely melted the remaining heat is used to melt ice
+          zqsn_mlt_rem  = MAX( zzero , -zhsn ) * xlsn
+          zqice_top_mlt = zqsn_mlt_rem 
+          zqstbif_old   = qstbif_1d(ji)
+
+          !--------------------------------------------------------------------------
+          !--      Melting ice processes at the top surface :
+          !--      The energy used to melt ice, zqice_top_mlt, is taken from the energy
+          !--      stored in brine pockets qstbif_1d and the remaining energy coming 
+          !--      from the melting snow process zqsn_mlt_rem.
+          !--      If qstbif_1d > zqsn_mlt_rem then, one uses only a zqsn_mlt_rem part
+          !--      of qstbif_1d to melt ice,
+          !--         zqice_top_mlt = zqice_top_mlt + zqsn_mlt_rem
+          !--         qstbif_1d = qstbif_1d - zqsn_mlt_rem
+          !--      Otherwise one uses all qstbif_1d to melt ice
+          !--         zqice_top_mlt = zqice_top_mlt + qstbif_1d
+          !--         qstbif_1d = 0
+          !------------------------------------------------------
+          
+          ziqf =  MAX ( zzero , SIGN( zone , qstbif_1d(ji) - zqsn_mlt_rem  ) )
+          zqice_top_mlt =         ziqf   * ( zqice_top_mlt + zqsn_mlt_rem )   &
+             &          + ( 1.0 - ziqf ) * ( zqice_top_mlt + qstbif_1d(ji)  )
+
+          qstbif_1d(ji) =         ziqf   * ( qstbif_1d(ji) - zqsn_mlt_rem )   &
+             &        + ( 1.0 - ziqf ) * ( qstbif_1d(ji) - qstbif_1d(ji)  )
+
+          !--    The contribution of the energy stored in brine pockets qstbif_1d to melt
+          !--    ice is taking into account only when qstbif_1d is less than zqmax. 
+          !--    Otherwise, only the remaining energy coming from the melting snow 
+          !--    process is used 
+          zihq =  MAX ( zzero , SIGN( zone , qstbif_1d(ji) - zqmax(ji) ) )
+
+          zqice_top_mlt =         zihq   * zqice_top_mlt   &
+             &          + ( 1.0 - zihq ) * zqsn_mlt_rem
+
+          qstbif_1d(ji) =         zihq   * qstbif_1d(ji)   &
+             &        + ( 1.0 - zihq ) * zqstbif_old
+
+          !--change in ice thickness due to melt at the top surface
+          zdhictop(ji) = -zqice_top_mlt / xlic
+          !--compute the volume formed after surface melting
+          dvsbq_1d(ji) =  zdhictop(ji) * ( 1.0 - frld_1d(ji) )
+
+          !-------------------------------------------------------------------------
+          !--      A small variation at the surface also occurs because of sublimation
+          !--      associated with the latent flux. If qla_ice_1d is negative, snow condensates at 
+          !        the surface. Otherwise, snow evaporates
+          !-----------------------------------------------------------------------
+          !----change in snow and ice thicknesses due to sublimation or evaporation
+          zdhssub  = parsub * ( qla_ice_1d(ji) / ( rhosn * xsn ) ) * rdt_ice 
+          zhsn     = h_snow_1d(ji) - zdhssub
+          zdhisub  = MAX( zzero , -zhsn ) * rhosn/rhoic
+          zdhictop(ji) =  zdhictop(ji) - zdhisub
+          h_snow_1d(ji)  =  MAX( zzero , zhsn )
+          !-------------------------------------------------
+          !--  Update Internal temperature and qstbif_1d.
+          !-------------------------------------------
+          zihsn  =  MAX( zzero , SIGN( zone, -h_snow_1d(ji) ) )
+          tbif_1d(ji,1) = ( 1.0 - zihsn ) * tbif_1d(ji,1) + zihsn   * tfu_1d(ji)
+          !--change in snow internal temperature if snow has increased
+          zihnf = MAX( zzero , SIGN( zone , h_snow_1d(ji) - zhsnw_old(ji) ) )
+          zdhsn = 1.0 - zhsnw_old(ji) / MAX( h_snow_1d(ji) , epsi20 )
+          zdtsn = zdhsn * ( sist_1d(ji) - tbif_1d(ji,1) )
+          tbif_1d(ji,1) = tbif_1d(ji,1) + z1midsn(ji) * zihnf * zdtsn
+          !--energy created due to ice melting in the first ice layer
+          zqnes  = ( rt0_ice - tbif_1d(ji,2) ) * rcpic * ( h_ice_1d(ji) / 2. )
+          !--change in first ice layer internal temperature
+          ziqr  = MAX( zzero , SIGN( zone , qstbif_1d(ji) - zqnes ) )
+          zdtic = qstbif_1d(ji) / ( rcpic * ( h_ice_1d(ji) / 2. ) )
+          tbif_1d(ji,2) =  ziqr * rt0_ice + ( 1 - ziqr ) * ( tbif_1d(ji,2) + zdtic )
+          !--update qstbif_1d
+          qstbif_1d(ji) = ziqr * ( qstbif_1d(ji) - zqnes ) * swiqst
+
+
+          !--      9.2. Calculate bottom accretion-ablation and update qstbif_1d.
+          !             Growth and melting at bottom ice surface are governed by  
+          !                 -xlic * Dh = (Fcb - Fbot ) * Dt 
+          !             where Fbot is the net downward heat flux from ice to the ocean
+          !            and Fcb is the conductive heat flux at the bottom surface
+          !---------------------------------------------------------------------------
+          ztbot = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,3) + zidsnic(ji) * sist_1d(ji)
+          !---computes conductive heat flux at bottom surface 
+          zfcbot =  4.0 * zkic(ji) * ( tfu_1d(ji) - ztbot )   &
+             &   / ( h_ice_1d(ji) + zidsnic(ji) * ( 3. * h_ice_1d(ji) &
+             &   + 4.0 * zkic(ji)/zksn(ji) * h_snow_1d(ji) ) )
+          !---computation of net energy needed for bottom melting/growing
+          zqice_bot = ( zfcbot - ( fbif_1d(ji) + qlbbq_1d(ji) ) ) * rdt_ice
+          zqstbif_bot = qstbif_1d(ji)
+          !---switch to know if bottom surface melts ( = 1 ) or grows ( = 0 )occurs
+          zibmlt = MAX( zzero , SIGN( zone , -zqice_bot ) )
+          !--particular case of melting (in the same way as the top surface)
+          zqice_bot_mlt = zqice_bot 
+          zqstbif_old = zqstbif_bot
+
+          ziqf =  MAX ( zzero , SIGN( zone , qstbif_1d(ji) + zqice_bot_mlt  ) )
+          zqice_bot_mlt =         ziqf   * ( zqice_bot_mlt + zqice_bot_mlt ) &
+             &          + ( 1.0 - ziqf ) * ( zqice_bot_mlt + qstbif_1d(ji)  )          
+          qstbif_1d(ji)   =         ziqf   * ( qstbif_1d(ji) + zqice_bot_mlt ) &
+             &          + ( 1.0 - ziqf ) * ( qstbif_1d(ji) - qstbif_1d(ji)  )
+          !--    The contribution of the energy stored in brine pockets qstbif_1d to melt
+          !--    ice is taking into account only when qstbif_1d is less than zqmax. 
+          zihq =  MAX ( zzero , SIGN( zone , qstbif_1d(ji) - zqmax(ji) ) )
+          zqice_bot_mlt =         zihq   * zqice_bot_mlt   &
+             &          + ( 1.0 - zihq ) * zqice_bot
+          qstbif_1d(ji)   =         zihq   * qstbif_1d(ji)   &
+             &             + ( 1.0 - zihq ) * zqstbif_old
+
+          !---treatment of the case of melting/growing
+          zqice_bot   =         zibmlt   * ( zqice_bot_mlt - zqcmlt(ji,2) )   &
+             &        + ( 1.0 - zibmlt ) * ( zqice_bot - zqcmlt(ji,2)  )
+          qstbif_1d(ji) =         zibmlt   * qstbif_1d(ji)   &
+             &           + ( 1.0 - zibmlt ) * zqstbif_bot
+
+          !--computes change in ice thickness due to melt or growth
+          zdhicbot(ji) = zqice_bot / xlic
+          !--limitation of bottom melting if so : hmelt maximum melting at bottom
+          zdhicmlt  = MAX( hmelt , zdhicbot(ji) ) 
+          !--energy after bottom melting/growing
+          zqsup(ji) = ( 1.0 - frld_1d(ji) ) * xlic * ( zdhicmlt - zdhicbot(ji) )
+          !-- compute the new thickness and the newly formed volume after bottom melting/growing
+          zdhicbot(ji)  = zdhicmlt
+          dvbbq_1d(ji) = ( 1.0 - frld_1d(ji) ) * zdhicbot(ji)
+
+
+          !        9.3.  Updating ice thickness after top surface ablation 
+          !              and bottom surface accretion/ablation
+          !---------------------------------------------------------------
+          zhicnew  = h_ice_1d(ji) + zdhictop(ji) + zdhicbot(ji)
+
+          !
+          !        9.4. Case of total ablation (ice is gone but snow may be left)
+          !-------------------------------------------------------------------
+          zhsn  = h_snow_1d(ji)
+          zihgnew = 1.0 - MAX( zzero , SIGN( zone , -zhicnew ) )
+          zihsn   = MAX( zzero , SIGN( zone , -zhsn ) )
+          !---convert 
+          zdhicm  = ( 1.0 - zihgnew ) * ( zhicnew - qstbif_1d(ji) / xlic )
+          zdhsnm  = ( 1.0 - zihsn ) * zdhicm * rhoic / rhosn
+          !---updating new ice thickness and computing the newly formed ice mass
+          zhicnew   =  zihgnew * zhicnew
+          rdmicif_1d(ji) =  rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) * rhoic
+          !---updating new snow thickness and computing the newly formed snow mass
+          zhsnfi   = zhsn + zdhsnm
+          h_snow_1d(ji) = MAX( zzero , zhsnfi )
+          rdmsnif_1d(ji) =  rdmsnif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsn ) * rhosn
+          !--remaining energy in case of total ablation
+          zqocea(ji) = - ( zihsn * xlic * zdhicm + xlsn * ( zhsnfi - h_snow_1d(ji) ) ) * ( 1.0 - frld_1d(ji) )
+          qstbif_1d(ji) = zihgnew * qstbif_1d(ji)
+
+          !
+          !        9.5. Update internal temperature and ice thickness.
+          !-------------------------------------------------------
+          !
+          sist_1d(ji) = zihgnew * sist_1d(ji) + ( 1.0 - zihgnew ) * tfu_1d(ji)
+          zidhb  = MAX( zzero , SIGN( zone , - zdhicbot(ji) ) )
+          zc1    = - zhicnew * 0.5
+          zpc1   = MIN( 0.5 * zone , - h_ice_1d(ji) * 0.5 - zdhictop(ji) )
+          zc2    = - zhicnew
+          zpc2   =  zidhb * zc2 + ( 1.0 - zidhb ) * ( - h_ice_1d(ji) - zdhictop(ji) )
+          zp1    =  MAX( zpc1 , zc1 )
+          zp2    =  MAX( zpc2 , zc1 )
+          zep(ji) =  tbif_1d(ji,2)
+          ztb2  = 2.0 * (         - zp1   * tbif_1d(ji,2)  &
+             &  + ( zp1 - zp2 ) * tbif_1d(ji,3)  &
+             &  + ( zp2 - zc1 ) * tfu_1d(ji) ) / MAX( zhicnew , epsi20 ) 
+          tbif_1d(ji,2) = zihgnew * ztb2 + ( 1.0 - zihgnew ) * tfu_1d(ji)
+          !---
+          zp1  =  MIN( zpc1 , zc1 )
+          zp2  =  MIN( zpc2 , zc1 )
+          zp1  =  MAX( zc2  , zp1 )
+          ztb3 =  2.0 * (   ( 1.0 - zidhb ) * (  ( zc1 - zp2 ) * tbif_1d(ji,3)  &
+             &                                 + ( zp2 - zc2 ) * tfu_1d(ji) )   &
+             &               +      zidhb   * (  ( zc1 - zp1 ) * zep(ji)      &
+             &                                 + ( zp1 - zc2 ) * tbif_1d(ji,3))  ) / MAX( zhicnew , epsi20 )
+          tbif_1d(ji,3) =  zihgnew * ztb3 + ( 1.0 - zihgnew ) * tfu_1d(ji)
+          h_ice_1d(ji)  =  zhicnew
+       END DO
+
+
+       !----------------------------------------------------------------------------
+       !  10. Surface accretion. 
+       !      The change of ice thickness after snow/ice formation is such that
+       !      the interface between snow and ice is located at the same height
+       !      as the ocean surface. It is given by (Fichefet and Morales Maqueda 1999)
+       !          D(h_ice) = (- D(hsn)/alph) =  [rhosn*hsn - (rau0 - rhoic)*hic]
+       !                                     / [alph*rhosn+rau0 - rhoic]
+       !----------------------------------------------------------------------------
+       !
+       DO ji = kideb , kiut
+
+          !--  Computation of the change of ice thickness after snow-ice formation
+          zdrmh =  ( rhosn * h_snow_1d(ji) + ( rhoic - rau0 ) * h_ice_1d(ji) )  &
+             &  / ( alphs * rhosn + rau0 - rhoic )
+          zdrmh = MAX( zzero , zdrmh )
+
+          !--New ice and snow thicknesses Fichefet and Morales Maqueda (1999)
+          zhicnew  = MAX( h_ice_1d(ji) , h_ice_1d(ji) + zdrmh )
+          zhsnnew  = MIN( h_snow_1d(ji) , h_snow_1d(ji) - alphs * zdrmh )
+          !---Compute new ice temperatures. snow temperature remains unchanged
+          !   Lepparanta (1983):
+          zihic = 1.0 - MAX( zzero , SIGN( zone , -zhicnew ) )
+          zquot  = ( 1.0 - zihic ) &
+             &   +         zihic * MIN( zone , h_ice_1d(ji) / MAX( zhicnew , epsi20 ) ) 
+          ztneq  =         alphs * cnscg * tbif_1d(ji,1)    &
+             &   + ( 1.0 - alphs * ( rhosn/rhoic ) ) * tfu_1d(ji)
+          zep(ji) = tbif_1d(ji,2)
+          tbif_1d(ji,2) = ztneq - zquot * zquot * ( ztneq - tbif_1d(ji,2) )
+          tbif_1d(ji,3) = 2.0 * ztneq &
+             &        + zquot * ( tbif_1d(ji,3) + zep(ji) - 2.0 * ztneq ) - tbif_1d(ji,2)
+
+          !---  Lepparanta (1983) (latent heat released during white ice formation
+          !     goes to the ocean -for lateral ablation-)
+          qldif_1d(ji)  = qldif_1d(ji) + zdrmh * ( 1.0 - alphs * ( rhosn/rhoic ) ) * xlic * ( 1.0 - frld_1d(ji) )
+          !--   Changes in ice volume and ice mass Lepparanta (1983):
+          dvnbq_1d(ji) = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) )
+          dmgwi_1d(ji) = dmgwi_1d(ji) + ( 1.0 -frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnnew ) * rhosn
+          !  case of natural freshwater flux
+#if defined key_lim_fdd  
+          rdmicif_1d(ji) = rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) )   * ( zhicnew - h_ice_1d(ji) )  * rhoic
+          rdmsnif_1d(ji) = rdmsnif_1d(ji) + ( 1.0 - frld_1d(ji) )   * ( zhsnnew - h_snow_1d(ji) ) * rhosn
+
+#else
+          rdmicif_1d(ji) = rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) ) * (  ( zhicnew - h_ice_1d(ji) ) * rhoic   &
+             &                                                    + ( zhsnnew - h_snow_1d(ji) ) * rhosn )
+#endif
+
+          !---  Actualize new snow and ice thickness.
+
+          h_snow_1d(ji)  = zhsnnew
+          h_ice_1d(ji)  = zhicnew
+
+       END DO
+
+       !----------------------------------------------------
+       !  11. Lateral ablation (Changes in sea/ice fraction) 
+       !----------------------------------------------------
+       DO ji = kideb , kiut
+          zfrl_old(ji)  = frld_1d(ji)
+          zihic   = 1.0 - MAX( zzero , SIGN( zone , -h_ice_1d(ji) ) )
+          zihsn   = 1.0 - MAX( zzero , SIGN( zone , -h_snow_1d(ji) ) )
+          !--In the case of total ablation (all the ice ice has melted) frld = 1
+          frld_1d(ji)  = ( 1.0 - zihic ) + zihic * zfrl_old(ji)
+          !--Part of solar radiation absorbing inside the ice and going
+          !--through the ocean
+          fscbq_1d(ji) = ( 1.0 - zfrl_old(ji) ) * ( 1.0 - thcm_1d(ji) ) * fstbif_1d(ji)
+          !--Total remaining energy after bottom melting/growing 
+          qfvbq_1d(ji) = zqsup(ji) + ( 1.0 - zihic ) * zqocea(ji)
+          !--Updating of total heat from the ocean
+          qldif_1d(ji)  = qldif_1d(ji) + qfvbq_1d(ji) + ( 1.0 - zihic ) * fscbq_1d(ji) * rdt_ice
+          !--Computation of total heat inside the snow/ice system
+          zqice  = h_snow_1d(ji) * xlsn + h_ice_1d(ji) * xlic
+          zqicetot  = ( 1.0 - frld_1d(ji) ) * zqice
+          !--The concentration of ice is reduced (frld increases) if the heat 
+          !--exchange between ice and ocean is positive
+          ziqf = MAX( zzero , SIGN( zone ,  zqicetot - qldif_1d(ji) ) )
+          zdfrl = qldif_1d(ji) / MAX( epsi20 , zqice ) 
+          frld_1d(ji)  = ( 1.0 - ziqf )    &
+             &       +         ziqf * ( frld_1d(ji) + MAX( zzero , zdfrl ) ) 
+          fltbif_1d(ji) = ( ( 1.0 - zfrl_old(ji) ) * qstbif_1d(ji) - zqicetot  ) / rdt_ice
+          !--  Opening of leads: Hakkinen & Mellor, 1992.
+          zdfrl = - ( zdhictop(ji) + zdhicbot(ji) ) * hakspl * ( 1.0 - zfrl_old(ji) ) &
+             &  / MAX( epsi13 , h_ice_1d(ji) + h_snow_1d(ji) * rhosn/rhoic ) 
+          zfrld_1d(ji) =  frld_1d(ji) + MAX( zzero , zdfrl )
+          !--Limitation of sea-ice fraction <= 1
+          zfrld_1d(ji) = ziqf * MIN( 0.99 * zone , zfrld_1d(ji) ) + ( 1 - ziqf )
+          !---Update surface and internal temperature and snow/ice thicknesses.
+          sist_1d(ji)   = sist_1d(ji)   + ( 1.0 - ziqf ) * ( tfu_1d(ji) - sist_1d(ji)   )
+          tbif_1d(ji,1) = tbif_1d(ji,1) + ( 1.0 - ziqf ) * ( tfu_1d(ji) - tbif_1d(ji,1) )
+          tbif_1d(ji,2) = tbif_1d(ji,2) + ( 1.0 - ziqf ) * ( tfu_1d(ji) - tbif_1d(ji,2) )
+          tbif_1d(ji,3) = tbif_1d(ji,3) + ( 1.0 - ziqf ) * ( tfu_1d(ji) - tbif_1d(ji,3) )
+          !--variation of ice volume and ice mass 
+          dvlbq_1d(ji)   = zihic * ( zfrl_old(ji) - frld_1d(ji) ) * h_ice_1d(ji)
+          rdmicif_1d(ji) = rdmicif_1d(ji) + dvlbq_1d(ji) * rhoic
+          !--variation of snow volume and snow mass 
+          zdvsnvol    = zihsn * ( zfrl_old(ji) - frld_1d(ji) ) * h_snow_1d(ji)
+          rdmsnif_1d(ji) = rdmsnif_1d(ji) + zdvsnvol * rhosn
+          h_snow_1d(ji)  = ziqf * h_snow_1d(ji)
+
+          zdrfrl1 = ziqf * ( 1.0 -  frld_1d(ji) ) / MAX( epsi20 , 1.0 - zfrld_1d(ji) )
+          zdrfrl2 = ziqf * ( 1.0 - zfrl_old(ji) ) / MAX( epsi20 , 1.0 - zfrld_1d(ji) )
+
+          h_snow_1d (ji) = zdrfrl1 * h_snow_1d(ji)
+          h_ice_1d  (ji) = zdrfrl1 * h_ice_1d(ji)
+          qstbif_1d(ji) = zdrfrl2 * qstbif_1d(ji)
+          frld_1d(ji)    = zfrld_1d(ji)
+
+       END DO
+       
+    END SUBROUTINE lim_thd_zdf
+#else
+   !!======================================================================
+   !!                       ***  MODULE limthd_zdf   ***
+   !!                              no sea ice model  
+   !!======================================================================
+CONTAINS
+   SUBROUTINE lim_thd_zdf          ! Empty routine
+   END SUBROUTINE lim_thd_zdf
+#endif
+ END MODULE limthd_zdf
Index: /branches/nemo/NEMO/LIM_SRC/limtrp.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limtrp.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limtrp.F90	(revision 4)
@@ -0,0 +1,315 @@
+MODULE limtrp
+   !!======================================================================
+   !!                       ***  MODULE limtrp   ***
+   !! LIM transport ice model : sea-ice advection/diffusion
+   !!======================================================================
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim' :                                   LIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_trp      : advection/diffusion process of sea ice
+   !!   lim_trp_init : initialization and namelist read
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE phycst
+   USE dom_oce
+   USE daymod
+   USE in_out_manager  ! I/O manager
+   USE ice_oce         ! ice variables
+   USE dom_ice
+   USE ice
+   USE iceini
+   USE limistate
+   USE limadv
+   USE limhdf
+!  USE limdyn
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC lim_trp       ! called by ice_step
+
+   !! * Module variables
+   REAL(wp), PUBLIC  ::   &
+      bound  = 0.0           ! boundary condit. (0.0 no-slip, 1.0 free-slip)
+
+   REAL(wp)  ::           &  ! constant values
+      epsi06 = 1.e-06  ,  &
+      epsi03 = 1.e-03  ,  &
+      epsi16 = 1.e-16  ,  &
+      rzero  = 0.e0    ,  &
+      rone   = 1.e0
+
+   !! * Substitution
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lim_trp
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_trp ***
+      !!                    
+      !! ** purpose : advection/diffusion process of sea ice
+      !!
+      !! ** method  : variables included in the process are scalar,   
+      !!     other values are considered as second order. 
+      !!     For advection, a second order Prather scheme is used.  
+      !!
+      !! ** action :
+      !!
+      !! History :
+      !!   1.0  !  00-01 (LIM)  Original code
+      !!        !  01-05 (G. Madec, R. Hordoir) opa norm
+      !!   2.0  !  04-01 (G. Madec, C. Ethe)  F90, mpp
+      !!---------------------------------------------------------------------
+      !! * Local Variables
+      INTEGER  ::   ji, jj, jk,   &  ! dummy loop indices
+         &          initad           ! number of sub-timestep for the advection
+
+      REAL(wp) ::  &                              
+         zindb  ,  &
+         zacrith, &
+         zindsn , &
+         zindic , &
+         zusvosn, &
+         zusvoic, &
+         zignm  , &
+         zindhe , &
+         zvbord , &
+         zcfl   , &
+         zusnit , &
+         zrtt, ztsn, ztic1, ztic2
+
+      REAL(wp), DIMENSION(jpi,jpj)  ::   &  ! temporary workspace
+         zui_u , zvi_v , zsm   ,         &
+         zs0ice, zs0sn , zs0a  ,         &
+         zs0c0 , zs0c1 , zs0c2 ,         &
+         zs0st
+      !---------------------------------------------------------------------
+
+      IF( numit == nstart  )   CALL lim_trp_init      ! Initialization (first time-step only)
+
+      zsm(:,:) = area(:,:)
+      
+      IF( ldyn ) THEN
+         !-------------------------------------!
+         !   Advection of sea ice properties   !
+         !-------------------------------------!
+
+         ! ice velocities at ocean U- and V-points (zui_u,zvi_v)
+         ! ---------------------------------------
+         ! zvbord factor between 1 and 2 to take into account slip or no-slip boundary conditions.        
+         zvbord = 1.0 + ( 1.0 - bound )
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zui_u(ji,jj) = ( u_ice(ji+1,jj  ) + u_ice(ji+1,jj+1) ) / ( MAX( tmu(ji+1,jj  ) + tmu(ji+1,jj+1), zvbord ) )
+               zvi_v(ji,jj) = ( v_ice(ji  ,jj+1) + v_ice(ji+1,jj+1) ) / ( MAX( tmu(ji  ,jj+1) + tmu(ji+1,jj+1), zvbord ) )
+            END DO
+         END DO
+         ! Lateral boundary conditions on zui_u, zvi_v
+         CALL lbc_lnk( zui_u, 'U', -1. )
+         CALL lbc_lnk( zvi_v, 'V', -1. )
+
+         ! CFL test for stability
+         ! ----------------------
+         zcfl  = 0.e0
+         zcfl  = MAX( zcfl, MAXVAL( ABS( zui_u(1:jpim1, :     ) ) * rdt_ice / e1u(1:jpim1, :     ) ) )
+         zcfl  = MAX( zcfl, MAXVAL( ABS( zvi_v( :     ,1:jpjm1) ) * rdt_ice / e2v( :     ,1:jpjm1) ) )
+
+         IF ( zcfl > 0.5 )   WRITE(numout,*) 'lim_trp : violation of cfl criterion the ',nday,'th day, cfl = ',zcfl
+
+         ! content of properties
+         ! ---------------------
+         zs0sn (:,:) =  hsnm(:,:) * area(:,:)                 ! Snow volume.
+         zs0ice(:,:) =  hicm (:,:) * area(:,:)                ! Ice volume.
+         zs0a  (:,:) =  ( 1.0 - frld(:,:) ) * area(:,:)       ! Surface covered by ice.
+         zs0c0 (:,:) =  tbif(:,:,1) / rt0_snow * zs0sn(:,:)   ! Heat content of the snow layer.
+         zs0c1 (:,:) =  tbif(:,:,2) / rt0_ice  * zs0ice(:,:)  ! Heat content of the first ice layer.
+         zs0c2 (:,:) =  tbif(:,:,3) / rt0_ice  * zs0ice(:,:)  ! Heat content of the second ice layer.
+         zs0st (:,:) =  qstoif(:,:) / xlic     * zs0a(:,:)    ! Heat reservoir for brine pockets.
+         
+ 
+         ! Advection 
+         ! ---------
+         ! If ice drift field is too fast, use an appropriate time step for advection.         
+         initad = 1 + INT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) )
+         zusnit = 1.0 / REAL( initad ) 
+         
+         IF ( MOD( nday , 2 ) == 0) THEN
+            DO jk = 1,initad
+               CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice )
+               CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice )
+               CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0sn , sxsn , sxxsn , sysn , syysn , sxysn  )
+               CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0sn , sxsn , sxxsn , sysn , syysn , sxysn  )
+               CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0a  , sxa  , sxxa  , sya  , syya  , sxya   )
+               CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0a  , sxa  , sxxa  , sya  , syya  , sxya   )
+               CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  )
+               CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  )
+               CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  )
+               CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  )
+               CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  )
+               CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  )
+               CALL lim_adv_x( zusnit, zui_u, rone , zsm, zs0st , sxst , sxxst , syst , syyst , sxyst  )
+               CALL lim_adv_y( zusnit, zvi_v, rzero, zsm, zs0st , sxst , sxxst , syst , syyst , sxyst  )
+            END DO
+         ELSE
+            DO jk = 1, initad
+               CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice )
+               CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0ice, sxice, sxxice, syice, syyice, sxyice )
+               CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0sn , sxsn , sxxsn , sysn , syysn , sxysn  )
+               CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0sn , sxsn , sxxsn , sysn , syysn , sxysn  )
+               CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0a  , sxa  , sxxa  , sya  , syya  , sxya   )
+               CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0a  , sxa  , sxxa  , sya  , syya  , sxya   )
+               CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  )
+               CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0c0 , sxc0 , sxxc0 , syc0 , syyc0 , sxyc0  )
+               CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  )
+               CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0c1 , sxc1 , sxxc1 , syc1 , syyc1 , sxyc1  )
+               CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  )
+               CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0c2 , sxc2 , sxxc2 , syc2 , syyc2 , sxyc2  )
+               CALL lim_adv_y( zusnit, zvi_v, rone , zsm, zs0st , sxst , sxxst , syst , syyst , sxyst  )
+               CALL lim_adv_x( zusnit, zui_u, rzero, zsm, zs0st , sxst , sxxst , syst , syyst , sxyst  )
+            END DO
+         ENDIF
+                        
+         ! recover the properties from their contents
+         ! ------------------------------------------
+         zs0ice(:,:) = zs0ice(:,:) / area(:,:)
+         zs0sn (:,:) = zs0sn (:,:) / area(:,:)
+         zs0a  (:,:) = zs0a  (:,:) / area(:,:)
+         zs0c0 (:,:) = zs0c0 (:,:) / area(:,:)
+         zs0c1 (:,:) = zs0c1 (:,:) / area(:,:)
+         zs0c2 (:,:) = zs0c2 (:,:) / area(:,:)
+         zs0st (:,:) = zs0st (:,:) / area(:,:)
+
+
+         !-------------------------------------!
+         !   Diffusion of sea ice properties   !
+         !-------------------------------------!
+
+         ! Masked eddy diffusivity coefficient at ocean U- and V-points
+         ! ------------------------------------------------------------
+         DO jj = 1, jpjm1          ! NB: has not to be defined on jpj line and jpi row
+            DO ji = 1 , fs_jpim1   ! vector opt.
+               pahu(ji,jj) = ( 1.0 - MAX( rzero, SIGN( rone, -zs0a(ji  ,jj) ) ) )   &
+                  &        * ( 1.0 - MAX( rzero, SIGN( rone, -zs0a(ji+1,jj) ) ) ) * ahiu(ji,jj)
+               pahv(ji,jj) = ( 1.0 - MAX( rzero, SIGN( rone, -zs0a(ji,jj  ) ) ) )   &
+                  &        * ( 1.0 - MAX( rzero, SIGN( rone,- zs0a(ji,jj+1) ) ) ) * ahiv(ji,jj)
+            END DO
+         END DO
+
+         ! diffusion
+         ! ---------
+         CALL lim_hdf( zs0ice )
+         CALL lim_hdf( zs0sn  )
+         CALL lim_hdf( zs0a   )
+         CALL lim_hdf( zs0c0  )
+         CALL lim_hdf( zs0c1  )
+         CALL lim_hdf( zs0c2  )
+         CALL lim_hdf( zs0st  )
+
+         zs0ice(:,:) = MAX( rzero, zs0ice(:,:) * area(:,:) )    !!bug:  est-ce utile
+         zs0sn (:,:) = MAX( rzero, zs0sn (:,:) * area(:,:) )    !!bug:  cf /area  juste apres
+         zs0a  (:,:) = MAX( rzero, zs0a  (:,:) * area(:,:) )    !! suppression des 2 change le resultat...
+         zs0c0 (:,:) = MAX( rzero, zs0c0 (:,:) * area(:,:) )
+         zs0c1 (:,:) = MAX( rzero, zs0c1 (:,:) * area(:,:) )
+         zs0c2 (:,:) = MAX( rzero, zs0c2 (:,:) * area(:,:) )
+         zs0st (:,:) = MAX( rzero, zs0st (:,:) * area(:,:) )
+
+
+         ! -------------------------------------------------------------------!
+         !   Up-dating and limitation of sea ice properties after transport   !
+         ! -------------------------------------------------------------------!
+
+         ! Up-dating and limitation of sea ice properties after transport.
+         DO jj = 1, jpj
+            zindhe = REAL( MAX( 0, isign(1, jj - jeq ) ) )              !ibug mpp  !!bugmpp  jeq!
+            DO ji = 1, jpi
+
+               ! Recover mean values over the grid squares.
+               zs0sn (ji,jj) = MAX( rzero, zs0sn (ji,jj)/area(ji,jj) )
+               zs0ice(ji,jj) = MAX( rzero, zs0ice(ji,jj)/area(ji,jj) )
+               zs0a  (ji,jj) = MAX( rzero, zs0a  (ji,jj)/area(ji,jj) )
+               zs0c0 (ji,jj) = MAX( rzero, zs0c0 (ji,jj)/area(ji,jj) )
+               zs0c1 (ji,jj) = MAX( rzero, zs0c1 (ji,jj)/area(ji,jj) )
+               zs0c2 (ji,jj) = MAX( rzero, zs0c2 (ji,jj)/area(ji,jj) )
+               zs0st (ji,jj) = MAX( rzero, zs0st (ji,jj)/area(ji,jj) )
+
+               ! Recover in situ values.
+               zindb         = MAX( rzero, SIGN( rone, zs0a(ji,jj) - epsi06 ) )
+               zacrith       = 1.0 - ( zindhe * acrit(1) + ( 1.0 - zindhe ) * acrit(2) )
+               zs0a (ji,jj)  = zindb * MIN( zs0a(ji,jj), zacrith )
+               hsnif(ji,jj)  = zindb * ( zs0sn(ji,jj) /MAX( zs0a(ji,jj), epsi16 ) )
+               hicif(ji,jj)  = zindb * ( zs0ice(ji,jj)/MAX( zs0a(ji,jj), epsi16 ) )
+               zindsn        = MAX( rzero, SIGN( rone, hsnif(ji,jj) - epsi06 ) )
+               zindic        = MAX( rzero, SIGN( rone, hicif(ji,jj) - epsi03 ) )
+               zindb         = MAX( zindsn, zindic )
+               zs0a (ji,jj)  = zindb * zs0a(ji,jj)
+               frld (ji,jj)  = 1.0 - zs0a(ji,jj)
+               hsnif(ji,jj)  = zindsn * hsnif(ji,jj)
+               hicif(ji,jj)  = zindic * hicif(ji,jj)
+               zusvosn       = 1.0/MAX( hsnif(ji,jj) * zs0a(ji,jj), epsi16 )
+               zusvoic       = 1.0/MAX( hicif(ji,jj) * zs0a(ji,jj), epsi16 )
+               zignm         = MAX( rzero,  SIGN( rone, hsndif - hsnif(ji,jj) ) )
+               zrtt          = 173.15 * rone 
+               ztsn          =          zignm   * tbif(ji,jj,1)  &
+                              + ( 1.0 - zignm ) * MIN( MAX( zrtt, rt0_snow * zusvosn * zs0c0(ji,jj)) , tfu(ji,jj) ) 
+               ztic1          = MIN( MAX( zrtt, rt0_ice * zusvoic * zs0c1(ji,jj) ) , tfu(ji,jj) )
+               ztic2          = MIN( MAX( zrtt, rt0_ice * zusvoic * zs0c2(ji,jj) ) , tfu(ji,jj) )
+ 
+               tbif(ji,jj,1) = zindsn * ztsn  + ( 1.0 - zindsn ) * tfu(ji,jj)               
+               tbif(ji,jj,2) = zindic * ztic1 + ( 1.0 - zindic ) * tfu(ji,jj)
+               tbif(ji,jj,3) = zindic * ztic2 + ( 1.0 - zindic ) * tfu(ji,jj)
+               qstoif(ji,jj) = zindb  * xlic * zs0st(ji,jj) /  MAX( zs0a(ji,jj), epsi16 )
+            END DO
+         END DO
+         
+      ENDIF
+      
+   END SUBROUTINE lim_trp
+
+
+   SUBROUTINE lim_trp_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_trp_init  ***
+      !!
+      !! ** Purpose :   initialization of ice advection parameters
+      !!
+      !! ** Method  : Read the namicetrp namelist and check the parameter 
+      !!       values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicetrp
+      !!
+      !! history :
+      !!   2.0  !  03-08 (C. Ethe)  Original code
+      !!-------------------------------------------------------------------
+      NAMELIST/namicetrp/ bound
+      !!-------------------------------------------------------------------
+
+      ! Read Namelist namicetrp
+      REWIND ( numnam_ice )
+      READ   ( numnam_ice  , namicetrp )
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_trp_init : Ice parameters for advection '
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   boundary conditions (0.0 no-slip, 1.0 free-slip) bound  = ', bound
+      ENDIF
+            
+   END SUBROUTINE lim_trp_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty Module                No sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_trp        ! Empty routine
+   END SUBROUTINE lim_trp
+#endif
+
+   !!======================================================================
+END MODULE limtrp
Index: /branches/nemo/NEMO/LIM_SRC/limwri.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/limwri.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/limwri.F90	(revision 4)
@@ -0,0 +1,298 @@
+MODULE limwri
+   !!======================================================================
+   !!                     ***  MODULE  limwri  ***
+   !!         Ice diagnostics :  write ice output files
+   !!======================================================================
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim'                                     LIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_wri      : write of the diagnostics variables in ouput file 
+   !!   lim_wri_init : initialization and namelist read
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE ioipsl
+   USE dianam    ! build name of file (routine)
+   USE phycst
+   USE dom_oce
+   USE daymod
+   USE in_out_manager
+   USE ice_oce         ! ice variables
+   USE flx_oce
+   USE dom_ice
+   USE ice
+   USE iceini
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC lim_wri        ! routine called by lim_step.F90
+
+   !! * Module variables
+   INTEGER  ::                                &
+      noumef                                     ! number of fields
+   REAL(wp)           , DIMENSION(noumax) ::  &
+      cmulti ,                                &  ! multiplicative constant
+      cadd                                       ! additive constant
+   CHARACTER(len = 35), DIMENSION(noumax) ::  &
+      titn                                       ! title of the field
+   CHARACTER(len = 8 ), DIMENSION(noumax) ::  &
+      nam                                        ! name of the field
+   CHARACTER(len = 8 ), DIMENSION(noumax) ::  &
+      uni                                        ! unit of the field
+   INTEGER            , DIMENSION(noumax) ::  &
+      nc                                         ! switch for saving field ( = 1 ) or not ( = 0 )
+
+   REAL(wp)  ::            &  ! constant values
+      epsi16 = 1e-16   ,  &
+      zzero  = 0.0     ,  &
+      zone   = 1.0
+
+CONTAINS
+
+   SUBROUTINE lim_wri
+      !!-------------------------------------------------------------------
+      !!  This routine computes the average of some variables and write it
+      !!  on the ouput files.
+      !!  ATTENTION cette routine n'est valable que si le pas de temps est
+      !!  egale a une fraction entiere de 1 jours.
+      !!  Diff 1-D 3-D : suppress common also included in etat
+      !!                 suppress cmoymo 11-18
+      !!  modif : 03/06/98
+      !!-------------------------------------------------------------------
+      !! * Local variables
+      REAL(wp),DIMENSION(1) ::   zdept
+      
+      REAL(wp) :: &
+         zsto, zsec, zjulian,zout, &
+         zindh,zinda,zindb,  &
+         ztmu
+      REAL(wp), DIMENSION(jpi,jpj,noumax) :: &
+         zcmo
+      REAL(wp), DIMENSION(jpi,jpj) ::  &
+         zfield
+      INTEGER ::  ji, jj, jf   ! dummy loop indices
+
+      CHARACTER(len = 40)  :: &
+         clhstnam, clop
+
+      INTEGER , SAVE ::      &
+         nice, nhorid, ndim, niter, ndepid
+      INTEGER , DIMENSION( jpij ) , SAVE ::  &
+         ndex51  
+      !!-------------------------------------------------------------------
+ 
+
+      
+      IF ( numit == nstart ) THEN 
+
+         CALL lim_wri_init 
+         
+         !---5----|----5----|----5----|----5----|----5----|----5----|----5----|72
+         !  1) INITIALIZATIONS.                                                 |
+         !-----------------------------------------------------------------------
+         
+         !-- essai NetCDF
+         
+         zsto     = rdt_ice
+!!Chris         clop     = "ave(only(x))"      !ibug  namelist parameter a ajouter
+         clop     = "ave(x)"
+         zout     = nwrite * rdt_ice / nfice
+         zsec     = 0.
+         niter    = 0
+         zdept(1) = 0.
+         
+         CALL ymds2ju ( nyear, nmonth, nday, zsec, zjulian )
+         CALL dia_nam ( clhstnam, nwrite, 'icemod' )
+         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, 0, zjulian, rdt_ice, nhorid, nice )
+         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid)
+         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
+         
+         DO jf = 1 , noumef
+            IF ( nc(jf) == 1 ) THEN
+               CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj &
+                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
+            ENDIF
+         END DO
+         CALL histend(nice)
+         
+      ENDIF
+      
+      !---5----|----5----|----5----|----5----|----5----|----5----|----5----|72
+      !--2. Computation of instantaneous values                                         |
+      !-----------------------------------------------------------------------
+
+      IF(lwp .AND. L_ctl) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit
+         WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      !-- calculs des valeurs instantanees
+      
+      zcmo( 1:jpi, 1:jpj, 1:noumax ) = 0.0 
+      DO jj = 2 , jpjm1
+         DO ji = 2 , jpim1
+            zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
+            zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
+            zindb  = zindh * zinda
+            ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
+            zcmo(ji,jj,1)  = hsnif (ji,jj)
+            zcmo(ji,jj,2)  = hicif (ji,jj)
+            zcmo(ji,jj,3)  = hicifp(ji,jj)
+            zcmo(ji,jj,4)  = frld  (ji,jj)
+            zcmo(ji,jj,5)  = sist  (ji,jj)
+            zcmo(ji,jj,6)  = fbif  (ji,jj)
+            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
+                                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+                                  / ztmu 
+
+            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
+                                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+                                  / ztmu
+            zcmo(ji,jj,9)  = sst_io(ji,jj)
+            zcmo(ji,jj,10) = sss_io(ji,jj)
+
+            zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj)
+            zcmo(ji,jj,12) = fsolar (ji,jj)
+            zcmo(ji,jj,13) = fnsolar(ji,jj)
+            ! See thersf for the coefficient
+            zcmo(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce
+            zcmo(ji,jj,15) = gtaux(ji,jj)
+            zcmo(ji,jj,16) = gtauy(ji,jj)
+            zcmo(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj)
+            zcmo(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj)
+            zcmo(ji,jj,19) = sprecip(ji,jj)
+         END DO
+      END DO
+                
+      !
+      ! ecriture d'un fichier netcdf
+      !
+      niter = niter + 1
+      DO jf = 1 , noumef
+         DO jj = 1 , jpj
+            DO ji = 1 , jpi
+               zfield(ji,jj) = zcmo(ji,jj,jf) * cmulti(jf) + cadd(jf)
+            END DO
+         END DO
+         
+         IF ( jf == 7  .OR. jf == 8  .OR. jf == 11 .OR. jf == 12 .OR. jf == 15 .OR.   &
+            jf == 23 .OR. jf == 24 .OR. jf == 16 ) THEN 
+            CALL lbc_lnk( zfield, 'T', -1. )
+         ELSE 
+            CALL lbc_lnk( zfield, 'T',  1. )
+         ENDIF
+         
+         IF ( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
+         
+      END DO
+      
+      IF ( ( nfice * niter + nit000 - 1 ) >= nitend ) THEN
+         CALL histclo( nice ) 
+      ENDIF
+      
+   END SUBROUTINE lim_wri
+
+   SUBROUTINE lim_wri_init
+      !!-------------------------------------------------------------------
+      !!                    ***   ROUTINE lim_wri_init  ***
+      !!                
+      !! ** Purpose :   ???
+      !!
+      !! ** Method  : Read the namicewri namelist and check the parameter 
+      !!       values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicewri
+      !!
+      !! history :
+      !!  8.5  ! 03-08 (C. Ethe) original code
+      !!-------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   nf      ! ???
+
+      TYPE FIELD 
+         CHARACTER(len = 35) :: ztitle 
+         CHARACTER(len = 8 ) :: zname          
+         CHARACTER(len = 8 ) :: zunit
+         INTEGER             :: znc   
+         REAL                :: zcmulti 
+         REAL                :: zcadd        
+      END TYPE FIELD
+
+      TYPE(FIELD) ::  &
+         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
+         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
+         field_13, field_14, field_15, field_16, field_17, field_18,   &
+         field_19
+
+      TYPE(FIELD) , DIMENSION(noumax) :: zfield
+
+      NAMELIST/namiceout/ noumef, &
+         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
+         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
+         field_13, field_14, field_15, field_16, field_17, field_18,   &
+         field_19
+      !!-------------------------------------------------------------------
+
+
+      ! Read Namelist namicewri
+      REWIND ( numnam_ice )
+      READ   ( numnam_ice  , namiceout )
+      zfield(1)  = field_1
+      zfield(2)  = field_2
+      zfield(3)  = field_3
+      zfield(4)  = field_4
+      zfield(5)  = field_5
+      zfield(6)  = field_6
+      zfield(7)  = field_7
+      zfield(8)  = field_8
+      zfield(9)  = field_9
+      zfield(10) = field_10
+      zfield(11) = field_11
+      zfield(12) = field_12
+      zfield(13) = field_13
+      zfield(14) = field_14
+      zfield(15) = field_15
+      zfield(16) = field_16
+      zfield(17) = field_17
+      zfield(18) = field_18
+      zfield(19) = field_19
+      
+      DO nf = 1, noumef
+         titn  (nf) = zfield(nf)%ztitle
+         nam   (nf) = zfield(nf)%zname
+         uni   (nf) = zfield(nf)%zunit
+         nc    (nf) = zfield(nf)%znc
+         cmulti(nf) = zfield(nf)%zcmulti
+         cadd  (nf) = zfield(nf)%zcadd
+      END DO
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '    number of fields to be stored         noumef = ', noumef
+         WRITE(numout,*) '           title                            name     unit      Saving (1/0) ',   &
+            &            '    multiplicative constant       additive constant '
+         DO nf = 1 , noumef         
+            WRITE(numout,*) '   ', titn(nf), '   ', nam(nf),'      ', uni(nf),'  ', nc(nf),'        ', cmulti(nf),   &
+               '        ', cadd(nf)
+         END DO
+      ENDIF
+            
+   END SUBROUTINE lim_wri_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :         Empty module          NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_wri          ! Empty routine
+   END SUBROUTINE lim_wri
+#endif
+
+   !!======================================================================
+END MODULE limwri
Index: /branches/nemo/NEMO/LIM_SRC/par_ice.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/par_ice.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/par_ice.F90	(revision 4)
@@ -0,0 +1,32 @@
+MODULE par_ice
+   !!======================================================================
+   !!                       ***  MODULE par_ice   ***
+   !! Sea-Ice model : definition of the parameters
+   !!======================================================================
+   !! * Modules used
+   USE par_oce
+
+   INTEGER, PARAMETER ::   &
+      kmax =   1    ,      &  ! ???
+      nsmax =  2              ! ???
+
+   !!-- Parameter providing the number of vertical ice layers
+   
+   INTEGER , PARAMETER ::   &
+      nlayers   = 2 ,          &  ! ???
+      nlayersp1 = nlayers + 1     ! ???
+
+   ! maximum number of variable for output
+   INTEGER, PARAMETER ::   &
+      noumax = 40                 ! ???
+
+   ! Parameters for outputs to files "evolu" made by routine "informe" : ???
+   INTEGER, PARAMETER :: &
+      ninfmx = 100                ! maximum number of key variables
+   INTEGER, PARAMETER :: &
+      nchinf = 5                  ! ???
+   INTEGER, PARAMETER :: &
+      nchsep = nchinf + 2         ! ???
+
+   !!======================================================================
+END MODULE par_ice
Index: /branches/nemo/NEMO/LIM_SRC/thd_ice.F90
===================================================================
--- /branches/nemo/NEMO/LIM_SRC/thd_ice.F90	(revision 4)
+++ /branches/nemo/NEMO/LIM_SRC/thd_ice.F90	(revision 4)
@@ -0,0 +1,82 @@
+MODULE thd_ice
+   !!======================================================================
+   !!                       ***  MODULE thd_ice  ***
+   !! LIM sea-ice :   Ice thermodynamics in 1D
+   !!=====================================================================
+   !!
+   !! ** Purpose : - Define in memory LIM thermodynamical variables in 1D
+   !!
+   !! History :
+   !!   2.0  !  02-11  (C. Ethe)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   !!  LIM 2.0, UCL-LODYC-IPSL (2002)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_ice
+
+   !! * Share Module variables
+   REAL(wp) , PUBLIC ::   & !!! ** ice-thermo namelist (namicethd) **
+      hmelt   = -0.15  ,  & ! maximum melting at the bottom
+      hicmin  = 0.2    ,  & ! ice th. corr. to max. ener. in brine pocket
+      hiclim  = 0.05   ,  & ! minimum ice thickness
+      amax    = 0.999  ,  & ! maximum lead fraction
+      swiqst  = 1.0    ,  & ! energy stored in brine pocket (1) or not (0)
+      sbeta   = 1.0    ,  & ! numerical scheme for diffusion in ice 
+      parlat  = 0.0    ,  & ! percent. of energy used for lateral ablation
+      hakspl  = 0.5    ,  & ! slope of distr. for Hakkinen-Mellro's lat. melt
+      hibspl  = 0.5    ,  & ! slope of distribution for Hibler's lat. melt
+      exld    = 2.0    ,  & ! exponent for leads-closure rate
+      hakdif  = 1.0    ,  & ! coefficient for diffusions of ice and snow
+      thth    = 0.2    ,  & ! thick. for comp. of eq. thermal conduct
+      hnzst   = 0.1    ,  & ! thick. of the surf. layer in temp. comp.
+      parsub  = 1.0    ,  & ! switch for snow sublimation or not
+      alphs   = 1.0         ! coef. for snow density when snow-ice formation
+
+   REAL(wp), PUBLIC, DIMENSION(2)  ::  &   
+      hiccrit = (/0.3,0.3/) ! ice th. for lateral accretion in the NH (SH) (m)
+
+   REAL(wp) , PUBLIC ::   &
+      uscomi,             & ! inverse of minimum lead fraction
+      cnscg                 ! ratio  rcpsn/rcpic
+
+   INTEGER , DIMENSION(jpij) ::   &
+      npb     ,   &  ! number of points where computations has to be done
+      npac           ! correspondance between the points
+
+   REAL(wp), DIMENSION(jpij) ::   &  
+      qldif_1d    ,     &  ! corresponding to the 2D var  qldif
+      qcmif_1d    ,     &  ! corresponding to the 2D var  qcmif
+      thcm_1d     ,     &  !    "                  "      thcm
+      fstbif_1d   ,     &  !    "                  "      fstric
+      fltbif_1d   ,     &  !    "                  "      ffltbif
+      fscbq_1d    ,     &  !    "                  "      fscmcbq
+      qsr_ice_1d  ,     &  !    "                  "      qsr_ice
+      fr1_i0_1d   ,     &  !    "                  "      fr1_i0
+      fr2_i0_1d   ,     &  !    "                  "      fr2_i0
+      qnsr_ice_1d ,     &  !    "                  "      qns_ice
+      qfvbq_1d    ,     &  !    "                  "      qfvbq
+      sist_1d     ,     &  !    "                  "      sist
+      tfu_1d      ,     &  !    "                  "      tfu
+      sprecip_1d  ,     &  !    "                  "      sprecip
+      h_snow_1d   ,     &  !    "                  "      h_snow
+      h_ice_1d    ,     &  !    "                  "      h_ice
+      frld_1d     ,     &  !    "                  "      frld
+      qstbif_1d   ,     &  !    "                  "      qstoif
+      fbif_1d     ,     &  !    "                  "      fbif
+      rdmicif_1d  ,     &  !    "                  "      rdmicif
+      rdmsnif_1d  ,     &  !    "                  "      rdmsnif
+      qlbbq_1d    ,     &  !    "                  "      qlbsbq
+      dmgwi_1d    ,     &  !    "                  "      dmgwi
+      dvsbq_1d    ,     &  !    "                  "      rdvosif
+      dvbbq_1d    ,     &  !    "                  "      rdvobif
+      dvlbq_1d    ,     &  !    "                  "      rdvolif
+      dvnbq_1d    ,     &  !    "                  "      rdvolif
+      dqns_ice_1d ,     &  !    "                  "      dqns_ice
+      qla_ice_1d  ,     &  !    "                  "      qla_ice
+      dqla_ice_1d          !    "                  "      dqla_ice
+
+   REAL(wp), DIMENSION(jpij,nlayersp1) ::   &
+      tbif_1d              ! corresponding to the 2D var  tbif
+
+   !!======================================================================
+END MODULE thd_ice
Index: /branches/nemo/NEMO/OPA_SRC/DIA/diafwb.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 4)
@@ -0,0 +1,449 @@
+MODULE diafwb
+   !!======================================================================
+   !!                       ***  MODULE  diafwb  ***
+   !! Ocean diagnostics: freshwater budget
+   !!======================================================================
+#if ( defined key_orca_r2 || defined  key_orca_r4 ) && defined key_dynspg_fsc && ! defined key_coupled
+   !!----------------------------------------------------------------------
+   !!   "key_dynspg_fsc" and "key_orca_r2 or 4"
+   !!----------------------------------------------------------------------
+   !!   dia_fwb     : freshwater budget for global ocean configurations
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE flxrnf          ! ???
+   USE ocesbc          ! ???
+   USE blk_oce         ! ???
+   USE flxblk          ! atmospheric surface quantity
+   USE lib_mpp         ! distributed memory computing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dia_fwb    ! routine called by step.F90
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .TRUE.    ! fresh water budget flag
+
+   !! * Module variables
+   REAL(wp) ::   &
+      a_emp, a_precip, a_rnf,   &
+      a_sshb, a_sshn, a_salb, a_saln,   &
+      a_aminus, a_aplus
+   REAL(wp), DIMENSION(4) ::   &
+      a_flxi, a_flxo, a_temi, a_temo, a_sali, a_salo
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dia_fwb( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_fwb  ***
+      !!     
+      !! ** Purpose :
+      !!	
+      !! ** Method :
+      !!	
+      !! History :
+      !!   8.2  !  01-02  (E. Durand)  Original code
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER :: ji, jj, jk, jt   ! dummy loop indices
+      REAL(wp) ::   zarea, zvol, zwei
+      REAL(wp) ::  ztemi(4), ztemo(4), zsali(4), zsalo(4), zflxi(4), zflxo(4)
+      REAL(wp) ::  zt, zs, zu  
+      REAL(wp) ::  zsm0, zempnew
+      !!----------------------------------------------------------------------
+
+      ! Mean global salinity
+      zsm0 = 34.72654
+
+      ! To compute emp mean value mean emp
+
+      IF( kt == nit000 ) THEN
+
+         a_emp    = 0.e0
+         a_precip = 0.e0
+         a_rnf    = 0.e0
+         a_sshb   = 0.e0 ! valeur de ssh au debut de la simulation
+         a_salb   = 0.e0 ! valeur de sal au debut de la simulation
+         a_aminus = 0.e0
+         a_aplus  = 0.e0
+         ! sshb used because diafwb called after tranxt (i.e. after the swap)
+         a_sshb = SUM( e1t(:,:) * e2t(:,:) * sshb(:,:) * tmask_i(:,:) )
+
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  a_salb = a_salb + ( sb(ji,jj,jk) - zsm0 ) * zwei
+               END DO
+            END DO
+         END DO
+      ENDIF
+      
+      a_emp    = SUM( e1t(:,:) * e2t(:,:) * emp   (:,:) * tmask_i(:,:) )
+#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+      a_precip = SUM( e1t(:,:) * e2t(:,:) * watm  (:,:) * tmask_i(:,:) )
+#endif
+      a_rnf    = SUM( e1t(:,:) * e2t(:,:) * runoff(:,:) * tmask_i(:,:) )
+
+      IF( aminus /= 0.0 ) a_aminus = a_aminus + ( MIN( aplus, aminus ) / aminus )
+      IF( aplus  /= 0.0 ) a_aplus  = a_aplus  + ( MIN( aplus, aminus ) / aplus  )
+
+#if defined key_mpp
+      ! Mpp: sum over all the global domain
+      CALL  mpp_sum( a_sshn )                            !!!!!! bugggggg   a_sshn note befined before!!!!!
+#endif
+
+      IF( kt == nitend ) THEN
+         a_sshn = 0.e0
+         a_saln = 0.e0
+         zarea = 0.e0
+         zvol  = 0.e0
+         zempnew = 0.e0
+         ! Mean sea level at nitend
+         a_sshn = SUM( e1t(:,:) * e2t(:,:) * sshn(:,:) * tmask_i(:,:) )
+         zarea  = SUM( e1t(:,:) * e2t(:,:) *             tmask_i(:,:) )
+         
+         DO jk = 1, jpkm1   
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  a_saln = a_saln + ( sn(ji,jj,jk) - zsm0 ) * zwei
+                  zvol  = zvol  + zwei
+               END DO
+            END DO
+         END DO
+         
+         a_aminus = a_aminus/(nitend-nit000+1)
+         a_aplus  = a_aplus/(nitend-nit000+1)
+
+         ! Conversion in m3
+         a_emp    = a_emp * rdttra(1) * 1.e-3 
+         a_precip = a_precip * rdttra(1) * 1.e-3 / rday
+         a_rnf    = a_rnf * rdttra(1) * 1.e-3
+         
+         ! Alpha1=Alpha0-Rest/(Precip+runoff)
+         !  C A U T I O N : precipitations are negative !!     
+         
+         zempnew = a_sshn / ( ( nitend - nit000 + 1 ) * rdt ) * 1.e3 / zarea
+
+      ENDIF
+
+
+      ! Calcul des termes de transport 
+      ! ------------------------------
+      
+      ! 1 --> Gibraltar 
+      ! 2 --> Cadiz 
+      ! 3 --> Red Sea
+      ! 4 --> Baltic Sea
+
+      IF( kt == nit000 ) THEN
+         a_flxi(:) = 0.e0
+         a_flxo(:) = 0.e0
+         a_temi(:) = 0.e0
+         a_temo(:) = 0.e0
+         a_sali(:) = 0.e0
+         a_salo(:) = 0.e0
+      ENDIF
+
+      zflxi(:) = 0.e0
+      zflxo(:) = 0.e0
+      ztemi(:) = 0.e0
+      ztemo(:) = 0.e0
+      zsali(:) = 0.e0
+      zsalo(:) = 0.e0
+
+      ! Mean flow at Gibraltar
+
+      IF( cp_cfg == "orca" ) THEN  
+               
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration
+            !                                        ! =======================
+            ji =  mi1(70)
+            jj =  mj1(52)
+            !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration
+            !                                        ! =======================
+            ji = mi1(139)
+            jj = mj1(102)
+            !                                        ! =======================
+         CASE DEFAULT                                !    ORCA R05 or R025
+            !                                        ! =======================
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*)' dia_fwb Not yet implemented in ORCA_R05 or R025'
+            nstop = nstop + 1
+            ! 
+         END SELECT
+         ! 
+      ENDIF
+      DO jk = 1, 18 
+         zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) )
+         zs = 0.5 * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) )
+         zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj)
+
+         IF( un(ji,jj,jk) > 0.0 ) THEN 
+            zflxi(1) = zflxi(1) +    zu
+            ztemi(1) = ztemi(1) + zt*zu
+            zsali(1) = zsali(1) + zs*zu
+         ELSE
+            zflxo(1) = zflxo(1) +    zu
+            ztemo(1) = ztemo(1) + zt*zu
+            zsalo(1) = zsalo(1) + zs*zu
+         ENDIF
+      END DO
+      
+      ! Mean flow at Cadiz
+      IF( cp_cfg == "orca" ) THEN
+               
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration
+            !                                        ! =======================
+            ji =  mi1(69  )
+            jj =  mj1(52  )
+            !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration
+            !                                        ! =======================
+            ji = mi1(137)
+            jj = mj1(102)
+            !                                        ! =======================
+         CASE DEFAULT                                !    ORCA R05 or R025
+            !                                        ! =======================
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*)' dia_fwb Not yet implemented in ORCA_R05 or R025'
+            nstop = nstop + 1
+            ! 
+         END SELECT
+         ! 
+      ENDIF
+      DO jk = 1, 23 
+         zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) )
+         zs = 0.5 * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) )
+         zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj)
+         
+         IF( un(ji,jj,jk) > 0.0 ) THEN 
+            zflxi(2) = zflxi(2) +    zu
+            ztemi(2) = ztemi(2) + zt*zu
+            zsali(2) = zsali(2) + zs*zu
+         ELSE
+            zflxo(2) = zflxo(2) +    zu
+            ztemo(2) = ztemo(2) + zt*zu
+            zsalo(2) = zsalo(2) + zs*zu
+         ENDIF
+      END DO
+
+      ! Mean flow at Red Sea entrance
+      IF( cp_cfg == "orca" ) THEN
+               
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration
+            !                                        ! =======================
+            ji =  mi1(83  )
+            jj =  mj1(45  )
+            !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration
+            !                                        ! =======================
+            ji = mi1(161)
+            jj = mj1( 88)
+            !                                        ! =======================
+         CASE DEFAULT                                !    ORCA R05 or R025
+            !                                        ! =======================
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*)' dia_fwb Not yet implemented in ORCA_R05 or R025'
+            nstop = nstop + 1
+            ! 
+         END SELECT
+         ! 
+      ENDIF
+      DO jk = 1, 15 
+         zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) )
+         zs = 0.5 * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) )
+         zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj)
+         
+         IF( un(ji,jj,jk) > 0.0 ) THEN 
+            zflxi(3) = zflxi(3) +    zu
+            ztemi(3) = ztemi(3) + zt*zu
+            zsali(3) = zsali(3) + zs*zu
+         ELSE
+            zflxo(3) = zflxo(3) +    zu
+            ztemo(3) = ztemo(3) + zt*zu
+            zsalo(3) = zsalo(3) + zs*zu
+         ENDIF
+      END DO
+
+      ! Mean flow at Baltic Sea entrance
+      IF( cp_cfg == "orca" ) THEN
+               
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration
+            !                                        ! =======================
+            ji =   1     ! Not in the domain
+            jj =   1  
+            !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration
+            !                                        ! =======================
+            ji = mi1(146)
+            jj = mj1(116)
+            !                                        ! =======================
+         CASE DEFAULT                                !    ORCA R05 or R025
+            !                                        ! =======================
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*)' dia_fwb Not yet implemented in ORCA_R05 or R025'
+            nstop = nstop + 1
+            ! 
+         END SELECT
+         ! 
+      ENDIF
+      DO jk = 1, 20
+         zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) )
+         zs = 0.5 * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) )
+         zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj)
+         
+         IF( un(ji,jj,jk) > 0.0 ) THEN 
+            zflxi(4) = zflxi(4) +    zu
+            ztemi(4) = ztemi(4) + zt*zu
+            zsali(4) = zsali(4) + zs*zu
+         ELSE
+            zflxo(4) = zflxo(4) +    zu
+            ztemo(4) = ztemo(4) + zt*zu
+            zsalo(4) = zsalo(4) + zs*zu
+         ENDIF
+      END DO
+
+      ! Sum at each time-step
+      DO jt = 1, 4 
+         IF( zflxi(jt) /= 0.0 .AND. zflxo(jt) /= 0.0 ) THEN
+            a_flxi(jt) = a_flxi(jt) + zflxi(jt)
+            a_temi(jt) = a_temi(jt) + ztemi(jt)/zflxi(jt)
+            a_sali(jt) = a_sali(jt) + zsali(jt)/zflxi(jt)
+            a_flxo(jt) = a_flxo(jt) + zflxo(jt)
+            a_temo(jt) = a_temo(jt) + ztemo(jt)/zflxo(jt)
+            a_salo(jt) = a_salo(jt) + zsalo(jt)/zflxo(jt)
+         ENDIF
+      END DO
+
+      IF( kt == nitend ) THEN
+         DO jt = 1, 4 
+            a_flxi(jt) = a_flxi(jt)/((nitend-nit000+1)*1.e6)
+            a_temi(jt) = a_temi(jt)/( nitend-nit000+1)
+            a_sali(jt) = a_sali(jt)/( nitend-nit000+1)
+            a_flxo(jt) = a_flxo(jt)/((nitend-nit000+1)*1.e6)
+            a_temo(jt) = a_temo(jt)/( nitend-nit000+1)
+            a_salo(jt) = a_salo(jt)/( nitend-nit000+1)
+         END DO
+      ENDIF
+
+
+      ! Ecriture des diagnostiques 
+      ! --------------------------
+
+      IF ( kt == nitend ) THEN
+
+         OPEN(111,FILE='STRAIT.dat')
+         WRITE(111,*)
+         WRITE(111,*)    'Net freshwater budget '
+         WRITE(111,9010) '  emp    = ',a_emp,   ' m3 =', a_emp   /((nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'
+         WRITE(111,9010) '  precip = ',a_precip,' m3 =', a_precip/((nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'
+         WRITE(111,9010) '  a_rnf   = ',a_rnf,   ' m3 =', a_rnf   /((nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'
+         WRITE(111,*)
+         WRITE(111,9010) '  zarea =',zarea
+         WRITE(111,9010) '  zvol  =',zvol
+         WRITE(111,*)
+         WRITE(111,*)    'Mean sea level : '
+         WRITE(111,9010) '  at nit000 = ',a_sshb        ,' m3 '
+         WRITE(111,9010) '  at nitend = ',a_sshn        ,' m3 '
+         WRITE(111,9010) '  diff      = ',(a_sshn-a_sshb),' m3 =', (a_sshn-a_sshb)/((nitend-nit000+1)*rdt) * 1.e-6,' Sv'
+         WRITE(111,9020) '  mean sea level elevation    =', a_sshn/zarea,' m'
+         WRITE(111,*)
+         WRITE(111,*)    'Anomaly of salinity content : '
+         WRITE(111,9010) '  at nit000 = ',a_salb        ,' psu.m3 '
+         WRITE(111,9010) '  at nitend = ',a_saln        ,' psu.m3 '
+         WRITE(111,9010) '  diff      = ',(a_saln-a_salb),' psu.m3'
+         WRITE(111,*)
+         WRITE(111,*)    'Mean salinity : '
+         WRITE(111,9020) '  at nit000 =',a_salb/zvol+zsm0   ,' psu '
+         WRITE(111,9020) '  at nitend =',a_saln/zvol+zsm0   ,' psu '
+         WRITE(111,9020) '  diff      =',(a_saln-a_salb)/zvol,' psu'
+         WRITE(111,9020) '  S-SLevitus=',a_saln/zvol,' psu'
+         WRITE(111,*)
+         WRITE(111,*)    'Coeff : '
+         WRITE(111,9030) '  Alpha+   =  ', a_aplus
+         WRITE(111,9030) '  Alpha-   =  ', a_aminus
+         WRITE(111,*)
+         WRITE(111,*)
+         WRITE(111,*)    'Gibraltar : '
+         WRITE(111,9030) '  Flux entrant (Sv) :', a_flxi(1)
+         WRITE(111,9030) '  Flux sortant (Sv) :', a_flxo(1)
+         WRITE(111,9030) '  T entrant (deg)   :', a_temi(1)
+         WRITE(111,9030) '  T sortant (deg)   :', a_temo(1)
+         WRITE(111,9030) '  S entrant (psu)   :', a_sali(1)
+         WRITE(111,9030) '  S sortant (psu)   :', a_salo(1)
+         WRITE(111,*)
+         WRITE(111,*)    'Cadiz : '
+         WRITE(111,9030) '  Flux entrant (Sv) :', a_flxi(2)
+         WRITE(111,9030) '  Flux sortant (Sv) :', a_flxo(2)
+         WRITE(111,9030) '  T entrant (deg)   :', a_temi(2)
+         WRITE(111,9030) '  T sortant (deg)   :', a_temo(2)
+         WRITE(111,9030) '  S entrant (psu)   :', a_sali(2)
+         WRITE(111,9030) '  S sortant (psu)   :', a_salo(2)
+         WRITE(111,*)
+         WRITE(111,*)    'Bab el Mandeb : '
+         WRITE(111,9030) '  Flux entrant (Sv) :', a_flxi(3)
+         WRITE(111,9030) '  Flux sortant (Sv) :', a_flxo(3)
+         WRITE(111,9030) '  T entrant (deg)   :', a_temi(3)
+         WRITE(111,9030) '  T sortant (deg)   :', a_temo(3)
+         WRITE(111,9030) '  S entrant (psu)   :', a_sali(3)
+         WRITE(111,9030) '  S sortant (psu)   :', a_salo(3)
+         WRITE(111,*)
+         WRITE(111,*)    'Baltic : '
+         WRITE(111,9030) '  Flux entrant (Sv) :', a_flxi(4)
+         WRITE(111,9030) '  Flux sortant (Sv) :', a_flxo(4)
+         WRITE(111,9030) '  T entrant (deg)   :', a_temi(4)
+         WRITE(111,9030) '  T sortant (deg)   :', a_temo(4)
+         WRITE(111,9030) '  S entrant (psu)   :', a_sali(4)
+         WRITE(111,9030) '  S sortant (psu)   :', a_salo(4)
+         CLOSE(111)
+      ENDIF
+
+ 9005 FORMAT(1X,A,ES24.16)
+ 9010 FORMAT(1X,A,ES12.5,A,F10.5,A)
+ 9020 FORMAT(1X,A,F10.5,A)
+ 9030 FORMAT(1X,A,F8.2,A)
+
+   END SUBROUTINE dia_fwb
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty Module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .FALSE.    ! fresh water budget flag
+CONTAINS
+   SUBROUTINE dia_fwb( kt )        ! Empty routine
+      WRITE(*,*) kt                      ! no warning in compilation phase
+   END SUBROUTINE dia_fwb
+#endif
+
+   !!======================================================================
+END MODULE diafwb
Index: /branches/nemo/NEMO/OPA_SRC/DIA/diagap.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DIA/diagap.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DIA/diagap.F90	(revision 4)
@@ -0,0 +1,303 @@
+MODULE diagap
+   !!======================================================================
+   !!                       ***  MODULE  diagap  ***
+   !! Ocean diagnostics : computation of model-data tracer gap
+   !!======================================================================
+#if defined key_diagap
+   !!----------------------------------------------------------------------
+   !!   'key_diagap' :                           model-data gap diagnostics
+   !!----------------------------------------------------------------------
+   !!   dia_gap      : model and data level mean temperature and salinity
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE dtatem          ! ???
+   USE dtasal          ! ???
+   USE daymod          ! calendar
+   USE dianam          ! build name of file (routine)
+   USE lib_mpp         ! distributed memory computing library
+
+   IMPLICIT NONE
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   &
+      lk_diagap = .TRUE.         ! model-data diagnostics flag
+
+   !! * Module variables
+   INTEGER ::                 &
+!!!   numgap,                 &  ! logical unit for differences diagnostic
+      ngap  ,                 &  ! time step frequency
+      nprg                       ! switch for control print
+#if ! defined key_fdir
+   ! netcdf files and index common
+   INTEGER ::   &
+      nhoridg, ndepidg,             &
+      ndex(1)
+#endif
+   REAL(wp) ::     &
+      vol                        ! total ocean volume
+   REAL(wp), DIMENSION(jpk) ::   &
+      volk , volkr,           &  ! level ocean volume and its inverse
+      tdtag, sdtag,           &  ! level mean data temperature & salinity
+      tmodg, smodg               ! level mean model temperature & salinity
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dia_gap( kt )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dia_gap  ***
+      !!
+      !! ** Purpose :   Compute model and data level mean T and S profiles
+      !!      and output it in numgap (NetCDF or direct access file)
+      !!
+      !! ** Method :
+      !!         tracers (model) : tn, sn
+      !!         tracers (data)  : t_dta, s_dta
+      !!         difference between model and data tracers
+      !!         variance between model and data tracers
+      !!
+      !! ** Action  :   output in file numgap
+      !!
+      !! History :
+      !!   6.0  !  91-10  (G. Madec)  Original code
+      !!   7.0  !  92-07  (M. Imbard)  Add variance and mpp staff
+      !!   8.5  !  02-07  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+#if ! defined key_fdir
+      USE ioipsl
+#endif
+      !! * Arguments
+      INTEGER, INTENT(in) ::   kt           ! ocean time-step index
+
+      !! * local declarations
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   it
+      CHARACTER (len=40) ::   clhstnam
+      CHARACTER (len=40) ::   clop
+      REAL(wp) ::   zbt, zdt    ! temporary scalar
+      REAL(wp) ::   zsto, zout, zmax, zjulian
+      REAL(wp), DIMENSION(jpi) ::   zfoo
+      REAL(wp), DIMENSION(jpj) ::   zloo
+
+      NAMELIST/namgap/ ngap, nprg
+      !!----------------------------------------------------------------------
+
+
+      ! 0. initialization
+      ! -----------------
+
+      zdt = rdt
+      IF( nacc == 1 )   zdt = rdtmin
+
+      IF( kt == nit000 ) THEN
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dia_gap : level mean model-data gap'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+         ! Read diagap parameters in namelist namgap
+         ngap = 15
+         nprg = 15
+
+         REWIND( numnam )
+         READ( numnam, namgap )
+
+         IF(lwp) WRITE(numout,*) '          time step frequency for gap     ngap  = ',ngap
+         IF(lwp) WRITE(numout,*) '          switch for control print gap    nprg  = ',nprg
+
+         ! horizontal slab volume (tmask_i to take into account only interior ocean domain)
+         volk(:) = 0.e0
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask_i(ji,jj)
+                  volk(jk) = volk(jk) + tmask(ji,jj,jk) * zbt
+               END DO
+            END DO
+         END DO
+#if defined key_mpp
+         CALL mpp_sum( volk, jpk )
+#endif
+         volkr(:) = 0.e0
+         DO jk = 1, jpk
+            IF( volk(jk) /= 0.e0 )   volkr(jk) = 1.e0 / volk(jk)
+         END DO
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '     volume of each horizontal slab (km3) :'
+            DO jk = 1, jpkm1
+               WRITE(numout,9010) jk, volk(jk) * 1.e-9
+            END DO
+         ENDIF
+9010     FORMAT( 9X, 'level ', i3, f15.3 )
+
+         ! basin volume
+         vol = 0.e0
+         DO jk = 1, jpkm1
+            vol = vol + volk(jk)
+         END DO
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '     basin volume : ',vol*1.e-9, '  km3'
+
+#if defined key_fdir
+      CALL ctlopn( numgap, 'differences.diag', 'UNKNOWN', 'UNFORMATTED', 'SEQUENTIAL', 1,numout,lwp,1)
+#else
+
+         ! OPEN netcdf file 
+
+         ! Define frequency of output and means
+         zsto = ngap * zdt
+         clop = "ave(x)"
+         zout = ngap * zdt
+         zmax = FLOAT( nitend - nit000 + 1 ) * zdt
+         zfoo(1:jpi) = 0.e0
+         zloo(1:jpj) = 0.e0
+
+         ! Compute julian date from starting date of the run
+
+         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian )
+
+         CALL dia_nam( clhstnam, ngap, 'diagap' )
+         IF(lwp) WRITE(numout,*) 'Name of diagap NETCDF file ', clhstnam
+         ! Horizontal grid : zphi()
+         CALL histbeg( clhstnam, 1, zfoo, 1, zloo,   &
+                        1, 1, 1, 1, 0, zjulian, zdt, nhoridg, numgap )
+         ! Vertical grids : gdept, gdepw
+         CALL histvert( numgap, "deptht", "Vertical T levels",   &
+                         "m", jpk, gdept, ndepidg )
+
+         ! define fields to be stored
+         ! mo(temp/sali)(da/mo/va): mean ocean temperature/salinity data/model/differences
+
+          CALL histdef( numgap, "motempda", "Mean Data Temperature","C",   &
+                        1, 1, nhoridg, jpk, 1, jpk, ndepidg, 32, clop,   &
+                        zsto,zout )
+          CALL histdef(numgap, "mosalida", "Mean Data Salinity","PSU",   &
+                        1, 1, nhoridg, jpk, 1, jpk, ndepidg, 32, clop,   &
+                        zsto,zout )
+          CALL histdef(numgap, "motempmo", "Mean Model Temperature","C",   &
+                        1, 1, nhoridg, jpk, 1, jpk, ndepidg, 32, clop,   &
+                        zsto,zout )
+          CALL histdef(numgap, "mosalimo", "Mean Model Salinity","PSU",   &
+                        1, 1, nhoridg, jpk, 1, jpk, ndepidg, 32, clop,   &
+                        zsto,zout )
+          CALL histend( numgap )
+          ndex(1) = 0
+#endif
+      ENDIF
+
+
+      ! 1. horizontal averaged
+      ! ----------------------
+
+      IF( MOD( kt, ngap ) == 0 ) THEN
+
+         ! initialization
+         tdtag(:) = 0.e0
+         sdtag(:) = 0.e0
+         tmodg(:) = 0.e0
+         smodg(:) = 0.e0
+         
+         !  c a u t i o n  : use of tmask_i : average over the interior domain only
+         
+         ! sum
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+              DO ji = 1, jpi
+                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask_i(ji,jj)
+                tdtag(jk) = tdtag(jk) + zbt * t_dta(ji,jj,jk) * volkr(jk)
+                sdtag(jk) = sdtag(jk) + zbt * s_dta(ji,jj,jk) * volkr(jk)
+                tmodg(jk) = tmodg(jk) + zbt * tn  (ji,jj,jk) * volkr(jk)
+                smodg(jk) = smodg(jk) + zbt * sn  (ji,jj,jk) * volkr(jk)
+              END DO  
+            END DO  
+         END DO
+
+
+         ! 2. Basin averaged
+         ! -----------------
+         
+         DO jk = 1, jpkm1
+            tdtag(jpk) = tdtag(jpk) + tdtag(jk) * volk(jk) / vol
+            sdtag(jpk) = sdtag(jpk) + sdtag(jk) * volk(jk) / vol
+            tmodg(jpk) = tmodg(jpk) + tmodg(jk) * volk(jk) / vol
+            smodg(jpk) = smodg(jpk) + smodg(jk) * volk(jk) / vol
+         END DO  
+
+#if defined key_mpp
+          CALL mpp_sum( tdtag, jpk )
+          CALL mpp_sum( sdtag, jpk )
+          CALL mpp_sum( tmodg, jpk )
+          CALL mpp_sum( smodg, jpk )
+#endif
+
+          ! 3.  Averaged output in file numgap
+          ! ----------------------------======
+
+          IF( MOD( kt, nprg ) == 0 ) THEN
+              IF(lwp) THEN
+                  WRITE(numout,*) 'dia_gap: time step = ', kt, 'model - data'
+                  WRITE(numout,9300)
+
+                  DO jk = 1, jpk
+                    WRITE(numout,9310) tdtag(jk), tmodg(jk), tdtag(jk) - tmodg(jk), jk, fsdept(1,1,jk),   &
+                                       sdtag(jk), smodg(jk), sdtag(jk) - smodg(jk)
+                  END DO  
+              ENDIF
+          ENDIF
+
+ 9300     FORMAT('  T-data  T-model    diff.   level  depth    S-data  S-model    diff.' )
+ 9310     FORMAT( 3(f8.3,1x),i5,f9.0,2x,3(f8.3,1x) )
+
+          ! Output in file numgap
+
+#if defined key_fdir
+          IF(lwp) WRITE (numgap) no, kt, jpk, tdtag, sdtag, tmodg, smodg
+#else
+
+          ! Netcdf write
+
+          IF (lwp ) THEN   ! Ok even in mpp after the call to mpp_sum
+             it = kt - nit000 + 1       ! define time axis
+             CALL histwrite( numgap, "motempda", it, tdtag, jpk, ndex )
+             CALL histwrite( numgap, "mosalida", it, sdtag, jpk, ndex )
+             CALL histwrite( numgap, "motempmo", it, tmodg, jpk, ndex )
+             CALL histwrite( numgap, "mosalimo", it, smodg, jpk, ndex )
+          END IF
+#endif
+      ENDIF
+
+      ! Closing numgap file
+
+      IF( kt == nitend ) THEN
+#if defined key_fdir
+          CLOSE( numgap )             ! direct acces file
+#else
+          CALL histclo( numgap )      !   Netcdf file
+#endif    
+      ENDIF 
+
+   END SUBROUTINE dia_gap
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diagap = .FALSE.   ! 'key_diagap' flag
+CONTAINS
+   SUBROUTINE dia_gap( kt )           ! Empty routine
+      WRITE(*,*) kt                       ! no warning in compilation phase
+   END SUBROUTINE dia_gap
+#endif
+
+   !!======================================================================
+END MODULE diagap
Index: /branches/nemo/NEMO/OPA_SRC/DIA/diahdy.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DIA/diahdy.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DIA/diahdy.F90	(revision 4)
@@ -0,0 +1,267 @@
+MODULE diahdy
+   !!======================================================================
+   !!                       ***  MODULE  diahdy  ***
+   !! Ocean diagnostics : computation the dynamical heigh
+   !!======================================================================
+#if   defined key_diahdy   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_diahdy' :                          dynamical heigh diagnostics
+   !!----------------------------------------------------------------------
+   !!   dia_hdy      : dynamical heigh computation
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diahdy = .TRUE.   ! dynamical heigh flag
+
+   !! * Module variables
+   REAL(wp), DIMENSION(jpk) ::   &
+      rhosp         ! ???
+
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+      hdy           ! dynamical heigh
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE dia_hdy ( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_hdy  ***
+      !!
+      !! ** Purpose :   Computes the dynamical heigh
+      !!
+      !! ** Method  : Millero + Poisson
+      !!
+      !! References : 
+      !!	A. E. Gill, atmosphere-ocean dynamics 7.7 pp 215
+      !!
+      !! History :
+      !!        !  9x-xx (P. Delecluse, C. Perigaud)  Original code
+      !!        !  93-10  (C. Perigaud)  a trapezoidal vertical integration 
+      !!                                 consistent WITH the code
+      !!        !  93-12  (G. Madec M. Imbard)
+      !!        !  96-03  (N. Ferry)  integration at t-points
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER :: ji, jj, jk
+      INTEGER :: ihdsup, ik, isup
+
+      REAL(wp) :: zgdsup, za, zb, zciint, zfacto, zhd
+      REAL(wp) :: zp, zh, zt, zs, zxk, zq, zsr, zr1, zr2, zr3, zr4
+      REAL(wp) :: ze, zbw, zc, zd, zaw, zb1, za1, zkw, zk0, zpval
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsva
+      REAL(wp), DIMENSION(jpk)         :: zwkx, zwky, zwkz
+      REAL(wp) :: fsatg
+      REAL(wp) :: pfps, pfpt, pfphp  
+
+      ! Adiabatic laspse rate fsatg, defined as the change of temperature
+      ! per unit pressure for adiabatic change of pressure of an element
+      ! of seawater (bryden,h.,1973,deep-sea res.,20,401-408).
+      ! units:
+      !      pressure        pfphp    decibars
+      !      temperature     pfpt     deg celsius (ipts-68)
+      !      salinity        pfps     (ipss-78)
+      !      adiabatic       fsatg    deg. c/decibar
+      ! checkvalue: atg=3.255976e-4 c/dbar for pfps=40 (ipss-78),
+      ! pfpt=40 deg c, pfphp=10000 decibars
+      
+      fsatg(pfps,pfpt,pfphp)   &
+         = (((-2.1687e-16*pfpt+1.8676e-14)*pfpt-4.6206e-13)*pfphp    &
+         +((2.7759e-12*pfpt-1.1351e-10)*(pfps-35.)+((-5.4481e-14*pfpt    &
+         +8.733e-12)*pfpt-6.7795e-10)*pfpt+1.8741e-8))*pfphp    &
+         +(-4.2393e-8*pfpt+1.8932e-6)*(pfps-35.)    &
+         +((6.6228e-10*pfpt-6.836e-8)*pfpt+8.5258e-6)*pfpt+3.5803e-5
+      !!----------------------------------------------------------------------
+
+      ! 1. height dynamic
+      ! -----------------
+      ! depth for reference
+
+      zgdsup = 1500.
+      
+      ! below for hdyn levitus
+      
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dia_hdy : computation of dynamical heigh'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+# if defined key_s_coord || defined key_partial_steps
+         ! Dynamic height diagnostics  not yet implemented
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          key_s_coord or key_partial_steps used'
+         IF(lwp) WRITE(numout,*) '          Dynamical height diagnostics not yet implemented'
+         nstop = nstop + 1
+# endif
+
+         DO jk = 1, jpk
+            IF( fsdepw(1,1,jk) > zgdsup ) GOTO 110
+         END DO
+         IF(lwp) WRITE(numout,*)'problem zgdsup greater than gdepw(jpk)'
+         STOP 'dia_hdy'
+110      CONTINUE
+         ihdsup = jk - 1
+         IF(lwp) WRITE(numout,*)' ihdsup = ', ihdsup
+
+         ! Interpolation coefficients for zgdsup-gdepw(ihdsup) layer
+
+         za = fsdepw(1,1,ihdsup  )
+         zb = fsdepw(1,1,ihdsup+1)
+         IF( za > zgdsup .OR. zb < zgdsup ) THEN
+            IF(lwp) WRITE(numout,*) za, zb, ihdsup, zgdsup
+            IF(lwp) WRITE(numout,*) ' bad ihdsup'
+            STOP
+         ENDIF
+         
+         zciint = (zgdsup - za) / (zb - za)
+
+         ! Computes the specific volume reference in situ temperature
+         
+         DO jk = 1, jpk
+            zp = 0.e0
+            zh = fsdept(1,1,jk)
+            zt = 0.e0
+            zs = 35.
+            zxk= zh * fsatg( zs, zt, zp )
+            zt = zt + 0.5 * zxk
+            zq = zxk
+            zp = zp + 0.5 * zh
+            zxk= zh*fsatg( zs, zt, zp )
+            zt = zt + 0.29289322 * ( zxk - zq )
+            zq = 0.58578644 * zxk + 0.121320344 * zq
+            zxk= zh * fsatg( zs, zt, zp )
+            zt = zt + 1.707106781 * ( zxk - zq )
+            zq = 3.414213562 * zxk - 4.121320344 * zq
+            zp = zp + 0.5 * zh
+            zxk= zh * fsatg( zs, zt, zp )
+            zwkx(jk) = zt + ( zxk - 2.0 * zq ) / 6.0
+         END DO
+
+         ! In situ density (add the compression terms)
+
+         DO jk = 1, jpk
+            zt = zwkx(jk)
+            zs = 35.
+            ! square root salinity
+            zsr = sqrt( abs( zs ) )
+            zwky(jk) = zsr
+            ! compute density pure water at atm pressure
+            zr1= ((((6.536332e-9*zt-1.120083e-6)*zt+1.001685e-4)*zt   &
+               -9.095290e-3)*zt+6.793952e-2)*zt+999.842594
+            ! seawater density atm pressure
+            zr2= (((5.3875e-9*zt-8.2467e-7)*zt+7.6438e-5)*zt   &
+               -4.0899e-3)*zt+8.24493e-1
+            zr3= (-1.6546e-6*zt+1.0227e-4)*zt-5.72466e-3
+            zr4= 4.8314e-4
+            zwkz(jk)= (zr4*zs + zr3*zsr + zr2)*zs + zr1
+         END DO
+
+         DO jk = 1, jpk
+            zt = zwkx(jk)
+            zs = 35.
+            zsr= zwky(jk)
+            zh = fsdept(1,1,jk)
+
+            ze = ( 9.1697e-11*zt+2.0816e-9 ) *zt-9.9348e-8
+            zbw= ( 5.2787e-9*zt-6.12293e-7 ) * zt+8.50935e-6
+            zb = zbw + ze * zs
+
+            zd = 1.91075e-4
+            zc = (-1.6078e-6*zt-1.0981e-5)*zt+2.2838e-3
+            zaw= ((-5.77905e-7*zt+1.16092e-4)*zt+1.43713e-3)*zt+3.239908
+            za = ( zd*zsr + zc)*zs + zaw
+
+            zb1= (-5.3009e-3*zt+1.6483e-1)*zt+7.944e-1
+            za1= ((-6.1670e-4*zt+1.09987e-1)*zt-6.03459)*zt+546.746
+            zkw= (((-5.155288e-4*zt+1.360477e-1)*zt-23.27105)*zt   &
+                +1484.206)*zt+196522.1
+            zk0= (zb1*zsr + za1)*zs + zkw
+            ! evaluate pressure polynomial
+            zwkz(jk) = zwkz(jk) / ( 1.0 - zh / ( zk0+zh*(za+zb*zh) ) )
+         END DO
+
+         DO jk = 1, jpk
+            rhosp(jk) = zwkz(jk)
+         END DO
+      ENDIF
+
+      ! Computes the specific volume anomaly
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tmask(ji,jj,jk) /= 0. ) THEN
+                  zsva(ji,jj,jk) = ( rau0*rhd(ji,jj,jk)+rau0 -rhosp(jk) ) / rhosp(jk)
+               ELSE
+                  zsva(ji,jj,jk)=0.
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! zfacto coefficient to cmg
+      
+      ! zfacto= 1.  e+2
+      !           mg->cmg
+      zfacto = 1.0 * 1.e2
+      
+      ! Fisrt compute at depth ik=ihdsup
+      
+      ik = ihdsup
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zhd = zfacto * zciint * fse3t(ji,jj,ik) * zsva(ji,jj,ik)
+            hdy(ji,jj,ik) = zhd * tmask(ji,jj,ik) * tmask(ji,jj,ik-1)
+         END DO
+      END DO
+      
+      ! Then compute other terms except level jk=1
+      
+      DO jk = ihdsup-1, 2, -1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zhd = hdy(ji,jj,jk+1) + zfacto * fse3t(ji,jj,jk) * zsva(ji,jj,jk)
+               hdy(ji,jj,jk) = zhd * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      
+      ! Then compute other the last layer term jk=1
+      
+      ik = 1
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zhd = hdy(ji,jj,ik+1) + zfacto * fse3t(ji,jj,ik) * zsva(ji,jj,ik)
+            hdy(ji,jj,ik) = zhd * tmask(ji,jj,ik)
+         END DO
+      END DO
+
+   END SUBROUTINE dia_hdy
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                       NO dynamic heigh diagnostics
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diahdy = .FALSE.   ! dynamical heigh flag
+CONTAINS
+   SUBROUTINE dia_hdy( kt )               ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE dia_hdy
+#endif
+
+   !!======================================================================
+END MODULE diahdy
Index: /branches/nemo/NEMO/OPA_SRC/DIA/diahth.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DIA/diahth.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DIA/diahth.F90	(revision 4)
@@ -0,0 +1,221 @@
+MODULE diahth
+   !!======================================================================
+   !!                       ***  MODULE  diahth  ***
+   !! Ocean diagnostics: thermocline and 20 degree depth
+   !!======================================================================
+#if   defined key_diahth   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_diahth' :                              thermocline depth diag.
+   !!----------------------------------------------------------------------
+   !!   dia_hth      : Compute diagnostics associated with the thermocline
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dia_hth    ! routine called by step.F90
+
+   !! * Shared module variables
+   LOGICAL , PUBLIC, PARAMETER ::   &
+      lk_diahth = .TRUE.   ! thermocline-20d depths flag
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &
+      hth  ,      &  ! depth of the max vertical temperature gradient (m)
+      hd20 ,      &  ! depth of 20 C isotherm (m)
+      hd28 ,      &  ! depth of 28 C isotherm (m)
+      htc3           ! heat content of first 300 m
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dia_hth( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_hth  ***
+      !!
+      !! ** Purpose :
+      !!      Computes the depth of strongest vertical temperature gradient
+      !!      Computes the depth of the 20 degree isotherm
+      !!      Computes the depth of the 28 degree isotherm
+      !!      Computes the heat content of first 300 m
+      !!
+      !! ** Method : 
+      !!
+      !! History :
+      !!        !  94-09  (J.-P. Boulanger)  Original code
+      !!        !  96-11  (E. Guilyardi)  OPA8 
+      !!        !  97-08  (G. Madec)  optimization
+      !!        !  99-07  (E. Guilyardi)  hd28 + heat content 
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!-------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER :: ji, jj, jk         ! dummy loop arguments
+      INTEGER :: iid, iif, ilevel   ! temporary integers
+      INTEGER, DIMENSION(jpi) ::   idepth
+      INTEGER, DIMENSION(jpi,jpj) ::   ikc
+
+      REAL(wp) :: zd, zmoy              ! temporary scalars
+      REAL(wp), DIMENSION(jpi) ::   zmax
+      REAL(wp), DIMENSION(jpi,jpk) ::   zdzt
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dia_hth : diagnostics of the thermocline depth'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+
+      ! -------------------------- !
+      !  Depth of the thermocline  !
+      ! -------------------------- !
+      ! The depth of the thermocline is defined as the depth of the 
+      ! strongest vertical temperature gradient
+      
+      DO jj = 1, jpj
+         
+         ! vertical gradient of temperature
+         DO jk = 2, jpkm1
+            zdzt(:,jk) = ( tn(:,jj,jk-1) - tn(:,jj,jk) ) / fse3w(:,jj,jk) * tmask(:,jj,jk)
+         END DO
+         
+         ! search the level of maximum vertical temperature gradient
+         zmax  (:) = 0.e0
+         idepth(:) = 1
+         DO jk = jpkm1, 2, -1
+            DO ji = 1, jpi
+               IF( zdzt(ji,jk) > zmax(ji) ) THEN
+                  zmax  (ji) = zdzt(ji,jk)
+                  idepth(ji) = jk
+               ENDIF
+            END DO
+         END DO
+
+         ! depth of the thermocline
+         DO ji = 1, jpi
+            hth(ji,jj) = fsdepw(ji,jj,idepth(ji))
+         END DO
+         
+      END DO
+
+
+      ! ----------------------- !
+      !  Depth of 20C isotherm  !
+      ! ----------------------- !
+
+      ! initialization to the number of ocean w-point mbathy
+      ! (cf dommsk, minimum value: 1)
+      ikc(:,:) = 1
+
+      ! search the depth of 20 degrees isotherm
+      ! ( starting from the top, last level above 20C, if not exist, = 1)
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tn(ji,jj,jk) >= 20. ) ikc(ji,jj) = jk
+            END DO
+         END DO
+      END DO
+      
+      ! Depth of 20C isotherm
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            iid = ikc(ji,jj)
+            iif = mbathy(ji,jj)
+            IF( iid /= 1 ) THEN 
+               ! linear interpolation
+               zd =  fsdept(ji,jj,iid)   &
+                  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) )   &
+                  * ( 20.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid) )   &
+                  / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid)    &
+                  + (1.-tmask(ji,jj,1))                       )
+               ! bound by the ocean depth, minimum value, first T-point depth
+               hd20(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif))
+            ELSE 
+               hd20(ji,jj)=0.
+            ENDIF
+         END DO
+      END DO
+
+      ! ----------------------- !
+      !  Depth of 28C isotherm  ! 
+      ! ----------------------- !
+      
+      ! initialization to the number of ocean w-point mbathy
+      ! (cf dommsk, minimum value: 1)
+      ikc(:,:) = 1
+      
+      ! search the depth of 28 degrees isotherm
+      ! ( starting from the top, last level above 28C, if not exist, = 1)
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tn(ji,jj,jk) >= 28. ) ikc(ji,jj) = jk
+            END DO
+         END DO
+      END DO
+      
+      ! Depth of 28C isotherm
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            iid = ikc(ji,jj)
+            iif = mbathy(ji,jj)
+            IF( iid /= 1 ) THEN 
+               ! linear interpolation
+               zd =  fsdept(ji,jj,iid)   &
+                  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid) )   &
+                  * ( 28.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid) )   &
+                  / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid)    &
+                  + ( 1. - tmask(ji,jj,1) )  )
+               ! bound by the ocean depth, minimum value, first T-point depth
+               hd28(ji,jj) = MIN( zd*tmask(ji,jj,1), fsdepw(ji,jj,iif) )
+            ELSE 
+               hd28(ji,jj) = 0.
+            ENDIF
+         END DO
+      END DO
+
+      ! ----------------------------------------- !
+      !  Heat content of first 300 m (18 levels)  !
+      ! ----------------------------------------- !
+
+      htc3(:,:) = 0.e0
+      ilevel = 18
+      zmoy = rau0 * rcp * 0.5
+      
+      ! intregrate tn from surface to klevel
+
+      DO jk = 1, ilevel
+               htc3(:,:) = htc3(:,:)   &
+                         + zmoy * ( tn(:,:,jk) + tn(:,:,jk+1) ) * fse3w(:,:,jk) * tmask(:,:,jk)
+      END DO
+
+   END SUBROUTINE dia_hth
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL , PUBLIC, PARAMETER ::   &
+      lk_diahth = .FALSE.   ! thermocline-20d depths flag
+CONTAINS
+   SUBROUTINE dia_hth( kt )         ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE dia_hth
+#endif
+
+   !!======================================================================
+END MODULE diahth
Index: /branches/nemo/NEMO/OPA_SRC/DIA/dianam.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DIA/dianam.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DIA/dianam.F90	(revision 4)
@@ -0,0 +1,328 @@
+MODULE dianam
+   !!======================================================================
+   !!                       ***  MODULE  dianam  ***
+   !! Ocean diagnostics:  Builds output file name
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dia_nam       : Builds output file name
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dia_nam   ! routine called by step.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dia_nam( cdfnam, kfreq, cdsuff )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_nam  ***
+      !!                   
+      !! ** Purpose :   Builds output file name
+      !!
+      !! ** Method  :   File name is a function of date and output frequency
+      !!      cdfnam=<cexper>_<clave>_<idtbeg>_<idtend>_grid_<cdsuff>
+      !!      <clave> = averaging frequency (DA, MO, etc...)
+      !!      <idtbeg>,<idtend> date of beginning and end of run
+      !!
+      !! History :
+      !!        !  99-02  (E. Guilyardi)  Creation for 30 days/month
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER (len=*), INTENT( out ) ::   cdfnam   ! file name
+      CHARACTER (len=*), INTENT( in  ) ::   cdsuff   ! ???
+      INTEGER,           INTENT( in  ) ::   kfreq    ! ???
+
+      !! * Local declarations
+      CHARACTER (len=8) ::   clexper
+      CHARACTER (len=2) ::   clave
+      CHARACTER (len=5) ::   clout
+      CHARACTER (len=6) ::   clsuff
+      INTEGER :: jt, jc, jd, je            ! dummy loop indices
+      INTEGER ::   &
+         ic, id, ie, ig, ijjmm, iout,   &  ! temporary integers
+         iyear1, imonth1, iday1,        &  !    "          "
+         iyear2, imonth2, iday2            !    "          "
+      REAL(wp) ::   &
+         z5j, znbsec, zdate1, zdate2, zdrun, zdt   ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' dia_nam: building output file name'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+      IF(lwp) WRITE(numout,*)
+
+      ! 0. Initialisation
+      ! -----------------
+
+      cdfnam = ''
+
+      !    number of seconds of the run
+
+      z5j = 5*rjjss
+      zdt = rdt
+      IF( nacc == 1 ) zdt = rdtmin
+      zdrun = FLOAT( nitend - nit000 ) * zdt
+
+      !  date of beginning of run
+
+      iyear1  = ndastp/10000
+      imonth1 = ndastp/100 - iyear1*100
+      iday1   = ndastp - imonth1*100 - iyear1*10000
+      IF( nleapy == 1) THEN 
+         ijjmm=0
+         IF( MOD( iyear1, 4 ) == 0 ) THEN
+            DO jt = 1, imonth1-1
+               ijjmm = ijjmm + nbiss(jt)
+            END DO
+         ELSE
+            DO jt = 1, imonth1-1
+               ijjmm = ijjmm + nobis(jt)
+            END DO
+         ENDIF
+         ijjmm = ijjmm + (iyear1-1)/4
+         zdate1 = ( (iyear1-1)*365 + ijjmm +iday1-1 ) * rjjss   
+      ELSE IF( nleapy == 0 ) THEN
+         ijjmm = 0
+         DO jt = 1, imonth1-1
+            ijjmm = ijjmm + nobis(jt)
+         END DO
+         zdate1 = ( (iyear1-1)*raajj + ijjmm + iday1-1)* rjjss
+      ELSE 
+         zdate1 = ( (iyear1-1)*nleapy*raamo + (imonth1-1)*nleapy + iday1-1)* rjjss
+      ENDIF
+
+      !  date of end of run (= date of beginning of next run)
+
+      zdate2 = zdate1 + zdrun
+      IF( nleapy == 1 ) THEN 
+         iyear2 = zdate2/(365.25*rjjss)+1
+         ijjmm = INT(zdate2/rjjss)-365*(iyear2-1)-(iyear2-1)/4
+         IF( ijjmm < 0 ) THEN
+            iyear2 = iyear2-1
+            ijjmm = zdate2/rjjss-365.*(iyear2-1)-(iyear2-1)/4
+         ENDIF
+         IF( MOD( iyear2, 4 ) == 0 ) THEN
+            DO jt = 1, 12
+               ijjmm = ijjmm - nbiss(jt)
+               IF( ijjmm <= 0 ) go to 10
+            END DO
+            jt = 12
+10          CONTINUE
+            imonth2 = jt
+            ijjmm = 0
+            DO jt = 1, jt-1
+               ijjmm = ijjmm + nbiss(jt)
+            END DO
+         ELSE
+            DO jt = 1, 12
+               ijjmm = ijjmm - nobis(jt)
+               IF( ijjmm <= 0 ) go to 15
+            END DO
+            jt = 12
+15          CONTINUE
+            imonth2 = jt
+            ijjmm = 0
+            DO jt = 1, jt-1
+               ijjmm = ijjmm + nobis(jt)
+            END DO
+         ENDIF
+         iday2 = zdate2/rjjss-365.*(iyear2-1)-ijjmm+1-(iyear2-1)/4     
+      ELSE IF( nleapy == 0 ) THEN
+         iyear2 = zdate2/raass+1
+         ijjmm  = zdate2/rjjss-raajj*(iyear2-1)
+         DO jt = 1, 12
+            ijjmm = ijjmm - nobis(jt)
+            IF(ijjmm <= 0) go to 20
+         END DO
+         jt = 12
+20       CONTINUE
+         imonth2 = jt
+         ijjmm = 0
+         DO jt = 1, jt-1
+            ijjmm = ijjmm + nobis(jt)
+         END DO
+         iday2 = zdate2/rjjss-raajj*(iyear2-1)-ijjmm+1          
+      ELSE 
+         zdate2 = zdate2 / rjjss
+         imonth2 = zdate2/FLOAT(nleapy)
+         iday2 = zdate2 - imonth2*FLOAT(nleapy) + 1.
+         iyear2 = imonth2/12
+         imonth2 = imonth2 - iyear2*12
+         imonth2 = imonth2 + 1
+         iyear2 = iyear2 + 1
+         IF( iday2 == 0 ) THEN
+            iday2 = nleapy
+            imonth2 = imonth2 - 1
+            IF( imonth2 == 0 ) THEN
+               imonth2 = 12
+               iyear2 = iyear2 - 1
+            ENDIF
+         ENDIF
+      ENDIF
+
+
+      ! 1. Define time averaging period <nn><type>
+      !    ---------------------------------------
+
+      iout = 0
+#if defined key_diainstant
+      clave = 'IN'
+      IF( iyear2 <= 99 ) THEN 
+         WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+      ELSE IF( iyear2 <= 999 ) THEN 
+         WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+      ELSE IF( iyear2 <= 9999 ) THEN 
+         WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+      ELSE
+         WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+      ENDIF
+#else
+
+      znbsec=kfreq*zdt
+      ! daily output
+      IF( znbsec == rjjss ) THEN
+         clave = '1d'
+         IF( iyear2 <= 99 ) THEN 
+            WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 999 ) THEN 
+            WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 9999 ) THEN 
+            WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE
+            WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ENDIF
+         ! 5 day output 
+      ELSE IF( znbsec == z5j ) THEN
+         clave='5d'
+         IF( iyear2 <= 99 ) THEN 
+            WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 999 ) THEN 
+            WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 9999 ) THEN 
+            WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE
+            WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ENDIF
+         ! monthly ouput 
+      ELSE IF( (znbsec == rmoss .AND. nleapy > 1) .OR.   &
+               (znbsec >= 29*rjjss .AND. znbsec <= 31*rjjss .AND. nleapy <= 1) ) THEN
+         clave = '1m'
+         IF( iyear2 <= 99 ) THEN 
+            WRITE(cdfnam,9011) iyear1,imonth1,iyear2,imonth2
+         ELSE IF( iyear2 <= 999 ) THEN 
+            WRITE(cdfnam,9012) iyear1,imonth1,iyear2,imonth2
+         ELSE IF( iyear2 <= 9999 ) THEN 
+            WRITE(cdfnam,9013) iyear1,imonth1,iyear2,imonth2
+         ELSE
+            WRITE(cdfnam,9014) iyear1,imonth1,iyear2,imonth2
+         ENDIF
+         ! annual output
+      ELSE IF( (znbsec == raass .AND. nleapy > 1) .OR.   &
+               (znbsec >= 365*rjjss .AND. znbsec <= 366*rjjss .AND. nleapy <= 1) ) THEN
+         clave = '1y'
+         IF( iyear2 <= 99 ) THEN 
+            WRITE(cdfnam,9021) iyear1,iyear2
+         ELSE IF( iyear2 <= 999 ) THEN 
+            WRITE(cdfnam,9022) iyear1,iyear2
+         ELSE IF( iyear2 <= 9999 ) THEN 
+            WRITE(cdfnam,9023) iyear1,iyear2
+         ELSE
+            WRITE(cdfnam,9024) iyear1,iyear2
+         ENDIF
+      ELSE
+         ! others
+         iout = kfreq
+         ig = 0
+         clout = ''
+         IF( iout <= 9 ) THEN 
+            ig = 1
+            WRITE(clout,'(i1.1)') iout
+         ELSE IF( iout <= 99 ) THEN 
+            ig = 2
+            WRITE(clout,'(i2.2)') iout
+         ELSE IF( iout <= 999 ) THEN 
+            ig = 3
+            WRITE(clout,'(i3.3)') iout
+         ELSE IF( iout <= 9999 ) THEN 
+            ig = 4
+            WRITE(clout,'(i4.4)') iout
+         ELSE
+            ig = 5
+            WRITE(clout,'(i5.5)') iout
+         ENDIF
+         clave = 'CU'
+         IF( iyear2 <= 99 ) THEN 
+            WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 999 ) THEN 
+            WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE IF( iyear2 <= 9999 ) THEN 
+            WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ELSE
+            WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2
+         ENDIF
+      ENDIF
+#endif
+      DO jc = 1, 8
+         IF( cexper(jc:jc)==' ' ) go to 120
+      END DO
+120   CONTINUE
+      ic = jc
+      clexper = cexper
+      IF( jc-1 == 0 ) THEN
+         clexper = 'orcafile'
+         ic = 9
+      ENDIF
+      DO jd = 1, 6
+         IF( cdsuff(jd:jd) == ' ' ) go to 130
+      END DO
+130   CONTINUE
+      id = jd
+      clsuff = cdsuff
+      IF( jd-1 == 0 ) THEN
+          clsuff = 'output'
+          id = 7
+      ENDIF
+      DO je = 1, 45
+        IF( cdfnam(je:je) == ' ' ) go to 140
+      END DO
+140   CONTINUE
+      ie = je
+      IF( iout == 0 ) THEN 
+         cdfnam=clexper(1:ic-1)//"_"//clave//cdfnam(1:ie-1)//clsuff(1:id-1)
+      ELSE 
+         cdfnam=clexper(1:ic-1)//"_"//clave//clout(1:ig)//cdfnam(1:ie-1)//clsuff(1:id-1)
+      ENDIF
+      IF(lwp) WRITE(numout,*) cdfnam     
+      IF(lwp) WRITE(numout,*)          
+
+      ! FORMATS
+
+ 9001 FORMAT("_",I2.2,2I2.2,"_",I2.2,2I2.2,"_")
+ 9002 FORMAT("_",I3.3,2I2.2,"_",I3.3,2I2.2,"_")
+ 9003 FORMAT("_",I4.4,2I2.2,"_",I4.4,2I2.2,"_")
+ 9004 FORMAT("_",I6.6,2I2.2,"_",I6.6,2I2.2,"_")
+ 9011 FORMAT("_",I2.2,I2.2,"_",I2.2,I2.2,"_")
+ 9012 FORMAT("_",I3.3,I2.2,"_",I3.3,I2.2,"_")
+ 9013 FORMAT("_",I4.4,I2.2,"_",I4.4,I2.2,"_")
+ 9014 FORMAT("_",I6.6,I2.2,"_",I6.6,I2.2,"_")
+ 9021 FORMAT("_",I2.2,"_",I2.2,"_")
+ 9022 FORMAT("_",I3.3,"_",I3.3,"_")
+ 9023 FORMAT("_",I4.4,"_",I4.4,"_")
+ 9024 FORMAT("_",I6.6,"_",I6.6,"_")
+
+   END SUBROUTINE dia_nam
+
+   !!======================================================================
+END MODULE dianam
Index: /branches/nemo/NEMO/OPA_SRC/DIA/diaspr.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DIA/diaspr.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DIA/diaspr.F90	(revision 4)
@@ -0,0 +1,615 @@
+MODULE diaspr
+   !!======================================================================
+   !!                       ***  MODULE  diaspr  ***
+   !! Ocean diagnostics:  surface pressure (rigid-lid case) 
+   !!=====================================================================
+#if   defined key_diaspr   &&   defined key_dynspg_rl
+   !!----------------------------------------------------------------------
+   !!   'key_diaspr'        and                surface pressure diagnostics
+   !!   'key_dynspg_rl'                                      rigid-lid case
+   !!----------------------------------------------------------------------
+   !!   dia_spr      : update momentum and tracer Kz from a tke scheme
+   !!   sprmat       : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE sol_oce         ! ocean elliptic solver
+   USE solpcg          ! preconditionned conjugate gradient solver
+   USE solsor          ! Successive Over-relaxation solver
+   USE solfet          ! FETI solver
+   USE lib_mpp         ! distributed memory computing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dia_spr   ! routine called by step.F90
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diaspr = .TRUE.    ! surface pressure diag. flag
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &
+      gps                        ! surface pressure)
+
+   !! * Module variables
+   INTEGER ::                 &
+      nmoyps,                 &  ! time step for average
+      nindic,                 &  ! indicator of convergence of the solver
+      !                          ! namspr  surface pressure diagnostic
+      nmaxp ,                 &  ! maximum of iterations for the solver
+      niterp                     ! number of iteration done by the solver
+
+   REAL(wp) ::     &
+      ! namspr  surface pressure diagnostic
+      epsp                       ! absolute precision of the solver
+
+      !! * Namelist
+      NAMELIST/namspr/ nmaxp, epsp, niterp
+
+   REAL(wp) ::     &
+      e1e2t                      ! ???
+
+   REAL(wp), PUBLIC DIMENSION(jpi,jpj) ::   &
+      spgum, spgvm,           &  ! average value of the surface pressure gradients
+      gpsuu, gpsvv,           &  ! surface pressure gradients computed from comp. PS
+      gcdpsc,                 &  ! inverse diagonal preconditioning matrix
+      gcsmat,                 &  ! diagonal preconditioning matrix
+      spmsk                      ! surface pressure Mask
+
+   REAL(wp), DIMENSION(jpi,jpj,4) ::   &
+      gcps                       ! extra-diagonal elements of SPG matrix
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dia_spr( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_spr  ***
+      !!
+      !! ** Purpose :   compute the surface pressure from its gradient
+      !!
+      !! ** Method  :   rigid-lid appromimation: the surface pressure 
+      !!      gradient is given by:
+      !!           spgu = 1/rau0 d/dx(ps) = Mu + 1/(hu e2u) dj-1(bsfd)
+      !!           spgv = 1/rau0 d/dy(ps) = Mv - 1/(hv e1v) di-1(bsfd)
+      !!
+      !!      where (Mu,Mv) is the vertically averaged momentum trend, i.e.
+      !!      the vertical ponderated sum of the general momentum trend.
+      !!      where bsfd is the trend of the barotropic stream function.
+      !!
+      !!       taking the divergence of the surface pressure gradient provides
+      !!      an elliptic equation for ps which is solved using either a
+      !!      diagonal preconditioned conjugate gradient method (solpcg.f) or
+      !!      an successive-over-relaxation method (solsor.f) or FETI method
+      !!      (solfet.F).
+      !!
+      !!      n.b. this resolution is valid with topography, cyclic east-west
+      !!      boundary conditions and islands.
+      !!
+      !! History :
+      !!        !  98-01  (G. Madec & M. Ioualalen)  Original code
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER  ::  ji, jj
+      INTEGER  ::   imax, ijt, iju
+      REAL(wp) ::   zpsmea, zeps, zmoyr
+      REAL(wp) ::   ztab(jpi,jpj,8)
+      REAL(wp) ::   zemin1, zemax1, zemin2, zemax2, zgwgt
+      REAL(wp) ::   z1, z2, zcompt,z3,z4
+      REAL(wp) ::   zdif1, zdif2, zvar1, zvar2
+      !!----------------------------------------------------------------------
+
+
+      ! 0. initialisation (the first time step)
+      ! ---------------------------------------
+      
+      IF( kt == nit000 ) THEN
+
+         ! Namelist namspr : surface pressure
+
+         nmaxp  = 2000
+         epsp   = 1.e-6
+         niterp = 16
+
+         ! Read Namelist namspr : surface pressure diagnostics
+         REWIND ( numnam )
+         READ(numnam,namspr)
+
+         IF(lwp) THEN
+            WRITE(numout,*) 'dia_spr : surface pressure diagnostic (rigid-lid case)'
+            WRITE(numout,*) '~~~~~~~'
+            WRITE(numout,*)
+            WRITE(numout,*) '          Namelist namspr : set solver parameters'
+            WRITE(numout,*)
+            WRITE(numout,*) '             maximum iterations for solver  nmaxp  = ', nmaxp
+            WRITE(numout,*) '             absolute precision of solver   epsp   = ', epsp
+            WRITE(numout,*) '             number of solver iterations    niterp = ', niterp
+            WRITE(numout,*) '             frequeny of averaged output    nwrite = ', nwrite
+            WRITE(numout,*)
+         ENDIF
+
+         ! control
+# if defined key_dynspg_fsc
+      IF(lwp) WRITE(numout,cform_err)
+      IF(lwp) WRITE(numout,*) '          surface pressure already explicitly computed !!'
+      nstop = nstop + 1
+# endif
+
+         ! compute the ocean surface
+         e1e2t = 0.e0
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               e1e2t = e1e2t + e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,1)
+            END DO
+         END DO
+#if defined key_mpp
+         CALL  mpp_sum( e1e2t )
+#endif
+         
+         ! build the matrix for the surface pressure
+         CALL sprmat
+         
+         ! set to zero the mean surface pressure gradient
+         nmoyps = 0
+         spgum(:,:) = 0.e0
+         spgvm(:,:) = 0.e0
+
+      ENDIF
+
+      ! 1. cumulate the surface pressure gradient (at each time step)
+      ! -----------------------------------------
+
+      nmoyps = nmoyps + 1
+      spgum(:,:) = spgum(:,:) + spgu(:,:)
+      spgvm(:,:) = spgvm(:,:) + spgv(:,:)
+      
+
+      ! 2. ps computation each nwrite time step
+      ! ---------------------------------------
+      
+      ! RETURN IF not the right time to compute ps
+      IF ( MOD(kt-nit000+1,nwrite) /= 0 ) RETURN
+      
+      
+      ! mean surface pressure gradient
+      !   averaging and mask
+      zmoyr = 1./float(nmoyps)
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            spgum(ji,jj) = spgum(ji,jj) * zmoyr * umask(ji,jj,1)
+            spgvm(ji,jj) = spgvm(ji,jj) * zmoyr * vmask(ji,jj,1)
+         END DO
+      END DO
+
+      CALL  lbc_lnk(spgum, 'U', -1. )
+      CALL  lbc_lnk(spgvm, 'V', -1. )
+
+      
+      ! SAVE in local arrays and variables of solver informations
+      zeps   = eps
+      imax  = nmax 
+      ztab(:,:,1) = gcp   (:,:,1)
+      ztab(:,:,2) = gcp   (:,:,2)
+      ztab(:,:,3) = gcp   (:,:,3)
+      ztab(:,:,4) = gcp   (:,:,4)
+      ztab(:,:,5) = gcdprc(:,:  )
+      ztab(:,:,6) = gcdmat(:,:  )
+      ztab(:,:,7) = gcx   (:,:  )
+      ztab(:,:,8) = bmask (:,:  )
+
+      ! replace bsf solver informations by ps solver one
+      eps    = epsp
+      nmax   = nmaxp
+      gcp   (:,:,1) = gcps  (:,:,1)
+      gcp   (:,:,2) = gcps  (:,:,2)
+      gcp   (:,:,3) = gcps  (:,:,3)
+      gcp   (:,:,4) = gcps  (:,:,4)
+      gcdprc(:,:  ) = gcdpsc(:,:  )
+      gcdmat(:,:  ) = gcsmat(:,:  )
+      bmask (:,:  ) = spmsk (:,:  )
+      !    first guess: ps
+      gcx   (:,:  ) = gps   (:,:  )
+
+      !,,,,,,,,,,,,,,,,,,,,,,,,synchro IF macrotasking,,,,,,,,,,,,,,,,,,,,,,,
+
+      ! right hand side: 2d div. of the surface pressure gradient
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            gcb(ji,jj) = -gcdpsc(ji,jj)*   &
+               (  e2u(ji,jj)*spgum(ji,jj) - e2u(ji-1,jj)*spgum(ji-1,jj)   &
+               + e1v(ji,jj)*spgvm(ji,jj) - e1v(ji,jj-1)*spgvm(ji,jj-1) )
+         END DO
+      END DO
+      
+      !,,,,,,,,,,,,,,,,,,,,,,,,synchro IF macrotasking,,,,,,,,,,,,,,,,,,,,,,,
+      
+      ! relative PRECISION
+      rnorme = 0.
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            rnorme = rnorme + gcb(ji,jj) * gcsmat(ji,jj) * gcb(ji,jj)
+         END DO
+      END DO
+#if defined key_mpp
+      CALL  mpp_sum( rnorme )
+#endif
+      epsr=eps*eps*rnorme
+      ncut=0
+      !   IF the second member is 0 the solution is 0, solpcg isn't called
+      IF ( rnorme == 0.e0 ) THEN
+         gps(:,:) = 0.e0
+         res   = 0.e0
+         niter = 0
+         ncut  = 999
+      ENDIF
+      
+      !,,,,,,,,,,,,,,,,,,,,,,,,synchro IF macrotasking,,,,,,,,,,,,,,,,,,,,,,,
+      
+      nindic = 0
+
+      ! iterarive solver of the spg system (except IF sol.=0)
+      !     (OUTPUT in gcx with boundary conditions applied)
+      IF ( ncut == 0 ) THEN
+         IF ( nsolv == 1 ) THEN
+            CALL sol_pcg( nindic )         !   diagonal preconditioned conjuguate gradient
+         ELSE IF ( nsolv == 2 ) THEN
+            CALL sol_sor( kt, nindic )     !   successive-over-relaxation
+         ELSE IF(nsolv == 3) THEN
+            CALL sol_fet( nindic )         !   FETI solver
+         ELSE
+            !   e r r o r  in nsolv namelist PARAMETER
+            IF(lwp) THEN
+               WRITE(numout,*) ' dia_spr: e r r o r, nsolv = 1 or 2'
+               WRITE(numout,*) ' ******               not = ',nsolv
+            ENDIF
+            STOP 'dia_spr'
+         ENDIF
+      ENDIF
+      
+      !,,,,,,,,,,,,,,,,,,,,,,,,synchro IF macrotasking,,,,,,,,,,,,,,,,,,,,,,,
+
+      
+      ! sp solver statistics  (i.e. problem for the solver) 
+      IF ( epsr < 0.) THEN
+         IF(lwp) THEN 
+            WRITE(numout,*)'rrrrrrrrrrrrrrr'
+            IF(lwp)WRITE(numout,*)'dia_spr-1:',epsr
+            IF(lwp)WRITE(numout,*)'rrrrrrrrrrrrrrr'
+         ENDIF
+      ENDIF
+      IF(lwp)WRITE(numout,9300) kt, niter, res, SQRT(epsr)/eps
+      IF (nindic < 0) THEN 
+         IF(lwp) THEN 
+            WRITE(numout,9100)
+            WRITE(numout,*) ' dia_spr : the surface pressure solver DO not converge'
+            WRITE(numout,*) ' ====== ' 
+            WRITE(numout,*) 
+         ENDIF
+      ENDIF
+9100  FORMAT( /,' ===>>>> : w a r n i n g',/,'          ===============',/ )
+9300  FORMAT(' it :', i8, ' niter :', i4, ' res :',e20.10,' b :', e20.10)
+
+      ! recover bsf solver informations and SAVE ps for next computation
+      eps    = zeps
+      nmax   = imax 
+      gps   (:,:  ) = gcx (:,:)
+      gcp   (:,:,1) = ztab(:,:,1)
+      gcp   (:,:,2) = ztab(:,:,2)
+      gcp   (:,:,3) = ztab(:,:,3)
+      gcp   (:,:,4) = ztab(:,:,4)
+      gcdprc(:,:  ) = ztab(:,:,5)
+      gcdmat(:,:  ) = ztab(:,:,6)
+      gcx   (:,:  ) = ztab(:,:,7)
+      bmask (:,:  ) = ztab(:,:,8)
+      
+      ! compute and substract the mean value
+      
+      zpsmea = 0.e0
+      DO jj=2,jpjm1
+         DO ji=2,jpim1
+            zpsmea = zpsmea + gps(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1)
+         END DO
+      END DO
+#if defined key_mpp
+      CALL  mpp_sum( zpsmea )
+#endif
+      zpsmea=zpsmea/e1e2t
+            gps(:,:)=(gps(:,:)-zpsmea)*tmask(:,:,1)
+ 
+      IF(lwp)WRITE(numout,*) ' mean value of ps = ',zpsmea,' is substracted'
+      ! ----------------------------------------
+      ! i. compute the surface pressure gradient
+      !    from the computed surface pressure
+      ! ----------------------------------------
+
+      DO jj=2,jpjm1
+         DO ji=2,jpim1
+            gpsuu(ji,jj)=(gps(ji+1,jj)-gps(ji,jj))/e1u(ji,jj) * umask(ji,jj,1)
+            gpsvv(ji,jj)=(gps(ji,jj+1)-gps(ji,jj))/e2v(ji,jj) * vmask(ji,jj,1)
+         END DO
+      END DO
+      
+      ! compute the max and min error
+      
+      zemax1=0.
+      zemin1=0.
+      zemax2=0.
+      zemin2=0.
+      DO jj=2,jpj-1
+         DO ji=2,jpi-1
+            z1=ABS( spgum(ji,jj)-gpsuu(ji,jj) )*umask(ji,jj,1)
+            z2=ABS( spgvm(ji,jj)-gpsvv(ji,jj) )*vmask(ji,jj,1)
+            z3=MAX ( ABS( spgum(ji,jj) ), ABS( spgvm(ji,jj) ) )
+            z4=MAX ( ABS( gpsuu(ji,jj) ), ABS( gpsvv(ji,jj) ) )
+            zemax1=MAX(z1,zemax1)
+            zemax2=MAX(z2,zemax2)
+            zemin1=MAX(z3,zemin1)
+            zemin2=MAX(z4,zemin2)
+         END DO
+      END DO
+#if defined key_mpp
+      CALL  mpp_max( zemax1 )
+      CALL  mpp_max( zemax2 )
+      CALL  mpp_max( zemin1 )
+      CALL  mpp_max( zemin2 )
+#endif
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'pserro : time step = ', kt
+         WRITE(numout,*) '******** ------------------'
+         WRITE(numout,*)
+         WRITE(numout,*) '         gpsx error  max=',zemax1
+         WRITE(numout,*) '         gpsy error  max=',zemax2
+         WRITE(numout,*) '         gps max =',zemin1
+         WRITE(numout,*) '         gpsc max =',zemin2
+         WRITE(numout,*)
+      ENDIF
+
+      ! compute the norme and variance of this error
+
+      zcompt=0.
+      zdif1=0.
+      zdif2=0.
+      zvar1=0.
+      zvar2=0.
+      DO jj = 2, jpj-1
+         DO ji = 2, jpi-1
+            z1 = ( spgum(ji,jj)-gpsuu(ji,jj) ) * umask(ji,jj,1)
+            z2 = ( spgvm(ji,jj)-gpsvv(ji,jj) ) * vmask(ji,jj,1)
+            zcompt=zcompt+tmask(ji,jj,1)
+            zdif1=zdif1+z1
+            zdif2=zdif2+z2
+            zvar1=zvar1+z1*z1
+            zvar2=zvar2+z2*z2
+         END DO
+      END DO
+      
+#if defined key_mpp
+      CALL mpp_sum( zcompt )
+      CALL mpp_sum( zdif1  )
+      CALL mpp_sum( zdif2  )
+      CALL mpp_sum( zvar1  )
+      CALL mpp_sum( zvar2  )
+#endif
+      IF(lwp) WRITE(numout,*) '        zcompt = ',zcompt
+      zdif1=zdif1/zcompt
+      zdif2=zdif2/zcompt
+      IF( zvar1 < 0.) THEN 
+         IF(lwp) THEN
+            WRITE(numout,*)'rrrrrrrrrrrrrrr'
+            WRITE(numout,*)'dia_spr-2:',zvar1
+            WRITE(numout,*)'rrrrrrrrrrrrrrr'
+         ENDIF
+      ENDIF
+      zvar1 = SQRT(zvar1)/zcompt
+      IF( zvar2 < 0. ) THEN 
+         IF(lwp)THEN
+            WRITE(numout,*)'rrrrrrrrrrrrrrr'
+            WRITE(numout,*)'dia_spr-3:',zvar2
+            WRITE(numout,*)'rrrrrrrrrrrrrrr'
+         ENDIF
+      ENDIF
+      zvar2 = SQRT(zvar2)/zcompt
+      
+      IF(lwp) THEN 
+         WRITE(numout,*)
+         WRITE(numout,*) '         gpsx mean error = ',zdif1
+         WRITE(numout,*) '         gpsy mean error = ',zdif2
+         WRITE(numout,*)
+         WRITE(numout,*) '         gpsx var. error = ',zvar1
+         WRITE(numout,*) '         gpsy var. error = ',zvar2
+         WRITE(numout,*)
+         WRITE(numout,*)
+      ENDIF
+      
+      ! reset to zero nmoyps and the mean surface pressure gradient
+      nmoyps = 0
+      spgum(:,:) = 0.e0
+      spgvm(:,:) = 0.e0
+      
+   END SUBROUTINE dia_spr
+
+
+   SUBROUTINE sprmat
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sprmat  ***
+      !!               
+      !! ** Purpose :   construction of the matrix of the surface pressure
+      !!      system and the diagonal preconditioning matrix.
+      !!
+      !! ** Method :
+      !!
+      !! History :
+      !!        !  98-01  (G. Madec & M. Ioualalen)  Original code
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj, jl                ! dummy loop indices
+      REAL(wp) ::   zcoefs, zcoefw, zcoefe, zcoefn
+      !!----------------------------------------------------------------------
+      
+      
+      ! 0. ocean/land mask at ps-point (computed from surface tmask): spmsk
+      ! --------------------------------------------------------------------
+      
+      ! computation
+      spmsk(:,:) = tmask(:,:,1)
+      
+      ! boundary conditions
+      ! south symmetry: psmsk must be set to 0. on 1
+      IF( nperio == 2 ) THEN
+         spmsk(:, 1 ) = 0.e0
+      ENDIF
+      
+      ! east-west cyclic: spmsk must be set to 0. on 1 and jpi
+      IF( nperio == 1 .OR. nperio == 4 .OR.nperio == 6) THEN 
+         spmsk( 1 ,:) = 0.e0
+         spmsk(jpi,:) = 0.e0
+      ENDIF
+      
+      ! north fold: spmsk must be set to 0. on ligne jpj and on half
+      !                   ligne jpj-1
+      ! T-point pivot
+      IF( nperio == 3 .OR. nperio == 4 ) THEN
+         spmsk(:,jpj) = 0.e0
+         DO ji = jpi/2+1, jpi
+            spmsk(ji,jpjm1) = 0.e0
+         END DO
+      ENDIF
+      ! F-point pivot
+      IF( nperio == 5 .OR. nperio == 6 ) THEN
+         spmsk(:,jpj) = 0.e0
+      ENDIF
+      
+      ! mpp boundary cond.: spmsk is initialized at zero on the overlap
+      ! region for both the preconjugate gradient and the sor algorithms
+
+      IF( nbondi /= -1 .AND. nbondi /= 2 ) THEN
+         DO jl = 1, jpreci
+            spmsk(jl,:) = 0.e0
+         END DO
+      ENDIF
+      IF( nbondi /= 1 .AND. nbondi /= 2 ) THEN
+         DO ji = nlci, jpi
+            spmsk(ji,:) = 0.e0
+         END DO
+      ENDIF
+      IF( nbondj /= -1 .AND. nbondj /= 2 ) THEN
+         DO jl=1,jprecj
+            spmsk(:,jl) = 0.e0
+         END DO
+      ENDIF
+      IF( nbondj /= 1 .AND. nbondj /= 2 ) THEN
+         DO jj = nlcj, jpj
+            spmsk(:,jj) = 0.e0
+         END DO
+      ENDIF
+      
+      ! 1. construction of the matrix
+      ! -----------------------------
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            
+            IF( spmsk(ji,jj) == 0. ) THEN
+               ! land points
+               gcps  (ji,jj,1) = 0.e0
+               gcps  (ji,jj,2) = 0.e0
+               gcps  (ji,jj,3) = 0.e0
+               gcps  (ji,jj,4) = 0.e0
+               gcdpsc(ji,jj  ) = 0.e0
+               gcsmat(ji,jj  ) = 0.e0
+            ELSE
+               ! south coefficient
+               zcoefs = -e1v(ji,jj-1) / e2v(ji,jj-1) * vmask(ji,jj-1,1)
+               gcps(ji,jj,1) = zcoefs
+               ! west coefficient
+               zcoefw = -e2u(ji-1,jj) / e1u(ji-1,jj) * umask(ji-1,jj,1)
+               gcps(ji,jj,2) = zcoefw
+               ! east coefficient
+               zcoefe = -e2u(ji  ,jj) / e1u(ji  ,jj) * umask(ji  ,jj,1)
+               gcps(ji,jj,3) = zcoefe
+               ! north coefficient
+               zcoefn = -e1v(ji,jj  ) / e2v(ji,jj  ) * vmask(ji,jj  ,1)
+               gcps(ji,jj,4) = zcoefn
+               
+               ! diagonal coefficient
+               gcsmat(ji,jj) = -zcoefs-zcoefw-zcoefe-zcoefn
+            ENDIF
+         END DO
+      END DO
+      
+
+      ! 2. boundary conditions 
+      ! ----------------------
+      
+      ! cyclic east-west boundary conditions
+      ! ji=2 is the column east of ji=jpim1 and reciprocally,
+      ! ji=jpim1 is the column west of ji=2
+      ! all the coef are already set to zero as spmask is initialized to
+      ! zero for ji=1 and ji=jpj.
+      
+      ! symetrical conditions
+      ! the diagonal coefficient of the southern grid points must be modify to
+      ! account for the existence of the south symmetric bassin.
+      IF( nperio == 2 ) THEN
+         DO ji = 1, jpi
+            IF( spmsk(ji,2) /= 0 ) THEN
+               zcoefs = e1v(ji,1) / e2v(ji,1)
+               gcsmat(ji,2) = gcsmat(ji,2) - zcoefs
+            ENDIF
+         END DO
+      ENDIF
+      
+      ! North fold boundary condition
+      ! all the coef are already set to zero as bmask is initialized to
+      ! zero on duplicated lignes and portion of lignes
+      
+      
+      ! 3. preconditioned matrix
+      ! ------------------------
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( spmsk(ji,jj) /= 0. ) gcdpsc(ji,jj) = 1.e0 / gcsmat(ji,jj)
+         END DO
+      END DO
+      
+      gcps(:,:,1) = gcps(:,:,1) * gcdpsc(:,:)
+      gcps(:,:,2) = gcps(:,:,2) * gcdpsc(:,:)
+      gcps(:,:,3) = gcps(:,:,3) * gcdpsc(:,:)
+      gcps(:,:,4) = gcps(:,:,4) * gcdpsc(:,:)
+      
+      
+      ! 3. initialization the arrays used in sp solver
+      ! ----------------------------------------------
+      
+      gps  (:,:) = 0.e0
+      gpsuu(:,:) = 0.e0
+      gpsvv(:,:) = 0.e0
+      
+   END SUBROUTINE sprmat
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                    NO surface pressure diagnostics
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diaspr = .FALSE.    ! surface pressure diag. flag
+CONTAINS
+   SUBROUTINE dia_spr( kt )      ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE dia_spr
+#endif
+
+   !!======================================================================
+END MODULE diaspr
Index: /branches/nemo/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DIA/diawri.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DIA/diawri.F90	(revision 4)
@@ -0,0 +1,635 @@
+MODULE diawri
+   !!======================================================================
+   !!                     ***  MODULE  diawri  ***
+   !! Ocean diagnostics :  write ocean output files
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE zdf_oce         ! ocean vertical physics
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldfdyn_oce      ! ocean dynamics: lateral physics
+   USE sol_oce         ! solver variables
+   USE ice_oce         ! ice variables
+   USE phycst          ! physical constants
+   USE ocfzpt          ! ???
+   USE ocesbc          ! surface thermohaline fluxes
+   USE taumod          ! surface stress
+   USE flxrnf          ! ???
+   USE zdfmxl          ! mixed layer
+   USE daymod          ! calendar
+   USE dianam          ! build name of file (routine)
+   USE zdfddm          ! vertical  physics: double diffusion
+   USE diahth          ! thermocline diagnostics
+   USE diaspr          ! surface pressure diagnostics (rigid lid case)
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC dia_wri                 ! routines called by step.F90
+   PUBLIC dia_wri_state
+   PUBLIC dia_wri_dimg            ! called by trd_mld (eg)
+
+   !! * Module variables
+   INTEGER ::   &
+      nid_T, nz_T, nh_T, ndim_T, ndim_hT,      &   ! grid_T file
+      nid_U, nz_U, nh_U, ndim_U, ndim_hU,      &   ! grid_U file
+      nid_V, nz_V, nh_V, ndim_V, ndim_hV,      &   ! grid_V file
+      nid_W, nz_W, nh_W,                       &   ! grid_W file
+      ndex(1)                                            ! ???
+   INTEGER, DIMENSION(jpi*jpj) ::   &
+      ndex_hT, ndex_hU, ndex_hV
+   INTEGER, DIMENSION(jpi*jpj*jpk) ::   &
+      ndex_T, ndex_U, ndex_V
+
+   !! * Substitutions
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined key_fdir 
+   !!----------------------------------------------------------------------
+   !!   'key_fdir' :                              direct access output file
+   !!----------------------------------------------------------------------
+#   include "diawri_fdir.h90"
+
+#elif defined key_dimgout
+   !!----------------------------------------------------------------------
+   !!   dia_wri       : create the dimg direct access output file (mpp)
+   !!----------------------------------------------------------------------
+#   include "diawri_dimg.h90"
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                   NetCDF output file
+   !!----------------------------------------------------------------------
+   !!   dia_wri       : create the standart NetCDF output files
+   !!   dia_wri_state : create an output NetCDF file for a single
+   !!                   instantaeous ocean state and forcing fields
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dia_wri( kt, kindic )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_wri  ***
+      !!                   
+      !! ** Purpose :   Standard output of opa: dynamics and tracer fields 
+      !!      NETCDF format is used by default 
+      !!
+      !! ** Method  :   At the beginning of the first time step (nit000), 
+      !!      define all the NETCDF files and fields
+      !!      At each time step call histdef to compute the mean if ncessary
+      !!      Each nwrite time step, output the instantaneous or mean fields
+      !!      IF kindic <0, output of fields before the model interruption.
+      !!      IF kindic =0, time step loop
+      !!      IF kindic >0, output of fields before the time step loop
+      !!
+      !! History :
+      !!        !  91-03  (M.-A. Foujols)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard)  correction restart file
+      !!        !  92-07  (M. Imbard)  split into diawri and rstwri
+      !!        !  93-03  (M. Imbard)  suppress writibm
+      !!        !  98-01  (C. Levy)  NETCDF format using ioipsl INTERFACE
+      !!        !  99-02  (E. Guilyardi)  name of netCDF files + variables
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT( in ) ::   kindic  ! 
+
+      !! * Local declarations
+      LOGICAL ::   ll_print = .FALSE.    ! =T print and flush numout
+      CHARACTER (len=40) ::           &
+         clhstnam, clop, clmx            ! temporary names
+      INTEGER ::   inum = 11             ! temporary logical unit
+      INTEGER ::   &
+         iimi, iima, ipk, it,         &  ! temporary integers
+         ijmi, ijma                      !    "          "
+      REAL(wp) ::   &
+         zsto, zout, zmax,            &  ! temporary scalars
+         zjulian, zdt                    !    "         "
+      REAL(wp), DIMENSION(jpi,jpj) :: &
+         zw2d                            ! temporary workspace
+      !!----------------------------------------------------------------------
+      
+      ! 0. Initialisation
+      ! -----------------
+      
+      ! local variable for debugging
+      ll_print = .FALSE.
+      ll_print = ll_print .AND. lwp
+
+      ! Define frequency of output and means
+      zdt = rdt
+      IF( nacc == 1 ) zdt = rdtmin
+#if defined key_diainstant
+      zsto = nwrite * zdt
+      clop = "inst(x)"           ! no use of the mask value (require less cpu time)
+      !!! clop="inst(only(x))"   ! put 1.e+20 on land (very expensive!!)
+#else
+      zsto=zdt
+      clop="ave(x)"              ! no use of the mask value (require less cpu time)
+      !!! clop="ave(only(x))"    ! put 1.e+20 on land (very expensive!!)
+#endif
+      zout = nwrite * zdt
+      zmax = ( nitend - nit000 + 1 ) * zdt
+
+      ! Define indices of the horizontal output zoom and vertical limit storage
+      iimi = 1      ;      iima = jpi
+      ijmi = 1      ;      ijma = jpj
+      ipk = jpk
+
+      ! define time axis
+      it = kt - nit000 + 1
+
+
+      ! 1. Define NETCDF files and fields at beginning of first time step
+      ! -----------------------------------------------------------------
+
+      IF(ll_print) WRITE(numout,*) 'dia_wri kt = ', kt, ' kindic ', kindic
+
+      IF( kt == nit000 ) THEN
+
+         ! Define the NETCDF files (one per grid)
+         
+         ! Compute julian date from starting date of the run
+         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian )
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'Date 0 used :', nit000, ' YEAR ', nyear,   &
+            &                    ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
+         IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,   &
+                                 ' limit storage in depth = ', ipk
+
+         ! WRITE root name in date.file for use by postpro
+         CALL dia_nam( clhstnam, nwrite,' ' )
+         CALL ctlopn( inum, 'date.file', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
+         WRITE(inum,*) clhstnam
+         CLOSE(inum)
+         
+         ! Define the T grid FILE ( nid_T )
+         
+         CALL dia_nam( clhstnam, nwrite, 'grid_T' )
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          0, zjulian, zdt, nh_T, nid_T )
+         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
+            &           "m", ipk, gdept, nz_T )
+         !                                                            ! Index of ocean points
+         CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T  )      ! volume
+         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndex_hT, ndim_hT )      ! surface
+
+         ! Define the U grid FILE ( nid_U )
+
+         CALL dia_nam( clhstnam, nwrite, 'grid_U' )
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename
+         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          0, zjulian, zdt, nh_U, nid_U )
+         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
+            &           "m", ipk, gdept, nz_U )
+         !                                                            ! Index of ocean points
+         CALL wheneq( jpi*jpj*ipk, umask, 1, 1., ndex_U , ndim_U  )      ! volume
+         CALL wheneq( jpi*jpj    , umask, 1, 1., ndex_hU, ndim_hU )      ! surface
+
+         ! Define the V grid FILE ( nid_V )
+
+         CALL dia_nam( clhstnam, nwrite, 'grid_V' )                   ! filename
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
+         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          0, zjulian, zdt, nh_V, nid_V )
+         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
+            &          "m", ipk, gdept, nz_V )
+         !                                                            ! Index of ocean points
+         CALL wheneq( jpi*jpj*ipk, vmask, 1, 1., ndex_V , ndim_V  )      ! volume
+         CALL wheneq( jpi*jpj    , vmask, 1, 1., ndex_hV, ndim_hV )      ! surface
+
+         ! Define the W grid FILE ( nid_W )
+
+         CALL dia_nam( clhstnam, nwrite, 'grid_W' )                   ! filename
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       &
+            &          0, zjulian, zdt, nh_W, nid_W )
+         CALL histvert( nid_W, "depthw", "Vertical W levels",      &  ! Vertical grid: gdepw
+            &          "m", ipk, gdepw, nz_W )
+ 
+
+         ! Declare all the output fields as NETCDF variables
+
+         !                                                                                      !!! nid_T : 3D
+         CALL histdef( nid_T, "votemper", "Temperature"                        , "C"      ,   &  ! tn
+            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
+         CALL histdef( nid_T, "vosaline", "Salinity"                           , "PSU"    ,   &  ! sn
+            &          jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout )
+         !                                                                                      !!! nid_T : 2D
+         CALL histdef( nid_T, "sosstsst", "Sea Surface temperature"            , "C"      ,   &  ! sst
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sosaline", "Sea Surface Salinity"               , "PSU"    ,   &  ! sss
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#if defined key_dynspg_fsc
+         CALL histdef( nid_T, "sossheig", "Sea Surface Height"                 , "m"      ,   &  ! ssh
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#else
+         CALL histdef( nid_T, "sobarstf","Barotropic StreamFunction"           , "m3/s2"  ,   &  ! bsf
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#endif
+#if defined key_dynspg_fsc && defined key_ice_lim
+         ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to
+         !    internal damping to Levitus that can be diagnosed from others
+         ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup
+         CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater"          , "kg/m2/s",   &  ! fsalt
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater"        , "kg/m2/s",   &  ! fmass
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#endif
+         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! emp
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sorunoff", "Runoffs"                            , "Kg/m2/s",   &  ! runoffs
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux"  , "kg/m2/s",   &  ! emps
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sosalflx", "Surface Salt Flux"                  , "Kg/m2/s",   &  ! emps * sn
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qt
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "soshfldo", "Shortwave Radiation"                , "W/m2"   ,   &  ! qsr
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "somxl010", "Mixed Layer Depth 0.01"             , "m"      ,   &  ! hmlp
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "somixhgt", "Turbocline Depth"                   , "m"      ,   &  ! hmld
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "soicecov", "Ice Cover"                          , "[0,1]"  ,   &  ! freeze
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#if ! defined key_coupled 
+         CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping"         , "Kg/m2/s",   &  ! erp * sn
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#endif
+
+#if ( defined key_coupled && ! defined key_ice_lim ) 
+         CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping"         , "W/m2"   ,   &  ! qrp
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping"        , "Kg/m2/s",   &  ! erp
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping"         , "Kg/m2/s",   &  ! erp * sn
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#endif
+#if defined key_diaspr
+         CALL histdef( nid_T, "sosurfps", "Surface Pressure"                   , "cm"     ,   &  ! sp
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#endif
+         clmx ="l_max(only(x))"    ! max index on a period
+         CALL histdef( nid_T, "sobowlin", "Bowl Index"                         , "W-point",   &  ! bowl INDEX 
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clmx, zsto, zout )
+#if defined key_diahth
+         CALL histdef( nid_T, "sothedep", "Thermocline Depth"                  , "m"      ,   & ! hth
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm"              , "m"      ,   & ! hd20
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm"              , "m"      ,   & ! hd28
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "W"      ,   & ! htc3
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#endif
+
+#if defined key_ice_lim && defined key_coupled
+         CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature"            , "K"      ,   &  ! tn_ice
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T,"soicealb" , "Ice Albedo"                         , "[0,1]"  ,   &  ! alb_ice
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#endif 
+
+         CALL histend( nid_T )
+
+         !                                                                                      !!! nid_U : 3D
+         CALL histdef( nid_U, "vozocrtx", "Zonal Current"                      , "m/s"    ,   &  ! un
+            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
+#if defined key_diaeiv
+         CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv
+            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
+#endif
+         !                                                                                      !!! nid_U : 2D
+         CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis"           , "N/m2"   ,   &  ! taux
+            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+#if ! defined key_dynspg_fsc
+         CALL histdef( nid_U, "sozospgx", "Zonal Surface Pressure Gradient"    , "N/kg"   ,   &  ! spgu
+            &          jpi, jpj, nh_U, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+#endif
+
+         CALL histend( nid_U )
+
+         !                                                                                      !!! nid_V : 3D
+         CALL histdef( nid_V, "vomecrty", "Meridional Current"                 , "m/s"    ,   &  ! vn
+            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
+#if defined key_diaeiv
+         CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv
+            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
+#endif
+         !                                                                                      !!! nid_V : 2D
+         CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis"           , "N/m2"   ,   &  ! tauy
+            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+#if ! defined key_dynspg_fsc
+         CALL histdef( nid_V, "somespgy", "Meridional Surface Pressure Grad."  , "N/kg"   ,   &  ! spgv
+            &          jpi, jpj, nh_V, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+#endif
+
+         CALL histend( nid_V )
+
+         !                                                                                      !!! nid_W : 3D
+         CALL histdef( nid_W, "vovecrtz", "Vertical Velocity"                  , "m/s"    ,   &  ! wn
+            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+#if defined key_diaeiv
+         CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv
+            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+#endif
+         CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity"          , "m2/s"   ,   &  ! avt
+            &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+         IF( lk_zdfddm ) THEN
+            CALL histdef( nid_W,"voddmavs","Salt Vertical Eddy Diffusivity"    , "m2/s"   ,   &  ! avs
+               &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+            CALL histdef( nid_W,"voddmrra","Heat/Salt buoyancy Ratio"          , "-"      ,   &  ! rrau
+               &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+         ENDIF
+         !                                                                                      !!! nid_W : 2D
+#if defined key_traldf_c2d
+         CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity"           , "m2/s"   ,   &  ! ahtw
+            &          jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+         IF( lk_traldf_eiv ) THEN
+            CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s",   &  ! aeiw
+               &       jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+         ENDIF
+#endif
+
+         CALL histend( nid_W )
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization'
+         IF(ll_print) CALL FLUSH(numout )
+
+      ENDIF
+
+      ! 2. Start writing data
+      ! ---------------------
+
+      ! ndex(1) est utilise ssi l'avant dernier argument est diffferent de 
+      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
+      ! donne le nombre d'elements, et ndex la liste des indices a sortir
+
+      IF( lwp .AND. MOD( kt, nwrite ) == 0 ) THEN 
+         WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step'
+         WRITE(numout,*) '~~~~~~ '
+      ENDIF
+
+      ! Write fields on T grid
+      CALL histwrite( nid_T, "votemper", it, tn            , ndim_T , ndex_T  )   ! temperature
+      CALL histwrite( nid_T, "vosaline", it, sn            , ndim_T , ndex_T  )   ! salinity
+      CALL histwrite( nid_T, "sosstsst", it, tn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface temperature
+      CALL histwrite( nid_T, "sosaline", it, sn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface salinity
+#if defined key_dynspg_fsc
+      CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height
+#else
+      CALL histwrite( nid_T, "sobarstf", it, bsfn          , ndim_hT, ndex_hT )   ! barotropic streamfunction
+#endif
+#if defined key_dynspg_fsc && defined key_ice_lim
+      CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:)    , ndim_hT, ndex_hT )   ! ice=>ocean water flux
+      CALL histwrite( nid_T, "sowaflep", it, fmass(:,:)    , ndim_hT, ndex_hT )   ! atmos=>ocean water flux
+#endif
+      CALL histwrite( nid_T, "sowaflup", it, emp           , ndim_hT, ndex_hT )   ! upward water flux
+      CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff
+      CALL histwrite( nid_T, "sowaflcd", it, emps          , ndim_hT, ndex_hT )   ! c/d water flux
+      zw2d(:,:) = emps(:,:) * sn(:,:,1) * tmask(:,:,1)
+      CALL histwrite( nid_T, "sosalflx", it, zw2d          , ndim_hT, ndex_hT )   ! c/d salt flux
+      CALL histwrite( nid_T, "sohefldo", it, qt            , ndim_hT, ndex_hT )   ! total heat flux
+      CALL histwrite( nid_T, "soshfldo", it, qsr           , ndim_hT, ndex_hT )   ! solar heat flux
+      CALL histwrite( nid_T, "somxl010", it, hmlp          , ndim_hT, ndex_hT )   ! mixed layer depth
+      CALL histwrite( nid_T, "somixhgt", it, hmld          , ndim_hT, ndex_hT )   ! turbocline depth
+      CALL histwrite( nid_T, "soicecov", it, freeze        , ndim_hT, ndex_hT )   ! ice cover 
+#if ! defined key_coupled
+      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
+      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
+      zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1)
+      CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
+#endif
+#if ( defined key_coupled && ! defined key_ice_lim ) 
+      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping
+      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping
+         zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1)
+      CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping
+#endif
+#if defined key_diaspr
+      CALL histwrite( nid_T, "sosurfps", it, gps           , ndim_hT, ndex_hT )   ! surface pressure
+#endif
+         zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1)
+      CALL histwrite( nid_T, "sobowlin", it, zw2d          , ndim_hT, ndex_hT )   ! ???
+
+#if defined key_diahth
+      CALL histwrite( nid_T, "sothedep", it, hth           , ndim_hT, ndex_hT )   ! depth of the thermocline
+      CALL histwrite( nid_T, "so20chgt", it, hd20          , ndim_hT, ndex_hT )   ! depth of the 20 isotherm
+      CALL histwrite( nid_T, "so28chgt", it, hd28          , ndim_hT, ndex_hT )   ! depth of the 28 isotherm
+      CALL histwrite( nid_T, "sohtc300", it, htc3          , ndim_hT, ndex_hT )   ! first 300m heaat content
+#endif
+#if defined key_ice_lim &&  defined key_coupled 
+      CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature
+      CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo
+#endif
+         ! Write fields on U grid
+      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current
+#if defined key_diaeiv
+      CALL histwrite( nid_U, "vozoeivu", it, u_eiv         , ndim_U , ndex_U )    ! i-eiv current
+#endif
+      CALL histwrite( nid_U, "sozotaux", it, taux          , ndim_hU, ndex_hU )   ! i-wind stress
+#if ! defined key_dynspg_fsc
+      CALL lbc_lnk( spgu, 'U', -1. )
+      CALL histwrite( nid_U, "sozospgx", it, spgu          , ndim_hU, ndex_hU )   ! i-surf. press. grad.
+#endif
+
+         ! Write fields on V grid
+      CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current
+#if defined key_diaeiv
+      CALL histwrite( nid_V, "vomeeivv", it, v_eiv         , ndim_V , ndex_V  )   ! j-eiv current
+#endif
+      CALL histwrite( nid_V, "sometauy", it, tauy          , ndim_hV, ndex_hV )   ! j-wind stress
+#if ! defined key_dynspg_fsc
+      CALL lbc_lnk( spgv, 'V', -1. )
+      CALL histwrite( nid_V, "somespgy", it, spgv          , ndim_hV, ndex_hV )   ! j-surf. pressure grad.
+#endif
+
+         ! Write fields on W grid
+      CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current
+#   if defined key_diaeiv
+      CALL histwrite( nid_W, "voveeivw", it, w_eiv          , ndim_T, ndex_T )    ! vert. eiv current
+#   endif
+      CALL histwrite( nid_W, "votkeavt", it, avt            , ndim_T, ndex_T )    ! T vert. eddy diff. coef.
+      IF( lk_zdfddm ) THEN
+         CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T )    ! S vert. eddy diff. coef.
+      ENDIF
+#if defined key_traldf_c2d
+      CALL histwrite( nid_W, "soleahtw", it, ahtw          , ndim_hT, ndex_hT )   ! lateral eddy diff. coef.
+      IF( lk_traldf_eiv ) THEN
+         CALL histwrite( nid_W, "soleaeiw", it, aeiw       , ndim_hT, ndex_hT )   ! EIV coefficient at w-point
+      ENDIF
+#endif
+
+      ! 3. Synchronise and close all files
+      ! ---------------------------------------
+      IF( MOD( kt, nwrite ) == 0 .OR. kindic < 0 ) THEN
+         CALL histsync( nid_T )
+         CALL histsync( nid_U )
+         CALL histsync( nid_V )
+         CALL histsync( nid_W )
+      ENDIF
+
+      !  Create an output files (output.abort.nc) if S < 0 or u > 20 m/s
+      IF( kindic < 0 )   CALL dia_wri_state( 'output.abort' )
+
+      IF( kt == nitend .OR. kindic < 0 ) THEN
+         CALL histclo( nid_T )
+         CALL histclo( nid_U )
+         CALL histclo( nid_V )
+         CALL histclo( nid_W )
+      ENDIF
+
+   END SUBROUTINE dia_wri
+
+
+   SUBROUTINE dia_wri_state( cdfile_name )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dia_wri_state  ***
+      !!        
+      !! ** Purpose :   create a NetCDF file named cdfile_name which contains 
+      !!      the instantaneous ocean state and forcing fields.
+      !!        Used to find errors in the initial state or save the last
+      !!      ocean state in case of abnormal end of a simulation
+      !!
+      !! ** Method  :   NetCDF files using ioipsl
+      !!      File 'output.init.nc'  is created if ninist = 1 (namelist)
+      !!      File 'output.abort.nc' is created in case of abnormal job end
+      !!
+      !! History :
+      !!   8.2  !  00-06  (M. Imbard)  Original code (diabort.F)
+      !!   8.5  !  02-06  (A.Bozec, E. Durand)  Original code (diainit.F)
+      !!   9.0  !  02-12  (G. Madec)  merge of diabort and diainit, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Arguments
+      CHARACTER (len=* ), INTENT( in ) ::   &
+         cdfile_name      ! name of the file created
+
+      !! * Local declarations
+      CHARACTER (len=40) :: clop
+      INTEGER  ::   &
+         id_i , nz_i, nh_i       
+      INTEGER, DIMENSION(1) ::   &
+         idex             ! temprary workspace
+      REAL(wp) ::   &
+         zsto, zout, zmax,   &
+         zjulian, zdt
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   and forcing fields file created '
+      IF(lwp) WRITE(numout,*) '                and named :', cdfile_name, '.nc'
+      
+      ! 0. Initialisation
+      ! -----------------
+      
+      ! Define frequency of output and means
+      zdt  = rdt
+      zsto = rdt
+      clop = "inst(x)"           ! no use of the mask value (require less cpu time)
+      zout = rdt
+      zmax = ( nitend - nit000 + 1 ) * zdt
+
+      ! 1. Define NETCDF files and fields at beginning of first time step
+      ! -----------------------------------------------------------------
+
+      ! Compute julian date from starting date of the run
+      CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian )         ! time axis 
+      CALL histbeg( cdfile_name, jpi, glamt, jpj, gphit,   &
+          1, jpi, 1, jpj, 0, zjulian, zdt, nh_i, id_i )       ! Horizontal grid : glamt and gphit
+      CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept
+          "m", jpk, gdept, nz_i)
+
+      ! Declare all the output fields as NetCDF variables
+
+      CALL histdef( id_i, "vosaline", "Salinity"              , "PSU"    ,   &   ! salinity
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+      CALL histdef( id_i, "votemper", "Temperature"           , "C"      ,   &   ! temperature
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+      CALL histdef( id_i, "vozocrtx", "Zonal Current"         , "m/s"    ,   &   ! zonal current
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout )
+      CALL histdef( id_i, "vomecrty", "Meridional Current"    , "m/s"    ,   &   ! meridonal current
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
+      CALL histdef( id_i, "vovecrtz", "Vertical Velocity"     , "m/s"    ,   &   ! vertical current
+         &          jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 
+      CALL histdef( id_i, "sowaflup", "Net Upward Water Flux" , "Kg/m2/S",   &   ! net freshwater 
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "sohefldo", "Net Downward Heat Flux", "W/m2"   ,   &   ! net heat flux
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "soshfldo", "Shortwave Radiation"   , "W/m2"   ,   &   ! solar flux
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "soicecov", "Ice fraction"          , "[0,1]"  ,   &   ! freeze
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "sozotaux", "Zonal Wind Stress"     , "N/m2"   ,   &   ! i-wind stress
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+      CALL histdef( id_i, "sometauy", "Meridional Wind Stress", "N/m2"   ,   &   ! j-wind stress
+         &          jpi, jpj, nh_i, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+
+      CALL histend( id_i )
+
+      ! 2. Start writing data
+      ! ---------------------
+      ! idex(1) est utilise ssi l'avant dernier argument est diffferent de 
+      ! la taille du tableau en sortie. Dans ce cas , l'avant dernier argument
+      ! donne le nombre d'elements, et idex la liste des indices a sortir
+      idex(1) = 1   ! init to avoid compil warning
+      
+      ! Write all fields on T grid
+      CALL histwrite( id_i, "votemper", 1, tn    , jpi*jpj*jpk, idex )    ! now temperature
+      CALL histwrite( id_i, "vosaline", 1, sn    , jpi*jpj*jpk, idex )    ! now salinity
+      CALL histwrite( id_i, "vozocrtx", 1, un    , jpi*jpj*jpk, idex )    ! now i-velocity
+      CALL histwrite( id_i, "vomecrty", 1, vn    , jpi*jpj*jpk, idex )    ! now j-velocity
+      CALL histwrite( id_i, "vovecrtz", 1, wn    , jpi*jpj*jpk, idex )    ! now k-velocity
+      CALL histwrite( id_i, "sowaflup", 1, emp   , jpi*jpj    , idex )    ! freshwater budget
+      CALL histwrite( id_i, "sohefldo", 1, qt    , jpi*jpj    , idex )    ! total heat flux
+      CALL histwrite( id_i, "soshfldo", 1, qsr   , jpi*jpj    , idex )    ! total heat flux
+      CALL histwrite( id_i, "soicecov", 1, freeze, jpi*jpj    , idex )    ! ice cover
+      CALL histwrite( id_i, "sozotaux", 1, taux  , jpi*jpj    , idex )    ! i-wind stress
+      CALL histwrite( id_i, "sometauy", 1, tauy  , jpi*jpj    , idex )    ! j-wind stress
+
+      ! 3. Close the file
+      ! -----------------
+      CALL histclo( id_i )
+
+   END SUBROUTINE dia_wri_state
+ 
+   SUBROUTINE dia_wri_dimg( cd_name, cd_exper, ptab, klev, cd_type )
+   REAL(wp), DIMENSION(:,:,:) :: ptab
+   INTEGER :: klev
+   CHARACTER(LEN=80) :: cd_name, cd_exper,cd_type
+   print *, ' This print must never occur ', cd_name, cd_exper, ptab, klev, cd_type
+   PRINT *, ' this routine is here just for compilation '
+   
+   END SUBROUTINE dia_wri_dimg
+#endif
+   !!======================================================================
+END MODULE diawri
Index: /branches/nemo/NEMO/OPA_SRC/DIA/diawri_dimg.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DIA/diawri_dimg.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DIA/diawri_dimg.h90	(revision 4)
@@ -0,0 +1,502 @@
+  !!----------------------------------------------------------------------
+  !!              ***  diawri_dimg.h90  ***
+  !!----------------------------------------------------------------------
+  !!   OPA 9.0 , LODYC-IPSL  (2003)
+  !!----------------------------------------------------------------------
+
+  SUBROUTINE dia_wri (kt, kindic)
+    !!----------------------------------------------------------------------
+    !!           *** routine dia_wri ***
+    !!
+    !! ** Purpose : output dynamics and tracer fields on direct access file
+    !!              suitable for MPP computing
+    !!
+    !! ** define key : 'key_dimgout'
+    !!
+    !! **  Method : Default is to cumulate the values over the interval between
+    !!      2 output, and each nwrite time-steps  the mean value is  computed 
+    !!      and written to the direct access file.
+    !!     If 'key_diainstant' is defined, no mean values are computed and the 
+    !!     instantaneous fields are dump.
+    !!     kindic is 0 or >0 in normal condition. When < 0 it indicates an error
+    !!     condition and instantaneous file output is forced.
+    !!       Each processor creates its own file with its local data
+    !!     Merging all the files is performed off line by a dedicated program
+    !!
+    !! ** Arguments :
+    !!     kt      : time-step number
+    !!     kindinc :  error condition indicator : >=0 :  OK, < 0 : error.
+    !!
+    !! ** Naming convention for files
+    !!
+    !! {cexper}_{var}_y----m--d--.dimg
+    !!   cexper is the name of the experience, given in the namelist
+    !!   var can be either U, V, T, S, KZ, SSH, ...
+    !!   var can also be 2D, which means that each level of the file is a 2D field as described below
+    !!    y----m--d--  is the date at the time of the dump
+    !!    For mpp output, each processor dumps its own memory, on appropriate record range 
+    !!    (direct access : for level jk of a klev field on proc narea irec = 1+ klev*(narea -1) + jk )
+    !!    To be tested with a lot of procs !!!!
+    !!
+    !!  level 1:  taux(ji,jj) * umask(ji,jj,1) zonal stress in N.m-2
+    !!  level 2:  tauy(ji,jj) * vmask(ji,jj,1) meridional stress in N. m-2
+    !!  level 3:   q   (ji,jj) + qsr(ji,jj) 	  total heat flux (W/m2)
+    !!  level 4:   emp (ji,jj) 	        	  E-P flux (mm/day)
+    !!  level 5:  tb  (ji,jj,1)-sst            model SST -forcing sst (degree C)
+    !!  level 6:  bsfb(ji,jj)		          streamfunction (m**3/s)
+    !!  level 7:  qsr (ji,jj)		          solar flux (W/m2)
+    !!  level 8:  qrp (ji,jj)                  relax component of T flux.
+    !!  level 9:  erp (ji,jj)                  relax component of S flux
+    !!  level 10: hmld(ji,jj)                   turbocline depth
+    !!  level 11: hmlp(ji,jj)                   mixed layer depth
+    !!  level 12: freeze (ji,jj)               Ice cover (1. or 0.)
+    !!  level 13: sst(ji,jj)                   the observed SST we relax to.
+    !!  level 14: qct(ji,jj)                   equivalent flux due to treshold SST
+    !!  level 15: fbt(ji,jj)                   feedback term .
+    !!  level 16: gps(ji,jj)                   the surface pressure (m).
+    !!  level 17: spgu(ji,jj)                  the surface pressure gradient in X direction.
+    !!  level 18: spgv(ji,jj)                  the surface pressure gradient in Y direction.
+    !! 
+    !! History 
+    !!      original  : 91-03 ()
+    !!      additions : 91-11 (G. Madec)
+    !!      additions : 92-06 (M. Imbard) correction restart file
+    !!      additions : 92-07 (M. Imbard) split into diawri and rstwri
+    !!      additions : 93-03 (M. Imbard) suppress writibm
+    !!      additions : 94-12 (M. Imbard) acces direct files
+    !!      additions : 97-2002 ( Clipper Group ) dimg files
+    !!                  dec 2003 ( J.M. Molines) f90, mpp output for OPA9.0
+    !!----------------------------------------------------------------------
+    !! * modules used
+    USE dtasst, ONLY : sst
+
+    !! * Arguments
+    INTEGER ,INTENT(in) :: kt, kindic
+
+    !! * local declarations
+    INTEGER :: inbsel
+    INTEGER :: ji, jj, jk, jl
+    INTEGER :: iwrite
+    INTEGER :: iyear,imon,iday
+
+#if defined key_diainstant
+    REAL(wp),DIMENSION(jpi,jpj,jpk)  :: fsel
+    LOGICAL, PARAMETER :: l_dia_inst=.true.
+
+    REAL(wp), SAVE, DIMENSION (1,1,1) ::  um , vm   ! dummy arrays for comiplation purpose
+    REAL(wp), SAVE, DIMENSION (1,1,1) ::  tm , sm   ! 
+    REAL(wp), SAVE, DIMENSION (1,1,1) ::  fsel      !
+    REAL(wp) :: zdtj
+#else
+    INTEGER, SAVE :: nmoyct 
+
+    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  um , vm   ! used to compute mean u, v fields
+    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  tm , sm   ! used to compute mean t, s fields
+    REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) ::  fsel      ! used to compute mean 2d fields
+    REAL(wp) :: zdtj
+    LOGICAL, PARAMETER :: l_dia_inst=.false.
+#endif
+    !
+    CHARACTER(LEN=80) :: clname
+    CHARACTER(LEN=80) :: cltext
+    CHARACTER(LEN=80) :: clmode
+    CHARACTER(LEN=4)  :: clver
+    !
+    !  Initialization
+    !  ---------------
+    !
+#ifdef key_diaspr
+    inbsel = 18
+#else
+    inbsel = 15
+#endif
+
+    IF (inbsel >  jpk) THEN
+       IF (lwp) WRITE(numout,*)  &
+            ' STOP inbsel =',inbsel,' is larger than jpk=',jpk
+       STOP
+    END IF
+
+
+    iyear = ndastp/10000
+    imon = (ndastp-iyear*10000)/100
+    iday = ndastp - imon*100 - iyear*10000
+
+    !     
+    !! dimg format V1.0 should start with the 4 char. string '@!01'
+    !!
+    clver='@!01'
+    !
+    IF ( .NOT. l_dia_inst ) THEN
+       !#if ! defined key_diainstant
+       !
+       !! * Mean output section
+       !! ----------------------
+       !
+       IF (kt == nit000 .AND. lwp ) WRITE(numout,*) &
+            'THE OUTPUT FILES CONTAINS THE AVERAGE OF EACH FIELD'
+       !
+       IF ( kt == nit000 .AND. kindic > 0 ) THEN
+          ! reset arrays for average computation
+          nmoyct = 0
+          !
+          um(:,:,:) = 0._wp
+          vm(:,:,:) = 0._wp
+          tm(:,:,:) = 0._wp
+          sm(:,:,:) = 0._wp
+          fsel(:,:,:) = 0._wp
+          !
+       END IF
+
+       !  cumulate values
+       !  ---------------
+
+       nmoyct = nmoyct+1
+       !
+       um(:,:,:)=um(:,:,:) + un (:,:,:)
+       vm(:,:,:)=vm(:,:,:) + vn (:,:,:)
+       tm(:,:,:)=tm(:,:,:) + tn (:,:,:)
+       sm(:,:,:)=sm(:,:,:) + sn (:,:,:)
+       !
+       fsel(:,:,1 ) = fsel(:,:,1 ) + taux(:,:) * umask(:,:,1)
+       fsel(:,:,2 ) = fsel(:,:,2 ) + tauy(:,:) * vmask(:,:,1)
+       fsel(:,:,3 ) = fsel(:,:,3 ) + q   (:,:) + qsr(:,:)
+       fsel(:,:,4 ) = fsel(:,:,4 ) + emp (:,:)
+       fsel(:,:,5 ) = fsel(:,:,5 ) + tb  (:,:,1) - sst(:,:)
+#if defined key_dynspg_fsc
+       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:)    ! SSH
+#else
+       fsel(:,:,6 ) = fsel(:,:,6 ) + bsfn(:,:)    ! BSF
+#endif
+       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:)
+       fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:)
+       fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:)
+       fsel(:,:,10) = fsel(:,:,10) + hmld(:,:)
+       fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
+       fsel(:,:,12) = fsel(:,:,12) + freeze(:,:)
+       fsel(:,:,13) = fsel(:,:,13) + sst(:,:)
+       !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
+       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
+#ifdef key_diaspr   
+       fsel(:,:,16) = fsel(:,:,16) + gps(:,:)/g 
+#endif
+       !
+       ! Output of dynamics and tracer fields and selected fields (numwri)
+       ! -----------------------------------------------------------------
+       !
+       !
+       zdtj=rdt/86400.   ! time step in days
+       WRITE(clmode,'(f5.1,a)' ) nwrite*zdtj,' days average'
+
+       !       iwrite=NINT(adatrj/rwrite)
+       !      IF (abs(adatrj-iwrite*rwrite) < zdtj/2.      &
+
+       IF (  ( MOD (kt,nwrite) ==  0 )          &
+            &   .OR.       kindic <   0            &
+            &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
+          ! it is time to make a dump on file 
+          ! compute average
+          um(:,:,:) = um(:,:,:) / nmoyct
+          vm(:,:,:) = vm(:,:,:) / nmoyct
+          tm(:,:,:) = tm(:,:,:) / nmoyct
+          sm(:,:,:) = sm(:,:,:) / nmoyct
+          !
+          fsel(:,:,:) = fsel(:,:,:) / nmoyct
+          !
+          ! note : the surface pressure is not averaged, but rather 
+          ! computed from the averaged gradients.
+          !
+#ifdef key_diaspr
+          fsel(:,:,16)= gps(:,:)/g
+          fsel(:,:,17)= spgu(:,:)
+          fsel(:,:,18)= spgv(:,:)
+#endif
+       ENDIF
+       !
+    ELSE   ! l_dia_inst true
+       !#  else
+       !
+       !! * Instantaneous output section
+       !! ------------------------------
+       !
+       IF (kt == nit000 .AND. lwp ) WRITE(numout,*) &
+            'THE OUTPUT FILES CONTAINS INSTANTANEOUS VALUES OF EACH FIELD'
+       !
+       zdtj=rdt/86400.   ! time step in days
+       !  iwrite=NINT(adatrj/rwrite)
+       clmode='instantaneous'
+       !     IF (abs(adatrj-iwrite*rwrite) < zdtj/2.  &
+       IF (  ( MOD (kt,nwrite) ==  0 )          &
+            &   .OR.       kindic <   0            &
+            &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
+          !
+          ! transfer wp arrays to sp arrays for dimg files
+          fsel(:,:,:) = 0._wp
+          !
+          fsel(:,:,1 ) = taux(:,:) * umask(:,:,1)
+          fsel(:,:,2 ) = tauy(:,:) * vmask(:,:,1)
+          fsel(:,:,3 ) = q   (:,:) + qsr(:,:)
+          fsel(:,:,4 ) = emp (:,:)
+          fsel(:,:,5 ) = (tb  (:,:,1) -sst(:,:)) *tmask(:,:,1)
+
+#if defined key_dynspg_fsc
+          fsel(:,:,6 ) = sshn(:,:)
+#else
+          fsel(:,:,6 ) = bsfn(:,:)
+#endif
+          fsel(:,:,7 ) = qsr (:,:)
+          fsel(:,:,8 ) = qrp (:,:)
+          fsel(:,:,9 ) = erp (:,:)*tmask(:,:,1)
+          fsel(:,:,10) = hmld(:,:) 
+          fsel(:,:,11) = hmlp(:,:)
+          fsel(:,:,12) = freeze(:,:)
+          fsel(:,:,13) =  sst(:,:)  
+          !         fsel(:,:,14) =  qct(:,:)
+          !         fsel(:,:,15) =  fbt(:,:)
+#ifdef key_diaspr           
+          fsel(:,:,16) =      gps(:,:) /g
+          fsel(:,:,17) =      spgu(:,:)
+          fsel(:,:,18) =      spgv(:,:)
+#endif
+          !
+          !         qct(:,:) = 0._wp
+       ENDIF
+       !#endif
+    ENDIF
+    !
+    ! Opening of the datrj.out file with the absolute time in day of each dump
+    ! this file gives a record of the dump date for post processing ( ASCII file )
+    !
+    IF (  ( MOD (kt,nwrite) ==  0 )          &
+         &   .OR.       kindic <   0            &
+         &   .OR. ( kt == 1 .AND. kindic > 0)  ) THEN
+       OPEN (14,FILE='datrj.out',FORM='FORMATTED', STATUS='UNKNOWN',POSITION='APPEND ')
+
+       IF (lwp) WRITE(14,'(f10.4,1x,i8)') adatrj, ndastp
+       CLOSE(14)
+
+       IF (lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj
+
+       !! * U section
+
+       WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday
+       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode)
+       IF ( kindic < 0 )   cltext=TRIM(cexper)//' U(m/s)  instantaneous (explosion)'
+       !
+       IF ( l_dia_inst) THEN 
+          CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
+
+       ELSE 
+          IF ( kindic ==  -3 ) THEN
+             ! ... in case of explosion on umax, dump instantateous u field instead of mean.
+             CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
+          ELSE
+             CALL dia_wri_dimg(clname, cltext, um, jpk, 'T')
+          END  IF
+       ENDIF
+
+       !! * V section
+
+       WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday
+       cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode)
+       !
+       IF ( l_dia_inst) THEN
+          CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T')
+       ELSE
+          CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T')
+       END IF
+       !
+
+       !! * KZ section
+
+       WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday
+       cltext=TRIM(cexper)//' KZ(m2/s) instantaneous'
+
+       ! no average on kz (convective area may show up too strongly )
+       CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W')
+       !
+
+       !! * T section
+
+       WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday
+       cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode)
+
+       IF (l_dia_inst) THEN
+          CALL dia_wri_dimg(clname, cltext, tn, jpk, 'T')
+       ELSE
+          CALL dia_wri_dimg(clname, cltext, tm, jpk, 'T')
+       END IF
+       !
+
+       !! * S section
+
+       WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday
+       cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode)
+
+       IF (l_dia_inst) THEN
+          CALL dia_wri_dimg(clname, cltext, sn, jpk, 'T')
+       ELSE
+          CALL dia_wri_dimg(clname, cltext, sm, jpk, 'T')
+       END IF
+       !
+
+       !! * 2D section
+
+       WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday
+       cltext='2D fields '//TRIM(clmode)
+
+       IF (l_dia_inst) THEN
+          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
+       ELSE
+          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
+       ENDIF
+
+#ifdef key_mpp
+       CALL mppsync
+#endif
+       !
+
+       !! * Log message in numout 
+
+       IF(lwp)WRITE(numout,*) ' '
+       IF(lwp)WRITE(numout,*) ' **** WRITE in numwri ',kt
+
+       IF(lwp .AND.        l_dia_inst) WRITE(numout,*) '    instantaneous fields'
+       IF(lwp .AND. .NOT. l_dia_inst ) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
+       !
+       !
+       !! * Reset cumulating arrays  and counter to 0 after writing
+       !
+       IF ( .NOT. l_dia_inst ) THEN
+          nmoyct = 0
+          !
+          um(:,:,:) = 0._wp
+          vm(:,:,:) = 0._wp
+          tm(:,:,:) = 0._wp
+          sm(:,:,:) = 0._wp
+          fsel(:,:,:) = 0._wp
+       ENDIF
+    END IF
+    !
+9000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
+
+  END SUBROUTINE dia_wri
+
+  SUBROUTINE dia_wri_state ( cdfile_name)
+    !!-------------------------------------------------------------------
+    !!        ***     ROUTINE dia_wri_state  ***
+    !!
+    !! ** Purpose :
+    !!     Dummy routine for compatibility with IOIPSL output
+    !!
+    !! ** History :
+    !!      9.O  ! 03-06  (J.M. Molines ) dimgout
+    !!--------------------------------------------------------------------
+    !! * Arguments
+    CHARACTER (len=*), INTENT(in) :: &
+         cdfile_name      ! name of the file created 
+
+    IF (lwp) WRITE(numout) 'dia_wri_state'
+    IF (lwp) WRITE(numout) '-------------'
+    IF (lwp) WRITE(numout) '      Dummy call to dia_wri_state '
+
+  END SUBROUTINE dia_wri_state
+
+  SUBROUTINE dia_wri_dimg(cd_name, cd_text, ptab, klev, cd_type )
+    !!-------------------------------------------------------------------------
+    !!        *** ROUTINE dia_wri_dimg ***
+    !!
+    !! ** Purpose : write ptab in the dimg file cd_name, with comment cd_text.
+    !!       ptab has klev x 2D fields
+    !!
+    !! ** Action :
+    !!       Define header variables from the config parameters
+    !!       Open the dimg file on unit inum = 14 ( IEEE I4R4 file )
+    !!       Write header on record 1
+    !!       Write ptab on the following klev records
+    !!
+    !! History :
+    !!   03-12 (J.M. Molines ) : Original. Replace ctlopn, writn2d
+    !!---------------------------------------------------------------------------
+
+    !!---------------------------------------------------------------------------
+    !! * subsitutions
+#  include "domzgr_substitute.h90"
+
+    !! * Arguments
+    INTEGER, INTENT(in)            :: klev         ! number of level in ptab to write
+    REAL(wp),INTENT(in), DIMENSION(:,:,:) :: ptab  ! 3D array to write 
+    CHARACTER(LEN=*),INTENT(in)  :: cd_name,  &    ! dimg file name
+         &                            cd_text        ! comment to write on record #1
+    CHARACTER(LEN=1),INTENT(in) :: cd_type         ! either 'T', 'W' or '2' , depending on the vertical
+    !                                           ! grid for ptab. 2 stands for 2D file
+
+    !! * Local declarations
+    INTEGER :: ji,jj,jk,jn              ! dummy loop indices
+    INTEGER :: irecl4,             &    ! record length in bytes
+         &       inum,             &    ! logical unit (set to 14)
+         &       irec                   ! current record to be written
+    REAL(sp)                    :: zdx,zdy,zspval,zwest,ztimm
+    REAL(sp)                    :: zsouth,zdtj
+    REAL(sp),DIMENSION(jpi,jpj) :: z42d        ! 2d temporary workspace (sp)
+    REAL(sp),DIMENSION(jpk)     :: z4dep       ! vertical level (sp)
+
+
+    CHARACTER(LEN=4) :: clver='@!01'
+
+    !! * Initialisations
+
+    irecl4 = jpi*jpj*sp
+    inum = 14
+
+    zspval=0.0_sp    ! special values on land
+    !  the 'numerical' grid is described. The geographical one is in a grid file
+    zdx=1._sp
+    zdy=1._sp
+    zsouth=njmpp * 1._sp
+    zwest=nimpp * 1._sp
+    !  time in days since the historical begining of the run (nit000 = 0 ) 
+    ztimm=adatrj
+
+    SELECT CASE ( cd_type )
+
+    CASE ( 'T')
+       z4dep(:)=fsdept(1,1,:)
+
+    CASE ( 'W' )
+       z4dep(:)=fsdepw(1,1,:)
+
+    CASE ( '2' )
+       z4dep(1:klev) =(/(jk, jk=1,klev)/)
+
+    CASE DEFAULT
+       IF (lwp) WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg '
+       STOP 'dia_wri_dimg'
+
+    END SELECT
+
+    !! * Open file
+    OPEN (inum, FILE=cd_name, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl4 )
+
+    !! * Write header on record #1
+    IF ( lwp ) WRITE(inum,REC=1 ) clver, cd_text, irecl4, &
+         &     jpi,jpj, klev*jpnij, 1 , 1 ,            &
+         &     zwest, zsouth, zdx, zdy, zspval,  &
+         &     (z4dep(1:klev),jn=1,jpnij),       &
+         &     ztimm,                            &
+         &     narea, jpnij,jpiglo,jpjglo,              &    ! extension to dimg for mpp output
+         &     nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt  !
+
+    !! * Write klev levels
+    DO jk = 1, klev
+       irec =1 + klev * (narea -1) +jk
+       z42d(:,:) = ptab(:,:,jk)
+       WRITE(inum,REC=irec)  z42d(:,:)
+    END DO
+
+    !! * Close the file
+    CLOSE(inum)
+
+    !! Rather simpler than IOIPSL isn't it ? :)
+
+  END SUBROUTINE dia_wri_dimg
Index: /branches/nemo/NEMO/OPA_SRC/DIA/diawri_fdir.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DIA/diawri_fdir.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DIA/diawri_fdir.h90	(revision 4)
@@ -0,0 +1,311 @@
+   !!---------------------------------------------------------------------
+   !!                           diawri_fdir.h90
+   !!                         *******************
+   !!---------------------------------------------------------------------
+   !!   dia_wri : create the standart direct access output files
+   !!---------------------------------------------------------------------
+
+   SUBROUTINE dia_wri ( kt, kindic )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE diawri  ***
+      !!   
+      !! ** Purpose :   Standard output of opa: dynamics and tracer fields
+      !!      in direct access format
+      !!
+      !! ** Method  :   At the first time step (nit000), output of the grid-
+      !!      point position and depth and of the mask at t-point.
+      !!      Each nwrite time step, output of velocity fields (un,vn,wn)
+      !!      tracer fields (tn,sn) and three two dimensional selected fields,
+      !!      usually the thermohaline forcing fields (q, e, qsr).
+      !!      If kindic <0, output of fields before the model interruption.
+      !!      If kindic =0, time step loop
+      !!      If kindic >0, output of fields before the time step loop
+      !!
+      !! History :
+      !!        !  91-03  ()  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard)  correction restart file
+      !!        !  92-07  (M. Imbard)  split into diawri and rstwri
+      !!        !  93-03  (M. Imbard)  suppress writibm
+      !!        !  94-12  (M. Imbard)  access direct format
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT( in ) ::   kindic  ! 
+
+      !! * Save variables 
+      INTEGER, SAVE ::   &
+         nmoyct,      &  ! time-step counter for averaging
+         nstepo          ! output number
+#   if ! defined key_diainstant
+      REAL(wp), SAVE, DIMENSION(jpi,jpj,jpk) ::   &
+         um, vm, wm,  &  ! average value of velocity components
+         tm, sm,      &  ! average value of temperature and salinity
+         am,          &  ! average value of vert.diffusivity coef.
+         fsel            ! average value of 2D fields collected in a 2D one
+#   endif
+
+      !! * Local declarations
+      INTEGER ::   inum = 11     ! temporary logical unit
+      INTEGER ::   inbrec, inbsel
+      INTEGER ::   jk, jc
+      INTEGER ::   ilglo, ibloc, ierror, ic
+      REAL(wp) :: zmoyctr
+#if defined key_diainstant
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zsel           ! temporary array for 2D fields collected in a 3D one
+#endif
+      CHARACTER (len=40) ::   clhstnam
+      CHARACTER (len=21) ::   cldir, clunf, clunk
+      CHARACTER (len=80) ::   classign
+      !!----------------------------------------------------------------------
+      
+      
+      ! 1. Initialization
+      ! -----------------
+      
+      inbrec = 7
+      inbsel = 13
+
+      IF( kt == nit000 .AND. kindic > 0 ) THEN
+
+         ! 0.1 Open specifier
+
+         clunk = 'UNKNOWN'
+         clunf = 'UNFORMATTED'
+         cldir = 'DIRECT'
+
+         ! computation of the record length for direct access file
+         ! this length depend of 512 for the t3d machine
+
+         ibloc = 4096
+         ilglo = ibloc*( (jpiglo*jpjglo*jpbytda-1 )/ibloc+1)
+
+         CALL dia_nam(clhstnam,nwrite,' ')
+         DO jc=1,40
+            IF( clhstnam(jc:jc) == ' ' ) go to 120
+         END DO
+120      CONTINUE
+         ic=jc
+         clhstnam=clhstnam(1:ic-1)//".fd"
+         CALL ctlopn( inum, 'date.file', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
+         WRITE(inum,*) clhstnam
+         CLOSE(inum)
+         WRITE (UNIT = classign,FMT ='(''assign -F null -N ieee f:'',a40)') clhstnam
+         IF(lwp) WRITE(numout,*) classign
+#if defined _CRAY
+         CALL ASSIGN(classign, ierror)
+#endif
+         IF(lwp)WRITE(numout,*) '   ierror assign = ',ierror
+         CALL ctlopn( numwri, clhstnam, clunk, clunf, cldir,   &
+            ilglo, numout, lwp, 1 )
+      ENDIF
+
+#if ! defined key_diainstant
+
+      IF( kt == nit000 .AND. kindic > 0 ) THEN
+
+         ! 1.1.1 Prognostic variables
+         
+         nmoyct = 0
+         nstepo = 0
+         
+         um(:,:,:) = 0.e0
+         vm(:,:,:) = 0.e0
+         wm(:,:,:) = 0.e0
+         tm(:,:,:) = 0.e0
+         sm(:,:,:) = 0.e0
+         am(:,:,:) = 0.e0
+
+         fsel(:,:,:) = 0.e0
+      ENDIF
+
+      ! 1.2 Sum
+      
+      nmoyct = nmoyct+1
+      
+      um(:,:,:) = um (:,:,:) + un(:,:,:)
+      vm(:,:,:) = vm (:,:,:) + vn(:,:,:)
+      wm(:,:,:) = wm (:,:,:) + wn(:,:,:)
+      tm(:,:,:) = tm (:,:,:) + tn(:,:,:)
+      sm(:,:,:) = sm (:,:,:) + sn(:,:,:)
+      am(:,:,:) = am (:,:,:) +avt(:,:,:)
+      
+      fsel(:,:,1 ) = fsel(:,:,1 ) + taux(:,:)
+      fsel(:,:,2 ) = fsel(:,:,2 ) + tauy(:,:)
+      fsel(:,:,3 ) = fsel(:,:,3 ) + qt  (:,:)
+      fsel(:,:,4 ) = fsel(:,:,4 ) + (emp(:,:) - runoff(:,:))*rday
+#if defined key_dtasst
+      fsel(:,:,5 ) = fsel(:,:,5 ) + sst (:,:)
+#else
+      fsel(:,:,5 ) = fsel(:,:,5 ) + tb  (:,:,1)
+#endif
+      fsel(:,:,6 ) = fsel(:,:,6 ) + qsr (:,:)
+#if defined key_dynspg_fsc
+      fsel(:,:,7 ) = fsel(:,:,7 ) + sshn(:,:)
+#else
+      fsel(:,:,7 ) = fsel(:,:,7 ) + bsfn(:,:)
+#endif
+      fsel(:,:,8 ) = fsel(:,:,8 ) + freeze(:,:)
+      fsel(:,:,9 ) = fsel(:,:,9 ) + qrp (:,:)
+      fsel(:,:,10) = fsel(:,:,10) + erp (:,:)*rday
+      fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
+      fsel(:,:,12) = fsel(:,:,12) + emp (:,:)*rday*sb(:,:,1)
+      fsel(:,:,13) = fsel(:,:,13) + erp (:,:)*rday*sb(:,:,1)
+      fsel(:,:,14) = fsel(:,:,14) + hmld(:,:)
+      fsel(:,:,15) = 0.e0
+      fsel(:,:,16) = fsel(:,:,16) + runoff(:,:)
+      ! vertical sum of intantaneous in situ density anomaly
+            fsel(:,:,17) = 0.
+      DO jk =1, jpk
+         fsel(:,:,17) = fsel(:,:,17) + rhd(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk)
+      END DO
+      ! 1.2 Output of the model domain (at nit000)
+      
+      IF( kt == nit000 .AND. kindic > 0 ) THEN
+         IF(lwp) WRITE ( numwri, REC=1 ) jpiglo, jpjglo, jpk
+      ENDIF
+      
+      
+      ! 2. Output of dynamics and tracer fields and selected fields (numwri)
+      ! -----------------------------------------------------------
+      
+      ! 2.1 Average
+      
+      IF( MOD( kt, nwrite ) == 0 .OR. kindic < 0 .OR.    &
+         ( kt == nit000 .AND. kindic > 0) .OR. kt == nitend ) THEN
+
+         IF(kindic /= -3) THEN 
+            zmoyctr = 1. / FLOAT(nmoyct)
+            um  (:,:,:) = um  (:,:,:) * zmoyctr
+            vm  (:,:,:) = vm  (:,:,:) * zmoyctr
+            wm  (:,:,:) = wm  (:,:,:) * zmoyctr
+            tm  (:,:,:) = tm  (:,:,:) * zmoyctr
+            sm  (:,:,:) = sm  (:,:,:) * zmoyctr
+            am  (:,:,:) = am  (:,:,:) * zmoyctr
+            fsel(:,:,:) = fsel(:,:,:) * zmoyctr
+            
+         ELSE 
+            ! kindic=-3 STOP with  e r r o r, instantaneous output
+            nmoyct = 1
+            um(:,:,:) = un (:,:,:)
+            vm(:,:,:) = vn (:,:,:)
+            wm(:,:,:) = wn (:,:,:)
+            tm(:,:,:) = tn (:,:,:)
+            sm(:,:,:) = sn (:,:,:)
+            am(:,:,:) = avt(:,:,:)
+            
+            fsel(:,:,1 ) = taux(:,:)
+            fsel(:,:,2 ) = tauy(:,:)
+            fsel(:,:,3 ) = qt  (:,:)
+            fsel(:,:,4 ) = (emp (:,:)- runoff(:,:))*rday
+#if defined key_dtasst
+            fsel(:,:,5 ) = sst (:,:)
+#else
+            fsel(:,:,5 ) = tb  (:,:,1)
+#endif
+            fsel(:,:,6 ) = qsr (:,:)
+#if defined key_dynspg_fsc
+            fsel(:,:,7 ) = sshn(:,:)
+#else
+            fsel(:,:,7 ) = bsfn(:,:)
+#endif
+            fsel(:,:,8 ) = freeze(:,:)
+            fsel(:,:,9 ) = qrp (:,:)
+            fsel(:,:,10) = erp (:,:)
+            fsel(:,:,11) = hmlp(:,:)
+            fsel(:,:,12) = emp (:,:)*rday*sb(:,:,1)
+            fsel(:,:,13) = erp (:,:)*rday*sb(:,:,1)
+            fsel(:,:,14) = hmld(:,:)
+            fsel(:,:,15) = 0.e0
+            fsel(:,:,16) = runoff(:,:)
+         ENDIF
+
+         ! 2.2 Write
+         
+         IF(lwp) THEN
+            um(3,1,1) = FLOAT( kt )
+            vm(3,1,1) = FLOAT( nmoyct )
+         ENDIF
+         CALL write4( numwri, um  , nstepo*inbrec+2 )
+         CALL write4( numwri, vm  , nstepo*inbrec+3 )
+         CALL write4( numwri, wm  , nstepo*inbrec+4 )
+         CALL write4( numwri, tm  , nstepo*inbrec+5 )
+         CALL write4( numwri, sm  , nstepo*inbrec+6 )
+         CALL write4( numwri, am  , nstepo*inbrec+7 )
+         CALL write4( numwri, fsel, nstepo*inbrec+8 )
+         
+         IF(lwp) WRITE(numout,*) ' '
+         IF(lwp) WRITE(numout,*) ' **** write in numwri ',kt
+         IF(lwp) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
+         
+         ! 2.3 Zero initialisation
+         
+         nmoyct = 0
+         nstepo = nstepo+1
+         
+         um(:,:,:) = 0.e0
+         vm(:,:,:) = 0.e0
+         wm(:,:,:) = 0.e0
+         tm(:,:,:) = 0.e0
+         sm(:,:,:) = 0.e0
+         am(:,:,:) = 0.e0
+         
+         fsel(:,:,:) = 0.e0
+         
+      ENDIF
+      
+#else
+
+      ! Sortie instantanee
+      
+      IF( kt == nit000 .AND. kindic > 0 ) THEN
+         nstepo = 0
+         IF(lwp) WRITE ( numwri, REC=1 ) jpiglo, jpjglo, jpk
+      ENDIF
+      
+      IF( MOD( kt, nwrite ) == 0 .OR. kindic < 0   &
+         .OR. (kt == nit000 .AND. kindic > 0) .OR.  kt == nitend ) THEN
+         fsel(:,:,:) = 0.e0
+         
+         zsel(:,:,1 ) = taux(:,:) * umask(:,:,1)
+         zsel(:,:,2 ) = tauy(:,:) * vmask(:,:,1)
+         zsel(:,:,3 ) = qt  (:,:)
+         zsel(:,:,4 ) = (emp (:,:)-runoff(:,:))*rday
+#if defined key_dtasst
+         zsel(:,:,5 ) = sst (:,:)
+#else
+         zsel(:,:,5 ) = tb  (:,:,1)
+#endif
+         zsel(:,:,6 ) = qsr (:,:)
+#if defined key_dynspg_fsc
+         zsel(:,:,7 ) = sshn(:,:)
+#else
+         zsel(:,:,7 ) = bsfn(:,:)
+#endif
+         zsel(:,:,8 ) = freeze(:,:)
+         zsel(:,:,9 ) = qrp (:,:)
+         zsel(:,:,10) = erp (:,:)
+         zsel(:,:,11) = hmlp(:,:)
+         zsel(:,:,12) = emp (:,:) * sb(:,:,1)
+         zsel(:,:,13) = erp (:,:) * sb(:,:,1)
+         zsel(:,:,14) = hmld(:,:)
+         zsel(:,:,15) = 0.e0
+         zsel(:,:,16) = runoff(:,:)
+         
+         CALL write4( numwri, un  , nstepo*inbrec+2 )
+         CALL write4( numwri, vn  , nstepo*inbrec+3 )
+         CALL write4( numwri, wn  , nstepo*inbrec+4 )
+         CALL write4( numwri, tn  , nstepo*inbrec+5 )
+         CALL write4( numwri, sn  , nstepo*inbrec+6 )
+         CALL write4( numwri, avt , nstepo*inbrec+7 )
+         CALL write4( numwri, zsel, nstepo*inbrec+8 )
+         
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' **** write in numwri ',kt
+         IF(lwp) WRITE(numout,*) '    instantaneous fields'
+         nstepo = nstepo+1
+      ENDIF
+      
+   END SUBROUTINE dia_wri
Index: /branches/nemo/NEMO/OPA_SRC/DIA/ptr.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DIA/ptr.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DIA/ptr.F90	(revision 4)
@@ -0,0 +1,522 @@
+MODULE ptr
+   !!======================================================================
+   !!                       ***  MODULE  ptr  ***
+   !! Ocean physics:  brief description of the purpose of the module
+   !!                 (please no more than 2 lines)
+   !!=====================================================================
+#if   defined key_diaptr
+   !!----------------------------------------------------------------------
+   !!   'key_diaptr'  :                    DIAgnostics: Poleward TRansports
+   !!----------------------------------------------------------------------
+   !!   exa_mpl      : liste of module subroutine (caution, never use the
+   !!   exa_mpl_init : name of the module for a routine)
+   !!   exa_mpl_stp  : Please try to use 3 letter block for routine names
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce           ! ocean dynamics and active tracers
+   USE dom_oce       ! ocean space and time domain
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! *  Routine accessibility
+   PUBLIC dia_ptr    ! call by stp routine
+   PUBLIC prt_vj     ! call by tra_ldf & tra_adv routines
+
+   !! * Share Module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diaptr = .TRUE.    ! poleward transport flag
+   INTEGER, PUBLIC ::      !!! ** ptr namelist (namptr) **
+      nf_ptr = 15           ! frequency of ptr computation
+   REAL(wp), PUBLIC, DIMENSION(jpj) ::   &   ! poleward transport
+      pht_adv, pst_adv,  &  ! heat and salt: advection
+      pht_ove, pst_ove,  &  ! heat and salt: overturning
+      pht_ldf, pst_ldf,  &  ! heat and salt: lateral diffusion
+      pht_eiv, pst_eiv      ! heat and salt: bolus advection
+
+   !! Module variables
+   REAL(wp), DIMENSION(jpj,jpk) ::   &  
+      tn_jk  , sn_jk  ,  &  ! "zonal" mean temperature and salinity
+      v_msf           ,  &  ! "meridional" Stream-Function
+#if defined key_diaeiv
+      v_msf_eiv       ,  &  ! bolus "meridional" Stream-Function
+#endif
+      surf_jk_r             ! inverse of the ocean "zonal" section surface
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   FUNCTION ptr_vj( pva )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_vj  ***
+      !!
+      !! ** Purpose :   "zonal" and vertical sum computation of a "meridional"
+      !!      flux array
+      !!
+      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
+      !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
+      !!
+      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
+      !!
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * arguments
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   &
+         pva                         ! mask flux array at V-point
+
+      !! * local declarations
+      INTEGER  ::   ji, jj, jk        ! dummy loop arguments
+      REAL(wp),DIMENSION(jpj) ::   &
+         p_fval                       ! function value
+      !!--------------------------------------------------------------------
+
+      p_fval(  1  ) = 0.e0
+      p_fval(jpjm1) = 0.e0
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! Vector opt.
+               p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) 
+            END DO
+         END DO
+      END DO
+
+#if defined key_mpp
+      CALL mpp_sum( p_fval, jpj )     !!bug  I presume
+#endif
+
+   END FUNCTION ptr_vj
+
+
+   FUNCTION ptr_vjk( pva )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_vjk  ***
+      !!
+      !! ** Purpose :   "zonal" sum computation of a "meridional" flux array
+      !!
+      !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i).
+      !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
+      !!
+      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
+      !!
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * arguments
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   &
+         pva                         ! mask flux array at V-point
+
+      !! * local declarations
+      INTEGER  ::   ji, jj, jk        ! dummy loop arguments
+      REAL(wp),DIMENSION(jpj,jpk) ::   &
+         p_fval                       ! return function value
+      !!--------------------------------------------------------------------
+ 
+      p_fval(  1  , : ) = 0.e0
+      p_fval(jpjm1, : ) = 0.e0
+      p_fval(  :  ,jpk) = 0.e0
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! Vector opt.
+               p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj)
+            END DO
+         END DO
+      END DO
+
+#if defined key_mpp
+      CALL mpp_sum( p_fval, jpj*jpk )    !!bug  I presume
+#endif
+
+   END FUNCTION ptr_vjk
+
+   FUNCTION ptr_vtjk( pva )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_vtjk  ***
+      !!
+      !! ** Purpose :   "zonal" mean computation of a tracer field
+      !!
+      !! ** Method  : - i-sum of mj(pva) using the interior 2D vmask (vmask_i)
+      !!      multiplied by the inverse of the surface of the "zonal" ocean
+      !!      section
+      !!
+      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
+      !!
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * arguments
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   &
+         pva                         ! mask flux array at V-point
+ 
+      !! * local declarations
+      INTEGER  ::   ji, jj, jk        ! dummy loop arguments
+      REAL(wp),DIMENSION(jpj,jpk) ::   &
+         p_fval                       ! return function value
+      !!-------------------------------------------------------------------- 
+      p_fval(  1  , : ) = 0.e0
+      p_fval(jpjm1, : ) = 0.e0
+      p_fval(  :  ,jpk) = 0.e0
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! Vector opt.
+               p_fval(jj,jk) = p_fval(jj,jk) + ( pva(ji,jj,jk) + pva(ji,jj,jk) )                &
+                  &                          * e1v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk)   &
+                  &                          * tmask_i(ji,jj+1) * tmask_i(ji,jj)
+            END DO
+         END DO
+      END DO
+      p_fval(:,:) = p_val(:,:) * 0.5
+
+#if defined key_mpp
+      CALL mpp_sum( p_fval, jpj*jpk )         !!bug  I presume
+#endif
+
+   END FUNCTION ptr_vtjk
+
+
+   SUBROUTINE dia_ptr( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_ptr  ***
+      !!----------------------------------------------------------------------
+      !! * Argument
+      INTEGER, INTENT(in) ::   kt   ! ocean time step index
+
+      !! * Local variables
+      REAL(wp) ::   &
+         zsverdrup = 1.e-6          ! conversion from m3/s to Sverdrup
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zvfl                       ! mask flux array at V-point
+      !!----------------------------------------------------------------------
+
+      ! "zonal" mean temperature and salinity at V-points
+      tn_jk(:,:) = prt_vtjk( tn(:,:,:) ) * surf_jk_r(:,:)
+      sn_jk(:,:) = prt_vtjk( sn(:,:,:) ) * surf_jk_r(:,:)
+
+      ! "zonal" mean mass flux at V-points
+      v_msf(:,:) = prt_vjk( vn(:,:,:) ) 
+#if defined key_diaeiv
+      ! "zonal" mean bolus mass flux at V-points
+      v_msf_eiv(:,:) = prt_vjk( v_eiv(:,:,:) ) 
+      ! Bolus "Meridional" Stream-Function
+      DO jk = jpkm1, 1
+         v_msf_eiv(:,jk) = v_msf_eiv(:,jk-1) + v_msf_eiv(:,jk)
+      END DO
+      v_msf_eiv(:,:) = v_msf_eiv(:,:) * zsverdrup
+#endif
+
+      ! poleward transport: overturning component
+      pht_ove(:) = SUM( v_msf(:,:) * tn_jk(:,:), 2 )   ! SUM over jk
+
+      ! "Meridional" Stream-Function
+      DO jk = jpkm1, 1
+         v_msf(:,jk) = v_msf(:,jk-1) + v_msf(:,jk)
+      END DO
+      v_msf(:,:) = v_msf(:,:) * zsverdrup
+
+      ! output
+      CALL dia_ptr_wri( kt )
+
+   END SUBROUTINE dia_ptr
+
+
+   SUBROUTINE dia_ptr_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_ptr_init  ***
+      !!                   
+      !! ** Purpose :   initialization of ....
+      !!
+      !! ** Method  :   blah blah blah ...
+      !!
+      !! ** input   :   Namlist namptr
+      !!
+      !! ** Action  :   ...  
+      !!
+      !! history :
+      !!   9.0  !  03-08  (Autor Names)  Original code
+      !!----------------------------------------------------------------------
+      !! * local declarations
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         z_1             ! temporary workspace
+
+      NAMELIST/namptr/ nf_ptr
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist namptr : poleward transport parameters
+      REWIND ( numptr )
+      READ   ( numnam, namptr )
+
+
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '          Namelist namptr : set ptr parameters'
+         WRITE(numout,*) '             frequency of computation       nf_ptr  = ', nf_ptr
+      ENDIF
+
+      ! inverse of the ocean "zonal" v-point section
+      z_1(:,:,:) = 1.e0
+      surf_jk_r(:,:) = prt_vtjk( z1(:,:,:) )
+      WHERE( surf_jk_r(:,:) /= 0.e0 )   surf_jk_r(:,:) = 1.e0 / surf_jk_r(:,:)
+
+   END SUBROUTINE dia_ptr_init
+
+#if defined key_fdir
+   !!---------------------------------------------------------------------
+   !!   'key_fdir'                                      direct access file
+   !!---------------------------------------------------------------------
+
+   SUBROUTINE dia_ptr_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                ***  ROUTINE diaptr  ***
+      !!
+      !! ** Purpose :   output of poleward fluxes 
+      !! 
+      !! ** Method  :   NetCDF file
+      !!
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  Original code  
+      !!---------------------------------------------------------------------- 
+      !! * Arguments
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!---------------------------------------------------------------------- 
+
+      IF( kt == nit000 ) THEN
+
+         ! Reference latitude
+         ! ------------------
+         !                                           ! =======================
+         IF( cp_cfg == "orca" ) THEN                 !   ORCA configurations
+            !                                        ! =======================
+ 
+            iline = 100 / jp_cfg             ! i-line that passes near the North Pole
+            zphi(:) = 0.e0   
+            DO ji = mi0(iline), mi1(iline)
+               zphi(:) = gphiv(ji,:)         ! if iline is in the local domain
+            END DO
+#  if defined key_mpp
+            CALL mpp_sum( zphi, jpj )        ! provide the correct zphi to all local domains
+#  endif
+            !                                        ! =======================
+         ELSE                                        !   OTHER configurations
+            !                                        ! =======================
+            zphi(:) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line
+            !
+         ENDIF
+ 
+         ! open the output file         
+         CALL ctlopn( numptr, 'opaptr.output', 'UNKNOWN', 'UNFORMATTED', 'SEQUENTIAL', 1, numout, lw
+p, 1 )
+
+         ! header of output
+         WRITE( numptr ) cexper, no, zdt, nf_ptr, jpj, jpk, zphi
+
+      ENDIF
+
+      IF( MOD( kt, nf_ptr ) == 0 ) THEN
+            IF(lwp) WRITE( numptr ) kt, tn_jk, sn_jk, v_msf,              &
+# if defined key_diaeiv
+               &                    pht_eiv, pst_eiv, v_msf_eiv,          &
+# endif
+               &                    pht_adv, pht_ldf, pst_adv, pst_ldf
+      ENDIF
+
+      IF( kt === nitend )   CLOSE( numptr )  
+
+   END SUBROUTINE dia_ptr_wri
+
+#else
+   !!---------------------------------------------------------------------
+   !!   Default option :                                       NetCDF file
+   !!---------------------------------------------------------------------
+
+   SUBROUTINE dia_ptr_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                ***  ROUTINE diaptr  ***
+      !!
+      !! ** Purpose :   output of poleward fluxes
+      !!
+      !! ** Method  :   NetCDF file
+      !!
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      USE ioipsl          ! NetCDF IPSL library
+
+      !! * Arguments
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+
+      !! * Save variables   
+      INTEGER, SAVE ::   nhoridz, ndepidzt, ndepidzw   &
+          , ndex(1)
+
+      !! * Local variables
+      CHARACTER (len=15) ::   clexp
+      CHARACTER (len=40) ::   &
+         clhstnam, clop, clmax      ! temporary names
+      REAL(wp) ::   &
+         zsto, zout, zdt,           ! temporary scalars
+         zjulian
+      !!----------------------------------------------------------------------
+      
+      ! Define frequency of output and means
+      zdt = rdt
+      IF( nacc == 1 ) zdt = rdtmin
+#if defined key_diainstant
+         zsto = nf_ptr * zdt
+         clop = "inst(x)"               ! no use of the mask value (require less cpu time)
+         !!! clop="inst(only(x))"       ! put 1.e+20 on land (very expensive!!)
+#else
+         zsto = zdt
+         clop = "ave(x)"                ! no use of the mask value (require less cpu time)
+         !!! clop="ave(only(x))"        ! put 1.e+20 on land (very expensive!!)
+#endif
+      zout = nf_ptr * zdt
+      zmax = ( nitend - nit000 + 1 ) * zdt
+      
+         
+      ! define time axis
+      it = kt - nit000 + 1
+
+      ! Initialization
+      ! --------------
+      IF( kt == nit000 ) THEN
+      
+      zdt = rdt
+      IF( nacc == 1 ) zdt = rdtmin
+
+         ! Reference latitude
+         ! ------------------
+         !                                           ! =======================
+         IF( cp_cfg == "orca" ) THEN                 !   ORCA configurations
+            !                                        ! =======================
+
+            iline = 100 / jp_cfg             ! i-line that passes near the North Pole
+            zphi(:) = 0.e0                   
+            DO ji = mi0(iline), mi1(iline) 
+               zphi(:) = gphiv(ji,:)         ! if iline is in the local domain
+            END DO
+#  if defined key_mpp
+            CALL mpp_sum( zphi, jpj )        ! provide the correct zphi to all local domains
+#  endif
+            !                                        ! =======================
+         ELSE                                        !   OTHER configurations
+            !                                        ! =======================
+            zphi(:) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line
+            !
+         ENDIF
+
+         ! OPEN netcdf file 
+         ! ----------------
+         ! Define frequency of output and means
+         zsto = nf_ptr * zdt
+         clop = "ave(x)"
+         zout = nf_ptr * zdt
+         zfoo = 0.e0
+
+         ! Compute julian date from starting date of the run
+
+         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian )
+
+         CALL dia_nam( clhstnam, nf_ptr, 'diaptr' )
+         IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file ",clhstnam
+
+         ! Horizontal grid : zphi()
+         CALL histbeg(clhstnam, 1, zfoo, jpj, zphi,   &
+            1, 1, 1, jpj, 0, zjulian, zdt, nhoridz, numptr )
+         ! Vertical grids : gdept, gdepw
+         CALL histvert( numptr, "deptht", "Vertical T levels",   &
+            "m", jpk, gdept, ndepidzt )
+         CALL histvert( numptr, "depthw", "Vertical W levels",   &
+            "m", jpk, gdepw, ndepidzw )
+         
+         !  Zonal mean T and S
+         
+         CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" ,   &
+            1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
+         CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU"  ,   &
+            1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
+
+         !  Meridional Stream-Function (eulerian and bolus)
+         
+         CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: global","Sv" ,   &
+            1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
+
+         !  Heat transport 
+
+         CALL histdef( numptr, "sophtadv", "Advective Heat Transport"      ,   &
+            "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+         CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport"      ,   &
+            "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+         CALL histdef( numptr, "sophtove", "Overturning Heat Transport"    ,   &
+            "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+
+         !  Salt transport 
+
+         CALL histdef( numptr, "sopstadv", "Advective Salt Transport"      ,   &
+            "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+         CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport"      ,   &
+            "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+         CALL histdef( numptr, "sopstove", "Overturning Salt Transport"    ,   &
+            "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+
+#if defined key_diaeiv
+         ! Eddy induced velocity
+         CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: global",   &
+            "Sv"      , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
+         CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport",   &
+            "PW"      , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+         CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport",   &
+            "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+#endif
+
+         CALL histend( numptr )
+
+      ENDIF
+
+      IF( MOD( kt, nf_ptr ) == 0 ) THEN
+
+         ! define time axis
+         it= kt - nit000 + 1
+         CALL histwrite( numptr, "zotemglo", it, tn_jk    , jpj*jpk, ndex )
+         CALL histwrite( numptr, "zosalglo", it, sn_jk    , jpj*jpk, ndex )
+         CALL histwrite( numptr, "zomsfglo", it, v_msf    , jpj*jpk, ndex )
+         CALL histwrite( numptr, "sophtadv", it, pht_adv  , jpj    , ndex )
+         CALL histwrite( numptr, "sophtldf", it, pht_ldf  , jpj    , ndex )
+         CALL histwrite( numptr, "sophtove", it, pht_ove  , jpj    , ndex )
+         CALL histwrite( numptr, "sopstadv", it, pst_adv  , jpj    , ndex )
+         CALL histwrite( numptr, "sopstldf", it, pst_ldf  , jpj    , ndex )
+         CALL histwrite( numptr, "sopstove", it, pst_ove  , jpj    , ndex )
+#if defined key_diaeiv
+         CALL histwrite( numptr, "zomsfeiv", it, v_msf_eiv, jpj*jpk, ndex )
+         CALL histwrite( numptr, "sophteiv", it, pht_eiv  , jpj    , ndex )
+         CALL histwrite( numptr, "sopsteiv", it, pst_eiv  , jpj    , ndex )
+#endif
+ 
+      ENDIF
+
+      ! Close the file
+      IF( kt === nitend )   CALL histclo( numptr )           ! Netcdf write
+
+   END SUBROUTINE dia_ptr_wri
+
+#endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty Module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diaptr = .FALSE.    ! poleward transport flag
+CONTAINS
+   SUBROUTINE dia_ptr( kt )        ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE dia_ptr
+#endif
+
+   !!======================================================================
+END MODULE ptr
Index: /branches/nemo/NEMO/OPA_SRC/DOM/closea.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/closea.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/closea.F90	(revision 4)
@@ -0,0 +1,316 @@
+MODULE closea
+   !!======================================================================
+   !!                       ***  MODULE  closea  ***
+   !! Closed Seas  : 
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_clo    : modification of the ocean domain for closed seas cases
+   !!   flx_clo    : Special handling of closed seas
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE ocesbc          ! ocean surface boundary conditions (fluxes)
+   USE flxrnf          ! runoffs
+   USE lib_mpp         ! distributed memory computing library
+   USE lbclnk          ! ???
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC dom_clo      ! routine called by dom_init
+   PUBLIC flx_clo      ! routine called by step
+
+   !! * Share module variables
+   INTEGER, PUBLIC, PARAMETER ::   &
+      jpncs   = 4               ! number of closed sea
+   INTEGER, PUBLIC ::          & !!! namclo : closed seas and lakes
+      nclosea =  0                ! = 0 no closed sea or lake
+      !                           ! = 1 closed sea or lake in the domain
+   INTEGER, PUBLIC, DIMENSION (jpncs) ::   &
+      ncstt,           &  ! Type of closed sea
+      ncsi1, ncsj1,    &  ! closed sea limits                                                                 
+      ncsi2, ncsj2,    &  !
+      ncsnr               ! number of point where run-off pours
+   INTEGER, PUBLIC, DIMENSION (jpncs,4) ::   &
+      ncsir, ncsjr        ! Location of run-off
+
+   !! * Module variable
+   REAL(wp), DIMENSION (jpncs+1) ::   &
+      surf               ! closed sea surface
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dom_clo
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_clo  ***
+      !!        
+      !! ** Purpose :   Closed sea domain initialization
+      !!
+      !! ** Method  :   if a closed sea is located only in a model grid point
+      !!      just the thermodynamic processes are applied.
+      !!
+      !! ** Action :   ncsi1(), ncsj1() : south-west closed sea limits (i,j)
+      !!               ncsi2(), ncsj2() : north-east Closed sea limits (i,j)
+      !!               ncsir(), ncsjr() : Location of runoff
+      !!               ncsnr            : number of point where run-off pours
+      !!               ncstt            : Type of closed sea
+      !!                                  =0 spread over the world ocean
+      !!                                  =2 put at location runoff
+      !!
+      !! History :
+      !!        !  01-04  (E. Durand)  Original code
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local variables
+      INTEGER ::   jc            ! dummy loop indices
+      !!----------------------------------------------------------------------
+      
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' dom_clo : closed seas '
+      IF(lwp) WRITE(numout,*)' ~~~~~~~'
+
+      ! initial values
+      ncsnr(:) = 1  ;  ncsi1(:) = 1  ;  ncsi2(:) = 1  ;  ncsir(:,:) = 1
+      ncstt(:) = 0  ;  ncsj1(:) = 1  ;  ncsj2(:) = 1  ;  ncsjr(:,:) = 1
+
+      ! set the closed seas (in data domain indices)
+      ! -------------------
+
+      IF( cp_cfg == "orca" ) THEN
+   
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration
+            !                                        ! =======================
+
+            !                                            ! Caspian Sea
+            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe
+            ncsi1(1)   =  11  ;  ncsj1(1)   = 103
+            ncsi2(1)   =  17  ;  ncsj2(1)   = 112
+            ncsir(1,1) =   1  ;  ncsjr(1,1) =   1 
+            !                                            ! Great North American Lakes
+            ncsnr(2)   =   1  ;  ncstt(2)   =   2           ! put at St Laurent mouth
+            ncsi1(2)   =  97  ;  ncsj1(2)   = 107
+            ncsi2(2)   = 103  ;  ncsj2(2)   = 111
+            ncsir(2,1) = 110  ;  ncsjr(2,1) = 111
+            !                                            ! Black Sea 1 : west part of the Black Sea 
+            ncsnr(3)   = 1    ; ncstt(3)   =   2            !            (ie west of the cyclic b.c.)
+            ncsi1(3)   = 174  ; ncsj1(3)   = 107            ! put in Med Sea
+            ncsi2(3)   = 181  ; ncsj2(3)   = 112
+            ncsir(3,1) = 171  ; ncsjr(3,1) = 106 
+            !                                            ! Black Sea 2 : est part of the Black Sea 
+            ncsnr(4)   =   1  ;  ncstt(4)   =   2           !               (ie est of the cyclic b.c.)
+            ncsi1(4)   =   2  ;  ncsj1(4)   = 107           ! put in Med Sea
+            ncsi2(4)   =   6  ;  ncsj2(4)   = 112
+            ncsir(4,1) = 171  ;  ncsjr(4,1) = 106 
+
+            !                                        ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration
+            !                                        ! =======================
+
+            !                                            ! Caspian Sea
+            ncsnr(1)   =  1  ;  ncstt(1)   =  0  
+            ncsi1(1)   =  4  ;  ncsj1(1)   = 53 
+            ncsi2(1)   =  4  ;  ncsj2(1)   = 56
+            ncsir(1,1) =  1  ;  ncsjr(1,1) =  1
+            !                                            ! Great North American Lakes
+            ncsnr(2)   =  1  ;  ncstt(2)   =  2 
+            ncsi1(2)   = 49  ;  ncsj1(2)   = 55
+            ncsi2(2)   = 51  ;  ncsj2(2)   = 56
+            ncsir(2,1) = 57  ;  ncsjr(2,1) = 55
+            !                                            ! Black Sea
+            ncsnr(3)   =  4  ;  ncstt(3)   =  2  
+            ncsi1(3)   = 88  ;  ncsj1(3)   = 55 
+            ncsi2(3)   = 91  ;  ncsj2(3)   = 56
+            ncsir(3,1) = 86  ;  ncsjr(3,1) = 53
+            ncsir(3,2) = 87  ;  ncsjr(3,2) = 53 
+            ncsir(3,3) = 86  ;  ncsjr(3,3) = 52 
+            ncsir(3,4) = 87  ;  ncsjr(3,4) = 52
+            !                                            ! Baltic Sea
+            ncsnr(4)   =  1  ;  ncstt(4)   =  2
+            ncsi1(4)   = 75  ;  ncsj1(4)   = 59
+            ncsi2(4)   = 76  ;  ncsj2(4)   = 61
+            ncsir(4,1) = 84  ;  ncsjr(4,1) = 59 
+
+         END SELECT
+
+      ENDIF
+
+      ! convert the position in local domain indices
+      ! --------------------------------------------
+      DO jc = 1, jpncs
+         ncsi1(jc)   = mi0( ncsi1(jc) )
+         ncsj1(jc)   = mj0( ncsj1(jc) )
+
+         ncsi2(jc)   = mi1( ncsi1(jc) )
+         ncsj2(jc)   = mj1( ncsj1(jc) )
+      END DO
+         
+
+   END SUBROUTINE dom_clo
+
+
+   SUBROUTINE flx_clo( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE flx_clo  ***
+      !!                    
+      !! ** Purpose :   Special handling of closed seas
+      !!
+      !! ** Method  :   Water flux is forced to zero over closed sea
+      !!      Excess is shared between remaining ocean, or
+      !!      put as run-off in open ocean.
+      !!
+      !! ** Action :
+      !!
+      !! History :
+      !!   8.2  !  00-05  (O. Marti)  Original code
+      !!   8.5  !  02-07  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT (in) :: kt
+
+      !! * Local declarations
+      REAL(wp), DIMENSION (jpncs) :: zemp
+      INTEGER  :: ji, jj, jc, jn
+      REAL(wp) :: zze2
+      !!----------------------------------------------------------------------
+
+      ! 1 - Initialisation
+      ! ------------------
+
+      IF( kt == nit000 ) THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*)' flx_clo : closed seas '
+         IF(lwp) WRITE(numout,*)' ~~~~~~~'
+
+         ! Total surface of ocean
+         surf(jpncs+1) = SUM( e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
+
+         DO jc = 1, jpncs
+            surf(jc) =0.e0
+            DO jj = ncsj1(jc), ncsj2(jc)
+               DO ji = ncsi1(jc), ncsi2(jc)
+                  ! surface of closed seas
+                  surf(jc) = surf(jc) + e1t(ji,jj)*e2t(ji,jj)*tmask_i(ji,jj)
+                  ! upstream in closed seas
+                  upsadv(ji,jj) = 0.5
+               END DO 
+            END DO 
+            ! upstream at closed sea outflow
+            IF( ncstt(jc) >= 1 ) THEN 
+                DO jn = 1, 4
+                  ji = mi0( ncsir(jc,jn) )
+                  jj = mj0( ncsjr(jc,jn) )
+                  upsrnfh(ji,jj) = MAX( upsrnfh(ji,jj), 1.0 )
+                END DO 
+            ENDIF 
+         END DO 
+
+#   if defined key_mpp
+         ! Mpp: sum over all the global domain
+         CALL mpp_sum ( surf, jpncs+1 )
+#   endif
+
+         IF(lwp) WRITE(numout,*)'     Closed sea surfaces'
+         DO jc = 1, jpncs
+            IF(lwp) WRITE(numout,FMT='(1I3,4I4,5X,F16.2)')    &
+                jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc)
+         END DO
+
+         ! jpncs+1 : surface of sea, closed seas excluded
+         DO jc = 1, jpncs
+            surf(jpncs+1) = surf(jpncs+1) - surf(jc)
+         END DO           
+ 
+      ENDIF
+
+      ! 2 - Computation
+      ! ---------------
+      zemp = 0.0e0
+
+      DO jc = 1, jpncs
+         DO jj = ncsj1(jc), ncsj2(jc)
+            DO ji = ncsi1(jc), ncsi2(jc)
+               zemp(jc) = zemp(jc) + e1t(ji,jj) * e2t(ji,jj) * emp(ji,jj) * tmask_i(ji,jj)
+            END DO  
+         END DO 
+      END DO
+#   if defined key_mpp
+      ! Mpp: sum over all the global domain
+      CALL mpp_sum ( zemp , jpncs )
+#   endif
+
+      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      ! Black Sea case for ORCA_R2 configuration
+         zze2    = ( zemp(3) + zemp(4) ) / 2.
+         zemp(3) = zze2
+         zemp(4) = zze2
+      ENDIF
+
+      DO jc = 1, jpncs
+
+         IF( ncstt(jc) == 0 ) THEN 
+            ! water/evap excess is shared by all open ocean
+            emp (:,:) = emp (:,:) + zemp(jc) / surf(jpncs+1)
+            emps(:,:) = emps(:,:) + zemp(jc) / surf(jpncs+1)
+         ELSEIF( ncstt(jc) == 1 ) THEN 
+            ! Excess water in open sea, at outflow location, excess evap shared
+            IF ( zemp(jc) <= 0.0e0 ) THEN 
+                DO jn = 1, ncsnr(jc)
+                  ji = mi0(ncsir(jc,jn))
+                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
+                  IF (      ji > 1 .AND. ji < jpi   &
+                      .AND. jj > 1 .AND. jj < jpj ) THEN 
+                      emp (ji,jj) = emp (ji,jj) + zemp(jc) /   &
+                         (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
+                      emps(ji,jj) = emps(ji,jj) + zemp(jc) /   &
+                          (FLOAT(ncsnr(jc)) * e1t(ji,jj) * e2t(ji,jj))
+                  END IF 
+                END DO 
+            ELSE 
+                emp (:,:) = emp (:,:) + zemp(jc) / surf(jpncs+1)
+                emps(:,:) = emps(:,:) + zemp(jc) / surf(jpncs+1)
+            ENDIF
+         ELSEIF( ncstt(jc) == 2 ) THEN 
+            ! Excess e-p+r (either sign) goes to open ocean, at outflow location
+            IF(      ji > 1 .AND. ji < jpi    &
+               .AND. jj > 1 .AND. jj < jpj ) THEN 
+                DO jn = 1, ncsnr(jc)
+                  ji = mi0(ncsir(jc,jn))
+                  jj = mj0(ncsjr(jc,jn)) ! Location of outflow in open ocean
+                  emp (ji,jj) = emp (ji,jj) + zemp(jc)   &
+                      / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) )
+                  emps(ji,jj) = emps(ji,jj) + zemp(jc)   &
+                      / (FLOAT(ncsnr(jc)) *  e1t(ji,jj) * e2t(ji,jj) )
+                END DO 
+            ENDIF 
+         ENDIF 
+
+         DO jj = ncsj1(jc), ncsj2(jc)
+            DO ji = ncsi1(jc), ncsi2(jc)
+               emp (ji,jj) = emp (ji,jj) - zemp(jc) / surf(jc)
+               emps(ji,jj) = emps(ji,jj) - zemp(jc) / surf(jc)
+            END DO  
+         END DO 
+
+      END DO 
+
+
+      ! 5. Boundary condition on emp and emps
+      ! -------------------------------------
+      CALL lbc_lnk( emp , 'T', 1. )
+      CALL lbc_lnk( emps, 'T', 1. )
+
+   END SUBROUTINE flx_clo
+
+   !!======================================================================
+END MODULE closea
Index: /branches/nemo/NEMO/OPA_SRC/DOM/dom_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 4)
@@ -0,0 +1,195 @@
+MODULE dom_oce
+   !!----------------------------------------------------------------------
+   !!                       ***  MODULE dom_oce  ***
+   !!       
+   !! ** Purpose :   Define in memory all the ocean space domain variables
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce      ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !! space domain parameters
+   !! -----------------------
+   LOGICAL ::   &
+      lclosea    =  .FALSE. ,   &  ! closed sea flag
+      lzoom      =  .FALSE. ,   &  ! zoom flag
+      lzoom_e    =  .FALSE. ,   &  ! East  zoom type flag
+      lzoom_w    =  .FALSE. ,   &  ! West  zoom type flag
+      lzoom_s    =  .FALSE. ,   &  ! South zoom type flag
+      lzoom_n    =  .FALSE. ,   &  ! North zoom type flag
+      lzoom_arct =  .FALSE. ,   &  ! ORCA    arctic zoom flag
+      lzoom_anta =  .FALSE.        ! ORCA antarctic zoom flag
+
+   INTEGER ::          & !!! namdom : space domain (bathymetry, mesh)
+      ntopo   =  0 ,   &  ! = 0/1 ,compute/read the bathymetry file
+      ngrid   =  0 ,   &  ! = 0/1, compute/read the horizontal mesh file
+      nmsh    =  0        ! = 1 create a mesh-mask file
+
+   INTEGER ::         &
+      ! domain parameters linked to mpp
+      nperio,          &  ! type of lateral boundary condition
+      nimpp, njmpp,    &  ! i- & j-indexes for mpp-subdomain left bottom
+      nreci, nrecj,    &  ! overlap region in i and j
+      nproc,           &  ! number for local processor
+      narea,           &  ! number for local area
+      nbondi, nbondj,  &  ! mark of i- and j-direction local boundaries
+      npolj,           &  ! north fold mark (0, 3 or 4)
+      nlci, nlcj,      &  ! i- & j-dimensions of the local subdomain
+      nldi, nlei,      &  ! first and last indoor i- and j-indexes
+      nldj, nlej,      &  !
+      noea, nowe,      &  ! index of the local neighboring processors in
+      noso, nono,      &  ! east, west, south and north directions
+      npne, npnw,      &  ! index of north east and north west processor
+      npse, npsw,      &  ! index of south east and south west processor
+      nbne, nbnw,      &  ! logical of north east & north west processor
+      nbse, nbsw          ! logical of south east & south west processor
+
+   INTEGER, DIMENSION(jpi) ::   &
+      mig                 ! local  ==> global  domain i-indice
+   INTEGER, DIMENSION(jpj) ::   &
+      mjg                 ! local  ==> global  domain j-indice
+   INTEGER, DIMENSION( jpiglo ) ::   &  !!bug ==> other solution?
+      mi0, mi1            ! global ==> local domain i-indice
+      !                   ! (mi0=1 and mi1=0 if the global indice is not in the local domain)
+   INTEGER, DIMENSION( jpjglo ) ::   &
+      mj0, mj1            ! global ==> local domain j-indice
+      !                   ! (mi0=1 and mi1=0 if the global indice is not in the local domain)
+
+   INTEGER, DIMENSION(jpnij) ::   &
+      nimppt, njmppt,  &  ! i-, j-indexes for each processor
+      nlcit, nlcjt,    &  ! dimensions of every subdomain
+      nldit, nldjt,    &  ! first, last indoor index for each i-domain
+      nleit, nlejt        ! first, last indoor index for each j-domain
+
+   !!----------------------------------------------------------------------
+   !! horizontal curvilinear coordinate and scale factors
+   !! ---------------------------------------------------------------------
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      glamt, glamu,    &  ! longitude of t-, u-, v- and f-points (degre)
+      glamv, glamf,    &  !
+      gphit, gphiu,    &  ! latitude  of t-, u-, v- and f-points (degre)
+      gphiv, gphif,    &  !
+      e1t, e2t,        &  ! horizontal scale factors at t-point (m)
+      e1u, e2u,        &  ! horizontal scale factors at u-point (m)
+      e1v, e2v,        &  ! horizontal scale factors at v-point (m)
+      e1f, e2f,        &  ! horizontal scale factors at f-point (m)
+      ff                  ! coriolis factor (2.*omega*sin(yphi) ) (s-1)
+
+   !!----------------------------------------------------------------------
+   !! vertical coordinate and scale factors
+   !! --------------------------------------
+
+   REAL(wp) ::         & !!! * namelist namdom *
+      e3zps_min = 5.0, &  ! miminum thickness for partial steps (meters)
+      e3zps_rat = 0.1  ! minimum thickness ration for partial steps
+
+   !! z-coordinate (default option) (also used in the other cases
+   !! -----------------------------  as reference z-coordinate)
+   REAL(wp), DIMENSION(jpk) ::   &
+      gdept, gdepw,    &  ! reference depth of t- and w-points (m)
+      e3t, e3w            ! reference vertical scale factors at T- and W-pts (m)
+
+#if defined key_partial_steps
+   !! Partial steps ('key_partial_steps')
+   !! -----------------------------------
+   LOGICAL, PARAMETER ::   lk_zps = .TRUE.   ! partial steps flag
+   LOGICAL, PARAMETER ::   lk_sco = .FALSE.  ! s-coordinate flag
+   LOGICAL, PARAMETER ::   lk_zco = .FALSE.  ! z-coordinate flag
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+      gdep3w,                 &  !
+      gdept_ps, gdepw_ps,     &  ! depth of t- and w-points (m)
+      e3t_ps, e3u_ps, e3v_ps, &  ! vertical scale factors at t-, u-, w-,
+      e3w_ps, e3f_ps,         &  ! w-, f-, uw- and vw- points (m)
+      e3uw_ps, e3vw_ps
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      hdept, hdepw, e3tp, e3wp
+
+#elif defined key_s_coord
+   !! s-coordinate ('key_s_coord')
+   !! ----------------------------
+   LOGICAL, PARAMETER ::   lk_zps = .FALSE.   ! partial steps flag
+   LOGICAL, PARAMETER ::   lk_sco = .TRUE.    ! s-coordinate flag
+   LOGICAL, PARAMETER ::   lk_zco = .FALSE.   ! z-coordinate flag
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      hbatt, hbatu,    &  ! ocean depth at the vertical of  t-, u-, v-
+      hbatv, hbatf        ! and f-point (m)
+
+   REAL(wp), DIMENSION(jpk) ::   &
+      gsigt, gsigw ,   &  ! model level depth coefficient at t-, w-levels
+      gsi3w,           &  ! model level depth coefficient at w-level
+                          !  defined as the sum of e3w scale factors
+      esigt, esigw        ! vertical scale factor coef. at t-, w-levels
+
+#else
+   !! z-coordinate (Default option)
+   !! -----------------------------
+   LOGICAL, PARAMETER ::   lk_zps = .FALSE.   ! partial steps flag
+   LOGICAL, PARAMETER ::   lk_sco = .FALSE.   ! s-coordinate flag
+   LOGICAL, PARAMETER ::   lk_zco = .TRUE.    ! s-coordinate flag
+#endif
+   !!----------------------------------------------------------------------
+   !! masks, bathymetry
+   !! -----------------
+
+   INTEGER , DIMENSION(jpi,jpj) ::   &
+      mbathy     ! number of ocean level (=0, 1, ... , jpk-1)
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      bathy  ,         &  ! ocean depth (meters)
+      tmask_i             ! interior domain T-point mask
+
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+      tmask, umask,    &  ! land/ocean mask at T-, U-, V- and F-points
+      vmask, fmask        !
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      bmask               ! land/ocean mask of barotropic stream function
+
+   REAL(wp), DIMENSION(jpiglo) ::   &
+      tpol, fpol          ! north fold mask (nperio= 3 or 4)
+
+#if defined key_noslip_accurate
+   INTEGER, DIMENSION(4,jpk) ::   &
+      npcoa               ! ???
+   INTEGER, DIMENSION(2*(jpi+jpj),4,jpk) ::   &
+      nicoa,           &  ! ???
+      njcoa               ! ???
+
+#endif
+
+   !!----------------------------------------------------------------------
+   !! time domain
+   !!----------------------------------------------------------------------
+   INTEGER ::    &
+      nacc   = 0 ,   &  ! = 0/1 use of the acceleration of convergence technique
+      neuler            ! restart euler forward option (0=Euler)
+
+
+   REAL(wp) ::   &
+      rdt    = 3600._wp ,    &  ! time step for the dynamics (and tracer if nacc=0)
+      rdtmin = 3600._wp ,    &  ! minimum time step on tracers
+      rdtmax = 3600._wp ,    &  ! maximum time step on tracers
+      rdth   =  800._wp ,    &  ! depth variation of tracer step
+      atfp   = 0.1_wp   ,    &  ! asselin time filter parameter
+      atfp1                     ! asselin time filter coeff. (atfp1= 1-2*atfp)
+
+   REAL(wp), DIMENSION(jpk) ::   &
+      rdttra                    ! vertical profile of tracer time step
+
+   !!----------------------------------------------------------------------
+   !! cross land advection
+   !!----------------------------------------------------------------------
+
+   INTEGER ::               & !!! namelist ???
+      n_cla                    ! flag (0/1) for cross land advection to
+      !                        ! parameterize exchanges through straits
+
+   !!----------------------------------------------------------------------
+END MODULE dom_oce
Index: /branches/nemo/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/domain.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/domain.F90	(revision 4)
@@ -0,0 +1,345 @@
+MODULE domain
+   !!==============================================================================
+   !!                       ***  MODULE domain   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_init       : initialize the space and time domain
+   !!   dom_nam        : read and contral domain namelists
+   !!   dom_ctl        : control print for the ocean domain
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! 
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE ice_oce         ! ice variables
+   USE blk_oce         ! bulk variables
+   USE flxrnf          ! runoffs
+   USE daymod          ! calendar
+   USE lib_mpp         ! distributed memory computing library
+
+   USE domhgr          ! domain: set the horizontal mesh
+   USE domzgr          ! domain: set the vertical mesh
+   USE domstp          ! domain: set the time-step
+   USE dommsk          ! domain: set the mask system
+   USE domwri          ! domain: write the meshmask file
+   USE closea          ! closed sea or lake              (dom_clo routine)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dom_init       ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dom_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_init  ***
+      !!                    
+      !! ** Purpose :   Domain initialization. Call the routines that are 
+      !!      required to create the arrays which define the space and time
+      !!      domain of the ocean model.
+      !!
+      !! ** Method  :
+      !!      - dom_msk: compute the masks from the bathymetry file
+      !!      - dom_hgr: compute or read the horizontal grid-point position and
+      !!                scale factors, and the coriolis factor
+      !!      - dom_zgr: define the vertical coordinate system and the bathymetry
+      !!      - dom_stp: defined the model time step
+      !!      - dom_wri: create the meshmask file if nmsh=1
+      !!
+      !! History :
+      !!        !  90-10  (C. Levy - G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  92-01  (M. Imbard) insert time step initialization
+      !!        !  96-06  (G. Madec) generalized vertical coordinate 
+      !!        !  97-02  (G. Madec) creation of domwri.F
+      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   jk                ! dummy loop argument
+      INTEGER ::   iconf = 0         ! temporary integers
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+
+      CALL dom_nam                        ! read namelist ( namrun, namdom, namcla )
+
+      CALL dom_clo                        ! Closed seas and lake
+
+      CALL dom_hgr                        ! Horizontal mesh
+
+      CALL dom_zgr                        ! Vertical mesh and bathymetry
+
+      CALL dom_msk                        ! Masks
+
+
+      ! Local depth or Inverse of the local depth of the water column at u- and v-points
+      ! ------------------------------
+#if defined key_dynspg_fsc
+      ! Ocean depth at U- and V-points
+      hu(:,:) = 0.
+      hv(:,:) = 0.
+
+      DO jk = 1, jpk
+         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
+         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
+      END DO
+#else
+      ! Inverse of the local depth
+      hur(:,:) = fse3u(:,:,1)             ! Lower bound : thickness of the first model level
+      hvr(:,:) = fse3v(:,:,1)
+      
+      DO jk = 2, jpk                      ! Sum of the vertical scale factors
+         hur(:,:) = hur(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
+         hvr(:,:) = hvr(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
+      END DO
+
+      ! Compute and mask the inverse of the local depth
+      hur(:,:) = 1. / hur(:,:) * umask(:,:,1)
+      hvr(:,:) = 1. / hvr(:,:) * vmask(:,:,1)
+#endif
+
+      CALL dom_stp                        ! Time step
+
+      IF( nmsh /= 0 )   CALL dom_wri      ! Create a domain file
+
+      IF( .NOT.ln_rstart )   CALL dom_ctl    ! Domain control
+
+   END SUBROUTINE dom_init
+
+
+   SUBROUTINE dom_nam
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read domaine namelists and print the variables.
+      !!
+      !! ** input   : - namrun namelist
+      !!              - namdom namelist
+      !!              - namcla namelist
+      !!
+      !! History :
+      !!   9.0  !  03-08  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+#if ! defined key_fdir
+      USE ioipsl
+#endif
+      NAMELIST/namrun/ no    , cexper   , ln_rstart , nrstdt , nit000,   &
+         &             nitend, ndate0   , nleapy   , ninist , nstock,   &
+         &             nprint, nwrite   , nrunoff  , ln_ctl
+      NAMELIST/namdom/ ntopo , e3zps_min, e3zps_rat, ngrid  , nmsh  ,   &
+         &             nacc  , atfp     , rdt      , rdtmin , rdtmax,   &
+         &             rdth  , nfice    , nfbulk   , nclosea
+      NAMELIST/namcla/ n_cla
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      ! Namelist namrun : parameters of the run
+      REWIND( numnam )
+      READ  ( numnam, namrun )
+
+      IF(lwp) THEN
+         WRITE(numout,*) 'namrun'
+         WRITE(numout,*) ' job number                      no        = ', no
+         WRITE(numout,*) ' experiment name for output      cexper    = ', cexper
+         WRITE(numout,*) ' restart logical                 ln_rstart = ', ln_rstart
+         WRITE(numout,*) ' control of time step            nrstdt    = ', nrstdt
+         WRITE(numout,*) ' number of the first time step   nit000    = ', nit000
+         WRITE(numout,*) ' number of the last time step    nitend    = ', nitend
+         WRITE(numout,*) ' initial calendar date aammjj    ndate0    = ', ndate0
+         WRITE(numout,*) ' leap year calendar (0/1)        nleapy    = ', nleapy
+         WRITE(numout,*) ' initial state output            ninist    = ', ninist
+         WRITE(numout,*) ' level of print                  nprint    = ', nprint
+         WRITE(numout,*) ' frequency of restart file       nstock    = ', nstock
+         WRITE(numout,*) ' frequency of output file        nwrite    = ', nwrite
+         WRITE(numout,*) ' runoff option                   nrunoff   = ', nrunoff
+         WRITE(numout,*) ' run control (for debugging)     ln_ctl    = ', ln_ctl
+      ENDIF
+
+      l_ctl = ln_ctl .AND. lwp             ! trend control print on the 1st processor only
+
+      ndastp = ndate0                     ! Assign initial date to current date
+
+
+! ... Control of output frequency
+      IF ( nstock == 0 ) THEN
+          IF(lwp)WRITE(numout,cform_war)
+          IF(lwp)WRITE(numout,*) '           nstock = ', nstock, ' it is forced to ', nitend
+          nstock = nitend
+          nwarn = nwarn + 1
+      ENDIF
+      IF ( nwrite == 0 ) THEN
+          IF(lwp)WRITE(numout,cform_war)
+          IF(lwp)WRITE(numout,*) '           nwrite = ', nwrite, ' it is forced to ', nitend
+          nwrite = nitend
+          nwarn = nwarn + 1
+      ENDIF
+
+#if ! defined key_fdir
+
+      SELECT CASE ( nleapy )   ! Choose calendar for IOIPSL
+      CASE (  1 ) 
+         CALL ioconf_calendar('gregorian')
+         IF(lwp) WRITE(numout,*)'The IOIPSL calendar is "gregorian", i.e. leap year'
+      CASE (  0 )
+         CALL ioconf_calendar('noleap')
+         IF(lwp) WRITE(numout,*)'The IOIPSL calendar is "noleap", i.e. no leap year'
+      CASE ( 30 )
+         CALL ioconf_calendar('360d')
+         IF(lwp) WRITE(numout,*)'The IOIPSL calendar is "360d", i.e. 360 days in a year'
+      END SELECT
+#endif
+
+      SELECT CASE ( nleapy )   ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ...
+      CASE ( 1 )
+         raajj = 365.25
+         raass = raajj * rjjss
+         rmoss = raass/raamo
+      CASE ( 0 )
+         raajj = 365.
+         raass = raajj * rjjss
+         rmoss = raass/raamo
+      CASE DEFAULT
+         raajj = FLOAT( nleapy ) * raamo
+         raass =        raajj    * rjjss
+         rmoss = FLOAT( nleapy ) * rjjss
+      END SELECT
+      IF(lwp) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' nb of days per year      raajj = ', raajj,' days'
+         WRITE(numout,*) ' nb of seconds per year   raass = ', raass, ' s'
+         WRITE(numout,*) ' nb of seconds per month  rmoss = ', rmoss, ' s'
+      ENDIF
+
+      ! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
+      REWIND( numnam )
+      READ  ( numnam, namdom )
+
+      IF(lwp) THEN
+         WRITE(numout,*) 'namdom'
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' flag read/compute bathymetry   ntopo     = ', ntopo
+         WRITE(numout,*) ' minimum thickness of partial   e3zps_min = ', e3zps_min, ' (m)'
+         WRITE(numout,*) '    step level                  e3zps_rat = ', e3zps_rat
+         WRITE(numout,*) ' flag read/compute coordinates  ngrid     = ', ngrid
+         WRITE(numout,*) ' flag write mesh/mask file(s)   nmsh      = ', nmsh
+         WRITE(numout,*) '      = 0   no file created                 '
+         WRITE(numout,*) '      = 1   mesh_mask                       '
+         WRITE(numout,*) '      = 2   mesh and mask                   '
+         WRITE(numout,*) '      = 3   mesh_hgr, msh_zgr and mask      '
+         WRITE(numout,*) ' acceleration of converge       nacc      = ', nacc
+         WRITE(numout,*) ' asselin time filter parameter  atfp      = ', atfp
+         WRITE(numout,*) ' time step                      rdt       = ', rdt
+         WRITE(numout,*) ' minimum time step on tracers   rdtmin    = ', rdtmin
+         WRITE(numout,*) ' maximum time step on tracers   rdtmax    = ', rdtmax
+         WRITE(numout,*) ' depth variation tracer step    rdth      = ', rdth
+         IF( lk_ice_lim ) THEN
+            WRITE(numout,*) ' ice model coupling frequency   nfice  = ', nfice
+            nfbulk = nfice
+         ENDIF
+         WRITE(numout,*) ' bulk computation frequency     nfbulk = ', nfbulk, ' = nfice if ice model used'
+         WRITE(numout,*) ' flag closed sea or not         nclosea= ', nclosea
+
+      ENDIF
+
+      ! Default values
+      n_cla = 0
+
+      ! Namelist cross land advection
+      REWIND( numnam )
+      READ  ( numnam, namcla )
+      IF(lwp) THEN
+         WRITE(numout,*) ' namcla'
+         WRITE(numout,*) ' cross land advection        n_cla           = ',n_cla
+      ENDIF
+
+   END SUBROUTINE dom_nam
+
+
+   SUBROUTINE dom_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_ctl  ***
+      !!
+      !! ** Purpose :   Domain control.
+      !!
+      !! ** Method  :   compute and print extrema of masked scale factors
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)    Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
+      INTEGER, DIMENSION(2) ::   iloc      ! 
+      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
+      !!----------------------------------------------------------------------
+
+      ! Extrema of the scale factors
+
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
+      IF(lwp)WRITE(numout,*) '~~~~~~~'
+      ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+      ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+      ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+      ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+#   if defined key_mpp    
+      CALL mpp_min( ze1min )
+      CALL mpp_min( ze2min )
+      CALL mpp_min( ze1max )
+      CALL mpp_min( ze2max )
+#   endif
+      iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+      iimi1 = iloc(1) + nimpp - 1
+      ijmi1 = iloc(2) + njmpp - 1
+      iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+      iimi2 = iloc(1) + nimpp - 1
+      ijmi2 = iloc(2) + njmpp - 1
+      iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+      iima1 = iloc(1) + nimpp - 1
+      ijma1 = iloc(2) + njmpp - 1
+      iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+      iima2 = iloc(1) + nimpp - 1
+      ijma2 = iloc(2) + njmpp - 1
+#   if defined key_mpp
+      CALL mpp_isl( iimi1 )
+      CALL mpp_isl( ijmi1 )
+      CALL mpp_isl( iimi2 )
+      CALL mpp_isl( ijmi2 )
+      CALL mpp_isl( iima1 )
+      CALL mpp_isl( ijma1 )
+      CALL mpp_isl( iima2 )
+      CALL mpp_isl( ijma2 )
+#   endif
+
+      IF(lwp) THEN
+         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i3,' j= ',i3)") ze1max, iima1, ijma1
+         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i3,' j= ',i3)") ze1min, iimi1, ijmi1
+         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i3,' j= ',i3)") ze2max, iima2, ijma2
+         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i3,' j= ',i3)") ze2min, iimi2, ijmi2
+      ENDIF
+
+   END SUBROUTINE dom_ctl
+
+   !!======================================================================
+END MODULE domain
Index: /branches/nemo/NEMO/OPA_SRC/DOM/domcfg.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/domcfg.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/domcfg.F90	(revision 4)
@@ -0,0 +1,228 @@
+MODULE domcfg
+   !!==============================================================================
+   !!                       ***  MODULE domcfg   ***
+   !! Ocean initialization : domain configuration initialization
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_cfg        : initialize the domain configuration
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing library
+   USE solisl          ! ???
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dom_cfg        ! called by opa.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dom_cfg
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_cfg  ***
+      !!                    
+      !! ** Purpose :   set the domain configuration
+      !!
+      !! ** Method  :
+      !!
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   iconf = 0         ! temporary integers
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_cfg : set the ocean configuration'
+         WRITE(numout,*) '~~~~~~~      ocean model configuration used :',   &
+            &                             ' cp_cfg = ', cp_cfg, ' jp_cfg = ', jp_cfg
+      ENDIF
+
+      ! Global domain boundary conditions
+      ! ---------------------------------
+      IF(lwp) THEN
+         WRITE(numout,*) '          global domain lateral boundaries'
+
+         IF( jperio == 0 ) WRITE(numout,*) '             jperio= 0, closed'
+         IF( jperio == 1 ) WRITE(numout,*) '             jperio= 1, cyclic east-west'
+         IF( jperio == 2 ) WRITE(numout,*) '             jperio= 2, equatorial symmetric'
+         IF( jperio == 3 ) WRITE(numout,*) '             jperio= 3, north fold with T-point pivot'
+         IF( jperio == 4 ) WRITE(numout,*) '             jperio= 4, cyclic east-west and',   &
+                                                                  ' north fold with T-point pivot'
+         IF( jperio == 5 ) WRITE(numout,*) '             jperio= 5, north fold with F-point pivot'
+         IF( jperio == 6 ) WRITE(numout,*) '             jperio= 6, cyclic east-west and',   &
+                                                                  ' north fold with F-point pivot'
+      ENDIF
+      IF( jperio <  0 .OR. jperio > 6 ) THEN
+          IF(lwp) WRITE(numout,cform_err)
+          IF(lwp) WRITE(numout,*) 'jperio is out of range'
+          nstop = nstop + 1
+      ENDIF
+
+
+      ! global domain versus zoom and/or local domain
+      ! ---------------------------------------------
+
+      CALL dom_glo 
+
+   END SUBROUTINE dom_cfg
+
+
+   SUBROUTINE dom_glo
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_glo  ***
+      !!
+      !! ** Purpose :   initialization for global domain, zoom and local domain
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  : - mig  , mjg : 
+      !!              - mi0  , mi1   :
+      !!              - mj0, , mj1   :
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)    Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj            ! dummy loop argument
+      !!----------------------------------------------------------------------
+
+      ! Local domain 
+      ! ============
+
+      ! local domain indices ==> global domain indices
+      DO ji = 1, jpi
+        mig(ji) = ji + jpizoom - 1 + nimpp - 1
+      END DO
+      DO jj = 1, jpj
+        mjg(jj) = jj + jpjzoom - 1 + njmpp - 1
+      END DO
+
+      ! global domain indices ==> local domain indices
+      ! (return (m.0,m.1)=(1,0) if global domain gridpoint is not in the local domain)
+      DO ji = 1, jpiglo
+        mi0(ji) = MAX( 1, MIN( ji - jpizoom + 1 - nimpp + 1, jpi   ) )
+        mi1(ji) = MAX( 0, MIN( ji - jpizoom + 1 - nimpp + 1, jpim1 ) )
+      END DO
+      DO jj = 1, jpjglo
+        mj0(jj) = MAX( 1, MIN( jj - jpjzoom + 1 - njmpp + 1, jpj   ) )
+        mj1(jj) = MAX( 0, MIN( jj - jpjzoom + 1 - njmpp + 1, jpjm1 ) )
+      END DO
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_glo : domain: data / global or zoom / local'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '          data input domain    : jpidta = ', jpidta,   &
+            &                                            ' jpjdta = ', jpjdta, ' jpkdta = ', jpkdta
+         WRITE(numout,*) '          global or zoom domain: jpiglo = ', jpiglo,   &
+            &                                            ' jpjglo = ', jpjglo, ' jpk    = ', jpk
+         WRITE(numout,*) '          local domain         : jpi    = ', jpi   ,   &
+            &                                            ' jpj    = ', jpj   , ' jpk    = ', jpk
+         WRITE(numout,*)
+         WRITE(numout,*) '          south-west indices    jpizoom = ', jpizoom,   &
+            &                                           ' jpjzoom = ', jpjzoom
+         WRITE(numout,*)
+         WRITE(numout,*) '          conversion local  ==> global/zoom i-index domain'
+         WRITE(numout,25)              (mig(ji),ji = 1,jpi)
+         WRITE(numout,*)
+         WRITE(numout,*) '          conversion global/zoom ==> local  i-index domain'
+         WRITE(numout,*) '             starting index'
+         WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
+         WRITE(numout,*) '             ending index'
+         WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
+         WRITE(numout,*)
+         WRITE(numout,*) '          conversion local  ==> global/zoom i-index domain'
+         WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
+         WRITE(numout,*)
+         WRITE(numout,*) '          conversion global/zoom ==> local  i-index domain'
+         WRITE(numout,*) '             starting index'
+         WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
+         WRITE(numout,*) '             ending index'
+         WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
+      ENDIF
+ 25   FORMAT( 100(10x,19i4,/) )
+
+      ! Zoom domain
+      ! ===========
+
+      ! zoom control
+      IF( jpiglo - jpizoom + 1  >  jpidta .OR.   &
+          jpjglo - jpjzoom + 1  >  jpjdta      ) THEN
+         IF(lwp)WRITE(numout,cform_err)
+         IF(lwp)WRITE(numout,*)' global or zoom domain exceed the data domain ! '
+         nstop = nstop + 1
+      ENDIF
+
+      ! set zoom flag
+      IF ( jpiglo < jpidta .OR. jpjglo < jpjdta )   lzoom = .TRUE.
+
+      ! set zoom type flags
+      IF( lzoom .AND. jpizoom /= 1 )   lzoom_e = .TRUE.                     ! 
+      IF( lzoom .AND. jpjzoom /= 1 )   lzoom_s = .TRUE.
+      IF( lzoom .AND. jpiglo + jpizoom -1 /= jpidta )   lzoom_w = .TRUE.
+      IF( lzoom .AND. jpjglo + jpjzoom -1 /= jpjdta )   lzoom_n = .TRUE.
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '          zoom flags : '
+         WRITE(numout,*) '             lzoom   = ', lzoom  , ' (T = zoom, F = global )'
+         WRITE(numout,*) '             lzoom_e = ', lzoom_e, ' (T = forced closed east  boundary)'
+         WRITE(numout,*) '             lzoom_w = ', lzoom_w, ' (T = forced closed west  boundary)'
+         WRITE(numout,*) '             lzoom_s = ', lzoom_s, ' (T = forced closed South boundary)'
+         WRITE(numout,*) '             lzoom_n = ', lzoom_n, ' (T = forced closed North boundary)'
+      ENDIF
+      IF(  ( lzoom_e .OR. lzoom_w )  .AND.  ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 )  ) THEN
+         IF(lwp)WRITE(numout,cform_err)
+         IF(lwp)WRITE(numout,*)' Your zoom choice is inconsistent with east-west cyclic boundary condition'
+         nstop = nstop + 1
+      ENDIF
+      IF(  lzoom_n  .AND.  ( 3 <= jperio .AND. jperio <= 6 )  ) THEN
+         IF(lwp)WRITE(numout,cform_err)
+         IF(lwp)WRITE(numout,*)' Your zoom choice is inconsistent with North fold boundary condition'
+         nstop = nstop + 1
+      ENDIF
+      IF(  lzoom  .AND.  l_isl  ) THEN
+         IF(lwp)WRITE(numout,cform_err)
+         IF(lwp)WRITE(numout,*)' key_islands and zoom are not allowed'
+         nstop = nstop + 1
+      ENDIF
+
+      ! Pre-defined arctic/antarctic zoom of ORCA configuration flag
+      IF( cp_cfg == "orca" ) THEN
+         SELECT CASE ( jp_cfg )
+         !                                        ! =======================
+         CASE ( 2 )                               !  ORCA_R2 configuration
+            !                                     ! =======================
+            IF(  jpiglo  == 142    .AND. jpjglo  ==  53 .AND.   &
+               & jpizoom ==  21    .AND. jpjzoom ==  97         )   lzoom_arct = .TRUE.
+            IF(  jpiglo  == jpidta .AND. jpjglo  ==  50 .AND.   &
+               & jpizoom ==   1    .AND. jpjzoom ==   1         )   lzoom_anta = .TRUE.
+            !                                     ! =======================
+         CASE ( 05 )                              !  ORCA_R05 configuration
+            !                                     ! =======================
+            IF(  jpiglo  == 562    .AND. jpjglo  == 202 .AND.   &
+               & jpizoom ==  81    .AND. jpjzoom == 301         )   lzoom_arct = .TRUE.
+            IF(  jpiglo  == jpidta .AND. jpjglo  == 187 .AND.   &
+               & jpizoom ==   1    .AND. jpjzoom ==   1         )   lzoom_anta = .TRUE.
+         END SELECT
+         !
+         IF(lwp) WRITE(numout,*) '          ORCA configuration: antarctic/arctic zoom flags : '
+         IF(lwp) WRITE(numout,*) '             lzoom_arct = ', lzoom_arct, ' (T=   arctic zoom, F=global)'
+         IF(lwp) WRITE(numout,*) '             lzoom_anta = ', lzoom_anta, ' (T=antarctic zoom, F=global)'
+         !
+      ENDIF
+         
+   END SUBROUTINE dom_glo
+
+   !!======================================================================
+END MODULE domcfg
Index: /branches/nemo/NEMO/OPA_SRC/DOM/domhgr.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 4)
@@ -0,0 +1,587 @@
+MODULE domhgr
+   !!==============================================================================
+   !!                       ***  MODULE domain   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_hgr        : initialize the horizontal mesh 
+   !!   dom_hgr_coo    : read "coordinate" file (except for EEL config.)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Module variables
+   REAL (wp)  :: glam0, gphi0        ! variables corresponding to parameters
+      !                              ! ppglam0 ppgphi0 set in par_oce
+
+   !! * Routine accessibility
+   PUBLIC dom_hgr        ! called by domain.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dom_hgr
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_hgr  ***
+      !!
+      !! ** Purpose :   Compute the geographical position (in degre) of the 
+      !!      model grid-points,  the horizontal scale factors (in meters) and 
+      !!      the Coriolis factor (in s-1).
+      !!
+      !! ** Method  :   The geographical position of the model grid-points is
+      !!      defined from analytical functions, fslam and fsphi, the deriva-
+      !!      tives of which gives the horizontal scale factors e1,e2.
+      !!      Defining two function fslam and fsphi and their derivatives in 
+      !!      the two horizontal directions (fse1 and fse2), the model grid-
+      !!      point position and scale factors are given by:
+      !!            t-point: glamt(i,j) = fslam(i,j)
+      !!                     gphit(i,j) = fsphi(i,j)
+      !!                     e1t  (i,j) = fse1 (i,j)
+      !!                     e2t  (i,j) = fse2 (i,j)
+      !!            u-point: glamu(i,j) = fslam(i+0.5,j)
+      !!                     gphiu(i,j) = fsphi(i+0.5,j)
+      !!                     e1u  (i,j) = fse1 (i+0.5,j)
+      !!                     e2u  (i,j) = fse2 (i+0.5,j)
+      !!            v-point: glamv(i,j) = fslam(i,j+0.5)
+      !!                     gphiv(i,j) = fsphi(i,j+0.5)
+      !!                     e1v  (i,j) = fse1 (i,j+0.5)
+      !!                     e2v  (i,j) = fse2 (i,j+0.5)
+      !!            f-point: glamf(i,j) = fslam(i+0.5,j+0.5)
+      !!                     gphif(i,j) = fsphi(i+0.5,j+0.5)
+      !!                     e1f  (i,j) = fse1 (i+0.5,j+0.5)
+      !!                     e2f  (i,j) = fse2 (i+0.5,j+0.5)
+      !!      Where fse1 and fse2 are defined by:
+      !!         fse1(i,j) = ra * rad * SQRT( (cos(phi) di(fslam))**2
+      !!                                     +          di(fsphi) **2 )(i,j)
+      !!         fse2(i,j) = ra * rad * SQRT( (cos(phi) dj(fslam))**2
+      !!                                     +          dj(fsphi) **2 )(i,j)
+      !!
+      !!        The coriolis factor is given at z-point by:
+      !!                     ff = 2.*omega*sin(gphif)      (in s-1)
+      !!
+      !!        This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
+      !!      well as the way to compute the model grid-point position and
+      !!      horizontal scale factors must be respected in order to insure
+      !!      second order accuracy schemes.
+      !!
+      !! N.B. If the domain is periodic, verify that scale factors are also
+      !!      periodic, and the coriolis term again.
+      !!
+      !! ** Action  : - define  glamt, glamu, glamv, glamf: longitude of t-, 
+      !!                u-, v- and f-points (in degre)
+      !!              - define  gphit, gphiu, gphiv, gphit: latitude  of t-,
+      !!               u-, v-  and f-points (in degre)
+      !!        define e1t, e2t, e1u, e2u, e1v, e2v, e1f, e2f: horizontal
+      !!      scale factors (in meters) at t-, u-, v-, and f-points.
+      !!        define ff: coriolis factor at f-point
+      !!
+      !! References :
+      !!      Marti, Madec and Delecluse, 1992, j. geophys. res., in press.
+      !!
+      !! History :
+      !!        !  88-03  (G. Madec)
+      !!        !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard)
+      !!        !  96-01  (G. Madec)  terrain following coordinates
+      !!        !  97-02  (G. Madec)  print mesh informations
+      !!        !  01-09  (M. Levy)  eel config: grid in km, beta-plane
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module, namelist
+      !!   9.0  !  04-01  (A.M. Treguier, J.M. Molines) Case 4 (Mercator mesh)
+      !!                  use of parameters in par_CONFIG-Rxx.h90, not in namelist
+      !!----------------------------------------------------------------------
+      !! * local declarations
+      INTEGER  ::   ji, jj          ! dummy loop indices
+      INTEGER  ::   jeq             ! index of equator T point (computed for case 4)
+      REAL(wp) ::   &
+         zti, zui, zvi, zfi,     &  ! temporary scalars
+         ztj, zuj, zvj, zfj,     &  !
+         zphi0, zbeta, znorme,   &  !
+         zarg, zf0
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_hgr : define the horizontal mesh from ithe following par_oce parameters '
+         WRITE(numout,*) '~~~~~~~      type of horizontal mesh           jphgr_msh = ', jphgr_msh
+         WRITE(numout,*) '             position of the first row and     ppglam0  = ', ppglam0
+         WRITE(numout,*) '             column grid-point (degrees)       ppgphi0  = ', ppgphi0
+         WRITE(numout,*) '             zonal      grid-spacing (degrees) ppe1_deg = ', ppe1_deg
+         WRITE(numout,*) '             meridional grid-spacing (degrees) ppe2_deg = ', ppe2_deg
+         WRITE(numout,*) '             zonal      grid-spacing (meters)  ppe1_m   = ', ppe1_m  
+         WRITE(numout,*) '             meridional grid-spacing (meters)  ppe2_m   = ', ppe2_m  
+      ENDIF
+
+
+      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
+
+      CASE ( 0 )                     !  curvilinear coordinate on the sphere read in coordinate.nc file
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in coordinate.nc file'
+
+         CALL dom_hgr_coo
+
+         ! N.B. :  General case, lat and long function of both i and j indices:
+         !     e1t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdila( zti, ztj ) )**2   &
+         !                                  + (                           fsdiph( zti, ztj ) )**2  )
+         !     e1u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdila( zui, zuj ) )**2   &
+         !                                  + (                           fsdiph( zui, zuj ) )**2  )
+         !     e1v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdila( zvi, zvj ) )**2   &
+         !                                  + (                           fsdiph( zvi, zvj ) )**2  )
+         !     e1f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdila( zfi, zfj ) )**2   &
+         !                                  + (                           fsdiph( zfi, zfj ) )**2  )
+         !
+         !     e2t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdjla( zti, ztj ) )**2   &
+         !                                  + (                           fsdjph( zti, ztj ) )**2  )
+         !     e2u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdjla( zui, zuj ) )**2   &
+         !                                  + (                           fsdjph( zui, zuj ) )**2  )
+         !     e2v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdjla( zvi, zvj ) )**2   &
+         !                                  + (                           fsdjph( zvi, zvj ) )**2  )
+         !     e2f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdjla( zfi, zfj ) )**2   &
+         !                                  + (                           fsdjph( zfi, zfj ) )**2  )
+
+
+      CASE ( 1 )                     ! geographical mesh on the sphere with regular grid-spacing
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere with regular grid-spacing'
+         IF(lwp) WRITE(numout,*) '          given by ppe1_deg and ppe2_deg' 
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - 1 + njmpp - 1 )
+               zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - 1 + njmpp - 1 )
+               zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5
+               zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5
+         ! Longitude
+               glamt(ji,jj) = ppglam0 + ppe1_deg * zti
+               glamu(ji,jj) = ppglam0 + ppe1_deg * zui
+               glamv(ji,jj) = ppglam0 + ppe1_deg * zvi
+               glamf(ji,jj) = ppglam0 + ppe1_deg * zfi
+         ! Latitude
+               gphit(ji,jj) = ppgphi0 + ppe2_deg * ztj
+               gphiu(ji,jj) = ppgphi0 + ppe2_deg * zuj
+               gphiv(ji,jj) = ppgphi0 + ppe2_deg * zvj
+               gphif(ji,jj) = ppgphi0 + ppe2_deg * zfj
+         ! e1
+               e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
+               e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
+               e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
+               e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
+         ! e2
+               e2t(ji,jj) = ra * rad * ppe2_deg
+               e2u(ji,jj) = ra * rad * ppe2_deg
+               e2v(ji,jj) = ra * rad * ppe2_deg
+               e2f(ji,jj) = ra * rad * ppe2_deg
+            END DO
+         END DO
+
+
+      CASE ( 2:3 )                   ! f- or beta-plane with regular grid-spacing
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          f- or beta-plane with regular grid-spacing'
+         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m' 
+
+         ! Position coordinates (in kilometers)
+         !                          ==========
+         glam0 = 0.e0
+         gphi0 = - ppe2_m * 1.e-3
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 )       )
+               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 ) + 0.5 )
+               glamv(ji,jj) = glamt(ji,jj)
+               glamf(ji,jj) = glamu(ji,jj)
+   
+               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 )       )
+               gphiu(ji,jj) = gphit(ji,jj)
+               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 ) + 0.5 )
+               gphif(ji,jj) = gphiv(ji,jj)
+            END DO
+         END DO
+
+         ! Horizontal scale factors (in meters)
+         !                              ======
+         e1t(:,:) = ppe1_m      ;      e2t(:,:) = ppe2_m
+         e1u(:,:) = ppe1_m      ;      e2u(:,:) = ppe2_m
+         e1v(:,:) = ppe1_m      ;      e2v(:,:) = ppe2_m
+         e1f(:,:) = ppe1_m      ;      e2f(:,:) = ppe2_m
+
+      CASE ( 4 )                     ! geographical mesh on the sphere, isotropic MERCATOR type
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere, MERCATOR type'
+         IF(lwp) WRITE(numout,*) '          longitudinal/latitudinal spacing given by ppe1_deg'
+         IF ( ppgphi0 == -90 ) THEN
+                IF(lwp) WRITE(numout,*) ' Mercator grid cannot start at south pole !!!! '
+                IF(lwp) WRITE(numout,*) ' We stop '
+                STOP
+         ENDIF
+
+         !  Find index corresponding to the equator, given the grid spacing e1_deg
+         !  and the (approximate) southern latitude ppgphi0.
+         !  This way we ensure that the equator is at a "T / U" point, when in the domain.
+         !  The formula should work even if the equator is outside the domain.
+         zarg = rpi / 4. - rpi / 180. * ppgphi0 / 2.
+         jeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg )
+
+         IF(lwp) WRITE(numout,*) '          Index of the equator on the MERCATOR grid:', jeq
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - jeq + njmpp - 1 )
+               zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - jeq + njmpp - 1 )
+               zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - jeq + njmpp - 1 ) + 0.5
+               zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - jeq + njmpp - 1 ) + 0.5
+         ! Longitude
+               glamt(ji,jj) = ppglam0 + ppe1_deg * zti
+               glamu(ji,jj) = ppglam0 + ppe1_deg * zui
+               glamv(ji,jj) = ppglam0 + ppe1_deg * zvi
+               glamf(ji,jj) = ppglam0 + ppe1_deg * zfi
+         ! Latitude
+               gphit(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* ztj ) )
+               gphiu(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* ztj ) )
+               gphiv(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* ztj ) )
+               gphif(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* ztj ) )
+         ! e1
+               e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
+               e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
+               e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
+               e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
+         ! e2
+               e2t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
+               e2u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
+               e2v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
+               e2f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
+            END DO
+         END DO
+
+
+
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for jphgr_msh = ', jphgr_msh
+         nstop = nstop + 1
+
+      END SELECT
+
+
+      ! Control printing : Grid informations (if not restart)
+      ! ----------------
+
+      IF(lwp .AND. .NOT.ln_rstart ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '          longitude and e1 scale factors'
+         WRITE(numout,*) '          ------------------------------'
+         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   &
+            glamv(ji,1), glamf(ji,1),   &
+            e1t(ji,1), e1u(ji,1),   &
+            e1v(ji,1), e1f(ji,1), ji = 1, jpi,10)
+9300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
+            f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 )
+         
+         WRITE(numout,*)
+         WRITE(numout,*) '          latitude and e2 scale factors'
+         WRITE(numout,*) '          -----------------------------'
+         WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   &
+            &                     gphiv(1,jj), gphif(1,jj),   &
+            &                     e2t  (1,jj), e2u  (1,jj),   &
+            &                     e2v  (1,jj), e2f  (1,jj), jj = 1, jpj, 10 )
+      ENDIF
+
+      
+      IF( nprint == 1 .AND. lwp ) THEN
+         WRITE(numout,*) '          e1u e2u '
+         CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         WRITE(numout,*) '          e1v e2v  '
+         CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         WRITE(numout,*) '          e1f e2f  '
+         CALL prihre( e1f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         CALL prihre( e2f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+      ENDIF
+
+
+      ! ================= !
+      !  Coriolis factor  !
+      ! ================= !
+
+      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
+
+      CASE ( 0, 1, 4 )               ! mesh on the sphere
+
+         ff(:,:) = 2. * omega * SIN( rad * gphif(:,:) ) 
+
+      CASE ( 2 )                     ! f-plane at ppgphi0 
+
+         ff(:,:) = 2. * omega * SIN( rad * ppgphi0 )
+
+         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1)
+
+      CASE ( 3 )                     ! beta-plane
+
+         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
+         zphi0   = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m *1.e-3  / ( ra * rad ) ! latitude of the first row F-points
+         zf0     = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
+
+         ff(:,:) = ( zf0  + zbeta * gphif(:,:) )                          ! f = f0 +beta* y ( y=0 at south)
+
+         IF(lwp) WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(1,1)
+         IF(lwp) WRITE(numout,*) '                      Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj)
+
+      END SELECT
+
+
+      ! Control of domain for symetrical condition
+      ! ------------------------------------------
+      ! The equator line must be the latitude coordinate axe
+
+      IF( nperio == 2 ) THEN
+         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / FLOAT( jpi )
+         IF( znorme > 1.e-13 ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' '
+            IF(lwp) WRITE(numout,*) ' ===>>>> : symmetrical condition'
+            IF(lwp) WRITE(numout,*) 'stop rerun with good equator line'
+            IF(lwp) WRITE(numout,*) '           ----'
+            nstop = nstop + 1
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE dom_hgr
+
+#if defined key_fdir
+   !!---------------------------------------------------------------------
+   !!   'key-fdir                                       direct access file 
+   !!---------------------------------------------------------------------
+#  include "domhgr_coo_fdir.h90"
+
+#else
+   !!---------------------------------------------------------------------
+   !!   Defaultl option  :                                     NetCDF file 
+   !!---------------------------------------------------------------------
+
+   SUBROUTINE dom_hgr_coo
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE dom_hgr_coo  ***
+      !!
+      !! ** Purpose :   Read a coordinate file in NetCDF format 
+      !!
+      !! ** Method  :   The mesh file has been defined trough a analytical 
+      !!      or semi-analytical method. It is read in a NetCDF file. 
+      !!     
+      !! References :
+      !!      Marti, Madec and Delecluse, 1992, JGR, 97, 12,763-12,766.
+      !!      Madec, Imbard, 1996, Clim. Dyn., 12, 381-388.
+      !!
+      !! History :
+      !!        !         (O. Marti)  Original code
+      !!        !  91-03  (G. Madec)
+      !!        !  92-07  (M. Imbard)
+      !!        !  99-11  (M. Imbard) NetCDF format with IOIPSL
+      !!        !  00-08  (D. Ludicone) Reduced section at Bab el Mandeb
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Local declarations
+      LOGICAL ::   llog
+      CHARACTER(len=21) ::   clname
+      INTEGER  ::   ji, jj              ! dummy loop indices
+      INTEGER  ::   ii0, ii1, ij0, ij1  ! temporary integers
+      INTEGER  ::   inum                ! temporary logical unit
+      INTEGER  ::   ilev, itime         ! temporary integers
+      REAL(wp) ::   zdt, zdate0         ! temporary scalars
+      REAL(wp) ::   zdept(1)            ! temporary workspace
+      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
+         zlamt, zphit, zdta             ! temporary workspace
+      !!----------------------------------------------------------------------
+
+
+      ! 1. Read of the grid coordinates and scale factors
+      ! -------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_hgr_coo : read the horizontal coordinates'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '         jpiglo jpjglo jpk : ', jpiglo, jpjglo, jpk
+      ENDIF
+
+      ! read the file
+      itime = 0
+      clname = 'coordinates'
+      llog = .FALSE.
+      ilev = 1   
+      zlamt(:,:) = 0.e0
+      zphit(:,:) = 0.e0
+      CALL restini( clname,jpidta,jpjdta,zlamt,zphit,ilev,zdept,clname   &
+         &          ,itime,zdate0,zdt,inum)
+
+      CALL restget(inum,'glamt',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            glamt(ji,jj) = zdta(mig(ji),mjg(jj))
+         END DO
+      END DO
+      CALL restget(inum,'glamu',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            glamu(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'glamv',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            glamv(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'glamf',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            glamf(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'gphit',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            gphit(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'gphiu',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            gphiu(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'gphiv',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            gphiv(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'gphif',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            gphif(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'e1t',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e1t  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'e1u',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e1u  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'e1v',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e1v  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'e1f',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e1f  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'e2t',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e2t  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'e2u',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e2u  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'e2v',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e2v  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      CALL restget(inum,'e2f',jpidta,jpjdta,1,0,llog,zdta)
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e2f  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+
+      CALL restclo(inum)
+
+      ! set extra rows add in mpp to none zero values
+      DO jj = nlcj+1, jpj
+         DO ji = 1, nlci
+            glamt(ji,jj) = glamt(ji,1)   ;   gphit(ji,jj) = gphit(ji,1)
+            glamu(ji,jj) = glamu(ji,1)   ;   gphiu(ji,jj) = gphiu(ji,1)
+            glamv(ji,jj) = glamv(ji,1)   ;   gphiv(ji,jj) = gphiv(ji,1)
+            glamf(ji,jj) = glamf(ji,1)   ;   gphif(ji,jj) = gphif(ji,1)
+            e1t  (ji,jj) = e1t  (ji,1)   ;   e2t  (ji,jj) = e2t  (ji,1)
+            e1u  (ji,jj) = e1u  (ji,1)   ;   e2u  (ji,jj) = e2u  (ji,1)
+            e1v  (ji,jj) = e1v  (ji,1)   ;   e2v  (ji,jj) = e2v  (ji,1)
+            e1f  (ji,jj) = e1f  (ji,1)   ;   e2f  (ji,jj) = e2f  (ji,1)
+         END DO
+      END DO
+
+      ! set extra columns add in mpp to none zero values
+      DO ji = nlci+1, jpi
+         glamt(ji,:) = glamt(1,:)   ;   gphit(ji,:) = gphit(1,:)
+         glamu(ji,:) = glamu(1,:)   ;   gphiu(ji,:) = gphiu(1,:)
+         glamv(ji,:) = glamv(1,:)   ;   gphiv(ji,:) = gphiv(1,:)
+         glamf(ji,:) = glamf(1,:)   ;   gphif(ji,:) = gphif(1,:)
+         e1t  (ji,:) = e1t  (1,:)   ;   e2t  (ji,:) = e2t  (1,:)
+         e1u  (ji,:) = e1u  (1,:)   ;   e2u  (ji,:) = e2u  (1,:)
+         e1v  (ji,:) = e1v  (1,:)   ;   e2v  (ji,:) = e2v  (1,:)
+         e1f  (ji,:) = e1f  (1,:)   ;   e2f  (ji,:) = e2f  (1,:)
+      END DO
+
+      !                                                ! =====================
+      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+         !                                             ! =====================
+         IF( n_cla == 0 ) THEN
+            e2u( mi0(160):mi1(161) , mj0(88):mj1(88) ) =  18.e3   ! Bab el Mandeb (e2u = 18 km)
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '          Bab el Mandeb: e2u reduced to 18 km'
+         ENDIF 
+ 
+         e2u( mi0(145):mi1(146) , mj0(116):mj1(116) ) =  15.e3    ! Sound Strait (e2u = 15 km)
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '        : Reduced e2u at the Sound Strait'
+         !
+      ENDIF
+
+      !                                                ! ======================
+      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration
+         !                                             ! ======================
+         ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u = 20 km)
+         ij0 = 327   ;   ij1 = 327   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij0) ) =  20.e3    
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '        : Reduced e2u at the Gibraltar Strait'
+         !
+      ENDIF
+
+   END SUBROUTINE dom_hgr_coo
+
+#endif
+   !!======================================================================
+END MODULE domhgr
Index: /branches/nemo/NEMO/OPA_SRC/DOM/domhgr_coo_fdir.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/domhgr_coo_fdir.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/domhgr_coo_fdir.h90	(revision 4)
@@ -0,0 +1,301 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  domhgr_coo_fdir.h90  ***
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dom_hgr_coo
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dom_hgr_coo  ***
+      !!
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      CHARACTER (len=5) ::   clfield
+      INTEGER ::   ji, jj         ! dummy loop indices
+      INTEGER ::   inumcoo = 11   ! logical unit for coordinate file
+      INTEGER ::   ijpi, ijpj     ! temporary integers
+      REAL(wp), DIMENSION(jpi,jpj) ::   zdta   ! temporary workspace
+      !!----------------------------------------------------------------------
+
+
+      ! 1. Read of the grid coordinates and scale factors
+      ! -------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'hgrcoo : read the horizontal coordinates'
+         WRITE(numout,*) '~~~~~~'
+         WRITE(numout,*) '         jpiglo jpjglo jpk : ', jpiglo, jpjglo, jpk
+      ENDIF
+
+      ! open the file
+          clname = 'coordinates'
+          CALL ctlopn( inumcoo, 'coordinates', 'OLD', 'UNFORMATTED', 'SEQUENTIAL',   &
+                       1      , numout       , lwp  , 1                            )
+
+      ! read the file
+      READ(inumcoo) ijpi,ijpj
+      IF( (ijpi /= jpidta) .OR. (ijpj /= jpjdta) ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '         inconsitency in reading coordinate file, unit=',inumcoo
+            WRITE(numout,*) '            jpidta = ',jpidta  ,' jpi  read = ',ijpi
+            WRITE(numout,*) '            jpjdta = ',jpjdta  ,' jpj  read = ',ijpj
+            WRITE(numout,*)
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+
+      READ(inumcoo) clfield, zdta
+      IF( clfield /= 'GLAMT' ) THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMT'
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            glamt(ji,jj) = zdta(mig(ji),mjg(jj))
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'GLAMU') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMU'
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            glamu(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'GLAMV') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMV'
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            glamv(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'GLAMF') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMF'
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            glamf(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'GPHIT') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIT'
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            gphit(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'GPHIU') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIU'
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            gphiu(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'GPHIV') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIV'
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            gphiv(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'GPHIF') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIF'
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            gphif(ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'E1T  ') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1T  '
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e1t  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'E1U  ') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1U  '
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e1u  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'E1V  ') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1V  '
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e1v  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'E1F  ') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1F  '
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e1f  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'E2T  ') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2T  '
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e2t  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'E2U  ') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2U  '
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e2u  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'E2V  ') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2V  '
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e2v  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+      READ(inumcoo) clfield,zdta
+      IF(clfield /= 'E2F  ') THEN
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2F  '
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            e2f  (ji,jj) = zdta(mig(ji),mjg(jj))                    
+         END DO
+      END DO
+
+      CLOSE( inumcoo )
+
+      DO jj = nlcj+1, jpj
+         DO ji = 1, nlci
+            glamt(ji,jj) = glamt(ji,1)
+            glamu(ji,jj) = glamu(ji,1)
+            glamv(ji,jj) = glamv(ji,1)
+            glamf(ji,jj) = glamf(ji,1)
+            gphit(ji,jj) = gphit(ji,1)
+            gphiu(ji,jj) = gphiu(ji,1)
+            gphiv(ji,jj) = gphiv(ji,1)
+            gphif(ji,jj) = gphif(ji,1)
+            e1t  (ji,jj) = e1t  (ji,1)
+            e1u  (ji,jj) = e1u  (ji,1)
+            e1v  (ji,jj) = e1v  (ji,1)
+            e1f  (ji,jj) = e1f  (ji,1)
+            e2t  (ji,jj) = e2t  (ji,1)
+            e2u  (ji,jj) = e2u  (ji,1)
+            e2v  (ji,jj) = e2v  (ji,1)
+            e2f  (ji,jj) = e2f  (ji,1)
+         END DO
+      END DO
+      DO jj = 1, jpj
+         DO ji = nlci+1, jpi
+            glamt(ji,jj) = glamt(1,jj)
+            glamu(ji,jj) = glamu(1,jj)
+            glamv(ji,jj) = glamv(1,jj)
+            glamf(ji,jj) = glamf(1,jj)
+            gphit(ji,jj) = gphit(1,jj)
+            gphiu(ji,jj) = gphiu(1,jj)
+            gphiv(ji,jj) = gphiv(1,jj)
+            gphif(ji,jj) = gphif(1,jj)
+            e1t  (ji,jj) = e1t  (1,jj)
+            e1u  (ji,jj) = e1u  (1,jj)
+            e1v  (ji,jj) = e1v  (1,jj)
+            e1f  (ji,jj) = e1f  (1,jj)
+            e2t  (ji,jj) = e2t  (1,jj)
+            e2u  (ji,jj) = e2u  (1,jj)
+            e2v  (ji,jj) = e2v  (1,jj)
+            e2f  (ji,jj) = e2f  (1,jj)
+         END DO
+      END DO
+
+   END SUBROUTINE dom_hgr_coo
Index: /branches/nemo/NEMO/OPA_SRC/DOM/dommsk.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 4)
@@ -0,0 +1,673 @@
+MODULE dommsk
+   !!==============================================================================
+   !!                       ***  MODULE dommsk   ***
+   !! Ocean initialization : domain land/sea mask 
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_msk        : compute land/ocean mask
+   !!   dom_msk_nsa    : update land/ocean mask when no-slip accurate
+   !!                    option is used.
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE obc_oce         ! ocean open boundary conditions
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE solisl          ! ???
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dom_msk        ! routine called by inidom.F90
+
+   !! * Module variables
+   REAL(wp) ::   &
+      shlat = 2.   ! type of lateral boundary condition on velocity (namelist namlbc)
+   
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE dom_msk
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk  ***
+      !!
+      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
+      !!      zontal velocity points (u & v), vorticity points (f) and baro-
+      !!      tropic stream function  points (b).
+      !!        Set mbathy to the number of non-zero w-levels of a water column
+      !!      (if island in the domain (l_isl=T), this is done latter in
+      !!      routine solver_init)
+      !!
+      !! ** Method  :   The ocean/land mask is computed from the basin bathy-
+      !!      metry in level (mbathy) which is defined or read in dommba.
+      !!      mbathy equals 0 over continental T-point, -n over the nth 
+      !!      island T-point, and the number of ocean level over the ocean.
+      !!
+      !!      At a given position (ji,jj,jk) the ocean/land mask is given by:
+      !!      t-point : 0. IF mbathy( ji ,jj) =< 0
+      !!                1. IF mbathy( ji ,jj) >= jk
+      !!      u-point : 0. IF mbathy( ji ,jj)  or mbathy(ji+1, jj ) =< 0
+      !!                1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk.
+      !!      v-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) =< 0
+      !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk.
+      !!      f-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1)
+      !!                   or mbathy(ji+1,jj)  or mbathy(ji+1,jj+1) =< 0
+      !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1)
+      !!                and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk.
+      !!      b-point : the same definition as for f-point of the first ocean
+      !!                level (surface level) but with 0 along coastlines.
+      !!
+      !!        The lateral friction is set through the value of fmask along
+      !!      the coast and topography. This value is defined by shlat, a
+      !!      namelist parameter:
+      !!         shlat = 0, free slip  (no shear along the coast)
+      !!         shlat = 2, no slip  (specified zero velocity at the coast)
+      !!         0 < shlat < 2, partial slip   | non-linear velocity profile
+      !!         2 < shlat, strong slip        | in the lateral boundary layer
+      !!
+      !!      N.B. If nperio not equal to 0, the land/ocean mask arrays
+      !!      are defined with the proper value at lateral domain boundaries,
+      !!      but bmask. indeed, bmask defined the domain over which the
+      !!      barotropic stream function is computed. this domain cannot
+      !!      contain identical columns because the matrix associated with
+      !!      the barotropic stream function equation is then no more inverti-
+      !!      ble. therefore bmask is set to 0 along lateral domain boundaries
+      !!      even IF nperio is not zero.
+      !!
+      !!      In case of open boundaries (key_xxxobc):
+      !!        - tmask is set to 1 on the points to be computed bay the open
+      !!          boundaries routines.
+      !!        - bmask is  set to 0 on the open boundaries.
+      !!
+      !!      Set mbathy to the number of non-zero w-levels of a water column
+      !!                  mbathy = min( mbathy, 1 ) + 1
+      !!      (note that the minimum value of mbathy is 2).
+      !!
+      !! ** Action :
+      !!                     tmask    : land/ocean mask at t-point (=0. or 1.)
+      !!                     umask    : land/ocean mask at u-point (=0. or 1.)
+      !!                     vmask    : land/ocean mask at v-point (=0. or 1.)
+      !!                     fmask    : land/ocean mask at f-point (=0. or 1.)
+      !!                          =shlat along lateral boundaries
+      !!                     bmask    : land/ocean mask at barotropic stream
+      !!                          function point (=0. or 1.) and set to
+      !!                          0 along lateral boundaries
+      !!                   mbathy   : number of non-zero w-levels 
+      !!
+      !! History :
+      !!        !  87-07  (G. Madec)  Original code
+      !!        !  91-12  (G. Madec)
+      !!        !  92-06  (M. Imbard)
+      !!        !  93-03  (M. Guyon)  symetrical conditions (M. Guyon)
+      !!        !  96-01  (G. Madec)  suppression of common work arrays
+      !!        !  96-05  (G. Madec)  mask computed from tmask and sup-
+      !!                 pression of the double computation of bmask
+      !!        !  97-02  (G. Madec)  mesh information put in domhgr.F
+      !!        !  97-07  (G. Madec)  modification of mbathy and fmask
+      !!        !  98-05  (G. Roullet)  free surface
+      !!        !  00-03  (G. Madec)  no slip accurate
+      !!        !  01-09  (J.-M. Molines)  Open boundaries
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! *Local declarations
+      INTEGER  :: ji, jj, jk, ii     ! dummy loop indices
+      INTEGER  :: iif, iil, ijf, ijl
+      INTEGER, DIMENSION(jpi,jpj) ::  imsk
+
+      REAL(wp), DIMENSION(jpi,jpj) ::   zwf
+
+      NAMELIST/namlbc/ shlat
+      !!---------------------------------------------------------------------
+      
+
+      ! Namelist namlbc : lateral momentum boundary condition
+      REWIND( numnam )
+      READ  ( numnam, namlbc )
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dommsk : ocean mask '
+         WRITE(numout,*) '~~~~~~'
+         WRITE(numout,*) '            lateral momentum boundary cond. shlat = ',shlat
+      ENDIF
+
+      IF(lwp)WRITE(numout,*) '     ocean lateral:'
+      IF ( shlat == 0. ) THEN
+          IF(lwp)WRITE(numout,*) '         free-slip '
+        ELSEIF ( shlat  ==  2. ) THEN
+          IF(lwp) WRITE(numout,*) '        no-slip '
+        ELSEIF ( 0. < shlat .AND. shlat < 2. ) THEN
+          IF(lwp) WRITE(numout,*) '        partial-slip '
+        ELSEIF ( 2. < shlat ) THEN
+          IF(lwp) WRITE(numout,*) '        strong-slip '
+        ELSE
+          IF(lwp)WRITE(numout,cform_err)
+          IF(lwp)WRITE(numout,*) ' shlat is negative = ', shlat
+          nstop = nstop + 1
+      ENDIF
+
+
+      ! 1. Ocean/land mask at t-point (computed from mbathy)
+      ! -----------------------------
+      ! Tmask has already the right boundary conditions since mbathy is ok
+
+      tmask(:,:,:) = 0.e0
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( FLOAT( mbathy(ji,jj)-jk )+.1 >= 0.e0 ) tmask(ji,jj,jk) = 1.e0
+            END DO  
+         END DO  
+      END DO  
+
+
+      ! Interior domain mask (used for global sum)
+      ! --------------------
+
+      tmask_i(:,:) = tmask(:,:,1)
+      iif = jpreci                         ! ???
+      iil = nlci - jpreci + 1
+      ijf = jprecj                         ! ???
+      ijl = nlcj - jprecj + 1
+
+      tmask_i( 1 :iif,   :   ) = 0.e0      ! first columns
+      tmask_i(iil:jpi,   :   ) = 0.e0      ! last  columns (including mpp extra columns)
+      tmask_i(   :   , 1 :ijf) = 0.e0      ! first rows
+      tmask_i(   :   ,ijl:jpj) = 0.e0      ! last  rows (including mpp extra rows)
+
+      ! north fold mask
+      tpol(1:jpiglo) = 1.e0 
+      fpol(1:jpiglo) = 1.e0
+      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot
+         tpol(jpiglo/2+1:jpiglo) = 0.e0
+         fpol(     1    :jpiglo) = 0.e0
+      ENDIF
+      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot
+         tpol(     1    :jpiglo) = 0.e0
+         fpol(jpiglo/2+1:jpiglo) = 0.e0
+      ENDIF
+
+      IF( nperio == 3 .OR. nperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row
+         DO ji = iif+1, iil-1
+            tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji))
+         END DO
+      ENDIF 
+
+
+      ! 2. Ocean/land mask at u-,  v-, and z-points (computed from tmask)
+      ! -------------------------------------------
+      
+      ! Computation
+      DO jk = 1, jpk
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector loop
+               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)
+               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk)
+               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   &
+                               * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk)
+            END DO
+         END DO
+      END DO
+
+      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN
+         !                                           ! =======================
+         ! modified vmask value in                   !  ORCA_R2 configuration
+         ! the vicinity of some straits              ! =======================
+
+         IF( n_cla == 1 ) THEN 
+            !                                ! vmask = 0. on Gibraltar zonal section
+            vmask(mi0(138):mi1(139), mj0(101):mj1(101) , 19:jpk ) = 0.e0
+            !                                ! vmask = 0. on Bab el Mandeb zonal section
+            vmask( mi0(161):mi1(163) , mj0(87):mj1(87) , 18:jpk ) = 0.e0
+         ENDIF
+
+      ENDIF
+      
+      ! Lateral boundary conditions
+      CALL lbc_lnk( umask, 'U', 1. )
+      CALL lbc_lnk( vmask, 'V', 1. )
+      CALL lbc_lnk( fmask, 'F', 1. )
+
+
+      ! 4. ocean/land mask for the elliptic equation
+      ! --------------------------------------------
+      
+      ! Computation
+#if defined key_dynspg_fsc
+      bmask(:,:) = tmask(:,:,1)       ! elliptic equation is written at t-point
+#else 
+      bmask(:,:) = fmask(:,:,1)       ! elliptic equation is written at f-point
+#endif    
+      
+      ! Boundary conditions
+      !   cyclic east-west : bmask must be set to 0. on rows 1 and jpi
+      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+         bmask( 1 ,:) = 0.e0
+         bmask(jpi,:) = 0.e0
+      ENDIF
+      
+      !   south symmetric :  bmask must be set to 0. on row 1
+      IF( nperio == 2 ) THEN
+         bmask(:, 1 ) = 0.e0
+      ENDIF
+      
+      !   north fold : 
+      IF( nperio == 3 .OR. nperio == 4 ) THEN
+#if defined key_dynspg_fsc
+         ! T-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj and on half jpjglo-1 row
+         DO ji = 1, jpi
+            ii = ji + nimpp - 1
+            bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii)
+            bmask(ji,jpj  ) = 0.e0
+         END DO
+#else
+         ! T-pt pivot and F-pt elliptic eq. : bmask set to 0. on rows jpj-1 and jpj
+         bmask(:,jpj-1) = 0.e0
+         bmask(:,jpj  ) = 0.e0
+#endif  
+      ENDIF
+      IF( nperio == 5 .OR. nperio == 6 ) THEN
+#if defined key_dynspg_fsc
+         ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj
+         bmask(:,jpj) = 0.e0
+#else
+         ! F-pt pivot and F-pt elliptic eq. : bmask set to 0. on row jpj and on half jpjglo-1 row
+         DO ji = 1, jpi
+            ii = ji + nimpp - 1
+            bmask(ji,jpj-1) = bmask(ji,jpj-1) * fpol(ii)
+            bmask(ji,jpj  ) = 0.e0
+         END DO
+#endif  
+      ENDIF
+
+      ! Mpp boundary conditions: bmask is set to zero on the overlap
+      ! region for all elliptic solvers
+
+#if defined key_mpp
+      IF( nbondi /= -1 .AND. nbondi /= 2 ) THEN
+         bmask(1:jpreci,:) = 0.e0
+      ENDIF
+      IF( nbondi /= 1 .AND. nbondi /= 2 ) THEN
+         bmask(nlci:jpi,:) = 0.e0
+      ENDIF
+      IF( nbondj /= -1 .AND. nbondj /= 2 ) THEN
+         bmask(:,1:jprecj) = 0.e0
+      ENDIF
+      IF( nbondj /= 1 .AND. nbondj /= 2 ) THEN
+         bmask(:,nlcj:jpj) = 0.e0
+      ENDIF
+      
+      ! north fold : bmask must be set to 0. on rows jpj-1 and jpj 
+      IF( npolj == 3 .OR. npolj == 4 ) THEN
+# if defined key_dynspg_fsc
+         DO ji = 1, nlci
+            ii = ji + nimpp - 1
+            bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * tpol(ii)
+            bmask(ji,nlcj  ) = 0.e0
+         END DO
+# else
+         DO ji = 1, nlci
+            bmask(ji,nlcj-1) = 0.e0
+            bmask(ji,nlcj  ) = 0.e0
+         END DO
+# endif
+      ENDIF
+      IF( npolj == 5 .OR. npolj == 6 ) THEN
+# if defined key_dynspg_fsc
+         DO ji = 1, nlci
+            ii = ji + nimpp - 1
+            bmask(ji,nlcj  ) = 0.e0
+         END DO
+# else
+         DO ji = 1, nlci
+            bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * fpol(ii)
+            bmask(ji,nlcj  ) = 0.e0
+         END DO
+# endif
+      ENDIF
+#endif
+
+
+      ! mask for second order calculation of vorticity
+      ! ----------------------------------------------
+      
+      CALL dom_msk_nsa
+
+      
+      ! Lateral boundary conditions on velocity (modify fmask)
+      ! ---------------------------------------
+      
+      DO jk = 1, jpk
+
+         zwf(:,:) = fmask(:,:,jk)
+         
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               IF( fmask(ji,jj,jk) == 0. ) THEN
+                  fmask(ji,jj,jk) = shlat * MIN( 1., MAX( zwf(ji+1,jj), zwf(ji,jj+1),   &
+                                                          zwf(ji-1,jj), zwf(ji,jj-1)  )  )
+               ENDIF
+            END DO
+         END DO
+         
+         DO jj = 2, jpjm1
+            IF( fmask(1,jj,jk) == 0. ) THEN
+               fmask(1  ,jj,jk) = shlat * MIN( 1., MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) )
+            ENDIF
+            IF( fmask(jpi,jj,jk) == 0. ) THEN
+               fmask(jpi,jj,jk) = shlat * MIN( 1., MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) )
+            ENDIF
+         END DO
+         
+         DO ji = 2, jpim1
+            IF( fmask(ji,1,jk) == 0. ) THEN
+               fmask(ji, 1 ,jk) = shlat * MIN( 1., MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) )
+            ENDIF
+            IF( fmask(ji,jpj,jk) == 0. ) THEN
+               fmask(ji,jpj,jk) = shlat * MIN( 1., MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) )
+            ENDIF
+         END DO
+      END DO
+      
+
+      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN
+         !                                           ! =======================
+         ! Increased lateral friction in             !  ORCA_R2 configuration
+         ! the vicinity of some straits              ! =======================
+         !
+         IF( n_cla == 0 ) THEN
+            !                                ! Gibraltar strait and Gulf of Cadiz
+            fmask( mi0(137):mi1(140) , mj0(101):mj1(102) , 1:jpk ) = 14.7e0
+            !                                ! Bab el Mandeb strait
+            fmask( mi0(162):mi1(163) , mj0( 87):mj1( 88) , 1:jpk ) = 20.e0
+            !                                ! Sound  strait
+            fmask( mi0(147):mi1(148) , mj0(116):mj1(117) , 1:jpk ) = 10.e0
+         ELSE
+            !                                ! Gibraltar strait and Gulf of Cadiz
+            fmask( mi0(137):mi1(139) , mj0(102):mj1(102) , 1:jpk ) =  0.e0
+            fmask( mi0(137):mi1(139) , mj0(100):mj1(100) , 1:jpk ) =  0.e0
+            fmask( mi0(139):mi1(139) , mj0(101):mj1(101) , 1:jpk ) =  0.e0
+            !                                ! Sound  strait
+            fmask( mi0(147):mi1(148) , mj0(116):mj1(117) , 1:jpk ) = 10.e0
+         ENDIF
+         !
+      ENDIF
+      
+      ! Lateral boundary conditions on fmask
+      CALL lbc_lnk( fmask, 'F', 1. )
+      
+      ! Mbathy set to the number of w-level (minimum value 2)
+      ! -----------------------------------
+      IF( l_isl ) THEN
+         ! this is done at the end of solver_init routine
+      ELSE
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               mbathy(ji,jj) = MAX( 1, mbathy(ji,jj) ) + 1
+            END DO
+         END DO
+      ENDIF
+      
+      ! Control print
+      ! -------------
+      IF( nprint == 1 .AND. lwp ) THEN
+         imsk(:,:) = INT( tmask_i(:,:) )
+         WRITE(numout,*) ' tmask_i : '
+         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
+               &                           1, jpj, 1, 1, numout)
+         WRITE (numout,*)
+         WRITE (numout,*) ' dommsk: tmask for each level'
+         WRITE (numout,*) ' ----------------------------'
+         DO jk = 1, jpk
+            imsk(:,:) = INT( tmask(:,:,jk) )
+
+            WRITE(numout,*)
+            WRITE(numout,*) ' level = ',jk
+            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
+               &                              1, jpj, 1, 1, numout)
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) ' dom_msk: vmask for each level'
+         WRITE(numout,*) ' -----------------------------'
+         DO jk = 1, jpk
+            imsk(:,:) = INT( vmask(:,:,jk) )
+            WRITE(numout,*)
+            WRITE(numout,*) ' level = ',jk
+            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
+               &                              1, jpj, 1, 1, numout)
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) ' dom_msk: fmask for each level'
+         WRITE(numout,*) ' -----------------------------'
+         DO jk = 1, jpk
+            imsk(:,:) = INT( fmask(:,:,jk) )
+            WRITE(numout,*)
+            WRITE(numout,*) ' level = ',jk
+            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
+               &                              1, jpj, 1, 1, numout )
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) ' dom_msk: bmask '
+         WRITE(numout,*) ' ---------------'
+         WRITE(numout,*)
+         imsk(:,:) = INT( bmask(:,:) )
+         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
+               &                           1, jpj, 1, 1, numout )
+      ENDIF
+
+   END SUBROUTINE dom_msk
+
+#if defined key_noslip_accurate
+   !!----------------------------------------------------------------------
+   !!   'key_noslip_accurate' :         accurate no-slip boundary condition
+   !!----------------------------------------------------------------------
+   
+   SUBROUTINE dom_msk_nsa
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk_nsa  ***
+      !! 
+      !! ** Purpose :
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action :
+      !!
+      !! History :
+      !!        !  00-03  (G. Madec)  no slip accurate
+      !!----------------------------------------------------------------------
+      !! *Local declarations
+      INTEGER  :: ji, jj, jk, ii     ! dummy loop indices
+      INTEGER ::   ine, inw, ins, inn, itest, ierror, iind, ijnd
+      INTEGER, DIMENSION(jpi*jpj*jpk,3) ::  icoord
+      REAL(wp) ::   zaa
+      !!---------------------------------------------------------------------
+      !!  OPA 9.0, LODYC-IPSL (2003)
+      !!---------------------------------------------------------------------
+      
+
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~~~~   using Schchepetkin and O Brian scheme'
+# if defined key_mpp
+      IF(lwp)WRITE(numout,cform_err)
+      IF(lwp)WRITE(numout,*) ' mpp version is not yet implemented'
+      nstop = nstop + 1
+# endif
+
+      ! mask for second order calculation of vorticity
+      ! ----------------------------------------------
+      ! noslip boundary condition: fmask=1  at convex corner, store
+      ! index of straight coast meshes ( 'west', refering to a coast,
+      ! means west of the ocean, aso)
+      
+      DO jk = 1, jpk
+         DO jl = 1, 4
+            npcoa(jl,jk) = 0
+            DO ji = 1, 2*(jpi+jpj)
+               nicoa(ji,jl,jk) = 0
+               njcoa(ji,jl,jk) = 0
+            END DO
+         END DO
+      END DO
+      
+      IF( jperio == 2 ) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' symetric boundary conditions need special'
+         WRITE(numout,*) ' treatment not implemented. we stop.'
+         STOP
+      ENDIF
+      
+      ! convex corners
+      
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zaa = tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   &
+                   + tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk)
+               IF( ABS(zaa-3.) <= 0.1 )   fmask(ji,jj,jk) = 1.
+            END DO
+         END DO
+      END DO
+
+      ! north-south straight coast
+
+      DO jk = 1, jpkm1
+         inw = 0
+         ine = 0
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               zaa = tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk)
+               IF( ABS(zaa-2.) <= 0.1 .AND. fmask(ji,jj,jk) == 0 ) THEN
+                  inw = inw + 1
+                  nicoa(inw,1,jk) = ji
+                  njcoa(inw,1,jk) = jj
+                  IF( nprint == 1 ) WRITE(numout,*) ' west  : ', jk, inw, ji, jj
+               ENDIF
+               zaa = tmask(ji,jj,jk) + tmask(ji,jj+1,jk)
+               IF( ABS(zaa-2.) <= 0.1 .AND. fmask(ji,jj,jk) == 0 ) THEN
+                  ine = ine + 1
+                  nicoa(ine,2,jk) = ji
+                  njcoa(ine,2,jk) = jj
+                  IF( nprint == 1 ) WRITE(numout,*) ' east  : ', jk, ine, ji, jj
+               ENDIF
+            END DO
+         END DO
+         npcoa(1,jk) = inw
+         npcoa(2,jk) = ine
+      END DO
+
+      ! west-east straight coast
+
+      DO jk = 1, jpkm1
+         ins = 0
+         inn = 0
+         DO jj = 2, jpjm1
+            DO ji =2, jpim1
+               zaa = tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk)
+               IF( ABS(zaa-2.) <= 0.1 .AND. fmask(ji,jj,jk) == 0 ) THEN
+                  ins = ins + 1
+                  nicoa(ins,3,jk) = ji
+                  njcoa(ins,3,jk) = jj
+                  IF( nprint == 1 ) WRITE(numout,*) ' south : ', jk, ins, ji, jj
+               ENDIF
+               zaa = tmask(ji+1,jj,jk) + tmask(ji,jj,jk)
+               IF( ABS(zaa-2.) <= 0.1 .AND. fmask(ji,jj,jk) == 0 ) THEN
+                  inn = inn + 1
+                  nicoa(inn,4,jk) = ji
+                  njcoa(inn,4,jk) = jj
+                  IF( nprint == 1 ) WRITE(numout,*) ' north : ', jk, inn, ji, jj
+               ENDIF
+            END DO
+         END DO
+         npcoa(3,jk) = ins
+         npcoa(4,jk) = inn
+      END DO
+
+      itest = 2 * ( jpi + jpj )
+      DO jk = 1, jpk
+         IF( npcoa(1,jk) > itest .OR. npcoa(2,jk) > itest .OR.   &
+             npcoa(3,jk) > itest .OR. npcoa(4,jk) > itest ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' level jk = ',jk
+            WRITE(numout,*) ' straight coast index arraies are',   &
+               ' too small.:'
+            WRITE(numout,*) ' npe, npw, nps, npn = ',   &
+                npcoa(1,jk), npcoa(2,jk),   &
+                npcoa(3,jk), npcoa(4,jk)
+            WRITE(numout,*) ' 2*(jpi+jpj) = ',itest,'. we stop.'
+            STOP
+        ENDIF
+      END DO
+
+      ierror = 0
+      iind = 0
+      ijnd = 0
+      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) iind = 2
+      IF( nperio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6 ) ijnd = 2
+      DO jk = 1, jpk
+         DO jl = 1, npcoa(1,jk)
+            IF( nicoa(jl,1,jk)+3 > jpi+iind ) THEN
+               ierror = ierror+1
+               icoord(ierror,1) = nicoa(jl,1,jk)
+               icoord(ierror,2) = njcoa(jl,1,jk)
+               icoord(ierror,3) = jk
+            ENDIF
+         END DO
+         DO jl = 1, npcoa(2,jk)
+            IF(nicoa(jl,2,jk)-2 < 1-iind ) THEN
+               ierror = ierror + 1
+               icoord(ierror,1) = nicoa(jl,2,jk)
+               icoord(ierror,2) = njcoa(jl,2,jk)
+               icoord(ierror,3) = jk
+            ENDIF
+         END DO
+         DO jl = 1, npcoa(3,jk)
+            IF( njcoa(jl,3,jk)+3 > jpj+ijnd ) THEN
+               ierror = ierror + 1
+               icoord(ierror,1) = nicoa(jl,3,jk)
+               icoord(ierror,2) = njcoa(jl,3,jk)
+               icoord(ierror,3) = jk
+            ENDIF
+         END DO
+         DO jl=1,npcoa(4,jk)
+            IF( njcoa(jl,4,jk)-2 < 1) THEN
+               ierror=ierror+1
+               icoord(ierror,1)=nicoa(jl,4,jk)
+               icoord(ierror,2)=njcoa(jl,4,jk)
+               icoord(ierror,3)=jk
+            ENDIF
+         END DO
+      END DO
+      
+      IF( ierror > 0 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '              Problem on lateral conditions'
+         IF(lwp) WRITE(numout,*) '                 Bad marking off at points:'
+         DO jl = 1, ierror
+            IF(lwp) WRITE(numout,*) 'Level:',icoord(jl,3),   &
+               '  Point(',icoord(jl,1),',',icoord(jl,2),')'
+         END DO
+         IF(lwp) WRITE(numout,*) 'We stop...'
+         nstop = nstop + 1
+      ENDIF
+
+   END SUBROUTINE dom_msk_nsa
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                      Empty routine
+   !!----------------------------------------------------------------------
+   SUBROUTINE dom_msk_nsa       
+   END SUBROUTINE dom_msk_nsa
+#endif
+   
+   !!======================================================================
+END MODULE dommsk
Index: /branches/nemo/NEMO/OPA_SRC/DOM/domstp.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/domstp.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/domstp.F90	(revision 4)
@@ -0,0 +1,131 @@
+MODULE domstp
+   !!==============================================================================
+   !!                       ***  MODULE domstp   ***
+   !! Ocean initialization : time domain
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_stp        : ocean time domain initialization
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * routine accessibility
+   PUBLIC dom_stp        ! routine called by inidom.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dom_stp
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dom_stp  ***
+      !!          
+      !! ** Purpose :   Intialize ocean time step for the run
+      !!
+      !! ** Method  : - Initialization of a coef. use in the Asselin time
+      !!      filter:  atfp1 = 1 - 2 * atfp  where atfp is the Asselin time
+      !!      filter parameter read in namelist
+      !!              - Model time step:
+      !!      nacc = 0 : synchronous time intergration. 
+      !!      There is one time step only, defined by: rdt, rdttra(k)=rdt
+      !!      nacc = 1 : accelerating the convergence. There is 2 different
+      !!      time steps for dynamics and tracers:
+      !!        rdt      : dynamical part
+      !!        rdttra(k): temperature and salinity
+      !!      The tracer time step is a function of vertical level. the model
+      !!      reference time step ( i.e. for wind stress, surface heat and
+      !!      salt fluxes) is the surface tracer time step is rdttra(1).
+      !!         N.B. depth dependent acceleration of convergence is not im-
+      !!      plemented for s-coordinate.
+      !!
+      !! ** Action  : - rdttra   : vertical profile of tracer time step
+      !!              - atfp1    : = 1 - 2*atfp
+      !!
+      !! References :
+      !!      Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673.
+      !!
+      !! History :
+      !!        !  90-10  (O. Marti)  Original code
+      !!        !  96-01  (G. Madec)  terrain following coordinates
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   jk              ! dummy loop indice
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_stp : time stepping setting'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      ! 0. Asselin Time filter
+      ! ----------------------
+      
+      atfp1 = 1. - 2. * atfp
+
+
+      SELECT CASE ( nacc )
+
+         CASE ( 0 )                ! Synchronous time stepping
+            IF(lwp) WRITE(numout,*)'               synchronous time stepping'
+            IF(lwp) WRITE(numout,*)'               dynamics and tracer time step = ', rdt/3600., ' hours'
+
+            rdttra(:) = rdt
+
+         CASE ( 1 )                ! Accelerating the convergence
+            IF(lwp) WRITE(numout,*) '              no tracer damping in the turbocline'
+            IF(lwp) WRITE(numout,*)'               accelerating the convergence'
+            IF(lwp) WRITE(numout,*)'               dynamics time step = ', rdt/3600., ' hours'
+#if defined key_s_coord
+            IF( rdtmin /= rdtmax ) THEN
+               IF(lwp) WRITE(numout,cform_err)
+               IF(lwp) WRITE(numout,*)' depth dependent acceleration of &
+                                      &convergence not implemented in s-coordinates'
+               nstop = nstop + 1
+            ENDIF
+#endif
+#if defined key_partial_steps
+            IF( rdtmin /= rdtmax ) THEN
+               IF(lwp) WRITE(numout,cform_err)
+               IF(lwp) WRITE(numout,*)' depth dependent acceleration of &
+                                      &convergence not implemented for partial steps case'
+               nstop = nstop + 1
+            ENDIF
+#endif
+            IF(lwp) WRITE(numout,*)'         tracers   time step :  dt (hours)  level'
+
+            DO jk = 1, jpk
+               IF( fsdept(1,1,jk) <= rdth ) rdttra(jk) = rdtmin
+               IF( fsdept(1,1,jk) >  rdth ) THEN
+                  rdttra(jk) = rdtmin + ( rdtmax - rdtmin )   &
+                                      * ( EXP( ( fsdept(1,1,jk ) - rdth ) / rdth ) - 1. )   &
+                                      / ( EXP( ( fsdept(1,1,jpk) - rdth ) / rdth ) - 1. )
+               ENDIF
+               IF(lwp) WRITE(numout,9200) rdttra(jk)/3600., jk
+            END DO  
+ 9200       FORMAT(36x,f5.2,'     ',i3)
+
+         CASE DEFAULT              ! E R R O R 
+
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' nacc value e r r o r, nacc= ',nacc
+            IF(lwp) WRITE(numout,*) ' we stop'
+            nstop = nstop + 1
+
+      END SELECT
+
+   END SUBROUTINE dom_stp
+
+   !!======================================================================
+END MODULE domstp
Index: /branches/nemo/NEMO/OPA_SRC/DOM/domwri.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/domwri.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/domwri.F90	(revision 4)
@@ -0,0 +1,226 @@
+MODULE domwri
+   !!======================================================================
+   !!                       ***  MODULE domwri  ***
+   !! Ocean initialization : write the ocean domain mesh and mask file(s)
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_wri        : create mesh and mask file (s)
+   !!                    nmsh = 1  :   mesh_mask file
+   !!                         = 2  :   mesh and mask file
+   !!                         = 3  :   mesh_hgr, dom_zgr and mask
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC dom_wri        ! routine called by inidom.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined key_fdir
+   !!----------------------------------------------------------------------
+   !!   'key_fdir' :                                     direct access file
+   !!----------------------------------------------------------------------
+#  include "domwri_fdir.h90"
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                        NetCDF file
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dom_wri
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE 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
+      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
+      !!      the vertical coord. used (z-coord, partial steps, s-coord)
+      !!                    nmsh = 1  :   'mesh_mask.nc' file
+      !!                         = 2  :   'mesh.nc' and mask.nc' files
+      !!                         = 3  :   'mesh_hgr.nc', 'dom_zgr.nc' and
+      !!                                  'mask.nc' files
+      !!      For huge size domain, use option 2 or 3 depending on your 
+      !!      vertical coordinate.
+      !!
+      !! ** output file : 
+      !!      meshmask.nc  : domain size, horizontal grid-point position,
+      !!                     masks, depth and vertical scale factors
+      !!
+      !! History :
+      !!        !  97-02  (G. Madec)  Original code
+      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
+      !!   9.0  !  02-08  (G. Madec)  F90 and several file
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Local declarations
+      INTEGER  ::                & !!! * temprary units for :
+         inum0 ,                 &  ! 'mesh_mask.nc' file
+         inum1 ,                 &  ! 'mesh.nc'      file
+         inum2 ,                 &  ! 'mask.nc'      file
+         inum3 ,                 &  ! 'mesh_hgr.nc'  file
+         inum4                      ! 'mesh_zgr.nc'  file
+      INTEGER  ::   itime           !  output from restini ???
+      REAL(wp) ::   zdate0
+      CHARACTER (len=21) ::      &
+         clnam0 = 'mesh_mask',   &  ! filename (mesh and mask informations)
+         clnam1 = 'mesh'     ,   &  ! filename (mesh informations)
+         clnam2 = 'mask'     ,   &  ! filename (mask informations)
+         clnam3 = 'mesh_hgr' ,   &  ! filename (horizontal mesh informations)
+         clnam4 = 'mesh_zgr'        ! filename (vertical   mesh informations)
+      !!----------------------------------------------------------------------
+
+       IF(lwp) WRITE(numout,*)
+       IF(lwp) WRITE(numout,*) 'dom_wri : create NetCDF mesh and mask information file(s)'
+       IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      CALL ymds2ju( 0, 1, 1, 0.e0, zdate0 )    ! calendar initialization
+
+
+      SELECT CASE (nmsh)
+         !                                     ! ============================
+         CASE ( 1 )                            !  create 'mesh_mask.nc' file
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" '
+            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh_mask.nc' file
+            &             jpk   , gdept , trim(clnam0)        ,  &   ! in unit inum0
+            &             itime , zdate0, rdt   , inum0          )
+            inum2 = inum0                                            ! put all the informations
+            inum3 = inum0                                            ! in unit inum0
+            inum4 = inum0
+
+            !                                  ! ============================
+         CASE ( 2 )                            !  create 'mesh.nc' and 
+            !                                  !         'mask.nc' files
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          two files in "mesh.nc" and "mask.nc" '
+            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh.nc' file 
+            &             jpk   , gdept , trim(clnam1)        ,  &   ! in unit inum1 
+            &             itime , zdate0, rdt   , inum1          )
+            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mask.nc' file 
+            &             jpk   , gdept , trim(clnam2)        ,  &   ! in unit inum2 
+            &             itime , zdate0, rdt   , inum2          )
+            inum3 = inum1                                            ! put mesh informations 
+            inum4 = inum1                                            ! in unit inum1 
+
+            !                                  ! ============================
+         CASE ( 3 )                            !  create 'mesh_hgr.nc'
+            !                                  !         'mesh_zgr.nc' and
+            !                                  !         'mask.nc'     files
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr.nc" , mesh_zgr.nc" and "mask.nc" '
+            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh_hgr.nc' file
+            &             jpk   , gdept , trim(clnam3)        ,  &   ! in unit inum3
+            &             itime , zdate0, rdt   , inum3          )
+            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mesh.nc' file
+            &             jpk   , gdept , trim(clnam4)        ,  &   ! in unit inum4
+            &             itime , zdate0, rdt   , inum4          )
+            CALL restini( 'NONE', jpi   , jpj   , glamt, gphit,  &   ! create 'mask.nc' file
+            &             jpk   , gdept , trim(clnam2)        ,  &   ! in unit inum2
+            &             itime , zdate0, rdt   , inum2          ) 
+
+         END SELECT
+
+         !                                                         ! masks (inum2) 
+         CALL restput( inum2, 'tmask', jpi, jpj, jpk, 0, tmask ) 
+         CALL restput( inum2, 'umask', jpi, jpj, jpk, 0, umask )
+         CALL restput( inum2, 'vmask', jpi, jpj, jpk, 0, vmask )
+         CALL restput( inum2, 'fmask', jpi, jpj, jpk, 0, fmask )
+
+         !                                                         ! horizontal mesh (inum3)
+         CALL restput( inum3, 'glamt', jpi, jpj, 1, 0, glamt )     !    ! latitude
+         CALL restput( inum3, 'glamu', jpi, jpj, 1, 0, glamu )
+         CALL restput( inum3, 'glamv', jpi, jpj, 1, 0, glamv )
+         CALL restput( inum3, 'glamf', jpi, jpj, 1, 0, glamf )
+
+         CALL restput( inum3, 'gphit', jpi, jpj, 1, 0, gphit )     !    ! longitude
+         CALL restput( inum3, 'gphiu', jpi, jpj, 1, 0, gphiu )
+         CALL restput( inum3, 'gphiv', jpi, jpj, 1, 0, gphiv )
+         CALL restput( inum3, 'gphif', jpi, jpj, 1, 0, gphif )
+
+         CALL restput( inum3, 'e1t', jpi, jpj, 1, 0, e1t )         !    ! e1 scale factors
+         CALL restput( inum3, 'e1u', jpi, jpj, 1, 0, e1u )
+         CALL restput( inum3, 'e1v', jpi, jpj, 1, 0, e1v )
+         CALL restput( inum3, 'e1f', jpi, jpj, 1, 0, e1f )
+
+         CALL restput( inum3, 'e2t', jpi, jpj, 1, 0, e2t )         !    ! e2 scale factors
+         CALL restput( inum3, 'e2u', jpi, jpj, 1, 0, e2u )
+         CALL restput( inum3, 'e2v', jpi, jpj, 1, 0, e2v )
+         CALL restput( inum3, 'e2f', jpi, jpj, 1, 0, e2f )
+
+         CALL restput( inum3, 'ff', jpi, jpj, 1, 0, ff )           !    ! coriolis factor
+
+# if defined key_s_coord
+         !                                                         ! s-coordinate
+         CALL restput( inum4, 'hbatt', jpi, jpj, 1, 0, hbatt )      !    ! depth
+         CALL restput( inum4, 'hbatu', jpi, jpj, 1, 0, hbatu ) 
+         CALL restput( inum4, 'hbatv', jpi, jpj, 1, 0, hbatv )
+         CALL restput( inum4, 'hbatf', jpi, jpj, 1, 0, hbatf )
+
+         CALL restput( inum4, 'gsigt', 1, 1, jpk, 0, gsigt )        !    ! scaling coef.
+         CALL restput( inum4, 'gsigw', 1, 1, jpk, 0, gsigw )  
+         CALL restput( inum4, 'gsi3w', 1, 1, jpk, 0, gsi3w )
+         CALL restput( inum4, 'esigt', 1, 1, jpk, 0, esigt )
+         CALL restput( inum4, 'esigw', 1, 1, jpk, 0, esigw )
+
+# elif defined key_partial_steps
+         !                                                          ! z-coordinate with partial steps
+         CALL restput( inum4, 'hdept' , jpi, jpj, 1, 0, hdept  )    !    ! depth
+         CALL restput( inum4, 'hdepw' , jpi, jpj, 1, 0, hdepw  ) 
+
+         CALL restput( inum4, 'e3tp'  , jpi, jpj, 1  , 0, e3tp   )  !    ! scale factors
+         CALL restput( inum4, 'e3wp'  , jpi, jpj, 1  , 0, e3wp   )
+         CALL restput( inum4, 'e3u_ps', jpi, jpj, jpk, 0, e3u_ps )
+         CALL restput( inum4, 'e3v_ps', jpi, jpj, jpk, 0, e3v_ps )
+
+         CALL restput( inum4, 'gdept' , 1, 1, jpk, 0, gdept )       !    ! reference z-coord.
+         CALL restput( inum4, 'gdepw' , 1, 1, jpk, 0, gdepw )
+         CALL restput( inum4, 'e3t'   , 1, 1, jpk, 0, e3t   )
+         CALL restput( inum4, 'e3w'   , 1, 1, jpk, 0, e3w   )
+
+# else
+         !                                                          ! z-coordinate 
+         CALL restput( inum4, 'gdept', 1, 1, jpk, 0, gdept )        !    ! depth
+         CALL restput( inum4, 'gdepw', 1, 1, jpk, 0, gdepw )
+         CALL restput( inum4, 'e3t'  , 1, 1, jpk, 0, e3t   )        !    ! scale factors
+         CALL restput( inum4, 'e3w'  , 1, 1, jpk, 0, e3w   )
+# endif
+
+         !                                     ! ============================
+         !                                     !        close the files 
+         !                                     ! ============================
+         SELECT CASE ( nmsh )
+            CASE ( 1 )                
+               CALL restclo( inum0 )
+            CASE ( 2 )
+               CALL restclo( inum1 )
+               CALL restclo( inum2 )
+            CASE ( 3 )
+               CALL restclo( inum2 )
+               CALL restclo( inum3 )
+               CALL restclo( inum4 )
+         END SELECT
+
+   END SUBROUTINE dom_wri
+
+#endif
+
+   !!======================================================================
+END MODULE domwri
Index: /branches/nemo/NEMO/OPA_SRC/DOM/domwri_fdir.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/domwri_fdir.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/domwri_fdir.h90	(revision 4)
@@ -0,0 +1,95 @@
+   !!----------------------------------------------------------------------
+   !!                     ***  domwri_fdir.h90  ***
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dom_wri
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_wri  ***
+      !!                   
+      !! ** Purpose :   Create a direct access file named meshmask
+      !!        This file contains all ocean domain informations (mesh and
+      !!      mask arrays). It is used for visualisation (SAXO software)
+      !!      and diagnostic computation.
+      !!        Caution, this file is not assigned so that diagnostics can
+      !!      be computed with a 64 bits precision.
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      CHARACTER (len=5) ::   clfield  ! field name
+      INTEGER ::   inum = 11          ! logical unit used for meshmask file
+      !!----------------------------------------------------------------------
+
+       IF(lwp) WRITE(numout,*)
+       IF(lwp) WRITE(numout,*) 'dom_wri : create a direct acces mesh_mask file'
+       IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+       ! open meshmask file
+       CALL ctlopn( inum, 'mesh_mask','UNKNOWN', 'UNFORMATTED', 'SEQUENTIAL',   &
+                    1 , numout, lwp, 1 )
+
+
+      ! 0. Domain size
+      ! --------------
+      WRITE(inum) jpiglo, jpjglo, jpk
+
+
+      ! 1. Horzontal grid-point position
+      ! --------------------------------
+      clfield='GLAMT'   ;    WRITE(inum) clfield, glamt
+      clfield='GLAMU'   ;    WRITE(inum) clfield, glamu
+      clfield='GLAMV'   ;    WRITE(inum) clfield, glamv
+      clfield='GLAMF'   ;    WRITE(inum) clfield, glamf
+
+      clfield='GPHIT'   ;    WRITE(inum) clfield, gphit
+      clfield='GPHIU'   ;    WRITE(inum) clfield, gphiu
+      clfield='GPHIV'   ;    WRITE(inum) clfield, gphiv
+      clfield='GPHIF'   ;    WRITE(inum) clfield, gphif
+
+
+      ! 2. Horizontal scale factors
+      ! ---------------------------
+      clfield='E1T  '   ;    WRITE(inum) clfield, e1t
+      clfield='E1U  '   ;    WRITE(inum) clfield, e1u
+      clfield='E1V  '   ;    WRITE(inum) clfield, e1v
+      clfield='E1F  '   ;    WRITE(inum) clfield, e1f
+
+      clfield='E2T  '   ;    WRITE(inum) clfield, e2t
+      clfield='E2U  '   ;    WRITE(inum) clfield, e2u
+      clfield='E2V  '   ;    WRITE(inum) clfield, e2v
+      clfield='E2F  '   ;    WRITE(inum) clfield, e2f
+
+
+      ! 3. masks
+      ! --------
+      clfield='TMASK'   ;    WRITE(inum) clfield, tmask
+      clfield='UMASK'   ;    WRITE(inum) clfield, umask
+      clfield='VMASK'   ;    WRITE(inum) clfield, vmask
+      clfield='FMASK'   ;    WRITE(inum) clfield, fmask
+      clfield='FF   '   ;    WRITE(inum) clfield, ff
+
+      ! 4. depth and vertical scale factors
+      ! -----------------------------------
+#if defined key_s_coord
+      clfield='HBATT'   ;    WRITE(inum) clfield, hbatt
+      clfield='HBATU'   ;    WRITE(inum) clfield, hbatu
+      clfield='HBATV'   ;    WRITE(inum) clfield, hbatv
+      clfield='HBATF'   ;    WRITE(inum) clfield, hbatf
+      clfield='GSIGT'   ;    WRITE(inum) clfield, gsigt
+      clfield='GSIGW'   ;    WRITE(inum) clfield, gsigw
+      clfield='GSI3W'   ;    WRITE(inum) clfield, gsi3w
+      clfield='ESIGT'   ;    WRITE(inum) clfield, esigt
+      clfield='ESIGW'   ;    WRITE(inum) clfield, esigw
+#else
+      clfield='GDEPT'   ;    WRITE(inum) clfield, gdept
+      clfield='GDEPW'   ;    WRITE(inum) clfield, gdepw
+      clfield='E3T  '   ;    WRITE(inum) clfield, e3t
+      clfield='E3W  '   ;    WRITE(inum) clfield,  e3w
+#endif
+
+      CLOSE( inum )
+
+   END SUBROUTINE dom_wri
Index: /branches/nemo/NEMO/OPA_SRC/DOM/domzgr.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 4)
@@ -0,0 +1,707 @@
+MODULE domzgr
+   !!==============================================================================
+   !!                       ***  MODULE domzgr   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_zgr     : defined the ocean vertical coordinate system
+   !!       zgr_bat      : bathymetry fields (levels and meters)
+   !!       zgr_bat_zoom : modify the bathymetry field if zoom domain
+   !!       zgr_bat_ctl  : check the bathymetry files
+   !!       zgr_z        : reference z-coordinate 
+   !!       zgr_zps      : z-coordinate with partial steps
+   !!       zgr_s        : s-coordinate
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE closea
+   USE solisl
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dom_zgr        ! called by dom_init.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS       
+
+   SUBROUTINE dom_zgr
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_zgr  ***
+      !!                   
+      !! ** Purpose :  set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  reference vertical coordinate
+      !!        Z-coordinates : The depth of model levels is defined
+      !!      from an analytical function the derivative of which gives
+      !!      the vertical scale factors.
+      !!      both depth and scale factors only depend on k (1d arrays).
+      !!              w-level: gdepw  = fsdep(k)
+      !!                       e3w(k) = dk(fsdep)(k)     = fse3(k)
+      !!              t-level: gdept  = fsdep(k+0.5)
+      !!                       e3t(k) = dk(fsdep)(k+0.5) = fse3(k+0.5)
+      !!
+      !! ** Action : - gdept, gdepw : depth of T- and W-point (m)
+      !!             -  e3t, e3w    : scale factors at T- and W-levels (m)
+      !!
+      !! Reference :
+      !!      Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
+      !!
+      !! History :
+      !!   9.0  !  03-08  (G. Madec)  original code
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio = 0      ! temporary integer
+      !!----------------------------------------------------------------------
+
+      ! Check Vertical coordinate options
+      ! ---------------------------------
+      ioptio = 0
+      IF( lk_sco ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dom_zgr : s-coordinate'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         ioptio = ioptio + 1
+      ENDIF
+      IF( lk_zps ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dom_zgr : z-coordinate with partial steps'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         ioptio = ioptio + 1
+      ENDIF
+      IF( ioptio == 0 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dom_zgr : z-coordinate'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      IF ( ioptio > 1 ) THEN
+          IF(lwp) WRITE(numout,cform_err)
+          IF(lwp) WRITE(numout,*) ' several vertical coordinate options used'
+          nstop = nstop + 1
+      ENDIF
+
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+
+      CALL zgr_z                       ! Reference z-coordinate system
+
+      CALL zgr_bat                     ! Bathymetry fields (levels and meters)
+
+      CALL zgr_zps                     ! Partial step z-coordinate
+
+      CALL zgr_s                       ! s-coordinate
+
+   END SUBROUTINE dom_zgr
+
+
+   SUBROUTINE zgr_z
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zgr_z  ***
+      !!                   
+      !! ** Purpose :   set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  :   z-coordinate system (use in all type of coordinate)
+      !!        The depth of model levels is defined from an analytical
+      !!      function the derivative of which gives the scale factors.
+      !!        both depth and scale factors only depend on k (1d arrays).
+      !!              w-level: gdepw  = fsdep(k)
+      !!                       e3w(k) = dk(fsdep)(k)     = fse3(k)
+      !!              t-level: gdept  = fsdep(k+0.5)
+      !!                       e3t(k) = dk(fsdep)(k+0.5) = fse3(k+0.5)
+      !!
+      !! ** Action  : - gdept, gdepw : depth of T- and W-point (m)
+      !!              -  e3t, e3w    : scale factors at T- and W-levels (m)
+      !!
+      !! Reference :
+      !!      Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766.
+      !!
+      !! History :
+      !!   9.0  !  03-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER  ::   jk                     ! dummy loop indices
+      REAL(wp) ::   zt, zw                 ! temporary scalars
+      REAL(wp) ::   &
+      zsur , za0, za1, zkth, zacr,      &  ! Values set from parameters in
+      zdzmin, zhmax                        ! par_CONFIG_Rxx.h90
+      !!----------------------------------------------------------------------
+
+      ! Set variables from parameters
+      ! ------------------------------
+       zkth = ppkth       ;   zacr = ppacr
+       zdzmin = ppdzmin   ;   zhmax = pphmax
+
+      ! If ppa1 and ppa0 and ppsur are et to pp_to_be_computed
+      !  za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr
+      !
+       IF(  ppa1  == pp_to_be_computed  .AND.  &
+         &  ppa0  == pp_to_be_computed  .AND.  &
+         &  ppsur == pp_to_be_computed           ) THEN
+         za1 = ( ppdzmin - pphmax / FLOAT(jpk-1) )          &
+             / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpk-1) &
+             &                         *  (  LOG( COSH( (jpk - ppkth) / ppacr) )      &
+             &                             - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+         za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+         zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+
+       ELSE
+         za1 = ppa1 ;       za0 = ppa0 ;          zsur = ppsur
+       ENDIF
+
+
+      ! Parameter print
+      ! ---------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '    zgr_z   : Reference vertical z-coordinates'
+         WRITE(numout,*) '    ~~~~~~~'
+         IF ( ppa1 == 0. .AND. ppa0 == 0. .AND. ppsur == 0. ) THEN
+            WRITE(numout,*) '         zsur, za0, za1 computed from '
+            WRITE(numout,*) '                 zdzmin = ', zdzmin
+            WRITE(numout,*) '                 zhmax  = ', zhmax
+         ENDIF
+         WRITE(numout,*) '              Namelist namzgr : value of coefficients for vertical mesh:'
+         WRITE(numout,*) '                 zsur = ', zsur
+         WRITE(numout,*) '                 za0  = ', za0
+         WRITE(numout,*) '                 za1  = ', za1
+         WRITE(numout,*) '                 zkth = ', zkth
+         WRITE(numout,*) '                 zacr = ', zacr
+      ENDIF
+
+
+      ! Reference z-coordinate (depth - scale factor at T- and W-points)
+      ! ======================
+
+      DO jk = 1, jpk
+         zw = FLOAT( jk )
+         zt = FLOAT( jk ) + 0.5
+         gdepw(jk) = ( zsur + za0 * zw + za1 * zacr * LOG( COSH( (zw-zkth)/zacr ) )  )
+         gdept(jk) = ( zsur + za0 * zt + za1 * zacr * LOG( COSH( (zt-zkth)/zacr ) )  )
+         e3w  (jk) =          za0      + za1        * TANH(      (zw-zkth)/zacr   )
+         e3t  (jk) =          za0      + za1        * TANH(      (zt-zkth)/zacr   )
+      END DO
+      gdepw(1) = 0.e0   ! force first w-level to be exactly at zero
+
+
+      ! Control and  print
+      ! ==================
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept(jk), gdepw(jk), e3t(jk), e3w(jk), jk = 1, jpk )
+      ENDIF
+
+      DO jk = 1, jpk
+         IF( e3w(jk) <= 0. .OR. e3t(jk) <= 0. ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' e3w or e3t =< 0 '
+            nstop = nstop + 1
+         ENDIF
+         IF( gdepw(jk) < 0. .OR. gdept(jk) < 0.) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' gdepw or gdept < 0 '
+            nstop = nstop + 1
+         ENDIF
+      END DO
+
+   END SUBROUTINE zgr_z
+
+
+   SUBROUTINE zgr_bat
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bat  ***
+      !! 
+      !! ** Purpose :   set bathymetry both in levels and meters
+      !!
+      !! ** Method  :   read or define mbathy and bathy arrays
+      !!       * level bathymetry:
+      !!      The ocean basin geometry is given by a two-dimensional array,
+      !!      mbathy, which is defined as follow :
+      !!            mbathy(ji,jj) = 1, ..., jpk-1, the number of ocean level
+      !!                              at t-point (ji,jj).
+      !!                            = 0  over the continental t-point.
+      !!                            = -n over the nth island t-point.
+      !!      The array mbathy is checked to verified its consistency with
+      !!      model option. in particular:
+      !!            mbathy must have at least 1 land grid-points (mbathy<=0)
+      !!                  along closed boundary.
+      !!            mbathy must be cyclic IF jperio=1.
+      !!            mbathy must be lower or equal to jpk-1.
+      !!            isolated ocean grid points are suppressed from mbathy
+      !!                  since they are only connected to remaining
+      !!                  ocean through vertical diffusion.
+      !!      ntopo=-1 :   rectangular channel or bassin with a bump 
+      !!      ntopo= 0 :   flat rectangular channel or basin 
+      !!      ntopo= 1 :   mbathy is read in 'bathy_level' file
+      !!                   bathy  is read in 'bathy_meter.nc' NetCDF file
+      !!      C A U T I O N : mbathy will be modified during the initializa-
+      !!      tion phase to become the number of non-zero w-levels of a water
+      !!      column, with a minimum value of 1.
+      !!
+      !! ** Action  : - mbathy: level bathymetry (in level index)
+      !!              - bathy : meter bathymetry (in meters)
+      !!
+      !! History :
+      !!   9.0  !  03-08  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Local declarations
+      CHARACTER (len=15) ::  &
+         clexp ,                     &  ! temporary characters
+         clname                         !    "           "
+      LOGICAL ::   llbon                ! check the existence of bathy files
+      INTEGER ::   ji, jj, jl, jn, jk   ! dummy loop indices
+      INTEGER ::   inum = 11            ! temporary logical unit
+      INTEGER ::   &
+         iim, ijm, ifreq,            &  ! temporary integers
+         il1, il2, ij, ii               ! (user to read "bathy_level" file
+      INTEGER  ::   &
+         ipi, ipj, ipk,              &  ! temporary integers
+         itime,                      &  !    "          "
+         ii_bump, ij_bump               ! bump center position
+      INTEGER, DIMENSION (1) ::   istep
+      INTEGER , DIMENSION(jpidta,jpjdta) ::   &
+         idta                           ! global domain integer data
+      REAL(wp) ::   &
+         r_bump, h_bump, h_oce,      &  ! bump characteristics 
+         zi, zj, zdate0                 ! temporary scalars
+      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
+         zlamt, zphit,               &  ! temporary workspace (NetCDF read)
+         zdta                           ! global domain scalar data
+      REAL(wp), DIMENSION(jpk) ::   &
+         zdept                          ! temporary workspace (NetCDF read)
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bat : defines level and meter bathymetry'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~'
+
+      ! ========================================
+      ! global domain level and meter bathymetry (idta,zdta)
+      ! ========================================
+      !                                               ! =============== ! 
+      IF( ntopo == 0 .OR. ntopo == -1 ) THEN          ! defined by hand !
+         !                                            ! =============== !
+
+         IF( ntopo == 0 ) THEN                        ! flat basin
+
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin'
+
+            idta(:,:) = jpkm1                            ! flat basin 
+            zdta(:,:) = gdepw(jpk)
+
+         ELSE                                         ! bump
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin with a bump'
+
+            ii_bump = jpidta / 3 + 3       ! i-index of the bump center
+            ij_bump = jpjdta / 2           ! j-index of the bump center
+            r_bump  =    6              ! bump radius (index)       
+            h_bump  =  240.e0           ! bump height (meters)
+            h_oce   = gdepw(jpk)        ! background ocean depth (meters)
+            IF(lwp) WRITE(numout,*) '            bump characteristics: '
+            IF(lwp) WRITE(numout,*) '               bump center (i,j)   = ', ii_bump, ii_bump
+            IF(lwp) WRITE(numout,*) '               bump height         = ', h_bump , ' meters'
+            IF(lwp) WRITE(numout,*) '               bump radius         = ', r_bump , ' index'
+            IF(lwp) WRITE(numout,*) '            background ocean depth = ', h_oce  , ' meters'
+            ! zdta :
+            DO jj = 1, jpjdta
+               DO ji = 1, jpidta
+                  zi = FLOAT( ji - ii_bump ) / r_bump      
+                  zj = FLOAT( jj - ij_bump ) / r_bump       
+                  zdta(ji,jj) = h_oce - h_bump * EXP( -( zi*zi + zj*zj ) )
+               END DO
+            END DO
+            ! idta :
+            idta(:,:) = jpkm1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjdta
+                  DO ji = 1, jpidta
+                     IF( gdepw(jk) < zdta(ji,jj) .AND. zdta(ji,jj) <= gdepw(jk+1) )   idta(ji,jj) = jk
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
+         ! set boundary conditions (caution, idta on the global domain: use of jperio, not nperio)
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+            idta( : , 1 ) = -1                ;      zdta( : , 1 ) = -1.e0
+            idta( : ,jpj) =  0                ;      zdta( : ,jpj) =  0.e0
+         ELSEIF( jperio == 2 ) THEN
+            idta( : , 1 ) = idta( : ,  3  )   ;      zdta( : , 1 ) = zdta( : ,  3  )
+            idta( : ,jpj) = 0                 ;      zdta( : ,jpj) =  0.e0
+            idta( 1 , : ) = 0                 ;      zdta( 1 , : ) =  0.e0
+            idta(jpi, : ) = 0                 ;      zdta(jpi, : ) =  0.e0
+         ELSE
+            idta( : , 1 ) = 0                 ;      zdta( : , 1 ) =  0.e0
+            idta( : ,jpj) = 0                 ;      zdta( : ,jpj) =  0.e0
+            idta( 1 , : ) = 0                 ;      zdta( 1 , : ) =  0.e0
+            idta(jpi, : ) = 0                 ;      zdta(jpi, : ) =  0.e0
+         ENDIF
+
+         !                                            ! =============== !
+      ELSEIF( ntopo == 1 ) THEN                       !   read in file  !
+         !                                            ! =============== !
+
+         clname = 'bathy_level'                          ! level bathymetry
+         INQUIRE( FILE=clname, EXIST=llbon )
+         IF( llbon ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         read level bathymetry in ', clname
+            IF(lwp) WRITE(numout,*)
+!!bugs      OPEN( UNIT=inum, FILE=clname, FORM='FORMATTED', ACCESS='SEQUENTIAL', RECL=1 )
+            OPEN( UNIT=inum, FILE=clname, FORM='FORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD' )
+
+         REWIND(inum)
+         READ  (inum,9101) clexp, iim, ijm
+         READ  (inum,'(/)')
+         ifreq = 40
+         il1   = 1
+         DO jn = 1, jpidta/ifreq+1
+            READ(inum,'(/)')
+            il2 = MIN( jpidta, il1+ifreq-1 )
+            READ(inum,9201) ( ii, ji = il1, il2, 5 )
+            READ(inum,'(/)')
+            DO jj = jpjdta, 1, -1
+               READ(inum,9202) ij, ( idta(ji,jj), ji = il1, il2 )
+            END DO
+            il1 = il1 + ifreq
+         END DO
+            CLOSE(inum)
+9101     FORMAT(1x,a15,2i8)
+9201     FORMAT(3x,13(i3,12x))
+9202     FORMAT(i3,41i3)
+
+         ELSE
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*)'    zgr_bat : unable to read the file', clname
+            nstop = nstop + 1
+         ENDIF     
+
+         clname = 'bathy_meter.nc'                       ! meter bathymetry
+         INQUIRE( FILE=clname, EXIST=llbon )
+         IF( llbon ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         read meter bathymetry in ', clname
+            IF(lwp) WRITE(numout,*)
+            itime = 1
+            ipi = jpi
+            ipj = jpj
+            ipk = 1
+            CALL flinopen( clname, jpizoom, jpi, jpjzoom, jpj, .FALSE.,   &    
+                           ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, rdt, inum )
+            CALL flinget( inum, 'Bathymetry', jpidta, jpjdta, 1,   &
+                          itime, 1, 1, jpizoom, jpi, jpjzoom, jpj, zdta(:,:) ) 
+            CALL flinclo( inum )
+         ELSE
+            IF( lk_zps .OR. lk_sco ) THEN
+               IF(lwp) WRITE(numout,cform_err)       
+               IF(lwp) WRITE(numout,*)'    zgr_bat : unable to read the file', clname
+               nstop = nstop + 1
+            ELSE
+               zdta(:,:) = 0.e0
+               IF(lwp) WRITE(numout,*)'    zgr_bat : bathy_meter not found, but not used, bathy array set to zero'
+            ENDIF
+         ENDIF
+         !                                            ! =============== !
+      ELSE                                            !      error      !
+         !                                            ! =============== !
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          parameter , ntopo = ', ntopo
+         nstop = nstop + 1
+      ENDIF
+
+
+      ! =======================================
+      ! local domain level and meter bathymetry (mbathy,bathy)
+      ! =======================================
+
+      mbathy(:,:) = 0                                 ! set to zero extra halo points
+      bathy (:,:) = 0.e0                              ! (require for mpp case)
+
+      DO jj = 1, nlcj                                 ! interior values
+         DO ji = 1, nlci
+            mbathy(ji,jj) = idta( mig(ji), mjg(jj) )
+            bathy (ji,jj) = zdta( mig(ji), mjg(jj) )
+         END DO
+      END DO
+
+      ! =======================
+      ! NO closed seas or lakes
+      ! =======================
+
+      IF( .NOT. lclosea ) THEN
+         DO jl = 1, jpncs
+            DO jj = ncsj1(jl), ncsj2(jl)
+               DO ji = ncsi1(jl), ncsi2(jl)
+                  mbathy(ji,jj) = 0                   ! suppress closed seas
+                  bathy (ji,jj) = 0.e0                ! and lakes
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! ===========
+      ! Zoom domain 
+      ! ===========
+
+      IF( lzoom )   CALL zgr_bat_zoom
+
+      ! ================
+      ! Bathymetry check
+      ! ================
+
+      CALL zgr_bat_ctl
+
+   END SUBROUTINE zgr_bat
+
+
+   SUBROUTINE zgr_bat_zoom
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bat_zoom  ***
+      !!
+      !! ** Purpose : - Close zoom domain boundary if necessary
+      !!              - Suppress Med Sea from ORCA R2 and R05 arctic zoom
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : - update mbathy: level bathymetry (in level index)
+      !!
+      !! History :
+      !!   9.0  !  03-08  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local variables
+      INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integers
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bat_zoom : modify the level bathymetry for zoom domain'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~'
+
+      ! Zoom domain
+      ! ===========
+
+      ! Forced closed boundary if required
+      IF( lzoom_e )   mbathy( mi0(jpizoom):mi1(jpizoom) , :  ) = 0
+      IF( lzoom_s )   mbathy(  : , mj0(jpjzoom):mj1(jpjzoom) ) = 0
+      IF( lzoom_w )   mbathy( mi0(jpidta ):mi1(jpidta ) , :  ) = 0
+      IF( lzoom_n )   mbathy(  : , mj0(jpjdta ):mj1(jpjdta ) ) = 0
+
+      ! Configuration specific domain modifications
+      ! (here, ORCA arctic configuration: suppress Med Sea)
+      IF( cp_cfg == "orca" .AND. lzoom_arct ) THEN
+         SELECT CASE ( jp_cfg )
+         !                                        ! =======================
+         CASE ( 2 )                               !  ORCA_R2 configuration
+            !                                     ! =======================
+            IF(lwp) WRITE(numout,*) '                   ORCA R2 arctic zoom: suppress the Med Sea'
+
+            ii0 = 141   ;   ii1 = 162      ! Sea box i,j indices
+            ij0 =  98   ;   ij1 = 110
+            !                                     ! =======================
+         CASE ( 05 )                              !  ORCA_R05 configuration
+            !                                     ! =======================
+            IF(lwp) WRITE(numout,*) '                   ORCA R05 arctic zoom: suppress the Med Sea'
+  
+            ii0 = 563   ;   ii1 = 642      ! zero over the Med Sea boxe
+            ij0 = 314   ;   ij1 = 370 
+
+         END SELECT
+         !
+         mbathy( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0   ! zero over the Med Sea boxe
+         !
+      ENDIF
+
+   END SUBROUTINE zgr_bat_zoom
+
+
+   SUBROUTINE zgr_bat_ctl
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bat_ctl  ***
+      !!
+      !! ** Purpose :   check the bathymetry in levels
+      !!
+      !! ** Method  :   The array mbathy is checked to verified its consistency
+      !!      with the model options. in particular:
+      !!            mbathy must have at least 1 land grid-points (mbathy<=0)
+      !!                  along closed boundary.
+      !!            mbathy must be cyclic IF jperio=1.
+      !!            mbathy must be lower or equal to jpk-1.
+      !!            isolated ocean grid points are suppressed from mbathy
+      !!                  since they are only connected to remaining
+      !!                  ocean through vertical diffusion.
+      !!      C A U T I O N : mbathy will be modified during the initializa-
+      !!      tion phase to become the number of non-zero w-levels of a water
+      !!      column, with a minimum value of 1.
+      !!
+      !! ** Action  : - update mbathy: level bathymetry (in level index)
+      !!              - update bathy : meter bathymetry (in meters)
+      !!
+      !! History :
+      !!   9.0  !  03-08  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj, jl           ! dummy loop indices
+      INTEGER ::   &
+         icompt, ibtest, ikmax          ! temporary integers
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zbathy                         ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_bat_ctl : check the bathymetry'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~'
+
+      ! ================
+      ! Bathymetry check
+      ! ================
+
+      ! Suppress isolated ocean grid points
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)'                   suppress isolated ocean grid points'
+      IF(lwp) WRITE(numout,*)'                   -----------------------------------'
+
+      icompt = 0
+
+      DO jl = 1, 2
+
+         IF( nperio == 1 .OR. nperio  ==  4 .OR. nperio  ==  6 ) THEN
+            mbathy( 1 ,:) = mbathy(jpim1,:)
+            mbathy(jpi,:) = mbathy(  2  ,:)
+         ENDIF
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ibtest = MAX( mbathy(ji-1,jj), mbathy(ji+1,jj),   &
+                  mbathy(ji,jj-1),mbathy(ji,jj+1) )
+               IF( ibtest < mbathy(ji,jj) ) THEN
+                  IF(lwp) WRITE(numout,*) ' the number of ocean level at ',   &
+                     'grid-point (i,j) =  ',ji,jj,' is changed from ',   &
+                     mbathy(ji,jj),' to ', ibtest
+                  mbathy(ji,jj) = ibtest
+                  icompt = icompt + 1
+               ENDIF
+            END DO
+         END DO
+
+      END DO
+      IF( icompt == 0 ) THEN
+         IF(lwp) WRITE(numout,*)'     no isolated ocean grid points'
+      ELSE
+         IF(lwp) WRITE(numout,*)'    ',icompt,' ocean grid points suppressed'
+      ENDIF
+#if defined key_mpp
+      zbathy(:,:) = FLOAT( mbathy(:,:) )
+      CALL lbc_lnk( zbathy, 'T', 1. )
+      mbathy(:,:) = INT( zbathy(:,:) )
+#endif
+
+      ! 3.2 East-west cyclic boundary conditions
+
+      IF( nperio == 0 ) THEN
+         IF(lwp) WRITE(numout,*) ' mbathy set to 0 along east and west',   &
+            ' boundary: nperio = ', nperio
+#if defined key_mpp
+         IF( nbondi == -1 .OR. nbondi == 2 ) THEN
+            IF( jperio /= 1 )   mbathy(1,:) = 0
+         ENDIF
+         IF( nbondi == 1 .OR. nbondi == 2 ) THEN
+            IF( jperio /= 1 )   mbathy(nlci,:) = 0
+         ENDIF
+#else
+         mbathy( 1 ,:) = 0
+         mbathy(jpi,:) = 0
+#endif
+      ELSEIF( nperio == 1 .OR. nperio == 4 .OR. nperio ==  6 ) THEN
+         IF(lwp) WRITE(numout,*)' east-west cyclic boundary conditions',   &
+            ' on mbathy: nperio = ', nperio
+         mbathy( 1 ,:) = mbathy(jpim1,:)
+         mbathy(jpi,:) = mbathy(  2  ,:)
+      ELSEIF( nperio == 2 ) THEN
+         IF(lwp) WRITE(numout,*) '   equatorial boundary conditions',   &
+            ' on mbathy: nperio = ', nperio
+      ELSE
+         IF(lwp) WRITE(numout,*) '    e r r o r'
+         IF(lwp) WRITE(numout,*) '    parameter , nperio = ', nperio
+         !         STOP 'dom_mba'
+      ENDIF
+
+      ! Set to zero mbathy over islands if necessary  (l_isl=F)
+      IF( .NOT. l_isl ) THEN    ! No island
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '         mbathy set to 0 over islands'
+         IF(lwp) WRITE(numout,*) '         ----------------------------'
+
+         mbathy(:,:) = MAX( 0, mbathy(:,:) )
+
+         !  Boundary condition on mbathy
+#   if ! defined key_mpp
+         !!bug ???  y reflechir!
+         !   ... mono- or macro-tasking: T-point, >0, 2D array, no slab
+         zbathy(:,:) = FLOAT( mbathy(:,:) )
+         CALL lbc_lnk( zbathy, 'T', 1. )
+         mbathy(:,:) = INT( zbathy(:,:) )
+#   endif
+
+      ENDIF
+
+      ! Number of ocean level inferior or equal to jpkm1
+
+      ikmax = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ikmax = MAX( ikmax, mbathy(ji,jj) )
+         END DO
+      END DO
+      !!! test a faire:   ikmax = MAX( mbathy(:,:) )   ???
+
+      IF( ikmax > jpkm1 ) THEN
+         IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' >  jpk-1'
+         IF(lwp) WRITE(numout,*) ' change jpk to ',ikmax+1,' to use the exact ead bathymetry'
+      ELSE IF( ikmax < jpkm1 ) THEN
+         IF(lwp) WRITE(numout,*) ' maximum number of ocean level = ', ikmax,' < jpk-1' 
+         IF(lwp) WRITE(numout,*) ' you can decrease jpk to ', ikmax+1
+      ENDIF
+
+      IF( lwp .AND. nprint == 1 ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' bathymetric field '
+         WRITE(numout,*) ' ------------------'
+         WRITE(numout,*) ' number of non-zero T-levels '
+         CALL prihin( mbathy, jpi, jpj, 1, jpi,   &
+                      1     , 1  , jpj, 1, 3  ,   &
+                      numout )
+         WRITE(numout,*)
+      ENDIF
+
+   END SUBROUTINE zgr_bat_ctl
+
+
+#  include "domzgr_zps.h90"
+
+
+#  include "domzgr_s.h90"
+
+
+   !!======================================================================
+END MODULE domzgr
Index: /branches/nemo/NEMO/OPA_SRC/DOM/domzgr_s.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/domzgr_s.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/domzgr_s.h90	(revision 4)
@@ -0,0 +1,253 @@
+   !!----------------------------------------------------------------------
+   !!                     ***  domzgr.s.h90  ***
+   !!----------------------------------------------------------------------
+
+#if defined key_s_coord
+   !!----------------------------------------------------------------------
+   !!   'key_s_coord' :                                        s-coordinate
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE zgr_s
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_s  ***
+      !!                     
+      !! ** Purpose :   define the s-coordinate system
+      !!
+      !! ** Method  :   s-coordinate
+      !!         The depth of model levels is defined as the product of an
+      !!      analytical function by the local bathymetry, while the vertical
+      !!      scale factors are defined as the product of the first derivative
+      !!      of the analytical function by the bathymetry.
+      !!      (this solution save memory as depth and scale factors are not
+      !!      3d fields)
+      !!          - Read bathymetry (in meters) at t-point and compute the
+      !!         bathymetry at u-, v-, and f-points.
+      !!            hbatu = mi( hbatt )
+      !!            hbatv = mj( hbatt )
+      !!            hbatf = mi( mj( hbatt ) )
+      !!          - Compute gsigt, gsigw, esigt, esigw from an analytical
+      !!         function and its derivative given as statement function.
+      !!            gsigt(k) = fssig (k+0.5)
+      !!            gsigw(k) = fssig (k    )
+      !!            esigt(k) = fsdsig(k+0.5)
+      !!            esigw(k) = fsdsig(k    )
+      !!      This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order a!!uracy
+      !!      schemes.
+      !!
+      !! Reference :
+      !!      Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.
+      !!
+      !! History :
+      !!        !  95-12  (G. Madec)  Original code : s vertical coordinate
+      !!        !  97-07  (G. Madec)  lbc_lnk call
+      !!        !  97-04  (J.-O. Beismann) 
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER  ::   in
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   fssig, fsdsig, pfkk
+      REAL(wp) ::   zh0, zdz1, zdzn, zd, za, zb, zc, zdepmi
+
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      ! a. Sigma stretching coefficient
+      !      hyperbolic stretching sigma= za(in-jk)^3+zb(in-jk)^2+zc(in-jk)+zd
+      !      hyperbolic stretching sigma= za(jk)^3+zb(jk)^2+zc(jk)+zd
+      !  calculate stretching coefficients (to ensure
+      !        ss(sigma) =1 at sigma=1,  and -1 at sigma=-1)
+      !        sigma =1 at the surface (k=1) and  =-1 at the bottom (k=jpk)
+      !   the only free parameters are the depths of the  first level
+      !   dz1 and of the last level(zdzn) in meters (given as a positive
+      !   quantity).
+      
+      fssig(pfkk) =-0.5* ( ( ( za*(pfkk-1.) + zb ) * (pfkk-1.) + zc ) * (pfkk-1.) + zd -1. )
+
+      ! b. Vertical derivative of sigma stretching coefficient
+      
+      fsdsig(pfkk)= 0.5*( ( 3.*za*(pfkk-1.) + 2.*zb )* (pfkk-1.) + zc )
+      
+      ! ------------------ stretching polynomial ------------------------
+      
+      ! SPEM coefficients
+      ! spem opa: kopa= jpk-kspem
+      !        pfkk =in-jk (spem) <==> pfkk=in-jk-jpk=-jk-1  (opa)
+
+      zh0  = 5500.
+      zdz1 = 800.
+      zdzn = 17.5
+      in   = 19
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' stretching with a third order polynamial'
+         WRITE(numout,*) ' h0 = ',zh0
+         WRITE(numout,*) ' at ',zh0,'  dz(1)= z(1)-z(0)   = ',zdz1
+         WRITE(numout,*) '             dz(n)= z(n)-z(n-1) = ',zdzn
+      ENDIF
+
+      za =     - 2.*(zdz1+zdzn)/zh0/float(in-1)/float(in-2)   &
+                + 4./float(in)/float(in-1)/float(in-2)
+
+      zb =     - 6./float(in-1)/float(in-2)   &
+                + 2.*(zdz1*float(in+1)+ zdzn*float(2*in-1))   &
+                /zh0/float(in-2)/float(in-1)
+
+      zc =     -2.*zdzn*float(in)/zh0/float(in-2)   &
+                -2.*zdz1*float(in)/zh0/float(in-1)/float(in-2)   &
+                +(6.* float(in) - 4.)/float(in)/float(in-1)/float(in-2)
+
+      zd =     1.
+
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+
+      ! 1. Lecture and computation of hbat fields
+      ! -----------------------------------------
+
+      ! 1.1 Read hbatt (in meters)
+      ! 1.2 Set the hbatt to negative value   ???
+
+      hbatt(:,:) = - bathy(:,:)
+
+
+      ! 1.3 Set a minimum depth  (zdepmi)
+
+      zdepmi = -50.
+      IF( zdepmi >= 0. ) THEN
+         IF(lwp) WRITE(numout,*)'domzgr: the minimum depth must be < 0'
+         STOP 'domzgr'
+      ENDIF
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            hbatt(ji,jj) = MIN( hbatt(ji,jj), zdepmi )
+            hbatu(ji,jj) = zdepmi
+            hbatv(ji,jj) = zdepmi
+            hbatf(ji,jj) = zdepmi
+         END DO
+      END DO
+
+      CALL lbc_lnk( hbatt, 'T', 1. )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: minimum depth set to : ',zdepmi
+         WRITE(numout,*)
+      ENDIF
+
+      ! 1.4 Control print
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: hbatt field; ocean depth in meters'
+         WRITE(numout,*)
+         CALL prihre(hbatt(1,1),jpi,jpj,1,jpi,1,1,jpj,1,0.,numout)
+      ENDIF
+
+      ! 1.5 Compute hbat fields at u-, v-, f-points
+
+      DO jj = 1, jpjm1
+        DO ji = 1, jpim1
+           hbatu(ji,jj)= 0.5 *( hbatt(ji  ,jj)+hbatt(ji+1,jj  ) ) * umask(ji,jj,1)
+           hbatv(ji,jj)= 0.5 *( hbatt(ji  ,jj)+hbatt(ji  ,jj+1) ) * vmask(ji,jj,1)
+           hbatf(ji,jj)= 0.25*( hbatt(ji  ,jj)+hbatt(ji  ,jj+1)   &
+                               +hbatt(ji+1,jj)+hbatt(ji+1,jj+1) ) * fmask(ji,jj,1)
+        END DO
+      END DO
+
+      CALL lbc_lnk( hbatu, 'U', 1. )
+      CALL lbc_lnk( hbatv, 'V', 1. )
+      CALL lbc_lnk( hbatf, 'F', 1. )
+
+
+      ! 2. Computation of gsig and esig fields
+      ! --------------------------------------
+
+      ! 2.1 Coefficients for model level depth at w- and t-levels
+
+      DO jk = 1, jpk
+         gsigw(jk) = -fssig ( float(jk)    )
+         gsigt(jk) = -fssig ( float(jk)+0.5)
+      END DO
+
+      ! 2.2 Coefficients for vertical scale factors at w-, t- levels
+
+      DO jk = 1, jpk
+         esigw(jk)=fsdsig( float(jk)    )
+         esigt(jk)=fsdsig( float(jk)+0.5)
+      END DO
+
+      ! 2.3 Coefficients for vertical depth as the sum of e3w scale factors
+
+      gsi3w(1) = 0.5 * esigw(1)
+      DO jk = 2, jpk
+        gsi3w(jk) = gsi3w(jk-1)+ esigw(jk)
+      END DO
+
+      ! 2.4 Control print
+
+      IF(lwp) THEN
+         WRITE(numout,*) 
+         WRITE(numout,*) ' domzgr: vertical coefficients for model level'
+         WRITE(numout,9400)
+         WRITE(numout,9410) (jk,gsigt(jk),gsigw(jk),esigt(jk),esigw(jk),gsi3w(jk),jk=1,jpk)
+      ENDIF
+ 9400 FORMAT(9x,' level   gsigt    gsigw    esigt    esigw    gsi3w')
+ 9410 FORMAT(10x,i4,5f9.2)
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: vertical coordinates : point (10,10,k)'
+         WRITE(numout,*) ' ~~~~~~  --------------------'
+         WRITE(numout,9420)
+         WRITE(numout,9430) (jk,fsdept(10,10,jk),fsdepw(10,10,jk),     &
+                             fse3t (10,10,jk),fse3w (10,10,jk),jk=1,jpk)
+      ENDIF
+
+ 9420 FORMAT(9x,' level   gdept    gdepw    gde3w     e3t      e3w  ')
+ 9430 FORMAT(10x,i4,4f9.2)
+
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( fse3w(ji,jj,jk) <= 0. .OR. fse3t(ji,jj,jk) <= 0. ) THEN
+                  IF(lwp) THEN
+                     WRITE(numout,*)
+                     WRITE(numout,*) ' e r r o r :         e3w or e3t =< 0 '
+                     WRITE(numout,*) ' =========           --------------- '
+                     WRITE(numout,*)
+                     WRITE(numout,*) '             point (i,j,k)= ',ji,jj,jk
+                     WRITE(numout,*)
+                  ENDIF
+                  STOP 'domzgr'
+               ENDIF
+               IF( fsdepw(ji,jj,jk) < 0. .OR. fsdept(ji,jj,jk) < 0. ) THEN
+                  IF(lwp) THEN
+                     WRITE(numout,*)
+                     WRITE(numout,*) ' e r r o r :      gdepw or gdept < 0 '
+                     WRITE(numout,*) ' =========        ------------------ '
+                     WRITE(numout,*)
+                     WRITE(numout,*) '             point (i,j,k)= ',ji,jj,jk
+                     WRITE(numout,*)
+                  ENDIF
+                  STOP 'domzgr'
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE zgr_s
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                      Empty routine
+   !!----------------------------------------------------------------------
+   SUBROUTINE zgr_s
+   END SUBROUTINE zgr_s
+#endif
Index: /branches/nemo/NEMO/OPA_SRC/DOM/domzgr_substitute.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/domzgr_substitute.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/domzgr_substitute.h90	(revision 4)
@@ -0,0 +1,57 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  domzgr_substitute.h90   ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute fsdep. and fse.., the vert. depth and scale
+   !!      factors depending on the vertical coord. used, using CPP macro.
+   !!----------------------------------------------------------------------
+#if defined key_s_coord
+   !! s-coord:  substitution  fsdep.(,,) ==>  hbat.(,) * gsig.()
+   !!                         fse3.(,,)  ==>  hbat.(,) * esig.()
+#   define  fsdept(i,j,k)   hbatt(i,j)*gsigt(k)
+#   define  fsdepu(i,j,k)   hbatu(i,j)*gsigt(k)
+#   define  fsdepv(i,j,k)   hbatv(i,j)*gsigt(k)
+#   define  fsdepf(i,j,k)   hbatf(i,j)*gsigt(k)
+#   define  fsdepw(i,j,k)   hbatt(i,j)*gsigw(k)
+#   define  fsdepuw(i,j,k)  hbatu(i,j)*gsi3w(k)
+#   define  fsdepvw(i,j,k)  hbatv(i,j)*gsi3w(k)
+#   define  fsde3w(i,j,k)   hbatt(i,j)*gsi3w(k)
+#   define  fse3t(i,j,k)    hbatt(i,j)*esigt(k)
+#   define  fse3u(i,j,k)    hbatu(i,j)*esigt(k)
+#   define  fse3v(i,j,k)    hbatv(i,j)*esigt(k)
+#   define  fse3f(i,j,k)    hbatf(i,j)*esigt(k)
+#   define  fse3w(i,j,k)    hbatt(i,j)*esigw(k)
+#   define  fse3uw(i,j,k)   hbatu(i,j)*esigw(k)
+#   define  fse3vw(i,j,k)   hbatv(i,j)*esigw(k)
+#elif defined key_partial_steps
+   !! z-coord:  substitution  fsdep.(,,) ==>  gdep._ps()
+   !!                         fse3.(,,)  ==>  e3._ps()
+#   define  fsdept(i,j,k)   gdept_ps(i,j,k)
+#   define  fsdepw(i,j,k)   gdepw_ps(i,j,k)
+#   define  fsde3w(i,j,k)   gdep3w(i,j,k)
+#   define  fsdepuw(i,j,k)  gdepw(k)
+#   define  fsdepvw(i,j,k)  gdepw(k)
+#   define  fse3t(i,j,k)    e3t_ps(i,j,k)
+#   define  fse3u(i,j,k)    e3u_ps(i,j,k)
+#   define  fse3v(i,j,k)    e3v_ps(i,j,k)
+#   define  fse3f(i,j,k)    e3f_ps(i,j,k)
+#   define  fse3w(i,j,k)    e3w_ps(i,j,k)
+#   define  fse3uw(i,j,k)   e3uw_ps(i,j,k)
+#   define  fse3vw(i,j,k)   e3vw_ps(i,j,k)
+#else
+   !! z-coord:  substitution  fsdep.(,,) ==>  gdep()
+   !!                         fse3.(,,)  ==>  e3.()
+#   define  fsdept(i,j,k)   gdept(k)
+#   define  fsdepu(i,j,k)   gdept(k)
+#   define  fsdepv(i,j,k)   gdept(k)
+#   define  fsdepf(i,j,k)   gdept(k)
+#   define  fsdepw(i,j,k)   gdepw(k)
+#   define  fsdepuw(i,j,k)  gdepw(k)
+#   define  fsdepvw(i,j,k)  gdepw(k)
+#   define  fse3t(i,j,k)   e3t(k)
+#   define  fse3u(i,j,k)   e3t(k)
+#   define  fse3v(i,j,k)   e3t(k)
+#   define  fse3f(i,j,k)   e3t(k)
+#   define  fse3w(i,j,k)   e3w(k)
+#   define  fse3uw(i,j,k)  e3w(k)
+#   define  fse3vw(i,j,k)  e3w(k)
+#endif
Index: /branches/nemo/NEMO/OPA_SRC/DOM/domzgr_zps.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DOM/domzgr_zps.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DOM/domzgr_zps.h90	(revision 4)
@@ -0,0 +1,429 @@
+   !!----------------------------------------------------------------------
+   !!                      ***  domzgr_zps.h90  ***
+   !!----------------------------------------------------------------------
+
+#if defined key_partial_steps
+   !!----------------------------------------------------------------------
+   !!   'key_partial_steps' :               z-coordinate with partial steps
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE zgr_zps
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_zps  ***
+      !!                     
+      !! ** Purpose :   the depth and vertical scale factor in partial step
+      !!      z-coordinate case
+      !!
+      !! ** Method  :   Partial steps : computes the 3D vertical scale factors
+      !!      of T-, U-, V-, W-, UW-, VW and F-points that are associated with
+      !!      a partial step representation of bottom topography.
+      !!
+      !!        The reference depth of model levels is defined from an analytical
+      !!      function the derivative of which gives the reference vertical
+      !!      scale factors.
+      !!        From  depth and scale factors reference, we compute there new value
+      !!      with partial steps  on 3d arrays ( i, j, k ).
+      !!
+      !!              w-level: gdepw_ps(i,j,k)  = fsdep(k)
+      !!                       e3w_ps(i,j,k) = dk(fsdep)(k)     = fse3(i,j,k)
+      !!              t-level: gdept_ps(i,j,k)  = fsdep(k+0.5)
+      !!                       e3t_ps(i,j,k) = dk(fsdep)(k+0.5) = fse3(i,j,k+0.5)
+      !!
+      !!        With the help of the bathymetric file ( bathymetry_depth_ORCA_R2.nc),
+      !!      we find the mbathy index of the depth at each grid point.
+      !!      This leads us to three cases:
+      !!
+      !!              - bathy = 0 => mbathy = 0
+      !!              - 1 < mbathy < jpkm1    
+      !!              - bathy > gdepw(jpk) => mbathy = jpkm1  
+      !!
+      !!        Then, for each case, we find the new depth at t- and w- levels
+      !!      and the new vertical scale factors at t-, u-, v-, w-, uw-, vw- 
+      !!      and f-points.
+      !! 
+      !!        This routine is given as an example, it must be modified
+      !!      following the user s desiderata. nevertheless, the output as
+      !!      well as the way to compute the model levels and scale factors
+      !!      must be respected in order to insure second order accuracy
+      !!      schemes.
+      !!
+      !!         c a u t i o n : gdept, gdepw and e3 are positives
+      !!         - - - - - - -   gdept_ps, gdepw_ps and e3_ps are positives
+      !!      
+      !!  Reference :
+      !!     Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
+      !!
+      !!  History :
+      !!    8.5  !  02-09 (A. Bozec, G. Madec)  F90: Free form and module
+      !!    9.0  !  02-09 (A. de Miranda)  rigid-lid + islands
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      INTEGER  ::   &
+         ik, it            ! temporary integers
+      
+      REAL(wp) ::   &  
+         ze3tp, ze3wp,    &  ! Last ocean level thickness at T- and W-points
+         zdepwp,          &  ! Ajusted ocean depth to avoid too small e3t
+         zdepth,          &  !    "         "
+         zmax, zmin,      &  ! Maximum and minimum depth
+         zdiff               ! temporary scalar
+
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zprt  !    "           "
+
+      LOGICAL ::  ll_print                          ! Allow  control print for debugging
+
+      !!---------------------------------------------------------------------
+      !! OPA8.5, LODYC-IPSL (2002)
+      !!---------------------------------------------------------------------
+      
+      ! Local variable for debugging
+      ll_print=.FALSE.
+!!!   ll_print=.TRUE.
+      
+      ! Initialization of constant
+      zmax = gdepw(jpk) + e3t(jpk)
+      zmin = gdepw(4)
+      
+      ! Ocean depth
+      IF(lwp .AND. ll_print) THEN 
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_zgr_zps:  bathy (in hundred of meters)'
+         CALL prihre( bathy, jpi, jpj, 1,jpi, 1, 1, jpj, 1, 1.e-2, numout )
+      ENDIF
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_zps : z-coordinate with partial steps'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~ '
+      IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used'
+
+
+      ! bathymetry in level (from bathy_meter)
+      ! ===================
+
+      ! initialize mbathy to the maximum ocean level available
+      mbathy(:,:) = jpkm1
+
+      ! storage of land and island's number (zera and negative values) in mbathy
+      DO jj = 1, jpj
+         DO ji= 1, jpi
+            IF( bathy(ji,jj) <= 0. )   mbathy(ji,jj) = INT( bathy(ji,jj) )
+         END DO
+      END DO
+
+      ! bounded value of bathy
+      ! minimum depth == 3 levels
+      ! maximum depth == gdepw(jpk)+e3t(jpk) 
+      ! i.e. the last ocean level thickness cannot exceed e3t(jpkm1)+e3t(jpk)
+      DO jj = 1, jpj
+         DO ji= 1, jpi
+            IF( bathy(ji,jj) <= 0. ) THEN
+               bathy(ji,jj) = 0.e0
+            ELSE
+               bathy(ji,jj) = MAX( bathy(ji,jj), zmin )
+               bathy(ji,jj) = MIN( bathy(ji,jj), zmax )
+            ENDIF
+         END DO
+      END DO
+
+      ! Compute mbathy for ocean points (i.e. the number of ocean levels)
+      ! find the number of ocean levels such that the last level thickness
+      ! is larger than the minimum of e3zps_min and e3zps_rat * e3t (where
+      ! e3t is the reference level thickness
+      DO jk = jpkm1, 1, -1
+         zdepth = gdepw(jk) + MIN( e3zps_min, e3t(jk)*e3zps_rat )
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( 0. < bathy(ji,jj) .AND. bathy(ji,jj) <= zdepth )   mbathy(ji,jj) = jk-1
+            END DO
+         END DO
+      END DO
+
+     ! Scale factors and depth at T- and W-points
+     
+     ! intitialization to the reference z-coordinate
+     DO jk = 1, jpk
+        gdept_ps(:,:,jk) = gdept(jk)
+        gdepw_ps(:,:,jk) = gdepw(jk)
+        e3t_ps(:,:,jk) = e3t(jk)
+        e3w_ps(:,:,jk) = e3w(jk)
+     END DO
+     hdept(:,:) = gdept_ps(:,:,2 )
+     hdepw(:,:) = gdepw_ps(:,:,3 )     
+     
+     ! 
+     DO jj = 1, jpj
+        DO ji = 1, jpi
+           ik = mbathy(ji,jj)
+           ! ocean point only
+           IF( ik > 0 ) THEN
+              ! max ocean level case
+              IF( ik == jpkm1 ) THEN
+                 zdepwp = bathy(ji,jj)
+                 ze3tp  = bathy(ji,jj) - gdepw(ik)
+                 ze3wp = 0.5 * e3w(ik) * ( 1. + ( ze3tp/e3t(ik) ) )
+                 e3t_ps(ji,jj,ik  ) = ze3tp
+                 e3t_ps(ji,jj,ik+1) = ze3tp
+                 e3w_ps(ji,jj,ik  ) = ze3wp
+                 e3w_ps(ji,jj,ik+1) = ze3tp
+                 gdepw_ps(ji,jj,ik+1) = zdepwp
+                 gdept_ps(ji,jj,ik  ) = gdept(ik-1) + ze3wp
+                 gdept_ps(ji,jj,ik+1) = gdept_ps(ji,jj,ik) + ze3tp
+                 ! standard case
+              ELSE
+!!alex
+                 IF( bathy(ji,jj) <= gdepw(ik+1) ) THEN
+                    gdepw_ps(ji,jj,ik+1) = bathy(ji,jj)
+                 ELSE
+!!alex ctl          write(*,*) 'zps',ji,jj,'bathy', bathy(ji,jj), 'depw_ps ',gdepw(ik+1)
+                    gdepw_ps(ji,jj,ik+1) = gdepw(ik+1)
+                 ENDIF
+!!Alex
+!!Alex           gdepw_ps(ji,jj,ik+1) = bathy(ji,jj)
+                 gdept_ps(ji,jj,ik  ) =  gdepw(ik) + ( gdepw_ps(ji,jj,ik+1) - gdepw(ik))   &
+                                      * ((gdept   (      ik  ) - gdepw(ik))   &
+                                      / ( gdepw   (      ik+1) - gdepw(ik)))
+                 e3t_ps(ji,jj,ik) = e3t(ik) * ( gdepw_ps(ji,jj,ik+1) - gdepw(ik))   & 
+                                  /( gdepw   (      ik+1) - gdepw(ik)) 
+                 e3w_ps(ji,jj,ik) = 0.5 *( gdepw_ps(ji,jj,ik+1) + gdepw(ik+1)-2.*gdepw(ik))   &
+                                  *( e3w(ik) / ( gdepw(ik+1) - gdepw(ik)))
+                 !       ... on ik+1
+                 e3w_ps(ji,jj,ik+1) = e3t_ps(ji,jj,ik)
+                 e3t_ps(ji,jj,ik+1) = e3t_ps(ji,jj,ik)
+                 gdept_ps(ji,jj,ik+1) = gdept_ps(ji,jj,ik) + e3t_ps  (ji,jj,ik)
+              ENDIF
+           ENDIF
+        END DO
+     END DO
+
+     it = 0
+     DO jj = 1, jpj
+        DO ji = 1, jpi
+           ik = mbathy(ji,jj)
+           ! ocean point only
+           IF( ik > 0 ) THEN
+              ! bathymetry output
+              hdept(ji,jj) = gdept_ps(ji,jj,ik  )
+              hdepw(ji,jj) = gdepw_ps(ji,jj,ik+1)
+              e3tp (ji,jj) = e3t_ps(ji,jj,ik  )
+              e3wp (ji,jj) = e3w_ps(ji,jj,ik  )
+              ! test
+              zdiff= gdepw_ps(ji,jj,ik+1) - gdept_ps(ji,jj,ik  )
+              IF( zdiff <= 0. .AND. lwp ) THEN 
+                 it=it+1
+                 WRITE(numout,*) ' it      = ', it, ' ik      = ', ik, ' (i,j) = ', ji, jj
+                 WRITE(numout,*) ' bathy = ', bathy(ji,jj)
+                 WRITE(numout,*) ' gdept_ps= ', gdept_ps(ji,jj,ik), ' gdepw_ps= ', gdepw_ps(ji,jj,ik+1),   &
+                                 ' zdiff   = ', zdiff
+                 WRITE(numout,*) ' e3tp    = ', e3t_ps(ji,jj,ik  ), ' e3wp    = ', e3w_ps(ji,jj,ik  )
+              ENDIF
+           ENDIF
+        END DO
+      END DO
+
+      ! Scale factors and depth at U-, V-, UW and VW-points
+
+      ! initialisation to z-scale factors
+      DO jk = 1, jpk
+         e3u_ps (:,:,jk)  = e3t(jk)
+         e3v_ps (:,:,jk)  = e3t(jk)
+         e3uw_ps(:,:,jk)  = e3w(jk)
+         e3vw_ps(:,:,jk)  = e3w(jk)
+      END DO
+
+     ! Computed as the minimum of neighbooring scale factors
+     DO jk = 1,jpk
+        DO jj = 1, jpjm1
+           DO ji = 1, fs_jpim1   ! vector opt.
+              e3u_ps (ji,jj,jk) = MIN( e3t_ps(ji,jj,jk), e3t_ps(ji+1,jj,jk))
+              e3v_ps (ji,jj,jk) = MIN( e3t_ps(ji,jj,jk), e3t_ps(ji,jj+1,jk))
+              e3uw_ps(ji,jj,jk) = MIN( e3w_ps(ji,jj,jk), e3w_ps(ji+1,jj,jk) )
+              e3vw_ps(ji,jj,jk) = MIN( e3w_ps(ji,jj,jk), e3w_ps(ji,jj+1,jk) )
+           END DO
+        END DO
+     END DO
+     
+     ! Boundary conditions
+     CALL lbc_lnk( e3u_ps , 'U', 1. )   ;   CALL lbc_lnk( e3uw_ps, 'U', 1. )
+     CALL lbc_lnk( e3v_ps , 'V', 1. )   ;   CALL lbc_lnk( e3vw_ps, 'V', 1. )
+     
+     ! set to z-scale factor if zero (i.e. along closed boundaries)
+     DO jk = 1, jpk
+        DO jj = 1, jpj
+           DO ji = 1, jpi
+              IF( e3u_ps (ji,jj,jk) == 0.e0 ) e3u_ps (ji,jj,jk) = e3t(jk)
+              IF( e3v_ps (ji,jj,jk) == 0.e0 ) e3v_ps (ji,jj,jk) = e3t(jk)
+              IF( e3uw_ps(ji,jj,jk) == 0.e0 ) e3uw_ps(ji,jj,jk) = e3w(jk)
+              IF( e3vw_ps(ji,jj,jk) == 0.e0 ) e3vw_ps(ji,jj,jk) = e3w(jk)
+           END DO
+        END DO
+     END DO
+     
+     ! Scale factor at F-point
+     
+     ! initialisation to z-scale factors
+     DO jk = 1, jpk
+        e3f_ps (:,:,jk) = e3t(jk)
+     END DO
+     
+     ! Computed as the minimum of neighbooring V-scale factors
+     DO jk = 1, jpk
+        DO jj = 1, jpjm1
+           DO ji = 1, fs_jpim1   ! vector opt.
+              e3f_ps(ji,jj,jk) = MIN( e3v_ps(ji,jj,jk), e3v_ps(ji+1,jj,jk) )
+           END DO
+        END DO
+     END DO
+     ! Boundary conditions
+     CALL lbc_lnk( e3f_ps, 'F', 1. )
+     
+     ! set to z-scale factor if zero (i.e. along closed boundaries)
+     DO jk = 1, jpk
+        DO jj = 1, jpj
+           DO ji = 1, jpi
+              IF( e3f_ps(ji,jj,jk) == 0.e0 ) e3f_ps(ji,jj,jk) = e3t(jk)
+           END DO
+        END DO
+     END DO
+     ! we duplicate factor scales for jj = 1 and jj = 2
+     e3t_ps(:,1,:) = e3t_ps(:,2,:) 
+     e3w_ps(:,1,:) = e3w_ps(:,2,:) 
+     e3u_ps(:,1,:) = e3u_ps(:,2,:) 
+     e3v_ps(:,1,:) = e3v_ps(:,2,:) 
+     e3f_ps(:,1,:) = e3f_ps(:,2,:) 
+
+     
+     ! Compute gdep3w (vertical sum of e3w)
+     
+     gdep3w   (:,:,1) = 0.5 * e3w_ps (:,:,1)
+     DO jk = 2, jpk
+        gdep3w   (:,:,jk) = gdep3w   (:,:,jk-1) + e3w_ps (:,:,jk) 
+     END DO
+          
+     ! Control print
+ 9600 FORMAT(9x,' level   gdept    gdepw     e3t      e3w   ')
+ 9610 FORMAT(10x,i4,4f9.2)
+      IF(lwp .AND. ll_print) THEN
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               ik = MAX(mbathy(ji,jj),1)
+               zprt(ji,jj) = e3t_ps(ji,jj,ik)
+            END DO
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3t(mbathy)'
+         CALL prihre(zprt,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               ik = MAX(mbathy(ji,jj),1)
+               zprt(ji,jj) = e3w_ps(ji,jj,ik)
+            END DO
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3w(mbathy)'
+         CALL prihre(zprt,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               ik = MAX(mbathy(ji,jj),1)
+               zprt(ji,jj) = e3u_ps(ji,jj,ik)
+            END DO
+         END DO
+
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3u(mbathy)'
+         CALL prihre(zprt,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               ik = MAX(mbathy(ji,jj),1)
+               zprt(ji,jj) = e3v_ps(ji,jj,ik)
+            END DO
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3v(mbathy)'
+         CALL prihre(zprt,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               ik = MAX(mbathy(ji,jj),1) 
+               zprt(ji,jj) = e3f_ps(ji,jj,ik)
+            END DO
+         END DO
+
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3f(mbathy)'
+         CALL prihre(zprt,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               ik =  MAX(mbathy(ji,jj),1)
+               zprt(ji,jj) = gdep3w(ji,jj,ik)
+            END DO
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr gdep3w(mbathy)'
+         CALL prihre(zprt,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+
+      ENDIF  
+
+
+      DO jk = 1,jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi 
+               IF( e3w_ps(ji,jj,jk) <= 0. .or. e3t_ps(ji,jj,jk) <= 0. ) THEN
+                  IF(lwp) THEN
+                     WRITE(numout,*) ' e r r o r :         e3w or e3t =< 0 '
+                     WRITE(numout,*) ' =========           --------------- '
+                     WRITE(numout,*)
+                  ENDIF
+                  STOP 'domzgr.psteps'
+               ENDIF
+               IF( gdepw_ps(ji,jj,jk) < 0. .or. gdept_ps(ji,jj,jk) < 0. ) THEN
+                  IF(lwp) THEN
+                     WRITE(numout,*) ' e r r o r :      gdepw or gdept < 0 '
+                     WRITE(numout,*) ' =========        ------------------ '
+                     WRITE(numout,*)
+                  ENDIF
+                  STOP 'domzgr.psteps'
+               ENDIF
+            END DO
+         END DO
+      END DO  
+
+   IF(lwp) THEN
+      WRITE(numout,*) ' e3t lev 21 '
+      CALL prihre(e3t_ps(1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout)
+      WRITE(numout,*) ' e3w lev 21  '
+      CALL prihre(e3w_ps(1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout)
+      WRITE(numout,*) ' e3u lev 21  '
+      CALL prihre(e3u_ps(1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout)
+      WRITE(numout,*) ' e3v lev 21  '
+      CALL prihre(e3v_ps(1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout)
+      WRITE(numout,*) ' e3f lev 21  '
+      CALL prihre(e3f_ps(1,1,21),jpi,jpj,50,59,1,1,5,1,0.,numout)
+      WRITE(numout,*) ' e3t lev 22 '
+      CALL prihre(e3t_ps(1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout)
+      WRITE(numout,*) ' e3w lev 22  '
+      CALL prihre(e3w_ps(1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout)
+      WRITE(numout,*) ' e3u lev 22  '
+      CALL prihre(e3u_ps(1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout)
+      WRITE(numout,*) ' e3v lev 22  '
+      CALL prihre(e3v_ps(1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout)
+      WRITE(numout,*) ' e3f lev 22  '
+      CALL prihre(e3f_ps(1,1,22),jpi,jpj,50,59,1,1,5,1,0.,numout)
+   ENDIF
+
+      ! ================
+      ! Bathymetry check
+      ! ================
+
+      CALL zgr_bat_ctl
+
+
+   END SUBROUTINE zgr_zps
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                      Empty routine
+   !!----------------------------------------------------------------------
+   SUBROUTINE zgr_zps
+   END SUBROUTINE zgr_zps
+#endif
Index: /branches/nemo/NEMO/OPA_SRC/DTA/dtasal.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DTA/dtasal.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DTA/dtasal.F90	(revision 4)
@@ -0,0 +1,289 @@
+MODULE dtasal
+   !!======================================================================
+   !!                     ***  MODULE  dtasal  ***
+   !! Ocean data  :  read ocean salinity data from monthly atlas data
+   !!=====================================================================
+#if defined key_dtasal   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_dtasal'                                          salinity data
+   !!----------------------------------------------------------------------
+   !!   dta_sal      : read ocean salinity data
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dta_sal   ! called by step.F90 and inidta.F90
+   
+   !! * Shared module variables
+   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .TRUE.    ! salinity data flag
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &
+      s_dta       ! salinity data at given time-step
+
+   !! * Module variables
+   INTEGER ::   &
+      nlecsa = 0,   &  ! switch for the first read
+      nsal1     ,   &  ! first record used
+      nsal2            ! second record used
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
+      saldta    ! salinity data at two consecutive times
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+# if defined key_fdir
+   !!----------------------------------------------------------------------
+   !!   'key_fdir'                                       direct access file
+   !!----------------------------------------------------------------------
+#     include "dtasal_fdir.h90"
+# else
+   !!----------------------------------------------------------------------
+   !!   Default option:                                         NetCDF file
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dta_sal( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dta_sal  ***
+      !!        
+      !! ** Purpose :   Reads monthly salinity data
+      !!             
+      !! ** Method  : - Read on unit numsdt the monthly salinity data interpo-
+      !!     lated onto the model grid.
+      !!              - At each time step, a linear interpolation is applied
+      !!     between two monthly values.
+      !!
+      !! History :
+      !!        !  91-03  ()  Original code
+      !!        !  92-07  (M. Imbard)
+      !!   9.0  !  02-06  (G. Madec)  F90: Free form and module 
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Arguments
+      INTEGER, INTENT(in) ::   kt             ! ocean time step
+
+      !! * Local declarations
+      CHARACTER (len=32) ::   clname
+
+      INTEGER, PARAMETER ::   jpmois = 12, jpf = 1
+      INTEGER ::   ji, jj, jk, jl    ! dummy loop indicies
+      INTEGER ::   &
+         imois, iman, ik, i15,  &  ! temporary integers
+         ipi, ipj, ipk, itime      !    "          "
+      INTEGER, DIMENSION(jpmois) ::   istep
+      REAL(wp) ::   &
+         zxy, zl, zdate0
+      REAL(wp), DIMENSION(jpi,jpj) ::   zlon, zlat
+      REAL(wp), DIMENSION(jpk) ::   zlev
+      !!----------------------------------------------------------------------
+
+
+      ! 0. Initialization
+      ! -----------------
+
+      iman  = jpmois
+      i15   = nday / 16
+
+      imois = nmonth + i15 - 1
+      IF( imois == 0 ) imois = iman
+
+      itime = jpmois
+      ipi=jpiglo
+      ipj=jpjglo
+      ipk = jpk
+
+      ! 1. First call kt=nit000
+      ! -----------------------
+
+      IF( kt == nit000 .AND. nlecsa == 0 ) THEN
+         nsal1 = 0
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file'
+            WRITE(numout,*) ' ~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         ! open file
+         
+         clname = 'data_1m_salinity_nomask'
+         CALL flinopen(TRIM(clname),mig(1),nlci,mjg(1),nlcj,.FALSE.   &
+              ,ipi,ipj,ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numsdt)
+
+         ! title, dimensions and tests
+
+         IF( itime /= jpmois ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'problem with time coordinates'
+               WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
+            ENDIF
+            STOP 'dtasal_monthly.h90'
+         ENDIF
+         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= jpk ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'problem with dimensions'
+               WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
+               WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
+               WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
+            ENDIF
+            STOP 'dtasal_monthly.h90'
+         ENDIF
+         IF(lwp)WRITE(numout,*) itime,istep,zdate0,rdt,numsdt
+
+      ENDIF
+
+
+      ! 2. Read monthly file
+      ! -------------------
+
+      IF( ( kt == nit000 .AND. nlecsa == 0) .OR. imois /= nsal1 ) THEN
+         nlecsa = 1
+         
+         ! 2.1 Calendar computation
+         
+         nsal1 = imois        ! first file record used 
+         nsal2 = nsal1 + 1    ! last  file record used
+         nsal1 = MOD( nsal1, iman )
+         IF( nsal1 == 0 ) nsal1 = iman
+         nsal2 = MOD( nsal2, iman )
+         IF( nsal2 == 0 ) nsal2 = iman
+         IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1
+         IF(lwp) WRITE(numout,*) 'last  record file used nsal2 ', nsal2
+         
+         ! 2.3 Read monthly salinity data Levitus 
+
+         CALL flinget(numsdt,'vosaline',jpidta,jpjdta,jpk,jpmois,nsal1,   &
+           nsal1,mig(1),nlci,mjg(1),nlcj,saldta(1:nlci,1:nlcj,1:jpk,1))
+
+         CALL flinget(numsdt,'vosaline',jpidta,jpjdta,jpk,jpmois,nsal2,   &
+           nsal2,mig(1),nlci,mjg(1),nlcj,saldta(1:nlci,1:nlcj,1:jpk,2))
+
+         
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' read Levitus salinity ok'
+            WRITE(numout,*)
+         ENDIF
+         
+#  if defined key_tradmp
+         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
+
+            !                                        ! =======================
+            !                                        !  ORCA_R2 configuration
+            !                                        ! =======================
+         
+            DO jj = mj0(101), mj1(109)                      ! Reduced salinity in the Alboran Sea
+               DO ji = mi0(141), mi1(155)
+                  DO jk = 13, 13
+                     saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.15
+                  END DO
+                  DO jk = 14, 15
+                     saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.25
+                  END DO
+                  DO jk = 16, 17
+                     saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.30
+                  END DO
+                  DO jk = 18, 25
+                     saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.35
+                  END DO
+               END DO
+            END DO
+            IF( n_cla == 1 ) THEN 
+               !                                         ! New salinity profile at Gibraltar
+               saldta( mi0(139):mi1(139) , mj0(101):mj1(101) , : , : ) =   &
+                  &                                    saldta( mi0(138):mi1(138) , mj0(101):mj1(101) , : , : )
+               saldta( mi0(139):mi1(139) , mj0(102):mj1(102) , : , : ) =   &
+                  &                                    saldta( mi0(138):mi1(138) , mj0(102):mj1(102) , : , : )
+               DO jl = mi0(138), mi1(138)                ! New temperature profile at Gibraltar
+                  DO jj = mj0(101), mj1(102)
+                     DO ji = mi0(139), mi1(139)
+                        saldta(ji,jj,:,:) = saldta(jl,jj,:,:)
+                     END DO
+                  END DO
+               END DO
+
+               DO jl = mi0(164), mi1(164)                ! New salinity profile at Bab el Mandeb
+                  DO jj = mj0(88), mj1(88)
+                     DO ji = mi0(161), mi1(163)
+                        saldta(ji,jj,:,:) = saldta(jl,jj,:,:)
+                     END DO
+                  END DO
+                  DO jj = mj0(87), mj1(87)
+                     DO ji = mi0(161), mi1(163)
+                        saldta(ji,jj,:,:) = saldta(jl,jj,:,:)
+                     END DO
+                  END DO
+               END DO
+
+            ENDIF
+
+         ENDIF
+#endif
+         
+         !                                     ! Mask
+         DO jl = 1, 2
+            saldta(:,:,:,jl) = saldta(:,:,:,jl)*tmask(:,:,:)
+            saldta(:,:,jpk,jl) = 0.
+            IF( lk_zps ) THEN                   ! z-coord. partial steps
+               DO jj = 1, jpj                           ! interpolation of salinity at the last ocean level (i.e. the partial step)
+                  DO ji = 1, jpi
+                     ik = mbathy(ji,jj) - 1
+                     IF( ik > 2 ) THEN
+                        zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) )
+                        saldta(ji,jj,ik,jl) = (1.-zl) * saldta(ji,jj,ik,jl) +zl * saldta(ji,jj,ik-1,jl) 
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
+         END DO
+         
+
+         IF(lwp) THEN
+            WRITE(numout,*)' salinity Levitus month ',nsal1,nsal2
+            WRITE(numout,*)
+            WRITE(numout,*) ' Levitus mounth = ',nsal1,'  level = 1'
+            CALL prihre(saldta(1,1,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
+            WRITE(numout,*) ' Levitus mounth = ',nsal1,'  level = ',jpk/2
+            CALL prihre(saldta(1,1,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
+            WRITE(numout,*) ' Levitus mounth = ',nsal1,'  level = ',jpkm1
+            CALL prihre(saldta(1,1,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
+         ENDIF
+      ENDIF
+      
+ 
+      ! 3. At every time step compute salinity data
+      ! -------------------------------------------
+
+      zxy = FLOAT(nday + 15 - 30*i15)/30.
+      s_dta(:,:,:) = ( 1.- zxy ) * saldta(:,:,:,1) + zxy * saldta(:,:,:,2)
+
+   END SUBROUTINE dta_sal
+
+# endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option:                                    NO salinity data
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dtasal = .FALSE.   ! salinity data flag
+CONTAINS
+   SUBROUTINE dta_sal( kt )        ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE dta_sal
+#endif
+   !!======================================================================
+END MODULE dtasal
Index: /branches/nemo/NEMO/OPA_SRC/DTA/dtasal_fdir.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DTA/dtasal_fdir.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DTA/dtasal_fdir.h90	(revision 4)
@@ -0,0 +1,156 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  dtasal_fdir  ***
+   !!----------------------------------------------------------------------
+   !!   dta_sal   : read monthly salinity data in direct access file
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dta_sal( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dta_sal  ***
+      !!                    
+      !! ** Purpose :   Reads monthly salinity data 
+      !!                             
+      !! ** Method  :   Direct acces file case
+      !!     Read on unit numsdt the interpolated Levitus salinity onto
+      !!     the global grid.
+      !!     The value is centered at the middle of month.
+      !!     At each time step, a linear interpolation is applied between
+      !!     two monthly values.
+      !!
+      !! History :
+      !!        !  91-03  ()  Original code
+      !!        !  92-07  (M. Imbard)
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(in) ::   kt             ! ocean time step
+
+      !! * Local declarations
+      INTEGER ,PARAMETER :: jpmois= 12   &  ! number on month in file
+            &              ,jpf   = 1       ! number of fields
+      INTEGER :: ji,jj,jk,jl,ios, ik
+      INTEGER :: imois,iman
+      INTEGER :: iimlu,ijmlu,ikmlu,ilmlu,immlu
+      INTEGER :: i15, ibloc, ilindta
+      REAL(wp) ::  zxy, zl
+      CHARACTER (len=20) ::   cltit
+      !!----------------------------------------------------------------------
+
+
+      ! 0. Initialization
+      ! -----------------
+
+      iman  = jpmois
+      i15 = nday/16
+
+      imois = nmonth + i15 - 1
+      IF( imois == 0 ) imois = iman
+
+
+      ! 1. First call kt=nit000
+      ! -----------------------
+
+      IF( kt == nit000 .AND. nlecsa == 0 ) THEN
+         ! open sal.dta file
+         ibloc = 4096
+         ilindta = ibloc*((jpidta*jpjdta*jpbytda-1 )/ibloc+1)
+         CALL ctlopn(numsdt,'data_1m_salinity_nomask','OLD', 'UNFORMATTED', 'DIRECT',   &
+                     ilindta,numout,lwp,1)
+         nsal1 = 0
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'dta_sal : read monthly salinity in direct acces file in unit= ', numsdt
+            WRITE(numout,*) '~~~~~~~ '
+            WRITE(numout,*)
+         ENDIF
+
+         ! 1.2 Read first records
+         
+         ! title, dimensions and tests
+
+         READ (numsdt,REC=1,IOSTAT=ios) cltit, iimlu, ijmlu, ikmlu,   &
+                                        ilmlu, immlu
+         IF( ios /= 0 ) THEN
+            IF(lwp) WRITE(numout,*) 'e r r o r read numsdt ',ios
+            STOP 'dtasal'
+         ELSE
+            IF ( iimlu /= jpidta ) STOP 4050
+            IF ( ijmlu /= jpjdta ) STOP 4060
+            IF ( ikmlu /= jpk    ) STOP 4070
+            IF ( ilmlu /= jpmois ) STOP 4080
+            IF ( immlu /= jpf    ) STOP 4090
+            IF(lwp) WRITE(numout,*) 'nb of points in the 5 directions '
+            IF(lwp) WRITE(numout,*) iimlu, ijmlu, ikmlu, ilmlu, immlu
+         ENDIF
+
+      ENDIF
+
+
+      ! 2. Read monthly file
+      ! -------------------
+
+      IF( ( kt == nit000 .AND. nlecsa == 0 ) .OR. imois /= nsal1 ) THEN
+         nlecsa = 1
+
+         ! 2.1 Calendar computation
+
+         nsal1 = imois        ! first file record used 
+         nsal2 = nsal1 + 1    ! last  file record used
+         nsal1 = MOD( nsal1, iman )
+         IF( nsal1 == 0 ) nsal1 = iman
+         nsal2 = MOD( nsal2, iman )
+         IF( nsal2 == 0 ) nsal2 = iman
+         IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1
+         IF(lwp) WRITE(numout,*) 'last  record file used nsal2 ', nsal2
+
+         ! 2.3 Read monthly salinity data Levitus 
+
+         CALL read3d(numsdt,saldta(1,1,1,1),nsal1+1)
+         CALL read3d(numsdt,saldta(1,1,1,2),nsal2+1)
+         
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' read Levitus salinity ok'
+            WRITE(numout,*)
+         ENDIF
+
+         ! 2.4 Masks
+
+         DO jl = 1, 2
+            saldta(:,:,:,jl) = saldta(:,:,:,jl)*tmask(:,:,:)
+            saldta(:,:,jpk,jl) = 0.
+            IF( lk_zps ) THEN                   ! z-coordinate with partial steps
+               DO jj = 1, jpj                           ! interpolation of salinity at the last ocean level (i.e. the partial step)
+                  DO ji = 1, jpi
+                     ik = mbathy(ji,jj) - 1
+                     IF( ik > 2 ) THEN
+                        zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) )
+                        saldta(ji,jj,ik,jl) = (1.-zl) * saldta(ji,jj,ik,jl) +zl * saldta(ji,jj,ik-1,jl)
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
+         END DO
+
+         IF(lwp) THEN
+            WRITE(numout,*)' salinity Levitus month ',nsal1,nsal2
+            WRITE(numout,*)
+            WRITE(numout,*) ' Levitus mounth = ',nsal1,'  level = 1'
+            CALL prihre(saldta(1,1,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
+            WRITE(numout,*) ' Levitus mounth = ',nsal1,'  level = ',jpk/2
+            CALL prihre(saldta(1,1,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
+            WRITE(numout,*) ' Levitus mounth = ',nsal1,'  level = ',jpkm1
+            CALL prihre(saldta(1,1,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
+         ENDIF
+      ENDIF
+
+
+      ! 3. At every time step compute salinity data
+      ! ----------------------------------------------
+
+      zxy = FLOAT(nday + 15 - 30*i15)/30.
+      sdta(:,:,:)= ( (1.-zxy)*saldta(:,:,:,1) + zxy*saldta(:,:,:,2) )
+
+   END SUBROUTINE dta_sal
Index: /branches/nemo/NEMO/OPA_SRC/DTA/dtasal_monthly.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DTA/dtasal_monthly.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DTA/dtasal_monthly.h90	(revision 4)
@@ -0,0 +1,229 @@
+   !!----------------------------------------------------------------------
+   !!                     ***  dtasal_monthly.h90  ***
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dta_sal( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dta_sal  ***
+      !!        
+      !! ** Purpose :   Reads monthly salinity data
+      !!             
+      !! ** Method  :   Read on unit numsdt the interpolated Levitus salinity onto 
+      !!     onto the model grid.
+      !!     Data begin at january. 
+      !!     The value is centered at the middle of month.
+      !!     In the opa model, kt=1 agree with january 1.
+      !!     At each time step, a linear interpolation is applied between 
+      !!     two monthly values.
+      !!
+      !! History :
+      !!        !  91-03  ()  Original code
+      !!        !  92-07  (M. Imbard)
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Arguments
+      INTEGER, INTENT(in) ::   kt             ! ocean time step
+
+      !! * Local declarations
+      CHARACTER (len=32) ::   clname
+
+      INTEGER, PARAMETER ::   jpmois = 12, jpf = 1
+      INTEGER ::   ji, jj, jk, jl    ! dummy loop indicies
+      INTEGER ::   &
+         imois, iman, ik, i15,  &  ! temporary integers
+         ipi, ipj, ipk, itime      !    "          "
+      INTEGER, DIMENSION(jpmois) ::   istep
+      REAL(wp) ::   &
+         zxy, zl, zdate0
+      REAL(wp), DIMENSION(jpi,jpj) ::   zlon, zlat
+      REAL(wp), DIMENSION(jpk) ::   zlev
+      !!----------------------------------------------------------------------
+
+
+      ! 0. Initialization
+      ! -----------------
+
+      iman  = jpmois
+      i15   = nday / 16
+
+      imois = nmonth + i15 - 1
+      IF( imois == 0 ) imois = iman
+
+      itime = jpmois
+      ipi=jpiglo
+      ipj=jpjglo
+      ipk = jpk
+
+      ! 1. First call kt=nit000
+      ! -----------------------
+
+      IF( kt == nit000 .AND. nlecsa == 0 ) THEN
+         nsal1 = 0
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file'
+            WRITE(numout,*) ' ~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         ! open file
+         
+         clname = 'LEVITUS_1m_Salinity_Ice_nomask'
+         CALL flinopen(TRIM(clname),mig(1),nlci,mjg(1),nlcj,.FALSE.   &
+              ,ipi,ipj,ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numsdt)
+
+         ! title, dimensions and tests
+
+         IF( itime /= jpmois ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'problem with time coordinates'
+               WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
+            ENDIF
+            STOP 'dtasal_monthly.h90'
+         ENDIF
+         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= jpk ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'problem with dimensions'
+               WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
+               WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
+               WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
+            ENDIF
+            STOP 'dtasal_monthly.h90'
+         ENDIF
+         IF(lwp)WRITE(numout,*) itime,istep,zdate0,rdt,numsdt
+
+      ENDIF
+
+
+      ! 2. Read monthly file
+      ! -------------------
+
+      IF( ( kt == nit000 .AND. nlecsa == 0) .OR. imois /= nsal1 ) THEN
+         nlecsa = 1
+         
+         ! 2.1 Calendar computation
+         
+         nsal1 = imois        ! first file record used 
+         nsal2 = nsal1 + 1    ! last  file record used
+         nsal1 = MOD( nsal1, iman )
+         IF( nsal1 == 0 ) nsal1 = iman
+         nsal2 = MOD( nsal2, iman )
+         IF( nsal2 == 0 ) nsal2 = iman
+         IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1
+         IF(lwp) WRITE(numout,*) 'last  record file used nsal2 ', nsal2
+         
+         ! 2.3 Read monthly salinity data Levitus 
+
+         CALL flinget(numsdt,'vosaline',jpidta,jpjdta,jpk,jpmois,nsal1,   &
+           nsal1,mig(1),nlci,mjg(1),nlcj,saldta(1:nlci,1:nlcj,1:jpk,1))
+
+         CALL flinget(numsdt,'vosaline',jpidta,jpjdta,jpk,jpmois,nsal2,   &
+           nsal2,mig(1),nlci,mjg(1),nlcj,saldta(1:nlci,1:nlcj,1:jpk,2))
+
+         
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' read Levitus salinity ok'
+            WRITE(numout,*)
+         ENDIF
+         
+#  if defined key_tradmp
+         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
+
+            !                                        ! =======================
+            !                                        !  ORCA_R2 configuration
+            !                                        ! =======================
+         
+            DO jj = mj0(101), mj1(109)                      ! Reduced salinity in the Alboran Sea
+               DO ji = mi0(141), mi1(155)
+                  DO jk = 13, 13
+                     saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.15
+                  END DO
+                  DO jk = 14, 15
+                     saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.25
+                  END DO
+                  DO jk = 16, 17
+                     saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.30
+                  END DO
+                  DO jk = 18, 25
+                     saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.35
+                  END DO
+               END DO
+            END DO
+            IF( n_cla == 1 ) THEN 
+               !                                         ! New salinity profile at Gibraltar
+               saldta( mi0(139):mi1(139) , mj0(101):mj1(101) , : , : ) =   &
+                  &                                    saldta( mi0(138):mi1(138) , mj0(101):mj1(101) , : , : )
+               saldta( mi0(139):mi1(139) , mj0(102):mj1(102) , : , : ) =   &
+                  &                                    saldta( mi0(138):mi1(138) , mj0(102):mj1(102) , : , : )
+               DO jl = mi0(138), mi1(138)                ! New temperature profile at Gibraltar
+                  DO jj = mj0(101), mj1(102)
+                     DO ji = mi0(139), mi1(139)
+                        saldta(ji,jj,:,:) = saldta(jl,jj,:,:)
+                     END DO
+                  END DO
+               END DO
+
+               DO jl = mi0(164), mi1(164)                ! New salinity profile at Bab el Mandeb
+                  DO jj = mj0(88), mj1(88)
+                     DO ji = mi0(161), mi1(163)
+                        saldta(ji,jj,:,:) = saldta(jl,jj,:,:)
+                     END DO
+                  END DO
+                  DO jj = mj0(87), mj1(87)
+                     DO ji = mi0(161), mi1(163)
+                        saldta(ji,jj,:,:) = saldta(jl,jj,:,:)
+                     END DO
+                  END DO
+               END DO
+
+            ENDIF
+
+         ENDIF
+#endif
+         
+         !                                     ! Mask
+         DO jl = 1, 2
+            saldta(:,:,:,jl) = saldta(:,:,:,jl)*tmask(:,:,:)
+            saldta(:,:,jpk,jl) = 0.
+            IF( lk_zps ) THEN                   ! z-coord. partial steps
+               DO jj = 1, jpj                           ! interpolation of salinity at the last ocean level (i.e. the partial step)
+                  DO ji = 1, jpi
+                     ik = mbathy(ji,jj) - 1
+                     IF( ik > 2 ) THEN
+                        zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) )
+                        saldta(ji,jj,ik,jl) = (1.-zl) * saldta(ji,jj,ik,jl) +zl * saldta(ji,jj,ik-1,jl) 
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
+         END DO
+         
+
+         IF(lwp) THEN
+            WRITE(numout,*)' salinity Levitus month ',nsal1,nsal2
+            WRITE(numout,*)
+            WRITE(numout,*) ' Levitus mounth = ',nsal1,'  level = 1'
+            CALL prihre(saldta(1,1,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
+            WRITE(numout,*) ' Levitus mounth = ',nsal1,'  level = ',jpk/2
+            CALL prihre(saldta(1,1,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
+            WRITE(numout,*) ' Levitus mounth = ',nsal1,'  level = ',jpkm1
+            CALL prihre(saldta(1,1,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
+         ENDIF
+      ENDIF
+      
+ 
+      ! 3. At every time step compute salinity data
+      ! -------------------------------------------
+
+      zxy = FLOAT(nday + 15 - 30*i15)/30.
+      sdta(:,:,:)= ( (1.-zxy)*saldta(:,:,:,1) + zxy*saldta(:,:,:,2) )
+
+   END SUBROUTINE dta_sal
Index: /branches/nemo/NEMO/OPA_SRC/DTA/dtasst.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DTA/dtasst.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DTA/dtasst.F90	(revision 4)
@@ -0,0 +1,255 @@
+MODULE dtasst
+   !!======================================================================
+   !!                       ***  MODULE  dtasst  ***
+   !! Data : Sea Surface Temperature (SST)
+   
+   !!      BUG initialisation  nyearsst !!!!!!bug
+   
+   !!======================================================================
+   
+   !!----------------------------------------------------------------------
+   !!   dta_sst      : Reynolds sst data
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE ocfzpt          ! ???
+   USE daymod          ! calendar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Shared routine
+   PUBLIC dta_sst
+
+   !! * Shared module variables
+#if defined key_dtasst
+   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasst = .TRUE.   ! sst data flag
+#else
+   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasst = .TRUE.   ! sst data flag
+#endif
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &
+      sst             ! surface temperature
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2) ::   &
+      rclice          ! climatological ice index (0/1) (2 months)
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , IPSL-LODYC  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined key_dtasst
+   !!----------------------------------------------------------------------
+   !!   'key_dtasst'                                               SST data
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dta_sst( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dta_sst  ***
+      !!                    
+      !! ** Purpose :   Read Reynolds weekly mean sea surface temperature 
+      !!      data and update it at each time step.
+      !!
+      !! ** Method  : - Read a specific REYNOLDS daily sst in Celcius.
+      !!              -  Compute a climatological ice cover rclice (0 or 1)
+      !!
+      !! ** Action  : - sst (Celcius)
+      !!              - rclice, ice/ocean mask (0 or 1)
+      !!
+      !! History :
+      !!        !  90-03  (O. Marti and Ph Dandin)  Original code
+      !!        !  92-07  (M. Imbard)
+      !!        !  96-11  (E. Guilyardi)  Daily AGCM input files
+      !!        !  00-04  (M. Imbard)  NetCDF FORMAT
+      !!        !  00-10  (J.-P. Boulanger)  passage ORCA a TDH
+      !!        !  01-10  (A. Lazar)  Reynolds default
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!        !  02-11  (C. Levy)  MPP/MPI NetCDF read
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+      
+      !! * Arguments
+      INTEGER ::   kt
+
+      !! * Local save
+      INTEGER, SAVE ::   &
+      ndaysst,        &  ! new day for Reynolds sst
+      nyearsst           ! new year for Reynolds sst
+
+      !! * Local declarations
+      INTEGER ::   ji, jj
+      INTEGER ::   iprint
+      INTEGER ::   iy, iday, idy
+      INTEGER ::   istep(366)
+      INTEGER ::   ipi, ipj, ipk
+
+      REAL(wp) ::   zdate0, zdt, ztgel
+      REAL(wp) ::   zlon(jpi,jpj), zlat(jpi,jpj), zlev(jpk)
+      CHARACTER (len=45) ::   &
+         clname = "sst_1d.nc"      ! filename for daily SST
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dta_sst : DAILY sea surface temperature data'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   read in file: ', clname
+      ENDIF
+
+
+      ! 0. initialization
+      ! -----------------
+
+      ipi = jpiglo
+      ipj = jpjglo
+      ipk = jpk
+
+      IF( nleapy == 0 ) THEN
+         idy=365
+      ELSEIF( nleapy == 1 ) THEN
+         IF( MOD( nyear, 4 ) == 0 ) THEN
+            idy=366
+         ELSE
+            idy=365
+         ENDIF
+      ELSEIF( nleapy == 30 ) THEN
+         IF(lwp) WRITE(numout,*) 'dtasst : nleapy = 30 is not compatible'
+         IF(lwp) WRITE(numout,*) '         with existing files'
+         IF(lwp) WRITE(numout,*) 'WE STOP'
+         STOP 1234
+      ENDIF
+      
+      
+      ! 2. Open files if nyearsst
+      ! -------------------------
+
+      IF( nyearsst /= nyear ) THEN
+         nyearsst = nyear
+         iprint   = 1
+         
+         !  2.1 Define file name and record
+         
+         !   Close/open file if new year 
+         
+         IF( nyearsst /= 0 )   CALL flinclo(numsst)
+         iy = nyear
+         IF(lwp) WRITE (numout,*) iy
+         IF(lwp) WRITE (numout,*) 'open sst file = ', clname
+         CALL FLUSH(numout)
+         
+         CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj, .FALSE., ipi, ipj   &
+            , ipk, zlon, zlat, zlev, idy, istep, zdate0, zdt, numsst )
+         
+         IF( ipi /= jpidta .OR. ipj /= jpjdta ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'problem with dimensions'
+            IF(lwp) WRITE(numout,*) ' ipi ', ipi, ' jpidta ', jpidta
+            IF(lwp) WRITE(numout,*) ' ipj ', ipj, ' jpjdta ', jpjdta
+            nstop = nstop + 1
+         ENDIF
+         IF(lwp) WRITE(numout,*) idy, istep, zdate0, zdt
+      ELSE
+         iprint = 0
+      ENDIF
+
+
+      ! 3. Read SST if new day
+      ! -------------------------
+
+      ! Read daily SST 
+
+      IF( ndaysst /= nday ) THEN 
+         ndaysst = nday
+         iday = nday_year
+         
+         CALL flinget( numsst, 'sst', jpidta, jpjdta, 1, idy, iday,   &
+            iday, mig(1), nlci, mjg(1), nlcj, sst(1:nlci,1:nlcj) )
+         
+         IF ( kt == nit000 .AND. lwp ) THEN
+            WRITE(numout,*) ' '
+            WRITE(numout,*) ' read daily sea surface temperature ok'
+            WRITE(numout,*) ' '
+            WRITE(numout,*) ' Surface temp day: ', ndastp
+            CALL prihre(sst(1,1),jpi,jpj,1,jpi,20,1,jpj,10,1.,numout)
+         ENDIF
+         
+      ENDIF
+      
+      ! 2. At every time step compute temperature data
+      ! ----------------------------------------------
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ztgel = fzptn(ji,jj)
+            rclice(ji,jj,1) = tmask(ji,jj,1)
+            IF( sst(ji,jj) >= ztgel )   rclice(ji,jj,1) = 0.e0
+            rclice(ji,jj,2) = rclice(ji,jj,1)
+         END DO
+      END DO
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'Computed Ice cover rclice'
+         WRITE(numout,*)
+         WRITE(numout,*) 'Ice cover : '
+         CALL prihre( rclice(1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
+      ENDIF
+      
+      ! Close the file
+      ! --------------
+      
+      IF( kt == nitend )   CALL flinclo(numsst)
+      CALL FLUSH(numout)
+      
+
+   END SUBROUTINE dta_sst
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                        NO SST data
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dta_sst( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dta_sst  ***
+      !!                    
+      !! ** Purpose :   sea surface temperature data and update it
+      !!     at each time step.   ???
+      !!
+      !! ** Method  : - sst   = tn
+      !!              - rclice = 1. IF tn =< ztgel
+      !!
+      !! History :
+      !!        !  91-03  ()  Original code
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean timestep
+      
+      !! * Local declarations
+      INTEGER :: ji, jj
+      !!---------------------------------------------------------------------
+      
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dta_sst : No SST data'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+      
+      ! 1. Update at each time step
+      ! ---------------------------
+
+      sst   (:,:)   = tn   (:,:,1)
+      rclice(:,:,1) = tmask(:,:,1)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( tn(ji,jj,1) >= fzptn(ji,jj) ) rclice(ji,jj,1) = 0.e0
+         END DO
+      END DO
+      rclice(:,:,2) = rclice(:,:,1)
+      
+   END SUBROUTINE dta_sst
+#endif
+
+   !!======================================================================
+END MODULE dtasst
Index: /branches/nemo/NEMO/OPA_SRC/DTA/dtatem.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DTA/dtatem.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DTA/dtatem.F90	(revision 4)
@@ -0,0 +1,283 @@
+MODULE dtatem
+   !!======================================================================
+   !!                     ***  MODULE  dtatem  ***
+   !! Ocean data  :  read ocean temperature data from monthly atlas data
+   !!=====================================================================
+#if defined key_dtatem   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_dtatem'                              3D temperature data field
+   !!----------------------------------------------------------------------
+   !!   dta_tem      : read ocean temperature data
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dta_tem   ! called by step.F90 and inidta.F90
+
+   !! * Shared module variables
+   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   ! temperature data flag
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &
+      t_dta             ! temperature data at given time-step
+
+   !! * Module variables
+   CHARACTER (len=38) ::   &
+      cl_tdata = 'data_1m_potiential_temperature_nomask '
+   INTEGER ::   &
+      nlecte =  0,   &  ! switch for the first read
+      ntem1      ,   &  ! first record used
+      ntem2             ! second record used
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   &
+      temdta            ! temperature data at two consecutive times
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+# if defined key_fdir
+   !!----------------------------------------------------------------------
+   !!   'key_fdir'                                       direct access file
+   !!----------------------------------------------------------------------
+#  include "dtatem_fdir.h90"
+
+# else
+   !!----------------------------------------------------------------------
+   !!   Default case                                            NetCDF file
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dta_tem( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dta_tem  ***
+      !!                    
+      !! ** Purpose :   Reads monthly temperature data 
+      !! 
+      !! ** Method  :   Read on unit numtdt the interpolated temperature 
+      !!      onto the model grid.
+      !!      Data begin at january. 
+      !!      The value is centered at the middle of month.
+      !!      In the opa model, kt=1 agree with january 1.
+      !!      At each time step, a linear interpolation is applied between 
+      !!      two monthly values.
+      !!      Read on unit numtdt
+      !!
+      !! ** Action  :   define t_dta array at time-step kt
+      !!
+      !! History :
+      !!        !  91-03  ()  Original code
+      !!        !  92-07  (M. Imbard)
+      !!        !  99-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT 
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step
+
+      !! * Local declarations
+      INTEGER, PARAMETER ::   &
+         jpmois = 12                    ! number of month
+      INTEGER ::   ji, jj, jl           ! dummy loop indicies
+      INTEGER ::   &
+         imois, iman, itime, ik ,    &  ! temporary integers
+         i15, ipi, ipj, ipk             !    "          "
+
+      INTEGER, DIMENSION(jpmois) ::   istep
+      REAL(wp) ::   zxy, zl, zdate0
+      REAL(wp), DIMENSION(jpi,jpj) ::   zlon,zlat
+      REAL(wp), DIMENSION(jpk) ::   zlev
+      !!----------------------------------------------------------------------
+
+
+      ! 0. Initialization
+      ! -----------------
+
+      iman  = jpmois
+      i15   = nday / 16
+      imois = nmonth + i15 - 1
+      IF( imois == 0 )   imois = iman
+
+      itime = jpmois
+      ipi=jpiglo
+      ipj=jpjglo
+
+      ! 1. First call kt=nit000
+      ! -----------------------
+
+      IF( kt == nit000 .AND. nlecte == 0 ) THEN
+         ntem1 = 0
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~'
+         IF(lwp) WRITE(numout,*) '             NetCDF FORMAT'
+         IF(lwp) WRITE(numout,*)
+         
+         ! open file
+
+         CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1),  nlcj   &
+                      , .false.     , ipi   , ipj  , ipk   , zlon   &
+                      , zlat        , zlev  , itime, istep , zdate0   &
+                      , rdt         , numtdt                        )
+
+         ! title, dimensions and tests
+
+         IF( itime /= jpmois ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'problem with time coordinates'
+               WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
+            ENDIF
+            STOP 'dtatem'
+         ENDIF
+         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= jpk ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'problem with dimensions'
+               WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
+               WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
+               WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk
+            ENDIF
+            STOP 'dtatem'
+         ENDIF
+         IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt
+
+      ENDIF
+
+
+      ! 2. Read monthly file
+      ! -------------------
+
+      IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN
+         nlecte = 1
+
+         ! Calendar computation
+         
+         ntem1 = imois        ! first file record used 
+         ntem2 = ntem1 + 1    ! last  file record used
+         ntem1 = MOD( ntem1, iman )
+         IF( ntem1 == 0 )   ntem1 = iman
+         ntem2 = MOD( ntem2, iman )
+         IF( ntem2 == 0 )   ntem2 = iman
+         IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1
+         IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2
+         
+         ! Read monthly temperature data Levitus 
+         
+         CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
+                     , jpmois, ntem1     , ntem1 , mig(1), nlci   &
+                     , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,1)     )
+         CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   &
+                     , jpmois, ntem2     , ntem2 , mig(1), nlci   &
+                     , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,2)     )
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' read Levitus temperature ok'
+         IF(lwp) WRITE(numout,*)
+         
+#  if defined key_tradmp
+         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN
+      
+            !                                        ! =======================
+            !                                        !  ORCA_R2 configuration
+            !                                        ! ======================= 
+
+            DO jj = mj0(101), mj1(109)                   ! Reduced temperature at Alboran Sea
+               DO ji = mi0(141), mi1(155)
+                  temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20
+                  temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35
+                  temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40
+               END DO
+            END DO
+         
+            IF( n_cla == 0 ) THEN 
+               !                                         ! Reduced temperature at Red Sea
+               temdta( mi0(148):mi1(160) , mj0(87):mj1(96) ,  4:10 , : ) = 7.0 
+               temdta( mi0(148):mi1(160) , mj0(87):mj1(96) , 11:13 , : ) = 6.5 
+               temdta( mi0(148):mi1(160) , mj0(87):mj1(96) , 14:20 , : ) = 6.0
+            ELSE
+               DO jl = mi0(138), mi1(138)                ! New temperature profile at Gibraltar
+                  DO jj = mj0(101), mj1(102)
+                     DO ji = mi0(139), mi1(139)
+                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
+                     END DO
+                  END DO
+               END DO
+               DO jl = mi0(164), mi1(164)                ! New temperature profile at Bab el Mandeb
+                  DO jj = mj0(88), mj1(88)
+                     DO ji = mi0(161), mi1(163)
+                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
+                     END DO
+                  END DO
+                  DO jj = mj0(87), mj1(87)
+                     DO ji = mi0(161), mi1(163)
+                        temdta(ji,jj,:,:) = temdta(jl,jj,:,:)
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+
+         ENDIF
+#  endif
+
+         !                                  ! Mask
+         DO jl = 1, 2
+            temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:)
+            temdta(:,:,jpk,jl) = 0.
+            IF( lk_zps ) THEN                ! z-coord. with partial steps
+               DO jj = 1, jpj                  ! interpolation of temperature at the last level
+                  DO ji = 1, jpi
+                     ik = mbathy(ji,jj) - 1
+                     IF( ik > 2 ) THEN
+                        zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) )
+                        temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
+         END DO
+
+         IF(lwp) THEN
+            WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2
+            WRITE(numout,*)
+            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1'
+            CALL prihre( temdta(1,1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+            WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2
+            CALL prihre( temdta(1,1,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+            WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1
+            CALL prihre( temdta(1,1,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+         ENDIF
+      ENDIF
+
+ 
+      ! 2. At every time step compute temperature data
+      ! ----------------------------------------------
+
+      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
+      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)
+
+   END SUBROUTINE dta_tem
+
+# endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case                           NO 3D temperature data field
+   !!----------------------------------------------------------------------
+   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .FALSE.   ! temperature data flag
+CONTAINS
+   SUBROUTINE dta_tem( kt )        ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE dta_tem
+#endif
+   !!======================================================================
+END MODULE dtatem
Index: /branches/nemo/NEMO/OPA_SRC/DTA/dtatem_fdir.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DTA/dtatem_fdir.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DTA/dtatem_fdir.h90	(revision 4)
@@ -0,0 +1,153 @@
+   SUBROUTINE dtatem ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dtatem  ***
+      !!                     
+      !! ** Purpose :   Reads temperature data (Levitus monthly data)
+      !!
+      !! ** Method  :   Read on unit numtdt the interpolated Levitus 
+      !!      temperature onto the global grid.
+      !!      Data begin at january.
+      !!      The value is centered at the middle of month.
+      !!      In the opa model, kt=1 agree with january 1.
+      !!      At each time step, a linear interpolation is applied between
+      !!      two monthly values.
+      !!      Read on unit numtdt
+      !!
+      !! ** Action :
+      !!      define t_dta array at time-step kt
+      !!
+      !! References :
+      !!      Sydney Levitus, climatological atlas of the world ocean
+      !!      NOAA professional paper 13, december 1982
+      !!
+      !! History :
+      !!        !  91-03  ()  Original code
+      !!        !  92-07  (M. Imbard)
+      !!        !  99-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+      !! * Local declarations
+      INTEGER, PARAMETER ::   jpmois=12, jpf=1
+      INTEGER ::   ji, jj, jl, ios, ik
+      INTEGER ::   ibloc, ilindta
+      INTEGER ::   imois, iman
+      INTEGER ::   iimlu, ijmlu, ikmlu, ilmlu, immlu
+      INTEGER ::   i15
+      REAL(wp) ::   zxy, zl
+      CHARACTER (len=20) ::   cltit
+      !!----------------------------------------------------------------------
+
+
+      ! 0. Initialization
+      ! -----------------
+
+      iman  = jpmois
+      i15 = nday/16
+      imois = nmonth + i15 - 1
+      IF( imois == 0 ) imois = iman
+
+
+      ! 1. First call kt=nit000
+      ! -----------------------
+
+      IF( kt == nit000 .AND. nlecte == 0 ) THEN
+         ! open temp.dta file
+         ibloc = 4096
+         ilindta = ibloc*((jpidta*jpjdta*jpbytda-1 )/ibloc+1)
+         CALL ctlopn(numtdt,'data_1m_potiential_temperature_nomask','OLD', 'UNFORMATTED', 'DIRECT',   &
+                     ilindta,numout,lwp,1)
+         ntem1 = 0
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dta_tem : read monthly temperature in direct acces file'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         IF(lwp) WRITE(numout,*)
+
+         ! 1.2 Read first records
+
+         ! title, dimensions and tests
+
+         READ( numtdt, REC=1, IOSTAT=ios ) cltit, iimlu, ijmlu, ikmlu,   &
+                                           ilmlu, immlu
+         IF( ios /= 0 ) THEN
+            IF(lwp) WRITE(numout,*) 'e r r o r read numtdt ', ios
+            STOP 'dtatem'
+         ELSE
+            IF ( iimlu /= jpidta ) STOP 4050
+            IF ( ijmlu /= jpjdta ) STOP 4060
+            IF ( ikmlu /= jpk    ) STOP 4070
+            IF ( ilmlu /= jpmois ) STOP 4080
+            IF ( immlu /= jpf    ) STOP 4090
+            IF(lwp) WRITE(numout,*) 'nb of points in the 5 directions '
+            IF(lwp) WRITE(numout,*) iimlu, ijmlu, ikmlu, ilmlu, immlu
+         ENDIF
+
+      ENDIF
+
+
+      ! 2. Read monthly file
+      ! -------------------
+
+      IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN
+         nlecte = 1
+
+         ! 2.1 Calendar computation
+         
+         ntem1 = imois        ! first file record used 
+         ntem2 = ntem1 + 1    ! last  file record used
+         ntem1 = MOD( ntem1, iman )
+         IF( ntem1 == 0 )   ntem1 = iman
+         ntem2 = MOD( ntem2, iman )
+         IF( ntem2 == 0 )   ntem2 = iman
+         IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1
+         IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2
+         
+         ! 2.3 Read monthly temperature data Levitus 
+
+         CALL read3d( numtdt, temdta(1,1,1,1), ntem1+1 )
+         CALL read3d( numtdt, temdta(1,1,1,2), ntem2+1 )
+         
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' read Levitus temperature ok'
+         IF(lwp) WRITE(numout,*)
+         
+         ! 2.4 Masks
+
+         DO jl = 1, 2
+            temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:)
+            temdta(:,:,jpk,jl) = 0.
+            IF( lk_zps ) THEN                ! z-coord. with partial steps
+               DO jj = 1, jpj                     ! interpolation of temperature at the last level
+                  DO ji = 1, jpi
+                     ik = mbathy(ji,jj) - 1
+                     IF ( ik > 2 ) THEN
+                        zl = ( gdept(ik) - fsgdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) )
+                        temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) +zl * temdta(ji,jj,ik-1,jl
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
+         END DO
+
+         IF(lwp) THEN
+            WRITE(numout,*) 'temperature Levitus month ', ntem1, ntem2
+            WRITE(numout,*)
+            WRITE(numout,*) ' Levitus mounth = ', ntem1, '  level = 1'
+            CALL prihre( temdta(1,1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+            WRITE(numout,*) ' Levitus mounth = ', ntem1, '  level = ', jpk/2
+            CALL prihre( temdta(1,1,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+            WRITE(numout,*) ' Levitus mounth = ',ntem1,'  level = ', jpkm1
+            CALL prihre( temdta(1,1,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+         ENDIF
+      ENDIF
+
+ 
+      ! 2. At every time step compute temperature data
+      ! ----------------------------------------------
+
+      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
+      t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2)
+
+   END SUBROUTINE dta_tem
Index: /branches/nemo/NEMO/OPA_SRC/DYN/divcur.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/divcur.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/divcur.F90	(revision 4)
@@ -0,0 +1,349 @@
+MODULE divcur
+   !!==============================================================================
+   !!                       ***  MODULE  divcur  ***
+   !! Ocean diagnostic variable : horizontal divergence and relative vorticity
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   div_cur    : Compute the horizontal divergence and relative
+   !!                vorticity fields
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE obc_oce         ! ocean lateral open boundary condition
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC div_cur    ! routine called by step.F90 and istate.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined key_noslip_accurate
+   !!----------------------------------------------------------------------
+   !!   'key_noslip_accurate'                     2nd order centered scheme
+   !!                                                4th order at the coast
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE div_cur( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE div_cur  ***
+      !!
+      !! ** Purpose :   compute the horizontal divergence and the relative
+      !!      vorticity at before and now time-step
+      !!
+      !! ** Method  : 
+      !!      I.  divergence :
+      !!         - save the divergence computed at the previous time-step
+      !!      (note that the Asselin filter has not been applied on hdivb)
+      !!         - compute the now divergence given by :
+      !!            * s-coordinate ('key_s_coord' defined)
+      !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
+      !!         * z-coordinate (default key)
+      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
+      !!         - apply lateral boundary conditions on hdivn 
+      !!      II. vorticity :
+      !!         - save the curl computed at the previous time-step
+      !!            rotb = rotn
+      !!      (note that the Asselin time filter has not been applied to rotb)
+      !!         - compute the now curl in tensorial formalism:
+      !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] )
+      !!         - apply lateral boundary conditions on rotn through a call
+      !!      of lbc_lnk routine.
+      !!         - Coastal boundary condition: 'key_noslip_accurate' defined,
+      !!      the no-slip boundary condition is computed using Schchepetkin
+      !!      and O'Brien (1996) scheme (i.e. 4th order at the coast).
+      !!      For example, along east coast, the one-sided finite difference
+      !!      approximation used for di[v] is:
+      !!         di[e2v vn] =  1/(e1f*e2f)
+      !!                    * ( (e2v vn)(i) + (e2v vn)(i-1) + (e2v vn)(i-2) )
+      !!
+      !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence
+      !!              - update rotb , rotn , the before & now rel. vorticity
+      !!
+      !! History :
+      !!   8.2  !  00-03  (G. Madec)  no slip accurate
+      !!   9.0  !  03-08  (G. Madec)  merged of cur and div, free form, F90
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk     ! dummy loop indices
+      INTEGER ::   ii, ij, jl     ! temporary integer
+      INTEGER ::   ijt, iju       ! temporary integer
+      REAL(wp) ::   zdiv, zdju
+      REAL(wp), DIMENSION(   jpi  ,1:jpj+2) ::   zwu   ! workspace
+      REAL(wp), DIMENSION(-1:jpi+2,  jpj  ) ::   zwv   ! workspace
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'div_cur : horizontal velocity divergence and relative vorticity'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   NOT optimal for auto-tasking case'
+      ENDIF
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays
+         rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays
+
+         !                                             ! --------
+         ! Horizontal divergence                       !   div
+         !                                             ! --------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_s_coord || defined key_partial_steps
+               hdivn(ji,jj,jk) =   &
+                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk)  * un(ji-1,jj  ,jk)       &
+                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk)  * vn(ji  ,jj-1,jk)  )    &
+                  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+#else
+               hdivn(ji,jj,jk) = (  e2u(ji,jj) * un(ji,jj,jk) - e2u(ji-1,jj  ) * un(ji-1,jj  ,jk)      &
+                  &               + e1v(ji,jj) * vn(ji,jj,jk) - e1v(ji  ,jj-1) * vn(ji  ,jj-1,jk)  )   &
+                  &            / ( e1t(ji,jj) * e2t(ji,jj) )
+#endif
+            END DO
+         END DO
+
+#if defined key_obc
+         ! open boundaries (div must be zero behind the open boundary)
+         !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column
+         IF( lpeastobc  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east
+         IF( lpwestobc  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west
+         IF( lpnorthobc )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north
+         IF( lpsouthobc )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south
+#endif         
+
+         !                                             ! --------
+         ! relative vorticity                          !   rot 
+         !                                             ! --------
+         ! contravariant velocity (extended for lateral b.c.)
+         ! inside the model domain
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwu(ji,jj) = e1u(ji,jj) * un(ji,jj,jk)
+               zwv(ji,jj) = e2v(ji,jj) * vn(ji,jj,jk)
+            END DO  
+         END DO  
+ 
+         ! East-West boundary conditions
+         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
+            zwv(  0  ,:) = zwv(jpi-2,:)
+            zwv( -1  ,:) = zwv(jpi-3,:)
+            zwv(jpi+1,:) = zwv(  3  ,:)
+            zwv(jpi+2,:) = zwv(  4  ,:)
+         ELSE
+            zwv(  0  ,:) = 0.e0
+            zwv( -1  ,:) = 0.e0
+            zwv(jpi+1,:) = 0.e0
+            zwv(jpi+2,:) = 0.e0
+         ENDIF
+
+         ! North-South boundary conditions
+         IF( nperio == 3 .OR. nperio == 4 ) THEN
+            ! north fold ( Grid defined with a T-point pivot) ORCA 2 degre
+            zwu(jpi,jpj+1) = 0.e0
+            zwu(jpi,jpj+2) = 0.e0
+            DO ji = 1, jpi-1
+               iju = jpi - ji + 1
+               zwu(ji,jpj+1) = - zwu(iju,jpj-3)
+               zwu(ji,jpj+2) = - zwu(iju,jpj-4)
+            END DO
+         ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN
+            ! north fold ( Grid defined with a F-point pivot) ORCA 0.5 degre\
+            zwu(jpi,jpj+1) = 0.e0
+            zwu(jpi,jpj+2) = 0.e0
+            DO ji = 1, jpi-1
+               iju = jpi - ji
+               zwu(ji,jpj  ) = - zwu(iju,jpj-1)
+               zwu(ji,jpj+1) = - zwu(iju,jpj-2)
+               zwu(ji,jpj+2) = - zwu(iju,jpj-3)
+            END DO
+            DO ji = -1, jpi+2
+               ijt = jpi - ji + 1
+               zwv(ji,jpj) = - zwv(ijt,jpj-2)
+            END DO
+            DO ji = jpi/2+1, jpi+2
+               ijt = jpi - ji + 1
+               zwv(ji,jpjm1) = - zwv(ijt,jpjm1)
+            END DO
+         ELSE
+            ! closed
+            zwu(:,jpj+1) = 0.e0
+            zwu(:,jpj+2) = 0.e0
+         ENDIF
+
+         ! relative vorticity (vertical component of the velocity curl) 
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               rotn(ji,jj,jk) = (  zwv(ji+1,jj  ) - zwv(ji,jj)      &
+                                 - zwu(ji  ,jj+1) + zwu(ji,jj)  )   &
+                              * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) )
+            END DO
+         END DO
+
+         ! second order accurate scheme along straight coast
+         DO jl = 1, npcoa(1,jk)
+            ii = nicoa(jl,1,jk)
+            ij = njcoa(jl,1,jk)
+            rotn(ii,ij,jk) = 1. / ( e1f(ii,ij) * e2f(ii,ij) )   &
+                           * ( + 4. * zwv(ii+1,ij) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) )
+         END DO
+         DO jl = 1, npcoa(2,jk)
+            ii = nicoa(jl,2,jk)
+            ij = njcoa(jl,2,jk)
+            rotn(ii,ij,jk) = 1./(e1f(ii,ij)*e2f(ii,ij))   &
+               *(-4.*zwv(ii,ij)+zwv(ii-1,ij)-0.2*zwv(ii-2,ij))
+         END DO
+         DO jl = 1, npcoa(3,jk)
+            ii = nicoa(jl,3,jk)
+            ij = njcoa(jl,3,jk)
+            rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   &
+               * ( +4. * zwu(ii,ij+1) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) )
+         END DO
+         DO jl = 1, npcoa(4,jk)
+            ii = nicoa(jl,4,jk)
+            ij = njcoa(jl,4,jk)
+            rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   &
+               * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) )
+         END DO
+
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      
+      ! 4. Lateral boundary conditions on hdivn and rotn
+      ! ---------------------------------=======---======
+      CALL lbc_lnk( hdivn, 'T',  1. )     ! T-point, no sign change
+      CALL lbc_lnk( rotn , 'F', -1. )     ! F-point,    sign change
+
+   END SUBROUTINE div_cur
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                           2nd order centered schemes
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE div_cur( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE div_cur  ***
+      !!                    
+      !! ** Purpose :   compute the horizontal divergence and the relative
+      !!      vorticity at before and now time-step
+      !!
+      !! ** Method  : - Divergence:
+      !!      - save the divergence computed at the previous time-step
+      !!      (note that the Asselin filter has not been applied on hdivb)
+      !!      - compute the now divergence given by :
+      !!         * s-coordinate ('key_s_coord' defined)
+      !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
+      !!         * z-coordinate (default key)
+      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
+      !!      - apply lateral boundary conditions on hdivn 
+      !!              - Relavtive Vorticity :
+      !!      - save the curl computed at the previous time-step (rotb = rotn)
+      !!      (note that the Asselin time filter has not been applied to rotb)
+      !!      - compute the now curl in tensorial formalism:
+      !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] )
+      !!      - apply lateral boundary conditions on rotn through a call to
+      !!      routine lbc_lnk routine.
+      !!      Note: Coastal boundary condition: lateral friction set through
+      !!      the value of fmask along the coast (see dommsk.F90) and shlat
+      !!      (namelist parameter)
+      !!
+      !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence
+      !!              - update rotb , rotn , the before & now rel. vorticity
+      !!
+      !! History :
+      !!   1.0  !  87-06  (P. Andrich, D. L Hostis)  Original code
+      !!   4.0  !  91-11  (G. Madec)
+      !!   6.0  !  93-03  (M. Guyon)  symetrical conditions
+      !!   7.0  !  96-01  (G. Madec)  s-coordinates
+      !!   8.0  !  97-06  (G. Madec)  lateral boundary cond., lbc
+      !!   8.1  !  97-08  (J.M. Molines)  Open boundaries
+      !!   9.0  !  02-09  (G. Madec, E. Durand)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
+      
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'div_cur : horizontal velocity divergence and'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   relative vorticity'
+      ENDIF
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays
+         rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays
+
+         !                                             ! --------
+         ! Horizontal divergence                       !   div 
+         !                                             ! --------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_s_coord || defined key_partial_steps
+               hdivn(ji,jj,jk) =   &
+                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk)  * un(ji-1,jj  ,jk)       &
+                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk)  * vn(ji  ,jj-1,jk)  )    &
+                  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+#else
+               hdivn(ji,jj,jk) = (  e2u(ji,jj) * un(ji,jj,jk) - e2u(ji-1,jj  ) * un(ji-1,jj  ,jk)      &
+                  &               + e1v(ji,jj) * vn(ji,jj,jk) - e1v(ji  ,jj-1) * vn(ji  ,jj-1,jk)  )   & 
+                  / ( e1t(ji,jj) * e2t(ji,jj) )
+#endif
+            END DO  
+         END DO  
+
+#if defined key_obc
+         ! open boundaries (div must be zero behind the open boundary)
+         !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column
+         IF( lpeastobc  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east
+         IF( lpwestobc  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west
+         IF( lpnorthobc )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north
+         IF( lpsouthobc )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south
+#endif         
+         !                                             ! --------
+         ! relative vorticity                          !   rot 
+         !                                             ! --------
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               rotn(ji,jj,jk) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                  &              - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) &
+                  &           * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj) )
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      
+      ! 4. Lateral boundary conditions on hdivn and rotn
+      ! ---------------------------------=======---======
+      CALL lbc_lnk( hdivn, 'T',  1. )       ! T-point, no sign change
+      CALL lbc_lnk( rotn , 'F', -1. )       ! F-point,    sign change
+
+   END SUBROUTINE div_cur
+   
+#endif
+   !!======================================================================
+END MODULE divcur
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynhpg.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 4)
@@ -0,0 +1,442 @@
+MODULE dynhpg
+   !!======================================================================
+   !!                       ***  MODULE  dynhpg  ***
+   !! Ocean dynamics:  hydrostatic pressure gradient trend
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dyn_hpg      : update the momentum trend with the horizontal
+   !!                  gradient of the hydrostatic pressure
+   !!
+   !!   default case : use of 3D work arrays (vector opt. available)
+   !!   key_s_coord       : s-coordinate
+   !!   key_partial_steps : z-coordinate with partial steps
+   !!   default key       : z-coordinate
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE trddyn_oce     ! dynamics trends diagnostics variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC dyn_hpg                ! routine called by step.F90
+
+#if defined key_autotasking
+   !!----------------------------------------------------------------------
+   !!   'key_autotasking' :                             j-k-i loop (j-slab)
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC ::   l_dyn_hpg_tsk = .TRUE.    ! ???
+   LOGICAL, PUBLIC ::   l_dyn_hpg     = .FALSE.   ! ???
+#else
+   !!----------------------------------------------------------------------
+   !!   default case :                             k-j-i loop (vector opt.)
+   !!----------------------------------------------------------------------   
+   LOGICAL, PUBLIC ::   l_dyn_hpg_tsk = .FALSE.   ! ???
+   LOGICAL, PUBLIC ::   l_dyn_hpg     = .TRUE.    ! ???
+#endif
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined key_s_coord
+   !!----------------------------------------------------------------------
+   !!   'key_s_coord' :                                        s-coordinate
+   !!----------------------------------------------------------------------   
+
+   SUBROUTINE dyn_hpg( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_hpg  ***
+      !!
+      !! ** Purpose :   Compute the now momentum trend due to the hor. gradient
+      !!      of the hydrostatic pressure. Add it to the general momentum trend.
+      !!
+      !! ** Method  :   The now hydrostatic pressure gradient at a given level
+      !!      jk is computed by taking the vertical integral of the in-situ 
+      !!      density gradient along the model level from the suface to that 
+      !!      level. s-coordinates ('key_s_coord'): a corrective term is added
+      !!      to the horizontal pressure gradient :
+      !!         zhpi = g .....  + 1/e1u mi(rhd) di[ g dep3w ]
+      !!         zhpj = g .....  + 1/e2v mj(rhd) dj[ g dep3w ]
+      !!      add it to the general momentum trend (ua,va).
+      !!         ua = ua - 1/e1u * zhpi
+      !!         va = va - 1/e2v * zhpj
+      !!
+      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !!             - Save the trend in (utrd,vtrd) ('key_trddyn')
+      !!
+      !! History :
+      !!   1.0  !  87-09  (P. Andrich, m.-a. Foujols)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  96-01  (G. Madec)  s-coordinates
+      !!        !  97-05  (G. Madec)  split dynber into dynkeg and dynhpg
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module, vector opt.
+      !!----------------------------------------------------------------------
+      !! * modules used
+      USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace
+         &              zhpj => sa      ! use sa as 3D workspace
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
+      
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   &
+         zcoef0, zcoef1, zuap, zvap     ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_hpg : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   s-coordinate case, vector opt. case'
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      zcoef0 = -g * 0.5
+      zuap   = 0.e0
+      zvap   = 0.e0
+
+      ! 1. Surface value
+      ! ----------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! hydrostatic pressure gradient along s-surfaces
+            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj)   &
+                       * ( fse3w(ji+1,jj,1) * rhd(ji+1,jj,1) - fse3w(ji,jj,1) * rhd(ji,jj,1)  )
+            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj)   &
+                       * ( fse3w(ji,jj+1,1) * rhd(ji,jj+1,1) - fse3w(ji,jj,1) * rhd(ji,jj,1)  )
+            ! s-coordinate pressure gradient correction
+            zuap = -zcoef0 * ( rhd(ji+1,jj,1) + rhd(ji,jj,1) )   &
+                 * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj)
+            zvap = -zcoef0 * ( rhd(ji,jj+1,1) + rhd(ji,jj,1) )   &
+                 * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj)
+            ! add to the general momentum trend
+            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap
+            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap
+# if defined key_trddyn
+            ! save the trend for diagnostics
+            utrd(ji,jj,1,1) = zhpi(ji,jj,1) + zuap
+            vtrd(ji,jj,1,1) = zhpj(ji,jj,1) + zvap
+# endif
+         END DO  
+      END DO  
+
+      ! 2. interior value (2=<jk=<jpkm1)
+      ! -----------------
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! hydrostatic pressure gradient along s-surfaces
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   &
+                           * ( fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) )   &
+                              -fse3w(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  )
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   &
+                           * ( fse3w(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) )   &
+                              -fse3w(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  )
+               ! s-coordinate pressure gradient correction 
+               zuap = -zcoef0 * ( rhd(ji+1,jj  ,jk) + rhd(ji,jj,jk) )   &
+                    * ( fsde3w(ji+1,jj,jk) - fsde3w(ji,jj,jk) ) / e1u(ji,jj)
+               zvap = -zcoef0 * ( rhd(ji  ,jj+1,jk) + rhd(ji,jj,jk) )   &
+                    * ( fsde3w(ji,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj)
+               ! add to the general momentum trend
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap
+               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap
+# if defined key_trddyn
+               ! save the momentum trends for diagnostics
+               utrd(ji,jj,jk,1) = zhpi(ji,jj,jk) + zuap
+               vtrd(ji,jj,jk,1) = zhpj(ji,jj,jk) + zvap
+# endif
+            END DO
+         END DO
+      END DO
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' hpg  - Ua: ', zuap-u_ctl, ' Va: ', zvap-v_ctl
+         u_ctl = zuap   ;   v_ctl = zvap
+      ENDIF
+
+   END SUBROUTINE dyn_hpg
+
+#elif defined key_partial_steps
+   !!---------------------------------------------------------------------
+   !!   'key_partial_steps'                     z-coordinate partial steps
+   !!---------------------------------------------------------------------
+
+   SUBROUTINE dyn_hpg( kt )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dyn_hpg  ***
+      !!                    
+      !! ** Purpose :   Compute the now momentum trend due to the horizontal 
+      !!      gradient of the hydrostatic pressure. Add it to the general
+      !!      momentum trend.
+      !!
+      !! ** Method  :   The now hydrostatic pressure gradient at a given level 
+      !!      jk is computed by taking the vertical integral of the in-situ 
+      !!      density gradient along the model level from the suface to that
+      !!      level:   zhpi = g .....
+      !!               zhpj = g .....
+      !!      add it to the general momentum trend (ua,va).
+      !!            ua = ua - 1/e1u * zhpi
+      !!            va = va - 1/e2v * zhpj
+      !!
+      !! ** Action  : - Update (ua,va) with the now hydrastatic pressure trend
+      !!              - Save the trend in (utrd,vtrd) ('key_trddyn')
+      !!
+      !! History :
+      !!   8.5  !  02-08  (A. Bozec)  Original code
+      !!----------------------------------------------------------------------
+      !! * modules used
+      USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace
+         &              zhpj => sa      ! use sa as 3D workspace
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
+
+      !! * local declarations
+      INTEGER ::   ji, jj, jk           ! dummy loop indices
+      INTEGER ::   iku, ikv             ! temporary integers
+      REAL(wp) ::   &
+         zcoef0, zcoef1, zuap,       &  ! temporary scalars
+         zcoef2, zcoef3, zvap           !    "         "
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_hpg : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   z-coordinate with partial steps'
+         IF(lwp) WRITE(numout,*) '          vector optimization, no autotasking'
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      zcoef0 = -g * 0.5
+      zuap   = 0.e0
+      zvap   = 0.e0
+
+      ! 1. Surface value
+      ! ----------------
+      zcoef1 = zcoef0 * fse3w(1,1,1)
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! hydrostatic pressure gradient
+            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) / e1u(ji,jj)
+            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) / e2v(ji,jj)
+            ! add to the general momentum trend
+            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
+            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1)
+# if defined key_trddyn
+            ! save the momentum trends for diagnostics
+            utrd(ji,jj,1,1) = zhpi(ji,jj,1)
+            vtrd(ji,jj,1,1) = zhpj(ji,jj,1)
+# endif
+         END DO
+      END DO
+
+      ! 2. interior value (2=<jk=<jpkm1)
+      ! -----------------
+      DO jk = 2, jpkm1
+         zcoef1 = zcoef0 * fse3w(1,1,jk)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! hydrostatic pressure gradient
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
+                           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )   &
+                                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) / e1u(ji,jj)
+
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
+                           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )   &
+                                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) / e2v(ji,jj)
+               ! add to the general momentum trend
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)
+# if defined key_trddyn
+               ! save the momentum trends for diagnostics
+               utrd(ji,jj,jk,1) = zhpi(ji,jj,jk)
+               vtrd(ji,jj,jk,1) = zhpj(ji,jj,jk)
+# endif
+            END DO 
+         END DO
+      END DO
+
+      ! partial steps correction at the last level  (new gradient with  intgrd.F)
+# if defined key_vectopt_loop
+         jj = 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1
+            ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1
+            zcoef2 = zcoef0 * MIN( fse3w(ji,jj,iku), fse3w(ji+1,jj  ,iku) )
+            zcoef3 = zcoef0 * MIN( fse3w(ji,jj,ikv), fse3w(ji  ,jj+1,ikv) )
+            ! on i-direction
+            IF ( iku > 2 ) THEN
+               ! subtract old value  
+               ua(ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku)
+               ! compute the new one   
+               zhpi (ji,jj,iku) = zhpi(ji,jj,iku-1)   &
+                  + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) / e1u(ji,jj)
+               ! add the new one to the general momentum trend
+               ua(ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku)
+# if defined key_trddyn
+               ! save the momentum trends for diagnostics
+               utrd(ji,jj,iku,1) = zhpi(ji,jj,iku)
+# endif
+            ENDIF
+            ! on j-direction
+            IF ( ikv > 2 ) THEN
+               ! subtract old value  
+               va(ji,jj,ikv) = va(ji,jj,ikv) - zhpj(ji,jj,ikv)
+               ! compute the new one   
+               zhpj (ji,jj,ikv) = zhpj(ji,jj,ikv-1)   &
+                  + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) / e2v(ji,jj)
+               ! add the new one to the general momentum trend
+               va(ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)
+# if defined key_trddyn
+               ! save the momentum trends for diagnostics
+               vtrd(ji,jj,ikv,1) = zhpj(ji,jj,ikv)
+# endif
+            ENDIF
+# if ! defined key_vectopt_loop
+         END DO
+# endif
+      END DO
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' hpg  - Ua: ', zuap-u_ctl, ' Va: ', zvap-v_ctl
+         u_ctl = zuap   ;   v_ctl = zvap
+      ENDIF
+
+   END SUBROUTINE dyn_hpg
+
+#else
+   !!---------------------------------------------------------------------
+   !!   Default case :                                        z-coordinate
+   !!---------------------------------------------------------------------
+
+   SUBROUTINE dyn_hpg( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_hpg  ***
+      !!
+      !! ** Purpose :   Compute the now momentum trend due to the horizontal
+      !!      gradient of the hydrostatic pressure. Add it to the general 
+      !!      momentum trend.
+      !!
+      !! ** Method  :   The now hydrostatic pressure gradient at a given level
+      !!      jk is computed by taking the vertical integral of the in-situ
+      !!      density gradient along the model level from the suface to that
+      !!      level:    zhpi = g .....
+      !!                zhpj = g .....
+      !!      add it to the general momentum trend (ua,va).
+      !!            ua = ua - 1/e1u * zhpi
+      !!            va = va - 1/e2v * zhpj
+      !!
+      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !!             - Save the trend in (utrd,vtrd) ('key_trddyn')
+      !!
+      !! History :
+      !!   1.0  !  87-09  (P. Andrich, m.-a. Foujols)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  96-01  (G. Madec)  s-coordinates
+      !!        !  97-05  (G. Madec)  split dynber into dynkeg and dynhpg
+      !!   8.5  !  02-07  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * modules used
+      USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace
+         &              zhpj => sa      ! use sa as 3D workspace
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
+
+      !! * local declarations
+      INTEGER ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   &
+         zcoef0, zcoef1, zuap, zvap     ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_hpg : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   z-coordinate case '
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      zcoef0 = -g * 0.5
+      zuap   = 0.e0
+      zvap   = 0.e0
+
+      ! 1. Surface value
+      ! ----------------
+      zcoef1 = zcoef0 * fse3w(1,1,1)
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! hydrostatic pressure gradient
+            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) / e1u(ji,jj)
+            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) / e2v(ji,jj)
+            ! add to the general momentum trend
+            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
+            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1)
+# if defined key_trddyn
+            ! save the momentum trends for diagnostics
+            utrd(ji,jj,1,1) = zhpi(ji,jj,1)
+            vtrd(ji,jj,1,1) = zhpj(ji,jj,1)
+# endif
+         END DO
+      END DO
+
+      ! 2. interior value (2=<jk=<jpkm1)
+      ! -----------------
+      DO jk = 2, jpkm1
+         zcoef1 = zcoef0 * fse3w(1,1,jk)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! hydrostatic pressure gradient
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
+                           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )   &
+                                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) / e1u(ji,jj)
+
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
+                           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )   &
+                                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) / e2v(ji,jj)
+               ! add to the general momentum trend
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)
+# if defined key_trddyn
+               ! save the momentum trends for diagnostics
+               utrd(ji,jj,jk,1) = zhpi(ji,jj,jk)
+               vtrd(ji,jj,jk,1) = zhpj(ji,jj,jk)
+# endif
+            END DO 
+         END DO
+      END DO
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' hpg  - Ua: ', zuap-u_ctl, ' Va: ', zvap-v_ctl
+         u_ctl = zuap   ;   v_ctl = zvap
+      ENDIF
+
+   END SUBROUTINE dyn_hpg
+
+#endif
+
+   !!======================================================================
+END MODULE dynhpg
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynhpg_atsk.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynhpg_atsk.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynhpg_atsk.F90	(revision 4)
@@ -0,0 +1,417 @@
+MODULE dynhpg_atsk
+   !!======================================================================
+   !!                       ***  MODULE  dynhpg_atsk  ***
+   !! Ocean dynamics:  hydrostatic pressure gradient trend
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dyn_hpg_atsk : update the momentum trend with the horizontal
+   !!                  gradient of the hydrostatic pressure
+   !!
+   !!   default case : use of 3D work arrays (vector opt. available)
+   !!   key_s_coord       : s-coordinate
+   !!   key_partial_steps : z-coordinate with partial steps
+   !!   default key       : z-coordinate
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE trddyn_oce     ! dynamics trends diagnostics variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC dyn_hpg_atsk ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined key_s_coord
+   !!---------------------------------------------------------------------
+   !!                  ***  dynhpg_atsk.h90  ***
+   !!---------------------------------------------------------------------
+   !!   'key_s_coord'                                         s-coordinate
+   !!---------------------------------------------------------------------
+
+   SUBROUTINE dyn_hpg_atsk( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_hpg_atsk  ***
+      !!        
+      !! ** Purpose :   Compute the now momentum trend due to the horizontal 
+      !!     gradient of the hydrostatic pressure. Add it to the general
+      !!     momentum trend.
+      !!
+      !! ** Method  :   The now hydrostatic pressure gradient at a given level
+      !!      jk is computed by taking the vertical integral of the in-situ 
+      !!      density gradient along the model level from the suface to that
+      !!      level. s-coordinate case ('key_s_coord'): a corrective term is
+      !!      added to the horizontal pressure gradient :
+      !!         zhpi = g .....   + 1/e1u mi(rhd) di[ g dep3w ]
+      !!         zhpj = g .....   + 1/e2v mj(rhd) dj[ g dep3w ]
+      !!      add it to the general momentum trend (ua,va).
+      !!         ua = ua - 1/e1u * zhpi
+      !!         va = va - 1/e2v * zhpj
+      !!      j-k-i loop (j-slab) ('key_autotasking')
+      !!
+      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !!             - Save the trend in (utrd,vtrd) ('key_trddyn')
+      !!
+      !! History :
+      !!   7.0  !  96-01  (G. Madec)  s-coordinates
+      !!        !  97-05  (G. Madec)  split dynber into dynkeg and dynhpg
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * modules used
+      USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace
+         &              zhpj => sa      ! use sa as 3D workspace
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
+      
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      REAL(wp) ::   &
+         zcoef0, zcoef1, zuap, zvap     ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_hpg_atsk : s-coordinate hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   autotasking case (j-k-i loop)'
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      zcoef0 = -g * 0.5
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+         ! 1. Surface value
+         ! ----------------
+         DO ji = 2, jpim1
+            ! hydrostatic pressure gradient along s-surfaces
+            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj)   &
+                       * ( fse3w(ji+1,jj,1) * rhd(ji+1,jj,1) - fse3w(ji,jj,1) * rhd(ji,jj,1)  )
+            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj)   &
+                       * ( fse3w(ji,jj+1,1) * rhd(ji,jj+1,1) - fse3w(ji,jj,1) * rhd(ji,jj,1)  )
+            ! s-coordinate pressure gradient correction
+            zuap = -zcoef0 * ( rhd(ji+1,jj,1) + rhd(ji,jj,1) )   &
+                 * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj)
+            zvap = -zcoef0 * ( rhd(ji,jj+1,1) + rhd(ji,jj,1) )   &
+                 * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj)
+            ! add to the general momentum trend
+            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap
+            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap
+#   if defined key_trddyn
+            ! save the trend for diagnostics
+            utrd(ji,jj,1,1) = zhpi(ji,jj,1) + zuap
+            vtrd(ji,jj,1,1) = zhpj(ji,jj,1) + zvap
+#   endif
+         END DO  
+
+         ! 2. interior value (2=<jk=<jpkm1)
+         ! -----------------
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               ! hydrostatic pressure gradient along s-surfaces
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   &
+                           * ( fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) )   &
+                              -fse3w(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  )
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   &
+                           * ( fse3w(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) )   &
+                              -fse3w(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  )
+               ! s-coordinate pressure gradient correction 
+               zuap = -zcoef0 * ( rhd(ji+1,jj  ,jk) + rhd(ji,jj,jk) )   &
+                    * ( fsde3w(ji+1,jj,jk) - fsde3w(ji,jj,jk) ) / e1u(ji,jj)
+               zvap = -zcoef0 * ( rhd(ji  ,jj+1,jk) + rhd(ji,jj,jk) )   &
+                    * ( fsde3w(ji,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj)
+               ! add to the general momentum trend
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap
+               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap
+#   if defined key_trddyn
+               ! save the momentum trends for diagnostics
+               utrd(ji,jj,jk,1) = zhpi(ji,jj,jk) + zuap
+               vtrd(ji,jj,jk,1) = zhpj(ji,jj,jk) + zvap
+#   endif
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' hpg  - Ua: ', zuap-u_ctl, ' Va: ', zvap-v_ctl
+         u_ctl = zuap   ;   v_ctl = zvap
+      ENDIF
+
+   END SUBROUTINE dyn_hpg_atsk
+
+#elif defined key_partial_steps
+   !!---------------------------------------------------------------------
+   !!   'key_partial_steps'                     z-coordinate partial steps
+   !!---------------------------------------------------------------------
+
+   SUBROUTINE dyn_hpg_atsk( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_hpg_atsk  ***
+      !!  
+      !! ** Purpose :   Compute the now momentum trend due to the hor. gradient
+      !!      of the hydrostatic pressure. Add it to the general momentum trend.
+      !!
+      !! ** Method  :   The now hydrostatic pressure gradient at a given level
+      !!      jk is computed by taking the vertical integral of the in-situ
+      !!      density gradient along the model level from the suface to that 
+      !!      level:    zhpi = g .....
+      !!                zhpj = g .....
+      !!      add it to the general momentum trend (ua,va).
+      !!            ua = ua - 1/e1u * zhpi
+      !!            va = va - 1/e2v * zhpj
+      !!      j-k-i loop (j-slab) ('key_autotasking')
+      !!
+      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !!             - Save the trend in (utrd,vtrd) ('key_trddyn')
+      !!
+      !! History :
+      !!   8.5  !  02-08  (A. Bozec)  Original code
+      !!----------------------------------------------------------------------
+      !! * modules used
+      USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace
+         &              zhpj => sa      ! use sa as 3D workspace
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
+
+      !! * local declarations
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      INTEGER  ::   iku, ikv            ! temporary integers
+      REAL(wp) ::   &
+         zcoef0, zcoef1, zuap,       &  ! temporary scalars
+         zcoef2, zcoef3, zvap           !    "         "
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_hpg_atsk : z-coord. partial steps hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   autotasking case (j-k-i loop)'
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      zcoef0 = -g * 0.5
+      zuap   = 0.e0
+      zvap   = 0.e0
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+         ! 1. Surface value
+         ! ----------------
+         zcoef1 = zcoef0 * fse3w(1,1,1)
+         DO ji = 2, jpim1
+            ! hydrostatic pressure gradient
+            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) / e1u(ji,jj)
+            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) / e2v(ji,jj)
+            ! add to the general momentum trend
+            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
+            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1)
+#   if defined key_trddyn
+            ! save the momentum trends for diagnostics
+            utrd(ji,jj,1,1) = zhpi(ji,jj,1)
+            vtrd(ji,jj,1,1) = zhpj(ji,jj,1)
+#   endif
+         END DO
+
+         ! 2. interior value (2=<jk=<jpkm1)
+         ! -----------------
+         DO jk = 2, jpkm1
+            zcoef1 = zcoef0 * fse3w(1,1,jk)
+            DO ji = 2, jpim1
+               ! hydrostatic pressure gradient
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
+                           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )   &
+                                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) / e1u(ji,jj)
+
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
+                           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )   &
+                                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) / e2v(ji,jj)
+               ! add to the general momentum trend
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)
+#   if defined key_trddyn
+               ! save the momentum trends for diagnostics
+               utrd(ji,jj,jk,1) = zhpi(ji,jj,jk)
+               vtrd(ji,jj,jk,1) = zhpj(ji,jj,jk)
+#   endif
+            END DO 
+         END DO
+
+         ! partial steps correction at the last level  (new gradient with  intgrd.F)
+         DO ji = 2, jpim1
+            iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1
+            ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1
+            zcoef2 = zcoef0 * MIN( fse3w(ji,jj,iku), fse3w(ji+1,jj  ,iku) )
+            zcoef3 = zcoef0 * MIN( fse3w(ji,jj,ikv), fse3w(ji  ,jj+1,ikv) )
+            ! on i-direction
+            IF ( iku > 2 ) THEN
+               ! subtract old value  
+               ua(ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku)
+               ! compute the new one   
+               zhpi (ji,jj,iku) = zhpi(ji,jj,iku-1)   &
+                  + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) / e1u(ji,jj)
+               ! add the new one to the general momentum trend
+               ua(ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku)
+#   if defined key_trddyn
+               ! save the momentum trends for diagnostics
+               utrd(ji,jj,iku,1) = zhpi(ji,jj,iku)
+#   endif
+            ENDIF
+            ! on j-direction
+            IF ( ikv > 2 ) THEN
+               ! subtract old value  
+               va(ji,jj,ikv) = va(ji,jj,ikv) - zhpj(ji,jj,ikv)
+               ! compute the new one   
+               zhpj (ji,jj,ikv) = zhpj(ji,jj,ikv-1)   &
+                  + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) / e2v(ji,jj)
+               ! add the new one to the general momentum trend
+               va(ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)
+#   if  defined key_trddyn
+               ! save the momentum trends for diagnostics
+               vtrd(ji,jj,ikv,1) = zhpj(ji,jj,ikv)
+#   endif
+            ENDIF
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE dyn_hpg_atsk
+
+#else
+   !!---------------------------------------------------------------------
+   !!   Default case :                                        z-coordinate
+   !!---------------------------------------------------------------------
+
+   SUBROUTINE dyn_hpg_atsk( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_hpg_atsk  ***
+      !!   
+      !! ** Purpose :   Compute the now momentum trend due to the horizontal
+      !!      gradient of the hydrostatic pressure. Add it to the general
+      !!      momentum trend.
+      !!
+      !! ** Method  :   The now hydrostatic pressure gradient at a given level
+      !!      jk is computed by taking the vertical integral of the in-situ  
+      !!      density gradient along the model level from the suface to that
+      !!      level:    zhpi = g .....
+      !!                zhpj = g .....
+      !!      add it to the general momentum trend (ua,va).
+      !!            ua = ua - 1/e1u * zhpi
+      !!            va = va - 1/e2v * zhpj
+      !!      j-k-i loop (j-slab) ('key_autotasking')
+      !!
+      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend
+      !!             - Save the trend in (utrd,vtrd) ('key_trddyn')
+      !!
+      !! History :
+      !!   1.0  !  87-09  (P. Andrich, m.-a. Foujols)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  96-01  (G. Madec)  s-coordinates
+      !!        !  97-05  (G. Madec)  split dynber into dynkeg and dynhpg
+      !!   8.5  !  02-07  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * modules used
+      USE oce, ONLY :   zhpi => ta,  &  ! use ta as 3D workspace
+         &              zhpj => sa      ! use sa as 3D workspace
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
+
+      !! * local declarations
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      REAL(wp) ::   &
+         zcoef0, zcoef1, zuap, zvap     ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_hpg_atsk : z-coordinate hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   auto-tasking (j-k-i loop)'
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      zcoef0 = -g * 0.5
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+         ! 1. Surface value
+         ! ----------------
+         
+         zcoef1 = zcoef0 * fse3w(1,1,1)
+
+         DO ji = 2, jpim1
+            ! hydrostatic pressure gradient
+            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) / e1u(ji,jj)
+            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) / e2v(ji,jj)
+            ! add to the general momentum trend
+            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1)
+            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1)
+#   if defined key_trddyn
+            ! save the momentum trends for diagnostics
+            utrd(ji,jj,1,1) = zhpi(ji,jj,1)
+            vtrd(ji,jj,1,1) = zhpj(ji,jj,1)
+#   endif
+         END DO
+
+         ! 2. interior value (2=<jk=<jpkm1)
+         ! -----------------
+         DO jk = 2, jpkm1
+            zcoef1 = zcoef0 * fse3w(1,1,jk)
+            DO ji = 2, jpim1
+               ! hydrostatic pressure gradient
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   &
+                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )   &
+                  &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) / e1u(ji,jj)
+
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   &
+                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )   &
+                  &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) / e2v(ji,jj)
+               ! add to the general momentum trend
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk)
+#   if defined key_trddyn
+               ! save the momentum trends for diagnostics
+               utrd(ji,jj,jk,1) = zhpi(ji,jj,jk)
+               vtrd(ji,jj,jk,1) = zhpj(ji,jj,jk)
+#   endif
+            END DO 
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         WRITE(numout,*) ' hpg  - Ua: ', SUM(ua*umask), ' Va: ', SUM(va*vmask)
+         zuap = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zvap = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' hpg  - Ua: ', zuap-u_ctl, ' Va: ', zvap-v_ctl
+         u_ctl = zuap   ;   v_ctl = zvap
+      ENDIF
+
+   END SUBROUTINE dyn_hpg_atsk
+
+#endif
+
+   !!======================================================================
+END MODULE dynhpg_atsk
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynkeg.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 4)
@@ -0,0 +1,131 @@
+MODULE dynkeg
+   !!======================================================================
+   !!                       ***  MODULE  dynkeg  ***
+   !! Ocean dynamics:  kinetic energy gradient trend
+   !!======================================================================
+   
+   !!----------------------------------------------------------------------
+   !!   dyn_keg      : update the momentum trend with the horizontal tke
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE trddyn_oce      ! dynamics trends diagnostics
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC dyn_keg                ! routine called by step.F90
+   
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_keg( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_keg  ***
+      !!
+      !! ** Purpose :   Compute the now momentum trend due to the horizontal
+      !!      gradient of the horizontal kinetic energy and add it to the 
+      !!      general momentum trend.
+      !!
+      !! ** Method  :   Compute the now horizontal kinetic energy:
+      !!         zhke = 1/2 [ mi-1( un^2 ) + mj-1( vn^2 ) ]
+      !!      Take its horizontal gradient and add it to the general momentum
+      !!      trend (ua,va).
+      !!         ua = ua - 1/e1u di[ zhke ]
+      !!         va = va - 1/e2v dj[ zhke ]
+      !!
+      !! ** Action : - Update the (ua, va) with the hor. ke gradient trend
+      !!             - Save the trends in (utrd,vtrd) ('key_trddyn')
+      !!
+      !! History :
+      !!   1.0  !  87-09  (P. Andrich, m.-a. Foujols)  Original code
+      !!   7.0  !  97-05  (G. Madec)  Split dynber into dynkeg and dynhpg
+      !!   9.0  !  02-07  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * modules used     
+      USE oce, ONLY :   zhke => ta      ! use ta as 3D workspace   
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      REAL(wp) ::   zua, zva, zu, zv    ! temporary scalars
+#if defined key_trddyn_new
+      REAL(wp) ::   zuu, zvv            ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zvke, zuke                     ! temporary workspace
+#endif
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+      
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! Horizontal kinetic energy at T-point
+         DO jj = 2, jpj
+            DO ji = fs_2, jpi   ! vector opt.
+               zv = 0.25 * (  vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
+                            + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)  )
+               zu = 0.25 * (  un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
+                            + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)  )
+               zhke(ji,jj,jk) = zv + zu
+#if defined key_trddyn_new
+               zvke(ji,jj) = zv
+               zuke(ji,jj) = zu
+#endif
+            END DO  
+         END DO  
+         
+         ! Horizontal gradient of Horizontal kinetic energy
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! gradient of kinetic energy
+               zua = -( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj)
+               zva = -( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj)
+               ! add to the general momentum trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zva
+#if defined key_trddyn
+               ! add to the general momentum trends
+               utrd(ji,jj,jk,2) = zua
+               vtrd(ji,jj,jk,2) = zva
+#endif
+#if defined key_trddyn_new
+               zuu = -( zuke(ji+1,jj  ) - zuke(ji,jj) ) / e1u(ji,jj)
+               zvv = -( zvke(ji  ,jj+1) - zvke(ji,jj) ) / e2v(ji,jj)
+               utrd(ji,jj,jk,2) = zua - zuu
+               vtrd(ji,jj,jk,3) = zva - zvv
+               utrd(ji,jj,jk,3) = zuu
+               vtrd(ji,jj,jk,2) = zvv
+#endif
+            END DO 
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' keg  - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl
+         u_ctl = zua   ;   v_ctl = zva
+      ENDIF
+
+   END SUBROUTINE dyn_keg
+
+   !!======================================================================
+END MODULE dynkeg
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynldf_bilap.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynldf_bilap.F90	(revision 4)
@@ -0,0 +1,224 @@
+MODULE dynldf_bilap
+   !!======================================================================
+   !!                     ***  MODULE  dynldf_bilap  ***
+   !! Ocean dynamics:  lateral viscosity trend
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dyn_ldf_bilap : update the momentum trend with the lateral diffusion
+   !!                   using an iso-level bilaplacian operator
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldfdyn_oce      ! ocean dynamics: lateral physics
+   USE in_out_manager  ! I/O manager
+   USE trddyn_oce      ! dynamics trends diagnostics variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dyn_ldf_bilap  ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldfdyn_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_ldf_bilap( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dyn_ldf_bilap  ***
+      !!
+      !! ** Purpose :   Compute the before trend of the lateral momentum
+      !!      diffusion and add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The before horizontal momentum diffusion trend is a 
+      !!      bi-harmonic operator (bilaplacian type) which separates the
+      !!      divergent and rotational parts of the flow.
+      !!      Its horizontal components are computed as follow:
+      !!      laplacian:
+      !!          zlu = 1/e1u di[ hdivb ] - 1/(e2u*e3u) dj-1[ e3f rotb ]
+      !!          zlv = 1/e2v dj[ hdivb ] + 1/(e1v*e3v) di-1[ e3f rotb ]
+      !!      third derivative:
+      !!       * multiply by the eddy viscosity coef. at u-, v-point, resp.
+      !!          zlu = ahmu * zlu
+      !!          zlv = ahmv * zlv
+      !!       * curl and divergence of the laplacian
+      !!          zuf = 1/(e1f*e2f) ( di[e2v zlv] - dj[e1u zlu] )
+      !!          zut = 1/(e1t*e2t*e3t) ( di[e2u*e3u zlu] + dj[e1v*e3v zlv] )
+      !!      bilaplacian:
+      !!              diffu = 1/e1u di[ zut ] - 1/(e2u*e3u) dj-1[ e3f zuf ]
+      !!              diffv = 1/e2v dj[ zut ] + 1/(e1v*e3v) di-1[ e3f zuf ]
+      !!      If lk_sco=F and lk_zps=F, the vertical scale factors in the
+      !!      rotational part of the diffusion are simplified
+      !!      Add this before trend to the general trend (ua,va):
+      !!            (ua,va) = (ua,va) + (diffu,diffv)
+      !!      'key_trddyn' defined: the two components of the horizontal
+      !!                               diffusion trend are saved.
+      !!
+      !! ** Action : - Update (ua,va) with the before iso-level biharmonic
+      !!               mixing trend.
+      !!             - Save in (utrd,vtrd) the trends ('key_diatrends')
+      !!
+      !! History :
+      !!        !  90-09  (G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  93-03  (M. Guyon)  symetrical conditions (M. Guyon)
+      !!        !  96-01  (G. Madec)  statement function for e3
+      !!        !  97-07  (G. Madec)  lbc calls
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   zua, zva, zbt, ze2u, ze2v ! temporary scalar
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zuf, zut, zlu, zlv, zcu, zcv         ! temporary workspace
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_ldf_bilap : iso-level bilaplacian operator'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+      zuf(:,:) = 0.e0
+      zut(:,:) = 0.e0
+      zlu(:,:) = 0.e0
+      zlv(:,:) = 0.e0
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! Laplacian
+         ! ---------
+
+         IF( lk_sco .OR. lk_zps ) THEN   ! s-coordinate or z-coordinate with partial steps
+            zuf(:,:) = rotb(:,:,jk) * fse3f(:,:,jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zlu(ji,jj) = - ( zuf(ji,jj) - zuf(ji,jj-1) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
+                     &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) / e1u(ji,jj)
+   
+                  zlv(ji,jj) = + ( zuf(ji,jj) - zuf(ji-1,jj) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
+                     &         + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) / e2v(ji,jj)
+               END DO
+            END DO
+         ELSE                            ! z-coordinate
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zlu(ji,jj) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) / e2u(ji,jj)   &
+                     &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj  ,jk) ) / e1u(ji,jj)
+   
+                  zlv(ji,jj) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) / e1v(ji,jj)   &
+                     &         + ( hdivb(ji,jj+1,jk) - hdivb(ji  ,jj,jk) ) / e2v(ji,jj)
+               END DO  
+            END DO  
+         ENDIF
+
+         ! Boundary conditions on the laplacian  (zlu,zlv)
+         CALL lbc_lnk( zlu, 'U', -1. )
+         CALL lbc_lnk( zlv, 'V', -1. )
+         
+         
+         ! Third derivative
+         ! ----------------
+         
+         ! Multiply by the eddy viscosity coef. (at u- and v-points)
+         zlu(:,:) = zlu(:,:) * fsahmu(:,:,jk)
+         zlv(:,:) = zlv(:,:) * fsahmv(:,:,jk)
+         
+         ! Contravariant "laplacian"
+         zcu(:,:) = e1u(:,:) * zlu(:,:)
+         zcv(:,:) = e2v(:,:) * zlv(:,:)
+         
+         ! Laplacian curl ( * e3f if s-coordinates or z-coordinate with partial steps)
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zuf(ji,jj) = fmask(ji,jj,jk) * (  zcv(ji+1,jj  ) - zcv(ji,jj)      &
+                  &                            - zcu(ji  ,jj+1) + zcu(ji,jj)  )   &
+#if defined key_s_coord || defined key_partial_steps
+                  &       * fse3f(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) )
+#else
+                  &                         / ( e1f(ji,jj)*e2f(ji,jj) )
+#endif
+            END DO  
+         END DO  
+
+         ! Laplacian Horizontal fluxes
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+#if defined key_s_coord || defined key_partial_steps
+               zlu(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) * zlu(ji,jj)
+               zlv(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) * zlv(ji,jj)
+#else
+               zlu(ji,jj) = e2u(ji,jj) * zlu(ji,jj)
+               zlv(ji,jj) = e1v(ji,jj) * zlv(ji,jj)
+#endif
+            END DO
+         END DO
+
+         ! Laplacian divergence
+         DO jj = 2, jpj
+            DO ji = fs_2, jpi   ! vector opt.
+#if defined key_s_coord || defined key_partial_steps
+               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+#else
+               zbt = e1t(ji,jj) * e2t(ji,jj)
+#endif
+               zut(ji,jj) = (  zlu(ji,jj) - zlu(ji-1,jj  )   &
+                  &          + zlv(ji,jj) - zlv(ji  ,jj-1)  ) / zbt
+            END DO
+         END DO
+
+
+         ! boundary conditions on the laplacian curl and div (zuf,zut)
+         CALL lbc_lnk( zuf, 'F', -1. )
+         CALL lbc_lnk( zut, 'T', -1. )
+
+         
+         ! Bilaplacian
+         ! -----------
+
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_s_coord || defined key_partial_steps
+               ze2u = e2u(ji,jj) * fse3u(ji,jj,jk)
+               ze2v = e1v(ji,jj) * fse3v(ji,jj,jk)
+#else
+               ze2u = e2u(ji,jj)
+               ze2v = e1v(ji,jj)
+#endif
+               ! horizontal biharmonic diffusive trends
+               zua = - ( zuf(ji  ,jj) - zuf(ji,jj-1) ) / ze2u   &
+                  &  + ( zut(ji+1,jj) - zut(ji,jj  ) ) / e1u(ji,jj)
+
+               zva = + ( zuf(ji,jj  ) - zuf(ji-1,jj) ) / ze2v   &
+                  &  + ( zut(ji,jj+1) - zut(ji  ,jj) ) / e2v(ji,jj)
+               ! add it to the general momentum trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zva
+#if defined key_trddyn
+               ! save the horizontal biharmonic diffusive trends
+               utrd(ji,jj,jk,5) = zua
+               vtrd(ji,jj,jk,5) = zva
+#endif
+            END DO
+         END DO
+
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE dyn_ldf_bilap
+
+   !!======================================================================
+END MODULE dynldf_bilap
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90	(revision 4)
@@ -0,0 +1,472 @@
+MODULE dynldf_bilapg
+   !!======================================================================
+   !!                       ***  MODULE  dynldf_bilapg  ***
+   !! Ocean dynamics:  lateral viscosity trend
+   !!======================================================================
+#if defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                              Rotation of mixing tensor
+   !!----------------------------------------------------------------------
+   !!   dyn_ldf_bilapg : update the momentum trend with the horizontal part
+   !!                    of the horizontal s-coord. bilaplacian diffusion
+   !!   ldfguv         : 
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldfdyn_oce      ! ocean dynamics lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE trddyn_oce      ! dynamics trends diagnostics variables
+   USE ldfslp          ! iso-neutral slopes available
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dyn_ldf_bilapg ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldfdyn_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_ldf_bilapg( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dyn_ldf_bilapg  ***
+      !!                      
+      !! ** Purpose :   Compute the before trend of the horizontal momentum
+      !!      diffusion and add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The lateral momentum diffusive trends is provided by a 
+      !!      a 4th order operator rotated along geopotential surfaces. It is 
+      !!      computed using before fields (forward in time) and geopotential
+      !!      slopes computed in routine inildf.
+      !!         -1- compute the geopotential harmonic operator applied to
+      !!      (ub,vb) and multiply it by the eddy diffusivity coefficient
+      !!      (done by a call to ldfgpu and ldfgpv routines) The result is in
+      !!      (wk1,wk2) arrays. Applied the domain lateral boundary conditions
+      !!      by call to lbc_lnk.
+      !!         -2- applied to (wk1,wk2) the geopotential harmonic operator
+      !!      by a second call to ldfgpu and ldfgpv routines respectively. The
+      !!      result is in (wk3,wk4) arrays.
+      !!         -3- Add this trend to the general trend (ta,sa):
+      !!            (ua,va) = (ua,va) + (wk3,wk4)
+      !!      'key_trddyn' defined: the trend is saved for diagnostics.
+      !!
+      !! ** Action  : - Update (ua,va) arrays with the before geopotential
+      !!                biharmonic mixing trend.
+      !!              - save the trend in (utrd,vtrd) ('key_diatrends')
+      !!
+      !! History :
+      !!   8.0  !  97-07  (G. Madec)  Original code
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk                 ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         wk1, wk2,            &  ! work array used for rotated biharmonic
+         wk3, wk4                ! operator on tracers and/or momentum
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_ldf_bilapg : horizontal biharmonic operator in s-coordinate'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
+         wk1(:,:,:) = 0.e0   ;   wk3(:,:,:) = 0.e0
+         wk2(:,:,:) = 0.e0   ;   wk4(:,:,:) = 0.e0
+      ENDIF
+
+      ! Laplacian of (ub,vb) multiplied by ahm
+      ! --------------------------------------  
+      ! rotated harmonic operator applied to (ub,vb)
+      !     and multiply by ahmu, ahmv (output in (wk1,wk2) )
+
+      CALL ldfguv ( ub, vb, wk1, wk2, 1 )
+
+
+      ! Lateral boundary conditions on (wk1,wk2)
+      CALL lbc_lnk( wk1, 'U', -1. )
+      CALL lbc_lnk( wk2, 'V', -1. )
+
+
+      ! Bilaplacian of (ub,vb)
+      ! ---------------------- 
+      ! rotated harmonic operator applied to (wk1,wk2) (output in (wk3,wk4) )
+
+      CALL ldfguv ( wk1, wk2, wk3, wk4, 2 )
+
+
+      ! Update the momentum trends			   (j-slab :   2, jpj-1)
+      ! --------------------------
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ! add the diffusive trend to the general momentum trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + wk3(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + wk4(ji,jj,jk)
+#if defined key_trddyn 
+               ! save the horizontal diffusive trends
+               utrd(ji,jj,jk,3) = wk3(ji,jj,jk)
+               vtrd(ji,jj,jk,3) = wk4(ji,jj,jk)
+#endif
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+   END SUBROUTINE dyn_ldf_bilapg
+
+
+   SUBROUTINE ldfguv( pu, pv, plu, plv, kahm )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldfguv  ***
+      !!      
+      !! ** Purpose :   Apply a geopotential harmonic operator to (pu,pv)
+      !!      (defined at u- and v-points) and multiply it by the eddy
+      !!      viscosity coefficient (if kahm=1).
+      !!
+      !! ** Method  :   The harmonic operator rotated along geopotential 
+      !!      surfaces is applied to (pu,pv) using the slopes of geopotential
+      !!      surfaces computed in inildf routine. The result is provided in
+      !!      (plu,plv) arrays. It is computed in 2 stepv:
+      !!
+      !!      First step: horizontal part of the operator. It is computed on
+      !!      ==========  pu as follows (idem on pv)
+      !!      horizontal fluxes :
+      !!         zftu = e2u*e3u/e1u di[ pu ] - e2u*uslp dk[ mi(mk(pu)) ]
+      !!         zftv = e1v*e3v/e2v dj[ pu ] - e1v*vslp dk[ mj(mk(pu)) ]
+      !!      take the horizontal divergence of the fluxes (no divided by
+      !!      the volume element :
+      !!         plu  = di-1[ zftu ] +  dj-1[ zftv ]
+      !!
+      !!      Second step: vertical part of the operator. It is computed on
+      !!      ===========  pu as follows (idem on pv)
+      !!      vertical fluxes :
+      !!         zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2)  dk-1[ pu ]
+      !!              -     e2t     *       wslpi        di[ mi(mk(pu)) ]
+      !!              -     e1t     *       wslpj        dj[ mj(mk(pu)) ]
+      !!      take the vertical divergence of the fluxes add it to the hori-
+      !!      zontal component, divide the result by the volume element and
+      !!      if kahm=1, multiply by the eddy diffusivity coefficient:
+      !!         plu  = aht / (e1t*e2t*e3t) { plu + dk[ zftw ] }
+      !!      else:
+      !!         plu  =  1  / (e1t*e2t*e3t) { plu + dk[ zftw ] }
+      !!
+      !! ** Action :
+      !!        plu, plv        : partial harmonic operator applied to
+      !!                          pu and pv (all the components except
+      !!                          second order vertical derivative term)
+      !!      'key_trddyn' defined: the trend is saved for diagnostics.
+      !!
+      !! History :
+      !!   8.0  !  97-07  (G. Madec)  Original code
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
+         pu, pv     ! momentum fields (before u and v for the 1st call, and
+      !             ! laplacian of these fields multiplied by ahm for the 2nd
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   &
+         plu, plv   ! partial harmonic operator applied to
+      !             ! pu and pv (all the components except
+      !             ! second order vertical derivative term)
+      INTEGER, INTENT( in ) ::   &
+         kahm       ! =1 the laplacian is multiplied by the eddy diffusivity coef.
+      !             ! =2 no multiplication
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk       ! dummy loop indices
+      REAL(wp) ::   &
+         zabe1, zabe2, zcof1, zcof2,    &  ! temporary scalars
+         zcoef0, zcoef3, zcoef4
+      REAL(wp) ::   &
+         zbur, zbvr, zmkt, zmkf, zuav, zvav,    &
+         zuwslpi, zuwslpj, zvwslpi, zvwslpj
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         ziut, zjuf , zjvt, zivf,       &  ! workspace
+         zdku, zdk1u, zdkv, zdk1v
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         zfuw, zfvw, zdiu, zdiv,        &  ! workspace
+         zdju, zdj1u, zdjv, zdj1v 
+      !!----------------------------------------------------------------------
+
+      !                               ! ********** !   ! ===============
+      DO jk = 1, jpkm1                ! First step !   ! Horizontal slab
+         !                            ! ********** !   ! ===============
+
+         ! I.1 Vertical gradient of pu and pv at level jk and jk+1
+         ! -------------------------------------------------------
+         ! surface boundary condition: zdku(jk=1)=zdku(jk=2)
+         !                             zdkv(jk=1)=zdkv(jk=2)
+
+         zdk1u(:,:) = ( pu(:,:,jk) - pu(:,:,jk+1) ) * umask(:,:,jk+1)
+         zdk1v(:,:) = ( pv(:,:,jk) - pv(:,:,jk+1) ) * vmask(:,:,jk+1)
+
+         IF( jk == 1 ) THEN
+            zdku(:,:) = zdk1u(:,:)
+            zdkv(:,:) = zdk1v(:,:)
+         ELSE
+            zdku(:,:) = ( pu(:,:,jk-1) - pu(:,:,jk) ) * umask(:,:,jk)
+            zdkv(:,:) = ( pv(:,:,jk-1) - pv(:,:,jk) ) * vmask(:,:,jk)
+         ENDIF
+
+         !                                -----f-----
+         ! I.2 Horizontal fluxes on U          |
+         ! ------------------------===     t   u   t
+         !                                     |
+         ! i-flux at t-point              -----f-----
+         DO jj = 1, jpjm1
+            DO ji = 2, jpi
+               zabe1 = e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)
+
+               zmkt  = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   &
+                              + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. )
+
+               zcof1 = -e2t(ji,jj) * zmkt   &
+                     * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
+
+               ziut(ji,jj) = tmask(ji,jj,jk) *   &
+                           (  zabe1 * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) )   &
+                            + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     &
+                                       +zdk1u(ji,jj) + zdku (ji-1,jj) )  )
+            END DO
+         END DO
+
+         ! j-flux at f-point
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zabe2 = e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj)
+
+               zmkf  = 1./MAX(  umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)   &
+                              + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ), 1. )
+
+               zcof2 = -e1f(ji,jj) * zmkf   &
+                     * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
+
+               zjuf(ji,jj) = fmask(ji,jj,jk) *   &
+                           (  zabe2 * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) )   &
+                            + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     &
+                                       +zdk1u(ji,jj+1) + zdku (ji,jj) )  )
+            END DO
+         END DO
+
+         !                                 |   t   |
+         ! I.3 Horizontal fluxes on V      |       |
+         ! ------------------------===     f---v---f
+         !                                 |       |
+         ! i-flux at f-point               |   t   |
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zabe1 = e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)
+
+               zmkf  = 1./MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)   &
+                              + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ), 1. )
+
+               zcof1 = -e2f(ji,jj) * zmkf   &
+                     * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
+
+               zivf(ji,jj) = fmask(ji,jj,jk) *   &
+                           (  zabe1 * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) )   &
+                            + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj)     &
+                                       +zdk1u(ji,jj) + zdku (ji+1,jj) )  )
+            END DO
+         END DO
+
+         ! j-flux at t-point
+         DO jj = 2, jpj
+            DO ji = 1, jpim1
+               zabe2 = e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)
+
+               zmkt  = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   &
+                              + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. )
+
+               zcof2 = -e1t(ji,jj) * zmkt   &
+                     * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
+
+               zjvt(ji,jj) = tmask(ji,jj,jk) *   &
+                           (  zabe2 * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) )   &
+                            + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj)     &
+                                       +zdk1u(ji,jj-1) + zdku (ji,jj) )  )
+            END DO
+         END DO
+
+
+         ! I.4 Second derivative (divergence) (not divided by the volume)
+         ! ---------------------
+
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               plu(ji,jj,jk) = ziut (ji+1,jj) - ziut (ji,jj  )   &
+                             + zjuf (ji  ,jj) - zjuf (ji,jj-1)
+               plv(ji,jj,jk) = zivf (ji,jj  ) - zivf (ji-1,jj)   &
+                             + zjvt (ji,jj+1) - zjvt (ji,jj  ) 
+            END DO
+         END DO
+
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+
+      !                             ! ************ !   ! ===============
+      DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
+         !                          ! ************ !   ! ===============
+
+         ! II.1 horizontal (pu,pv) gradients
+         ! ---------------------------------
+
+         DO jk = 1, jpk
+            DO ji = 2, jpi
+               ! i-gradient of u at jj
+               zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( pu(ji,jj  ,jk) - pu(ji-1,jj  ,jk) )
+               ! j-gradient of u and v at jj
+               zdju (ji,jk) = fmask(ji,jj  ,jk) * ( pu(ji,jj+1,jk) - pu(ji  ,jj  ,jk) )
+               zdjv (ji,jk) = tmask(ji,jj  ,jk) * ( pv(ji,jj  ,jk) - pv(ji  ,jj-1,jk) )
+               ! j-gradient of u and v at jj+1
+               zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( pu(ji,jj  ,jk) - pu(ji  ,jj-1,jk) )
+               zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( pv(ji,jj+1,jk) - pv(ji  ,jj  ,jk) )
+            END DO
+         END DO
+         DO jk = 1, jpk
+            DO ji = 1, jpim1
+               ! i-gradient of v at jj
+               zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( pv(ji+1,jj,jk) - pv(ji  ,jj  ,jk) )
+            END DO
+         END DO
+
+
+         ! II.2 Vertical fluxes
+         ! --------------------
+
+         ! Surface and bottom vertical fluxes set to zero
+
+         zfuw(:, 1 ) = 0.e0
+         zfvw(:, 1 ) = 0.e0
+         zfuw(:,jpk) = 0.e0
+         zfvw(:,jpk) = 0.e0
+
+         ! interior (2=<jk=<jpk-1) on pu field
+
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               ! i- and j-slopes at uw-point
+               zuwslpi = 0.5 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) )
+               zuwslpj = 0.5 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) )
+               ! coef. for the vertical dirative
+               zcoef0 = e1u(ji,jj) * e2u(ji,jj) / fse3u(ji,jj,jk)   &
+                      * ( zuwslpi * zuwslpi + zuwslpj * zuwslpj )
+               ! weights for the i-k, j-k averaging at t- and f-points, resp.
+               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)   &
+                             + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. )
+               zmkf = 1./MAX(  fmask(ji,jj-1,jk-1)+fmask(ji,jj,jk-1)   &
+                             + fmask(ji,jj-1,jk  )+fmask(ji,jj,jk  ), 1. )
+               ! coef. for the horitontal derivative
+               zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi
+               zcoef4 = - e1u(ji,jj) * zmkf * zuwslpj
+               ! vertical flux on u field
+               zfuw(ji,jk) = umask(ji,jj,jk) *   &
+                           (  zcoef0 * ( pu  (ji,jj,jk-1) - pu  (ji,jj,jk) )   &
+                            + zcoef3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1)     &
+                                        +zdiu (ji,jk  ) + zdiu (ji+1,jk  ) )   &
+                            + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji  ,jk-1)     &
+                                        +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) ) )
+            END DO
+         END DO
+
+         ! interior (2=<jk=<jpk-1) on pv field
+
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               ! i- and j-slopes at vw-point
+               zvwslpi = 0.5 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) )
+               zvwslpj = 0.5 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) )
+               ! coef. for the vertical derivative
+               zcoef0 = e1v(ji,jj) * e2v(ji,jj) / fse3v(ji,jj,jk)   &
+                      * ( zvwslpi * zvwslpi + zvwslpj * zvwslpj )
+               ! weights for the i-k, j-k averaging at f- and t-points, resp.
+               zmkf = 1./MAX(  fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1)   &
+                             + fmask(ji-1,jj,jk  )+fmask(ji,jj,jk  ), 1. )
+               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1)   &
+                             + tmask(ji,jj,jk  )+tmask(ji,jj+1,jk  ), 1. )
+               ! coef. for the horizontal derivatives
+               zcoef3 = - e2v(ji,jj) * zmkf * zvwslpi
+               zcoef4 = - e1v(ji,jj) * zmkt * zvwslpj
+               ! vertical flux on pv field
+               zfvw(ji,jk) = vmask(ji,jj,jk) *   &
+                           (  zcoef0 * ( pv  (ji,jj,jk-1) - pv  (ji,jj,jk) )   &
+                            + zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     &
+                                        +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   &
+                            + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     &
+                                        +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) )  )
+            END DO
+         END DO
+
+
+         ! II.3 Divergence of vertical fluxes added to the horizontal divergence
+         ! ---------------------------------------------------------------------
+
+         IF( kahm == 1 ) THEN
+            ! multiply the laplacian by the eddy viscosity coefficient
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  ! eddy coef. divided by the volume element
+                  zbur = fsahmu(ji,jj,jk) / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) )
+                  zbvr = fsahmv(ji,jj,jk) / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) )
+                  ! vertical divergence
+                  zuav = zfuw(ji,jk) - zfuw(ji,jk+1)
+                  zvav = zfvw(ji,jk) - zfvw(ji,jk+1)
+                  ! harmonic operator applied to (pu,pv) and multiply by ahm
+                  plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur
+                  plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr
+               END DO
+            END DO
+         ELSEIF( kahm == 2 ) THEN
+            ! second call, no multiplication
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  ! inverse of the volume element
+                  zbur = 1. / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) )
+                  zbvr = 1. / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) )
+                  ! vertical divergence
+                  zuav = zfuw(ji,jk) - zfuw(ji,jk+1)
+                  zvav = zfvw(ji,jk) - zfvw(ji,jk+1)
+                  ! harmonic operator applied to (pu,pv) 
+                  plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur
+                  plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr
+               END DO
+            END DO
+         ELSE
+            IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm
+            IF(lwp)WRITE(numout,*) '         We stop'
+            STOP 'ldfguv'
+         ENDIF
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE ldfguv
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                         NO rotation of mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE dyn_ldf_bilapg( kt )               ! Dummy routine
+      WRITE(*,*) kt
+   END SUBROUTINE dyn_ldf_bilapg
+#endif
+
+   !!======================================================================
+END MODULE dynldf_bilapg
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynldf_iso.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 4)
@@ -0,0 +1,258 @@
+MODULE dynldf_iso
+   !!======================================================================
+   !!                     ***  MODULE  dynldf_iso  ***
+   !! Ocean dynamics:  lateral viscosity trend
+   !!======================================================================
+#if defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                      slopes of the direction of mixing
+   !!----------------------------------------------------------------------
+   !!   dyn_ldf_iso  : update the momentum trend with the horizontal part
+   !!                  of the lateral diffusion using isopycnal or horizon-
+   !!                  tal s-coordinate laplacian operator.
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldfdyn_oce      ! ocean dynamics lateral physics
+   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE trddyn_oce      ! dynamics trends diagnostics
+   USE ldfslp          ! iso-neutral slopes 
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dyn_ldf_iso           ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldfdyn_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_ldf_iso( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dyn_ldf_iso  ***
+      !!                       
+      !! ** Purpose :   Compute the before trend of the horizontal part of the
+      !!      lateral momentum diffusion and add it to the general trend of
+      !!      momentum equation.
+      !!
+      !! ** Method :
+      !!        The horizontal component of the lateral diffusive trends on
+      !!      momentum is provided by a 2nd order operator rotated along neu-
+      !!      tral or geopotential surfaces (in s-coordinates).
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp or inildf.
+      !!      Here, u and v components are considered as 2 independent scalar
+      !!      fields. Therefore, the property of splitting divergent and rota-
+      !!      tional part of the flow of the standard, z-coordinate laplacian
+      !!      momentum diffusion is lost.
+      !!      horizontal fluxes associated with the rotated lateral mixing:
+      !!      u-component:
+      !!         ziut = ( ahmt + ahmb0 ) e2t * e3t / e1t  di[ ub ]
+      !!               -      ahmt       e2t * mi-1(uslp) dk[ mi(mk(ub)) ]
+      !!         zjuf = ( ahmf + ahmb0 ) e1f * e3f / e2f  dj[ ub ]
+      !!               -      ahmf       e1f * mi(vslp)   dk[ mj(mk(ub)) ]
+      !!      v-component:
+      !!         zivf = ( ahmf + ahmb0 ) e2t * e3t / e1t  di[ vb ]
+      !!               -      ahmf       e2t * mj(uslp)   dk[ mi(mk(vb)) ]
+      !!         zjvt = ( ahmt + ahmb0 ) e1f * e3f / e2f  dj[ ub ]
+      !!               -      ahmt       e1f * mj-1(vslp) dk[ mj(mk(vb)) ]
+      !!      take the horizontal divergence of the fluxes:
+      !!         diffu = 1/(e1u*e2u*e3u) {  di  [ ziut ] + dj-1[ zjuf ]  }
+      !!         diffv = 1/(e1v*e2v*e3v) {  di-1[ zivf ] + dj  [ zjvt ]  }
+      !!      Add this trend to the general trend (ua,va):
+      !!         ua = ua + diffu
+      !!      'key_trddyn' defined: the trends are saved for diagnostics.
+      !!
+      !! ** Action :
+      !!        Update (ua,va) arrays with the before geopotential biharmonic
+      !!      mixing trend.
+      !!        Save in (utrd,vtrd) arrays the trends if 'key_diatrends' defined
+      !!
+      !! History :
+      !!   8.0  !  97-07  (G. Madec)  Original code
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   &
+         zabe1, zabe2, zcof1, zcof2,   &      ! temporary scalars
+         zmskt, zmskf, zbu, zbv,       &
+         zuah, zvah
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         ziut, zjuf, zjvt, zivf,   &          ! temporary workspace
+         zdku, zdk1u, zdkv, zdk1v
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_ldf_iso : iso-neutral laplacian diffusive operator or '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate horizontal diffusive operator'
+      ENDIF
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         ! Vertical u- and v-shears at level jk and jk+1
+         ! ---------------------------------------------
+         ! surface boundary condition: zdku(jk=1)=zdku(jk=2)
+         !                             zdkv(jk=1)=zdkv(jk=2)
+
+         zdk1u(:,:) = ( ub(:,:,jk) -ub(:,:,jk+1) ) * umask(:,:,jk+1)
+         zdk1v(:,:) = ( vb(:,:,jk) -vb(:,:,jk+1) ) * vmask(:,:,jk+1)
+
+         IF( jk == 1 ) THEN
+            zdku(:,:) = zdk1u(:,:)
+            zdkv(:,:) = zdk1v(:,:)
+         ELSE
+            zdku(:,:) = ( ub(:,:,jk-1) - ub(:,:,jk) ) * umask(:,:,jk)
+            zdkv(:,:) = ( vb(:,:,jk-1) - vb(:,:,jk) ) * vmask(:,:,jk)
+         ENDIF
+
+         !                               -----f-----
+         ! Horizontal fluxes on U             |  
+         ! --------------------===        t   u   t
+         !                                    |  
+         ! i-flux at t-point             -----f-----
+
+         DO jj = 2, jpjm1
+            DO ji = fs_2, jpi   ! vector opt.
+               zabe1 = ( fsahmt(ji,jj,jk) + ahmb0 )   &
+#if defined key_partial_steps
+                     * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1, jj,jk) ) / e1t(ji,jj)
+#else
+                     * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)
+#endif
+
+               zmskt = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   &
+                              + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. )
+
+               zcof1 = - aht0 * e2t(ji,jj) * zmskt   &
+                     * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
+
+               ziut(ji,jj) = tmask(ji,jj,jk) *   &
+                           (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )   &
+                            + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     &
+                                       +zdk1u(ji,jj) + zdku (ji-1,jj) )  )
+            END DO
+         END DO
+
+         ! j-flux at f-point
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zabe2 = ( fsahmf(ji,jj,jk) + ahmb0 )   &
+                     * e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj)
+
+               zmskf = 1./MAX(  umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)   &
+                              + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ), 1. )
+
+               zcof2 = - aht0 * e1f(ji,jj) * zmskf   &
+                     * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
+
+               zjuf(ji,jj) = fmask(ji,jj,jk) *   &
+                           (  zabe2 * ( ub(ji,jj+1,jk) - ub(ji,jj,jk) )   &
+                            + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     &
+                                       +zdk1u(ji,jj+1) + zdku (ji,jj) )  )
+            END DO
+         END DO
+
+         !                                |   t   |
+         ! Horizontal fluxes on V         |       |
+         ! --------------------===        f---v---f
+         !                                |       |
+         ! i-flux at f-point              |   t   |
+
+         DO jj = 2, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zabe1 = ( fsahmf(ji,jj,jk) + ahmb0 )   &
+                     * e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)
+
+               zmskf = 1./MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)   &
+                              + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ), 1. )
+
+               zcof1 = - aht0 * e2f(ji,jj) * zmskf   &
+                     * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
+
+               zivf(ji,jj) = fmask(ji,jj,jk) *   &
+                           (  zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) )   &
+                            + zcof1 * ( zdkv (ji,jj) + zdk1v(ji+1,jj)     &
+                                       +zdk1v(ji,jj) + zdkv (ji+1,jj) )  )
+            END DO
+         END DO
+
+         ! j-flux at t-point
+         DO jj = 2, jpj
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zabe2 = ( fsahmt(ji,jj,jk) + ahmb0 )   &
+#if defined key_partial_steps
+                     * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji, jj-1, jk) ) / e2t(ji,jj)
+#else
+                     * e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)
+#endif
+
+               zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   &
+                              + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. )
+
+               zcof2 = - aht0 * e1t(ji,jj) * zmskt   &
+                     * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
+
+               zjvt(ji,jj) = tmask(ji,jj,jk) *   &
+                           (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )   &
+                            + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)     &
+                                       +zdk1v(ji,jj-1) + zdkv (ji,jj) )  )
+            END DO
+         END DO
+
+
+         ! Second derivative (divergence) and add to the general trend
+         ! -----------------------------------------------------------
+
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1          !! Question vectop possible??? !!bug
+               ! volume elements
+               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+               ! horizontal component of isopycnal momentum diffusive trends
+               zuah =( ziut (ji+1,jj) - ziut (ji,jj  ) +   &
+                       zjuf (ji  ,jj) - zjuf (ji,jj-1)  ) / zbu
+               zvah =( zivf (ji,jj  ) - zivf (ji-1,jj) +   &
+                       zjvt (ji,jj+1) - zjvt (ji,jj  )  ) / zbv
+               ! add the trends to the general trends
+               ua (ji,jj,jk) = ua (ji,jj,jk) + zuah
+               va (ji,jj,jk) = va (ji,jj,jk) + zvah
+#if defined key_trddyn
+               ! save the trends for diagnostics
+               utrd(ji,jj,jk,5) = zuah
+               vtrd(ji,jj,jk,5) = zvah
+#endif
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE dyn_ldf_iso
+
+# else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                           NO rotation of mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE dyn_ldf_iso( kt )               ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE dyn_ldf_iso
+#endif
+
+   !!======================================================================
+END MODULE dynldf_iso
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynldf_lap.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynldf_lap.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynldf_lap.F90	(revision 4)
@@ -0,0 +1,130 @@
+MODULE dynldf_lap
+   !!======================================================================
+   !!                       ***  MODULE  dynldf_lap  ***
+   !! Ocean dynamics:  lateral viscosity trend
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dyn_ldf_lap  : update the momentum trend with the lateral diffusion
+   !!                  using an iso-level harmonic operator
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldfdyn_oce      ! ocean dynamics: lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE trddyn_oce      ! ocean dynamics trends
+   USE ldfslp          ! iso-neutral slopes 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dyn_ldf_lap  ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldfdyn_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_ldf_lap( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dyn_ldf_lap  ***
+      !!                       
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The before horizontal momentum diffusion trend is an
+      !!      harmonic operator (laplacian type) which separates the divergent
+      !!      and rotational parts of the flow.
+      !!      Its horizontal components are computed as follow:
+      !!         difu = 1/e1u di[ahmt hdivb] - 1/(e2u*e3u) dj-1[e3f ahmf rotb]
+      !!         difv = 1/e2v dj[ahmt hdivb] + 1/(e1v*e3v) di-1[e3f ahmf rotb]
+      !!      If 'key_s_coord' key is not activated, the vertical scale factor
+      !!      is simplified in the rotational part of the diffusion.
+      !!      Add this before trend to the general trend (ua,va):
+      !!            (ua,va) = (ua,va) + (diffu,diffv)
+      !!      'key_trddyn' activated: the two components of the horizontal
+      !!                                 diffusion trend are saved.
+      !!
+      !! ** Action : - Update (ua,va) with the before iso-level harmonic 
+      !!               mixing trend.
+      !!             - Save in (utrd,vtrd) arrays the trends ('key_diatrends')
+      !!
+      !! History :
+      !!        !  90-09 (G. Madec) Original code
+      !!        !  91-11 (G. Madec)
+      !!        !  96-01 (G. Madec) statement function for e3 and ahm
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   &
+         zua, zva, ze2u, ze1v            ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacien) operator'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_s_coord || defined key_partial_steps
+               ze2u = rotb (ji,jj,jk)*fsahmf(ji,jj,jk)*fse3f(ji,jj,jk)
+               ze1v = hdivb(ji,jj,jk)*fsahmt(ji,jj,jk)
+               ! horizontal diffusive trends
+               zua = - ( ze2u - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk)*fse3f(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
+                     + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v                   ) / e1u(ji,jj)
+
+               zva = + ( ze2u - rotb (ji-1,jj,jk)*fsahmf(ji-1,jj,jk)*fse3f(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
+                     + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v                   ) / e2v(ji,jj)
+#else
+               ! horizontal diffusive trends
+               ze2u = rotb (ji,jj,jk)*fsahmf(ji,jj,jk)
+               ze1v = hdivb(ji,jj,jk)*fsahmt(ji,jj,jk)
+               zua = - (                ze2u                  - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk) ) / e2u(ji,jj)   &
+                     + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) -                ze1v                  ) / e1u(ji,jj)
+
+               zva = + (                ze2u                  - rotb (ji-1,jj,jk)*fsahmf(ji-1,jj,jk) ) / e1v(ji,jj)   &
+                     + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) -                ze1v                  ) / e2v(ji,jj)
+#endif
+
+               ! add it to the general momentum trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zva
+#if defined key_trddyn
+               ! save the horizontal diffusive trends
+               utrd(ji,jj,jk,5) = zua
+               vtrd(ji,jj,jk,5) = zva
+#endif
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' ldf  - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl
+         u_ctl = zua   ;   v_ctl = zva
+      ENDIF
+
+   END SUBROUTINE dyn_ldf_lap
+
+   !!======================================================================
+END MODULE dynldf_lap
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynnxt.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 4)
@@ -0,0 +1,142 @@
+MODULE dynnxt
+   !!======================================================================
+   !!                       ***  MODULE  dynnxt  ***
+   !! Ocean dynamics: time stepping
+   !!======================================================================
+   
+   !!----------------------------------------------------------------------
+   !!   dyn_nxt      : update the horizontal velocity from the momentum trend
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE obcdyn          ! open boundary condition for momentum (obc_dyn routine)
+   USE lbclnk          ! lateral boundary condition (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC dyn_nxt                ! routine called by step.F90
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_nxt ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_nxt  ***
+      !!                   
+      !! ** Purpose :   Compute the after horizontal velocity from the 
+      !!      momentum trend.
+      !!
+      !! ** Method  :   Apply lateral boundary conditions on the trends (ua,va) 
+      !!      through calls to routine lbc_lnk.
+      !!      After velocity is compute using a leap-frog scheme environment:
+      !!         (ua,va) = (ub,vb) + 2 rdt (ua,va)
+      !!      Note that if "key_dynspg_fsc" defined, the time stepping 
+      !!      has already been performed in dynspg.F routine
+      !!      Time filter applied on now horizontal velocity to avoid the
+      !!      divergence of two consecutive time-steps and swap of dynamics
+      !!      arrays to start the next time step:
+      !!         (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ]
+      !!         (un,vn) = (ua,va) 
+      !!
+      !! ** Action : - Update ub,vb arrays, the before horizontal velocity
+      !!             - Update un,vn arrays, the now horizontal velocity
+      !!
+      !! History :
+      !!        !  87-02  (P. Andrich, D. L Hostis)  Original code
+      !!        !  90-10  (C. Levy, G. Madec)
+      !!        !  93-03  (M. Guyon)  symetrical conditions
+      !!        !  97-02  (G. Madec & M. Imbard)  opa, release 8.0
+      !!        !  97-04  (A. Weaver)  Euler forward step
+      !!        !  97-06  (G. Madec)  lateral boudary cond., lbc routine
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!        !  02-10  (C. Talandier, A-M. Treguier) Open boundary cond.
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   z2dt         ! temporary scalar
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_nxt : time stepping'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      ! Local constant initialization
+      z2dt = 2. * rdt
+      IF( neuler == 0 .AND. kt == nit000 )  z2dt = rdt
+
+      ! Lateral boundary conditions on ( ua, va )
+      CALL lbc_lnk( ua, 'U', -1. )
+      CALL lbc_lnk( va, 'V', -1. )
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! Next velocity
+         ! -------------
+#if defined key_dynspg_fsc
+         ! Leap-frog time stepping already done in dynspg.F routine
+#else
+         DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop
+            DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking
+               ! Leap-frog time stepping
+               ua(ji,jj,jk) = ( ub(ji,jj,jk) + z2dt * ua(ji,jj,jk) ) * umask(ji,jj,jk)
+               va(ji,jj,jk) = ( vb(ji,jj,jk) + z2dt * va(ji,jj,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+# if defined key_obc
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      ! Update (ua,va) along open boundaries (only in the rigid-lid case)
+      CALL obc_dyn( kt )
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+# endif
+#endif
+         ! Time filter and swap of dynamics arrays
+         ! ------------------------------------------
+         IF( neuler == 0 .AND. kt == nit000 ) THEN
+            DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop
+               DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking
+                  ! Euler (forward) time stepping
+                  ub(ji,jj,jk) = un(ji,jj,jk)
+                  vb(ji,jj,jk) = vn(ji,jj,jk)
+                  un(ji,jj,jk) = ua(ji,jj,jk)
+                  vn(ji,jj,jk) = va(ji,jj,jk)
+               END DO
+            END DO
+         ELSE
+            DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop
+               DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking
+                  ! Leap-frog time stepping
+                  ub(ji,jj,jk) = atfp * ( ub(ji,jj,jk) + ua(ji,jj,jk) ) + atfp1 * un(ji,jj,jk)
+                  vb(ji,jj,jk) = atfp * ( vb(ji,jj,jk) + va(ji,jj,jk) ) + atfp1 * vn(ji,jj,jk)
+                  un(ji,jj,jk) = ua(ji,jj,jk)
+                  vn(ji,jj,jk) = va(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum fields (used for debugging)
+         WRITE(numout,*) ' nxt  - Un: ', SUM(un*umask), ' Vn: ', SUM(vn*vmask)
+      ENDIF
+
+   END SUBROUTINE dyn_nxt
+
+   !!======================================================================
+END MODULE dynnxt
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynspg_fsc.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynspg_fsc.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynspg_fsc.F90	(revision 4)
@@ -0,0 +1,401 @@
+MODULE dynspg_fsc
+   !!======================================================================
+   !!                   ***  MODULE  dynspg_fsc  ***
+   !! Ocean dynamics:  surface pressure gradient trend
+   !!======================================================================
+#if ( defined key_dynspg_fsc && ! defined key_autotasking ) ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_fsc'                       free surface cst volume
+   !!   NOT 'key_autotasking'                      k-j-i loop (vector opt.)
+   !!----------------------------------------------------------------------
+   !!   dyn_spg_fsc  : update the momentum trend with the surface pressure
+   !!                  gradient in the free surface constant volume case
+   !!                  with vector optimization
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain 
+   USE trdtra_oce      ! ocean active tracer   trend
+   USE trddyn_oce      ! ocean active dynamics trend
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE phycst          ! physical constants
+   USE ocesbc          ! ocean surface boundary condition
+   USE flxrnf          ! ???
+   USE sol_oce         ! solver variables
+   USE solpcg          ! preconditionned conjugate gradient solver
+   USE solsor          ! Successive Over-relaxation solver
+   USE solfet          ! FETI solver
+   USE obc_oce         ! Lateral open boundary condition
+   USE obcdyn          ! ocean open boundary condition (obc_dyn routines)
+   USE obcvol          ! ocean open boundary condition (obc_vol routines)
+   USE lib_mpp         ! ???
+   USE lbclnk          ! ???
+   USE cla_dynspg      ! ???
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC dyn_spg_fsc  ! routine called by step.F90
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_fsc = .TRUE.    ! free surface constant volume flag
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_spg_fsc( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine dyn_spg_fsc  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to the surface pressure 
+      !!      gradient in case of free surface formulation with a constant
+      !!      ocean volume add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   Free surface formulation. The surface pressure gradient
+      !!      is given by:
+      !!         spgu = 1/rau0 d/dx(ps) =  1/e1u di( etn + rnu btda )
+      !!         spgv = 1/rau0 d/dy(ps) =  1/e2v dj( etn + rnu btda )
+      !!      where etn is the free surface elevation and btda is the after
+      !!      of the free surface elevation
+      !!       -1- compute the after sea surface elevation from the cinematic
+      !!      surface boundary condition:
+      !!              zssha = sshb + 2 rdt ( wn - emp )
+      !!           Time filter applied on now sea surface elevation to avoid 
+      !!      the divergence of two consecutive time-steps and swap of free
+      !!      surface arrays to start the next time step:
+      !!              sshb = sshn + atfp * [ sshb + zssha - 2 sshn ]
+      !!              sshn = zssha
+      !!       -2- evaluate the surface presure trend (including the addi-
+      !!      tional force) in three steps:
+      !!        a- compute the right hand side of the elliptic equation:
+      !!            gcb = 1/(e1t e2t) [ di(e2u spgu) + dj(e1v spgv) ]
+      !!         where (spgu,spgv) are given by:
+      !!            spgu = vertical sum[ e3u (ub+ 2 rdt ua ) ]
+      !!                 - g 2 rdt hu /e1u di[sshn + emp]
+      !!            spgv = vertical sum[ e3v (vb+ 2 rdt va) ]
+      !!                 - g 2 rdt hv /e2v dj[sshn + emp]
+      !!         and define the first guess from previous computation :
+      !!            zbtd = btda
+      !!            btda = 2 zbtd - btdb
+      !!            btdb = zbtd
+      !!        b- compute the relative accuracy to be reached by the
+      !!         iterative solver
+      !!        c- apply the solver by a call to sol... routine
+      !!       -3- compute and add the free surface pressure gradient inclu-
+      !!      ding the additional force used to stabilize the equation.
+      !!
+      !! ** Action : - Update (ua,va) with the surf. pressure gradient trend
+      !!             - Save the trends in (utrd,vtrd) ('key_diatrends')
+      !!
+      !! References :
+      !!      Roullet and Madec 1999, JGR.
+      !!
+      !! History :
+      !!        !  98-05 (G. Roullet)  Original code
+      !!        !  98-10  (G. Madec, M. Imbard)  release 8.2
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!        !  02-11  (C. Talandier, A-M Treguier) Open boundaries
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in )  ::   kt         ! ocean time-step index
+      INTEGER, INTENT( out ) ::   kindic     ! solver convergence flag
+                                             ! if the solver doesn t converge
+                                             ! the flag is < 0
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk               ! dummy loop indices
+      REAL(wp) ::                         & 
+         z2dt, z2dtg, zraur, znugdt,      &  ! temporary scalars
+         znurau, zssha, zspgu, zspgv,     &  !   "          "
+         zegu, zegv, zgcb, zbtd,          &  !   "          "
+         ztdgu, ztdgv, zgwgt                 !   "          "
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_spg_fsc : surface pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   (free surface constant volume case)'
+       
+         ! set to zero free surface specific arrays
+         spgu(:,:) = 0.e0                     ! surface pressur gradient (i-direction)
+         spgv(:,:) = 0.e0                     ! surface pressur gradient (j-direction)
+         IF( .NOT.ln_rstart ) THEN 
+            sshb(:,:) = 0.e0                     ! before sea-surface height
+            sshn(:,:) = 0.e0                     ! now    sea-surface height
+         ENDIF
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      ! time step: leap-frog
+      z2dt = 2. * rdt
+      ! time step: Euler if restart from rest
+      IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt
+      ! coefficients
+      z2dtg  = g * z2dt
+      zraur  = 1. / rauw
+      znugdt =  rnu * g * z2dt
+      znurau =  znugdt * zraur
+#if defined key_mpp
+      ! Mpp : export boundary values of to neighboring processors
+      !!bug :  I don t understand why this only in mpp????
+      CALL lbc_lnk( ua, 'U', -1. )
+      CALL lbc_lnk( va, 'V', -1. )
+#endif
+
+      ! 1. Surface pressure gradient (now)
+      ! ----------------------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zspgu =      - g * ( sshn(ji+1,jj) - sshn(ji,jj) ) / e1u(ji,jj)
+            zspgv =      - g * ( sshn(ji,jj+1) - sshn(ji,jj) ) / e2v(ji,jj)
+            zegu  = + znurau * ( emp (ji+1,jj) - emp (ji,jj) ) / e1u(ji,jj)
+            zegv  = + znurau * ( emp (ji,jj+1) - emp (ji,jj) ) / e2v(ji,jj)
+            spgu(ji,jj) = zspgu + zegu
+            spgv(ji,jj) = zspgv + zegv
+#if defined key_trddyn
+            ! save the surface pressure gradient trends 
+            utrd2(ji,jj,1) = zspgu
+            vtrd2(ji,jj,1) = zspgv
+            ! save the first part of the additional force trend
+            utrd2(ji,jj,2) = zegu
+            vtrd2(ji,jj,2) = zegv
+#endif
+         END DO 
+      END DO 
+
+      ! 2. Add the surface pressure trend to the general trend
+      ! ------------------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj)
+               va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj)
+#if defined key_trddyn
+               ! save the surface pressure gradient trend for diagnostics
+               utrd(ji,jj,jk,8) = spgu(ji,jj)
+               vtrd(ji,jj,jk,8) = spgv(ji,jj) 
+#endif
+            END DO
+         END DO
+      END DO
+      
+      ! 1. Evaluate the masked next velocity
+      ! ------------------------------------
+      !     (effect of the additional force not included)
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) = ( ub(ji,jj,jk) + z2dt * ua(ji,jj,jk) ) * umask(ji,jj,jk)
+               va(ji,jj,jk) = ( vb(ji,jj,jk) + z2dt * va(ji,jj,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#if defined key_obc
+      ! Update velocities on each open boundary with the radiation algorithm
+      CALL obc_dyn( kt )
+      ! Correction of the barotropic componant velocity to control the volume of the system
+      CALL obc_vol( kt )
+#endif
+#if defined key_orca_r2
+      IF( n_cla == 1 )   CALL dyn_spg_cla( kt )      ! Cross Land Advection (update (ua,va))
+#endif
+
+      ! 2. compute the next vertically averaged velocity
+      ! ------------------------------------------------
+      !     (effect of the additional force not included)
+      ! initialize to zero
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            spgu(ji,jj) = 0.e0
+            spgv(ji,jj) = 0.e0
+         END DO
+      END DO
+
+      ! vertical sum
+!CDIR NOLOOPCHG
+      DO jk = 1, jpkm1
+#if defined key_vectopt_loop
+         DO ji = 1, jpij                 ! vector opt.
+            spgu(ji,1) = spgu(ji,1) + fse3u(ji,1,jk) * ua(ji,1,jk)
+            spgv(ji,1) = spgv(ji,1) + fse3v(ji,1,jk) * va(ji,1,jk)
+         END DO
+#else
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1             ! NO vector opt.
+               spgu(ji,jj) = spgu(ji,jj) + fse3u(ji,jj,jk) * ua(ji,jj,jk)
+               spgv(ji,jj) = spgv(ji,jj) + fse3v(ji,jj,jk) * va(ji,jj,jk)
+            END DO
+         END DO
+#endif
+      END DO
+
+      ! transport: multiplied by the horizontal scale factor
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            spgu(ji,jj) = spgu(ji,jj) * e2u(ji,jj)
+            spgv(ji,jj) = spgv(ji,jj) * e1v(ji,jj)
+         END DO
+      END DO
+
+      ! Boundary conditions on (spgu,spgv)
+      CALL lbc_lnk( spgu, 'U', -1. )
+      CALL lbc_lnk( spgv, 'V', -1. )
+
+      ! 3. Right hand side of the elliptic equation and first guess
+      ! -----------------------------------------------------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! Divergence of the after vertically averaged velocity
+            zgcb =  spgu(ji,jj) - spgu(ji-1,jj)   &
+                  + spgv(ji,jj) - spgv(ji,jj-1)
+            gcb(ji,jj) = gcdprc(ji,jj) * zgcb
+            ! First guess of the after barotropic transport divergence
+            zbtd = gcx(ji,jj)
+            gcx (ji,jj) = 2. * zbtd   - gcxb(ji,jj)
+            gcxb(ji,jj) =      zbtd
+         END DO
+      END DO
+
+      ! 4. Relative precision (computation on one processor)
+      ! ---------------------
+      rnorme =0.
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zgwgt  = gcdmat(ji,jj) * gcb(ji,jj)
+            rnorme = rnorme + gcb(ji,jj) * zgwgt
+         END DO
+      END DO
+#if defined key_mpp
+      CALL mpp_sum( rnorme )
+#endif
+      epsr = eps * eps * rnorme
+      ncut = 0
+      ! if rnorme is 0, the solution is 0, the solver isn't called
+      IF( rnorme == 0.e0 ) THEN
+         gcx(:,:) = 0.e0
+         res   = 0.e0
+         niter = 0
+         ncut  = 999
+      ENDIF
+
+      ! 5. Evaluate the next transport divergence
+      ! -----------------------------------------
+      !    Iterarive solver for the elliptic equation (except IF sol.=0)
+      !    (output in gcx with boundary conditions applied)
+      kindic = 0
+      IF( ncut == 0 ) THEN
+         IF( nsolv == 1 ) THEN         ! diagonal preconditioned conjuguate gradient
+            CALL sol_pcg( kindic )
+         ELSEIF( nsolv == 2 ) THEN     ! successive-over-relaxation
+            CALL sol_sor( kt, kindic )
+         ELSEIF( nsolv == 3 ) THEN     ! FETI solver
+            CALL sol_fet( kindic )
+         ELSE                          ! e r r o r in nsolv namelist parameter
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' dyn_spg_fsc : e r r o r, nsolv = 1, 2 or 3'
+            IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~                not = ', nsolv
+            nstop = nstop + 1
+         ENDIF
+      ENDIF
+
+      ! 6. Transport divergence gradient multiplied by z2dt
+      ! -----------------------------------------------====
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! trend of Transport divergence gradient
+            ztdgu = znugdt * (gcx(ji+1,jj  ) - gcx(ji,jj) ) / e1u(ji,jj)
+            ztdgv = znugdt * (gcx(ji  ,jj+1) - gcx(ji,jj) ) / e2v(ji,jj)
+            ! multiplied by z2dt
+#if defined key_obc
+            ! caution : grad D = 0 along open boundaries
+            spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj)
+            spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj)
+#else
+            spgu(ji,jj) = z2dt * ztdgu
+            spgv(ji,jj) = z2dt * ztdgv
+#endif
+#if defined key_trddyn
+            ! save the transport divergence gradient trends
+            utrd2(ji,jj,2) = utrd2(ji,jj,2) + ztdgu
+            vtrd2(ji,jj,2) = vtrd2(ji,jj,2) + ztdgv
+#endif
+         END DO
+      END DO
+
+      ! 7.  Add the trends multiplied by z2dt to the after velocity
+      ! -----------------------------------------------------------
+      !     ( c a u t i o n : (ua,va) here are the after velocity not the
+      !                       trend, the leap-frog time stepping will not
+      !                       be done in dynnxt.F routine)
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) = (ua(ji,jj,jk) + spgu(ji,jj)) * umask(ji,jj,jk)
+               va(ji,jj,jk) = (va(ji,jj,jk) + spgv(ji,jj)) * vmask(ji,jj,jk)
+#if defined key_trddyn
+               ! save the surface pressure gradient trend for diagnostics
+               utrd(ji,jj,jk,8) = utrd(ji,jj,jk,8) + spgu(ji,jj)/z2dt
+               vtrd(ji,jj,jk,8) = vtrd(ji,jj,jk,8) + spgv(ji,jj)/z2dt
+#endif
+            END DO
+         END DO
+      END DO
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         WRITE(numout,*) ' spg  - Ua: ', SUM( ua(2:jpim1,2:jpjm1,1:jpkm1)*umask(2:jpim1,2:jpjm1,1:jpkm1) ),   &
+            &                   ' Va: ', SUM( va(2:jpim1,2:jpjm1,1:jpkm1)*vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+      ENDIF
+
+
+      ! 8. Sea surface elevation time stepping
+      ! --------------------------------------
+      ! Euler (forward) time stepping, no time filter
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+         DO jj = 2, jpjm1            !!bug  if 1, jpj  the lbc_lnk call can be suppress
+            DO ji = 1, jpi
+               ! after free surface elevation
+               zssha = sshb(ji,jj) + rdt * ( wn(ji,jj,1) - emp(ji,jj) * zraur ) * tmask(ji,jj,1)
+               ! swap of arrays
+               sshb(ji,jj) = sshn(ji,jj)
+               sshn(ji,jj) = zssha
+            END DO
+         END DO
+      ELSE
+         ! Leap-frog time stepping and time filter
+         DO jj = 2, jpjm1            !!bug  if 1, jpj  the lbc_lnk call can be suppress
+            DO ji = 1, jpi
+               ! after free surface elevation
+               zssha = sshb(ji,jj) + z2dt * ( wn(ji,jj,1) - emp(ji,jj) * zraur ) * tmask(ji,jj,1)
+               ! time filter and array swap
+               sshb(ji,jj) = atfp * ( sshb(ji,jj) + zssha ) + atfp1 * sshn(ji,jj)
+               sshn(ji,jj) = zssha
+            END DO
+         END DO
+      ENDIF
+
+      ! Boundary conditions on sshn
+      CALL lbc_lnk( sshn, 'T', 1. )
+
+   END SUBROUTINE dyn_spg_fsc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case :   Empty module   No standart free surface cst volume
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_fsc = .FALSE.   ! free surface constant volume flag
+CONTAINS
+   SUBROUTINE dyn_spg_fsc( kt, kindic )       ! Empty routine
+      WRITE(*,*) kt, kindic
+   END SUBROUTINE dyn_spg_fsc
+#endif
+   
+   !!======================================================================
+END MODULE dynspg_fsc
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynspg_fsc_atsk.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynspg_fsc_atsk.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynspg_fsc_atsk.F90	(revision 4)
@@ -0,0 +1,410 @@
+MODULE dynspg_fsc_atsk
+   !!======================================================================
+   !!                  ***  MODULE  dynspg_fsc_atsk  ***
+   !! Ocean dynamics:  surface pressure gradient trend
+   !!======================================================================
+#if ( defined key_dynspg_fsc && defined key_autotasking )   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_fsc' & 'key_autotasking'   free surface cst volume
+   !!                                                   j-k-i loop (j-slab)
+   !!----------------------------------------------------------------------
+   !!   dyn_spg_fsc_atsk : Update the momentum trend with the surface pressure
+   !!                      gradient for the free surf. constant volume case
+   !!                      with auto-tasking (j-slab) (no vectior opt.)
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE trdtra_oce     ! ocean active tracer trend 
+   USE trddyn_oce     ! ocean dynamics trend
+   USE in_out_manager  ! I/O manager
+   USE phycst          ! physical constant
+   USE ocesbc          ! Ocen Surface Boundary condition
+   USE flxrnf          ! ???
+   USE sol_oce         ! ocean elliptic solver
+   USE solpcg          ! preconditionned conjugate gradient solver
+   USE solsor          ! Successive Over-relaxation solver
+   USE solfet          ! FETI solver
+   USE obc_oce         ! Lateral open boundary condition
+   USE obcdyn          ! open boudary condition
+   USE obcdyn          !    "              "
+   USE obcvol          !    "              "
+   USE lib_mpp         ! ???
+   USE lbclnk          ! ???
+   USE cla_dynspg      ! ???
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC dyn_spg_fsc_atsk        ! routine called by step.F90
+
+   !! * Shares module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_fsc_tsk = .TRUE.    ! free surf. cst vol. flag
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_spg_fsc_atsk( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine dyn_spg_fsc_atsk  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to the surface pressure 
+      !!      gradient for free surface formulation with a constant ocean
+      !!      volume case, add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   Free surface formulation. The surface pressure gradient
+      !!      is given by:
+      !!         spgu = 1/rau0 d/dx(ps) =  1/e1u di( etn + rnu btda )
+      !!         spgv = 1/rau0 d/dy(ps) =  1/e2v dj( etn + rnu btda )
+      !!      where etn is the free surface elevation and btda is the after
+      !!      of the free surface elevation
+      !!       -1- compute the after sea surface elevation from the cinematic
+      !!      surface boundary condition:
+      !!              zssha = sshb + 2 rdt ( wn - emp )
+      !!           Time filter applied on now sea surface elevation to avoid 
+      !!      the divergence of two consecutive time-steps and swap of free
+      !!      surface arrays to start the next time step:
+      !!              sshb = sshn + atfp * [ sshb + zssha - 2 sshn ]
+      !!              sshn = zssha
+      !!       -2- evaluate the surface presure trend (including the addi-
+      !!      tional force) in three steps:
+      !!        a- compute the right hand side of the elliptic equation:
+      !!            gcb = 1/(e1t e2t) [ di(e2u spgu) + dj(e1v spgv) ]
+      !!         where (spgu,spgv) are given by:
+      !!            spgu = vertical sum[ e3u (ub+ 2 rdt ua ) ]
+      !!                 - g 2 rdt hu /e1u di[sshn + emp]
+      !!            spgv = vertical sum[ e3v (vb+ 2 rdt va) ]
+      !!                 - g 2 rdt hv /e2v dj[sshn + emp]
+      !!         and define the first guess from previous computation :
+      !!            zbtd = btda
+      !!            btda = 2 zbtd - btdb
+      !!            btdb = zbtd
+      !!        b- compute the relative accuracy to be reached by the
+      !!         iterative solver
+      !!        c- apply the solver by a call to sol... routine
+      !!       -3- compute and add the free surface pressure gradient inclu-
+      !!      ding the additional force used to stabilize the equation.
+      !!      several slabs used ('key-autotasking')
+      !!
+      !! ** Action : - Update (ua,va) with the surf. pressure gradient trend
+      !!             - Save the trends in (utrd,vtrd) ('key_diatrends')
+      !!
+      !! References :
+      !!      Roullet and Madec 1999, JGR.
+      !!
+      !! History :
+      !!        !  98-05 (G. Roullet)  Original code
+      !!        !  98-10  (G. Madec, M. Imbard)  release 8.2
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!        !  02-11  (C. Talandier, A-M Treguier) Open boundaries
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
+      INTEGER, INTENT( out ) ::   kindic     ! solver convergence flag
+                                             ! if the solver doesn t converge
+                                             ! the flag is < 0
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk               ! dummy loop indices
+      REAL(wp) ::   &              ! temporary scalars
+         z2dt, z2dtg, zraur, znugdt, znurau,   &
+         zssha, zspgu, zspgv, zegu, zegv,   &
+         zgcb, zbtd, ztdgu, ztdgv, zgwgt
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_spg_fsc_atsk : surface pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~  (free surface constant volume, autotasking case)'
+
+         ! set to zero free surface specific arrays 
+         spgu(:,:) = 0.e0      ! surface pressure gradient (i-direction)
+         spgv(:,:) = 0.e0      ! surface pressure gradient (j-direction)
+         IF( .NOT.ln_rstart ) THEN 
+            sshb(:,:) = 0.e0      ! before sea-surface height 
+            sshn(:,:) = 0.e0      ! now    sea-surface height 
+         ENDIF
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      ! time step: leap-frog
+      z2dt = 2. * rdt
+      ! time step: Euler if restart from rest
+      IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt
+      ! coefficients
+      z2dtg  = g * z2dt
+      zraur  = 1. / rauw
+      znugdt =  rnu * g * z2dt
+      znurau =  znugdt * zraur
+#if defined key_mpp
+      ! Mpp : export boundary values of to neighboring processors
+      !!bug ???  why only in mpp?  is it really needed???
+      CALL lbc_lnk( ua, 'U' , -1. )
+      CALL lbc_lnk( va, 'V' , -1. )
+#endif
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+         ! 1. Surface pressure gradient (now)
+         ! ----------------------------
+         DO ji = 2, jpim1
+            zspgu =      - g * ( sshn(ji+1,jj) - sshn(ji,jj) ) / e1u(ji,jj)
+            zspgv =      - g * ( sshn(ji,jj+1) - sshn(ji,jj) ) / e2v(ji,jj)
+            zegu  = + znurau * ( emp (ji+1,jj) - emp (ji,jj) ) / e1u(ji,jj)
+            zegv  = + znurau * ( emp (ji,jj+1) - emp (ji,jj) ) / e2v(ji,jj)
+            spgu(ji,jj) = zspgu + zegu
+            spgv(ji,jj) = zspgv + zegv
+#if defined key_trddyn
+            ! save the surface pressure gradient trends 
+            utrd2(ji,jj,1) = zspgu
+            vtrd2(ji,jj,1) = zspgv
+            ! save the first part of the additional force trend
+            utrd2(ji,jj,2) = zegu
+            vtrd2(ji,jj,2) = zegv
+#endif
+         END DO 
+
+         ! 2. Add the surface pressure trend to the general trend
+         ! ------------------------------------------------------
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj)
+               va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj)
+#if defined key_trddyn
+               ! save the surface pressure gradient trend for diagnostics
+               utrd(ji,jj,jk,8) = spgu(ji,jj)
+               vtrd(ji,jj,jk,8) = spgv(ji,jj) 
+#endif
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+
+         ! 1. Evaluate the masked next velocity
+         ! ------------------------------------
+         !     (effect of the additional force not included)
+
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ua(ji,jj,jk) = ( ub(ji,jj,jk) + z2dt * ua(ji,jj,jk) ) * umask(ji,jj,jk)
+               va(ji,jj,jk) = ( vb(ji,jj,jk) + z2dt * va(ji,jj,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+#if defined key_obc
+         ! Update velocities on each open boundary with the radiation algorithm
+         CALL obc_dyn( kt )
+         ! Correction of the barotropic componant velocity to control the volume of the system
+         CALL obc_vol( kt )
+#endif
+#if defined key_orca_r2
+      IF( n_cla == 1 )   CALL dyn_spg_cla( kt )      ! Cross Land Advection (Update (ua,va))
+#endif
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+
+         ! 2. compute the next vertically averaged velocity
+         ! ------------------------------------------------
+         !     (effect of the additional force not included)
+         ! initialize to zero
+         DO ji = 2, jpim1
+            spgu(ji,jj) = 0.e0
+            spgv(ji,jj) = 0.e0
+         END DO
+
+         ! vertical sum
+         DO jk = 1, jpk
+            DO ji = 2, jpim1
+               spgu(ji,jj) = spgu(ji,jj) + fse3u(ji,jj,jk) * ua(ji,jj,jk)
+               spgv(ji,jj) = spgv(ji,jj) + fse3v(ji,jj,jk) * va(ji,jj,jk)
+            END DO
+         END DO
+
+         ! transport: multiplied by the horizontal scale factor
+         DO ji = 2, jpim1
+            spgu(ji,jj) = spgu(ji,jj) * e2u(ji,jj)
+            spgv(ji,jj) = spgv(ji,jj) * e1v(ji,jj)
+         END DO
+
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+      
+      ! Boundary conditions on (spgu,spgv)
+      CALL lbc_lnk( spgu, 'U', -1. )
+      CALL lbc_lnk( spgv, 'V', -1. )
+
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+
+      ! 3. Right hand side of the elliptic equation and first guess
+      ! -----------------------------------------------------------
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            ! Divergence of the after vertically averaged velocity
+            zgcb =  spgu(ji,jj) - spgu(ji-1,jj)   &
+                  + spgv(ji,jj) - spgv(ji,jj-1)
+            gcb(ji,jj) = gcdprc(ji,jj) * zgcb
+            ! First guess of the after barotropic transport divergence
+            zbtd = gcx(ji,jj)
+            gcx (ji,jj) = 2. * zbtd   - gcxb(ji,jj)
+            gcxb(ji,jj) =      zbtd
+         END DO
+      END DO
+
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+      
+      ! 4. Relative precision (computation on one processor)
+      ! ---------------------
+      rnorme =0.
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zgwgt  = gcdmat(ji,jj) * gcb(ji,jj)
+            rnorme = rnorme + gcb(ji,jj) * zgwgt
+         END DO
+      END DO
+#if defined key_mpp
+      CALL mpp_sum( rnorme )
+#endif
+      epsr = eps * eps * rnorme
+      ncut = 0
+      ! if rnorme is 0, the solution is 0, the solver isn't called
+      IF( rnorme == 0.e0 ) THEN
+         gcx(:,:) = 0.e0
+         res   = 0.e0
+         niter = 0
+         ncut  = 999
+      ENDIF
+      
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+      
+      ! 5. Evaluate the next transport divergence
+      ! -----------------------------------------
+      !    Iterarive solver for the elliptic equation (except IF sol.=0)
+      !    (output in gcx with boundary conditions applied)
+      kindic = 0
+      IF( ncut == 0 ) THEN
+         IF( nsolv == 1 ) THEN         ! diagonal preconditioned conjuguate gradient
+            CALL sol_pcg( kindic )
+         ELSEIF( nsolv == 2 ) THEN     ! successive-over-relaxation
+            CALL sol_sor( kt, kindic )
+         ELSEIF( nsolv == 3 ) THEN     ! FETI solver
+            CALL sol_fet( kindic )
+         ELSE                          ! e r r o r in nsolv namelist parameter
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' dyn_spg_fsc_atsk : e r r o r, nsolv = 1, 2 or 3'
+            IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                not = ', nsolv
+            nstop = nstop + 1
+         ENDIF
+      ENDIF
+
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+         
+         ! 6. Transport divergence gradient multiplied by z2dt
+         ! -----------------------------------------------====
+         DO ji = 2, jpim1
+            ! trend of Transport divergence gradient
+            ztdgu = znugdt * (gcx(ji+1,jj  ) - gcx(ji,jj) ) / e1u(ji,jj)
+            ztdgv = znugdt * (gcx(ji  ,jj+1) - gcx(ji,jj) ) / e2v(ji,jj)
+            ! multiplied by z2dt
+#if defined key_obc
+            ! caution : grad D = 0 along open boundaries
+            spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj)
+            spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj)
+#else
+            spgu(ji,jj) = z2dt * ztdgu
+            spgv(ji,jj) = z2dt * ztdgv
+#endif
+#if defined key_trddyn
+            ! save the transport divergence gradient trends
+            utrd2(ji,jj,2) = utrd2(ji,jj,2) + ztdgu
+            vtrd2(ji,jj,2) = vtrd2(ji,jj,2) + ztdgv
+#endif
+         END DO
+         
+         ! 7.  Add the trends multiplied by z2dt to the after velocity
+         ! -----------------------------------------------------------
+         !     ( c a u t i o n : (ua,va) here are the after velocity not the
+         !                       trend, the leap-frog time stepping will not
+         !                       be done in dynnxt.F routine)
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ua(ji,jj,jk) = (ua(ji,jj,jk) + spgu(ji,jj)) * umask(ji,jj,jk)
+               va(ji,jj,jk) = (va(ji,jj,jk) + spgv(ji,jj)) * vmask(ji,jj,jk)
+#if defined key_trddyn
+               ! save the surface pressure gradient trend for diagnostics
+               utrd(ji,jj,jk,8) = utrd(ji,jj,jk,8) + spgu(ji,jj)/z2dt
+               vtrd(ji,jj,jk,8) = vtrd(ji,jj,jk,8) + spgv(ji,jj)/z2dt
+#endif
+            END DO
+         END DO
+
+         ! 8. Sea surface elevation time stepping
+         ! --------------------------------------
+         ! Euler (forward) time stepping, no time filter
+         IF( neuler == 0 .AND. kt == nit000 ) THEN
+            DO ji = 1, jpi
+               ! after free surface elevation
+               zssha = sshb(ji,jj) + rdt * ( wn(ji,jj,1) - emp(ji,jj) * zraur ) * tmask(ji,jj,1)
+               ! swap of arrays
+               sshb(ji,jj) = sshn(ji,jj)
+               sshn(ji,jj) = zssha
+            END DO
+         ELSE
+            ! Leap-frog time stepping and time filter
+            DO ji = 1, jpi
+               ! after free surface elevation
+               zssha = sshb(ji,jj) + z2dt * ( wn(ji,jj,1) - emp(ji,jj) * zraur ) * tmask(ji,jj,1)
+               ! time filter and array swap
+               sshb(ji,jj) = atfp * ( sshb(ji,jj) + zssha ) + atfp1 * sshn(ji,jj)
+               sshn(ji,jj) = zssha
+            END DO
+         ENDIF
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      !Boundary conditions on sshn
+      CALL lbc_lnk( sshn, 'T', 1. )
+
+   END SUBROUTINE dyn_spg_fsc_atsk
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case :                                         Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_fsc_tsk = .FALSE.   ! free surf. cst vol. flag
+CONTAINS
+   SUBROUTINE dyn_spg_fsc_atsk( kt, kindic )      ! Empty module
+      WRITE(*,*) kt, kindic
+   END SUBROUTINE dyn_spg_fsc_atsk
+#endif
+   
+   !!======================================================================
+END MODULE dynspg_fsc_atsk
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynspg_rl.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynspg_rl.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynspg_rl.F90	(revision 4)
@@ -0,0 +1,557 @@
+MODULE dynspg_rl
+   !!======================================================================
+   !!                    ***  MODULE  dynspg_rl  ***
+   !! Ocean dynamics:  surface pressure gradient trend
+   !!======================================================================
+#if   defined key_dynspg_rl   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_rl'                                           rigid lid
+   !!----------------------------------------------------------------------
+   !!   dyn_spg_rl   : update the momentum trend with the surface pressure
+   !!                  for the rigid-lid case.
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldfdyn_oce      ! ocean dynamics: lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE trddyn_oce      ! ocean dynamics trends
+   USE in_out_manager  ! I/O manager
+   USE sol_oce         ! ocean elliptic solver
+   USE solpcg          ! preconditionned conjugate gradient solver
+   USE solsor          ! Successive Over-relaxation solver
+   USE solfet          ! FETI solver
+   USE solisl          ! ???
+   USE obc_oce         ! Lateral open boundary condition
+   USE lib_mpp         ! ???
+   USE lbclnk          ! ???
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC dyn_spg_rl   ! called by step.F90
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_rl = .TRUE.   ! rigid-lid flag
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_spg_rl( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine dyn_spg_rl  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to the surface pressure
+      !!      gradient for the rigid-lid case,  add it to the general trend of 
+      !!      momentum equation.
+      !!
+      !! ** Method  :   Rigid-lid appromimation: the surface pressure gradient 
+      !!      is given by:
+      !!         spgu = 1/rau0 d/dx(ps) = Mu + 1/(hu e2u) dj-1(bsfd)
+      !!         spgv = 1/rau0 d/dy(ps) = Mv - 1/(hv e1v) di-1(bsfd)
+      !!      where (Mu,Mv) is the vertically averaged momentum trend (i.e.
+      !!      the vertical ponderated sum of the general momentum trend),
+      !!      and bsfd is the barotropic streamfunction trend.
+      !!      The trend is computed as follows:
+      !!         -1- compute the vertically averaged momentum trend (Mu,Mv)
+      !!         -2- compute the barotropic streamfunction trend by solving an
+      !!      ellipic equation using a diagonal preconditioned conjugate
+      !!      gradient or a successive-over-relaxation method (depending
+      !!      on nsolv, a namelist parameter).
+      !!         -3- add to bsfd the island trends if l_isl=T
+      !!         -4- compute the after streamfunction is for further diagnos-
+      !!      tics using a leap-frog scheme.
+      !!         -5- add the momentum trend associated with the surface pres-
+      !!      sure gradient to the general trend.
+      !!
+      !! ** Action : - Update (ua,va) with the surf. pressure gradient trend
+      !!             - Save the trends in (utrd,vtrd) ('key_diatrends')
+      !!
+      !! References :
+      !!      Madec et al. 1988, ocean modelling, issue 78, 1-6.
+      !!
+      !! History :
+      !!        !  96-05  (G. Madec, M. Imbard, M. Guyon)  rewitting in 1
+      !!                  routine, without pointers, and with the same matrix
+      !!                  for sor and pcg, mpp exchange, and symmetric conditions
+      !!        !  96-07  (A. Weaver)  Euler forward step
+      !!        !  96-11  (A. Weaver)  correction to preconditioning:
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  98-05  (G. Roullet)  free surface
+      !!        !  97-09  (J.-M. Molines)  Open boundaries
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!        !  02-11  (C. Talandier, A-M Treguier) Open boundaries
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in  ) ::   kt       ! ocean time-step index
+      INTEGER, INTENT( out ) ::   kindic   ! solver flag, take a negative value
+      !                                    ! when the solver doesnot converge
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp) ::   zgwgt, zbsfa, zgcx, z2dt
+# if defined key_obc
+      INTEGER ::   ip, ii, ij
+      INTEGER ::   iii, ijj, jip, jnic
+      INTEGER ::   it, itm, itm2, ib, ibm, ibm2
+      REAL(wp) ::   z2dtr
+# endif
+      !!----------------------------------------------------------------------
+      
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_spg_rl : surface pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+         ! set to zero rigid-lid specific arrays
+         spgu(:,:) = 0.e0      ! surface pressure gradient (i-direction) 
+         spgv(:,:) = 0.e0      ! surface pressure gradient (j-direction)
+         bsfb(:,:) = 0.e0      ! before barotropic stream-function
+         bsfn(:,:) = 0.e0      ! now    barotropic stream-function
+         bsfd(:,:) = 0.e0      ! barotropic stream-function trend
+      ENDIF
+
+      ! 0. Initializations:
+      ! -------------------
+# if defined key_obc
+      ! space index on boundary arrays
+      ib = 1
+      ibm = 2
+      ibm2 = 3
+      ! time index on boundary arrays
+      it = 1
+      itm = 2
+      itm2 = 3
+# endif
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+
+         ! 1. Vertically averaged momentum trend
+         ! -------------------------------------
+         ! initialization to zero
+         spgu(:,jj) = 0.
+         spgv(:,jj) = 0.
+         ! vertical sum
+         DO jk = 1, jpk
+            DO ji = 2, jpim1
+               spgu(ji,jj) = spgu(ji,jj) + ua(ji,jj,jk) * fse3u(ji,jj,jk) * umask(ji,jj,jk)
+               spgv(ji,jj) = spgv(ji,jj) + va(ji,jj,jk) * fse3v(ji,jj,jk) * vmask(ji,jj,jk)
+            END DO 
+         END DO 
+         ! divide by the depth
+         spgu(:,jj) = spgu(:,jj) * hur(:,jj)
+         spgv(:,jj) = spgv(:,jj) * hvr(:,jj)
+
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+
+      ! Boundary conditions on (spgu,spgv)
+      CALL lbc_lnk( spgu, 'U', -1. )
+      CALL lbc_lnk( spgv, 'V', -1. )
+
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+
+      ! 2. Barotropic streamfunction trend (bsfd)
+      ! ----------------------------------
+
+      ! Curl of the vertically averaged velocity
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            gcb(ji,jj) = -gcdprc(ji,jj)   &
+                       *(  ( e2v(ji+1,jj  )*spgv(ji+1,jj  ) - e2v(ji,jj)*spgv(ji,jj) )   &
+                          -( e1u(ji  ,jj+1)*spgu(ji  ,jj+1) - e1u(ji,jj)*spgu(ji,jj) )   ) 
+         END DO
+      END DO
+
+# if defined key_obc
+      ! Open boundary contribution
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+           gcb(ji,jj) = gcb(ji,jj) - gcdprc(ji,jj) * gcbob(ji,jj)
+         END DO
+      END DO
+# else
+      ! No open boundary contribution
+# endif
+
+      ! First guess using previous solution of the elliptic system and
+      ! not bsfd since the system is solved with 0 as coastal boundary
+      ! condition. Also include a swap array (gcx,gxcb)
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            zgcx        = gcx(ji,jj)
+            gcx (ji,jj) = 2.*zgcx - gcxb(ji,jj)
+            gcxb(ji,jj) =    zgcx
+         END DO
+      END DO
+
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+
+      ! Relative precision (computation on one processor)
+      rnorme = 0.e0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zgwgt =  gcdmat(ji,jj) * gcb(ji,jj)
+            rnorme = rnorme + gcb(ji,jj) * zgwgt
+         END DO
+      END DO
+# if defined key_mpp
+      CALL mpp_sum( rnorme )
+# endif
+      epsr = eps*eps*rnorme
+      ncut = 0
+      ! if rnorme is 0, the solution is 0, the solver isn't called
+      IF( rnorme == 0.e0 ) THEN
+         bsfd (:,:) = 0.e0
+         res   = 0.e0
+         niter = 0
+         ncut  = 999
+      ENDIF
+
+      kindic = 0
+      ! solve the bsf system  ===> solution in gcx array
+      IF( ncut == 0 ) THEN
+         SELECT CASE ( nsolv )
+         CASE ( 1 )                    ! diagonal preconditioned conjuguate gradient
+            CALL sol_pcg( kindic )
+         CASE( 2 )                     ! successive-over-relaxation
+            CALL sol_sor( kt, kindic )
+         CASE( 3 )                     ! FETI solver
+            CALL sol_fet( kindic )
+         CASE DEFAULT                  ! e r r o r in nsolv namelist parameter
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' dyn_spg_rl : e r r o r, nsolv = 1, 2 or 3'
+            IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~                not = ', nsolv
+            nstop = nstop + 1
+         END SELECT
+      ENDIF
+
+
+      ! bsf trend update
+      ! ----------------
+
+      bsfd(:,:) = gcx(:,:)
+
+      
+      ! update bsf trend with islands trend
+      ! -----------------------------------
+
+      IF( l_isl )   CALL isl_dyn_spg         ! update bsfd
+
+
+# if defined key_obc
+      ! Compute bsf trend for OBC points (not masked)
+
+      IF( lpeastobc ) THEN
+      ! compute bsf trend at the boundary from bsfeob, computed in obc_spg
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+         z2dtr = 1. / rdt
+      ELSE
+         z2dtr = 1. / (2. * rdt )
+      ENDIF
+      ! (jped,jpefm1),nieob
+      DO ji = fs_nie0, fs_nie1   ! vector opt.
+         DO jj = nje0m1, nje1m1
+            bsfd(ji,jj) = ( bsfeob(jj) - bsfb(ji,jj) ) * z2dtr
+         END DO
+      END DO
+      ENDIF
+
+      IF( lpwestobc ) THEN
+      ! compute bsf trend at the boundary from bsfwob, computed in obc_spg
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+         z2dtr = 1. / rdt
+      ELSE
+         z2dtr = 1. / ( 2. * rdt )
+      ENDIF
+      ! (jpwd,jpwfm1),niwob
+      DO ji = fs_niw0, fs_niw1   ! vector opt.
+         DO jj = njw0m1, njw1m1
+            bsfd(ji,jj) = ( bsfwob(jj) - bsfb(ji,jj) ) * z2dtr
+         END DO
+      END DO
+      ENDIF
+
+      IF( lpnorthobc ) THEN
+      ! compute bsf trend at the boundary from bsfnob, computed in obc_spg
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+         z2dtr = 1. / rdt
+      ELSE
+         z2dtr = 1. / ( 2. * rdt )
+      ENDIF
+      ! njnob,(jpnd,jpnfm1)
+      DO jj = fs_njn0, fs_njn1   ! vector opt.
+         DO ji = nin0m1, nin1m1
+            bsfd(ji,jj) = ( bsfnob(ji) - bsfb(ji,jj) ) * z2dtr
+         END DO
+      END DO
+      ENDIF
+
+      IF( lpsouthobc ) THEN
+      ! compute bsf trend at the boundary from bsfsob, computed in obc_spg
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+         z2dtr = 1. / rdt
+      ELSE
+         z2dtr = 1. / ( 2. * rdt )
+      ENDIF
+      ! njsob,(jpsd,jpsfm1)
+      DO jj = fs_njs0, fs_njs1   ! vector opt.
+         DO ji = nis0m1, nis1m1
+            bsfd(ji,jj) = ( bsfsob(ji) - bsfb(ji,jj) ) * z2dtr
+         END DO
+      END DO
+      ENDIF
+
+      ! compute bsf trend for isolated coastline points
+
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+         z2dtr = 1. / rdt
+      ELSE
+         z2dtr = 1. /( 2. * rdt )
+      ENDIF
+
+      IF( nbobc > 1 ) THEN
+         DO jnic = 1,nbobc - 1
+            ip = mnic(0,jnic)
+            DO jip = 1,ip
+               ii = miic(jip,0,jnic)
+               ij = mjic(jip,0,jnic)
+               IF( ii >= 1 + nimpp - 1 .AND. ii <= jpi + nimpp -1 .AND. &
+                   ij >= 1 + njmpp - 1 .AND. ij <= jpj + njmpp -1 ) THEN
+                  iii = ii - nimpp + 1
+                  ijj = ij - njmpp + 1
+                  bsfd(iii,ijj) = ( bsfic(jnic) - bsfb(iii,ijj) ) * z2dtr
+               ENDIF
+            END DO
+         END DO
+      ENDIF
+# endif
+
+      ! 4. Barotropic stream function and array swap
+      ! --------------------------------------------
+
+      ! Leap-frog time scheme, time filter and array swap
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+         ! Euler time stepping (first time step, starting from rest)
+         z2dt = rdt
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zbsfa       = bsfb(ji,jj) + z2dt * bsfd(ji,jj)
+               bsfb(ji,jj) = bsfn(ji,jj)
+               bsfn(ji,jj) = zbsfa 
+            END DO
+         END DO
+      ELSE
+         ! Leap-frog time stepping - Asselin filter
+         z2dt = 2.*rdt
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zbsfa       = bsfb(ji,jj) + z2dt * bsfd(ji,jj)
+               bsfb(ji,jj) = atfp * ( bsfb(ji,jj) + zbsfa ) + atfp1 * bsfn(ji,jj)
+               bsfn(ji,jj) = zbsfa
+            END DO
+         END DO
+      ENDIF
+
+# if defined key_obc
+      ! Swap of boundary arrays
+      IF( lpeastobc ) THEN
+      ! (jped,jpef),nieob
+      IF( kt < nit000+3 .AND. .NOT.ln_rstart ) THEN
+         DO jj = nje0m1, nje1
+            ! fields itm2 <== itm
+            bebnd(jj,ib  ,itm2) = bebnd(jj,ib  ,itm)
+            bebnd(jj,ibm ,itm2) = bebnd(jj,ibm ,itm)
+            bebnd(jj,ibm2,itm2) = bebnd(jj,ibm2,itm)
+            bebnd(jj,ib  ,itm ) = bebnd(jj,ib  ,it )
+         END DO
+      ELSE
+         ! fields itm <== it  plus time filter at the boundary
+         DO ji = fs_nie0, fs_nie1   ! vector opt.
+            DO jj = nje0m1, nje1
+               bebnd(jj,ib  ,itm2) = bebnd(jj,ib  ,itm)
+               bebnd(jj,ibm ,itm2) = bebnd(jj,ibm ,itm)
+               bebnd(jj,ibm2,itm2) = bebnd(jj,ibm2,itm)
+               bebnd(jj,ib  ,itm ) = atfp * ( bebnd(jj,ib,itm) + bsfn(ji,jj) ) + atfp1 * bebnd(jj,ib,it)
+               bebnd(jj,ibm ,itm ) = bebnd(jj,ibm ,it )
+               bebnd(jj,ibm2,itm ) = bebnd(jj,ibm2,it )
+            END DO
+         END DO
+      ENDIF
+      ! fields it <== now (kt+1)
+      DO ji = fs_nie0, fs_nie1   ! vector opt.
+         DO jj = nje0m1, nje1
+            bebnd(jj,ib  ,it  ) = bsfn (ji  ,jj)
+            bebnd(jj,ibm ,it  ) = bsfn (ji-1,jj)
+            bebnd(jj,ibm2,it  ) = bsfn (ji-2,jj)
+         END DO
+      END DO
+#   if defined key_mpp
+      CALL mppobc( bebnd, jpjed, jpjef, jpieob, 3*3, 2, jpj )
+#   endif
+      ENDIF
+
+      IF( lpwestobc ) THEN
+      ! (jpwd,jpwf),niwob
+      IF( kt < nit000+3 .AND. .NOT.ln_rstart ) THEN
+         DO jj = njw0m1, njw1
+            ! fields itm2 <== itm
+            bwbnd(jj,ib  ,itm2) = bwbnd(jj,ib  ,itm)
+            bwbnd(jj,ibm ,itm2) = bwbnd(jj,ibm ,itm)
+            bwbnd(jj,ibm2,itm2) = bwbnd(jj,ibm2,itm)
+            bwbnd(jj,ib  ,itm ) = bwbnd(jj,ib  ,it )
+         END DO
+      ELSE
+         DO ji = fs_niw0, fs_niw1   ! Vector opt.
+            DO jj = njw0m1, njw1
+               bwbnd(jj,ib  ,itm2) = bwbnd(jj,ib  ,itm)
+               bwbnd(jj,ibm ,itm2) = bwbnd(jj,ibm ,itm)
+               bwbnd(jj,ibm2,itm2) = bwbnd(jj,ibm2,itm)
+               ! fields itm <== it  plus time filter at the boundary
+               bwbnd(jj,ib  ,itm ) = atfp * ( bwbnd(jj,ib,itm) + bsfn(ji,jj) ) + atfp1 * bwbnd(jj,ib,it)
+               bwbnd(jj,ibm ,itm ) = bwbnd(jj,ibm ,it )
+               bwbnd(jj,ibm2,itm ) = bwbnd(jj,ibm2,it )
+            END DO
+         END DO
+      ENDIF
+      ! fields it <== now (kt+1)
+      DO ji = fs_niw0, fs_niw1   ! Vector opt.
+         DO jj = njw0m1, njw1
+            bwbnd(jj,ib  ,it  ) = bsfn (ji  ,jj)
+            bwbnd(jj,ibm ,it  ) = bsfn (ji+1,jj)
+            bwbnd(jj,ibm2,it  ) = bsfn (ji+2,jj)
+         END DO
+      END DO
+#   if defined key_mpp
+      CALL mppobc( bwbnd, jpjwd, jpjwf, jpiwob, 3*3, 2, jpj )
+#   endif
+      ENDIF
+
+      IF( lpnorthobc ) THEN
+   ! njnob,(jpnd,jpnf)
+      IF( kt < nit000 + 3 .AND. .NOT.ln_rstart ) THEN
+         DO ji = nin0m1, nin1
+            ! fields itm2 <== itm
+            bnbnd(ji,ib  ,itm2) = bnbnd(ji,ib  ,itm)
+            bnbnd(ji,ibm ,itm2) = bnbnd(ji,ibm ,itm)
+            bnbnd(ji,ibm2,itm2) = bnbnd(ji,ibm2,itm)
+            bnbnd(ji,ib  ,itm ) = bnbnd(ji,ib  ,it )
+         END DO
+      ELSE
+         DO jj = fs_njn0, fs_njn1   ! Vector opt.
+            DO ji = nin0m1, nin1
+               bnbnd(ji,ib  ,itm2) = bnbnd(ji,ib  ,itm)
+               bnbnd(ji,ibm ,itm2) = bnbnd(ji,ibm ,itm)
+               bnbnd(ji,ibm2,itm2) = bnbnd(ji,ibm2,itm)
+               ! fields itm <== it  plus time filter at the boundary
+               bnbnd(jj,ib  ,itm ) = atfp * ( bnbnd(jj,ib,itm) + bsfn(ji,jj) ) + atfp1 * bnbnd(jj,ib,it)
+               bnbnd(ji,ibm ,itm ) = bnbnd(ji,ibm ,it )
+               bnbnd(ji,ibm2,itm ) = bnbnd(ji,ibm2,it )
+            END DO
+          END DO
+      ENDIF
+      ! fields it <== now (kt+1)
+      DO jj = fs_njn0, fs_njn1   ! Vector opt.
+         DO ji = nin0m1, nin1
+            bnbnd(ji,ib  ,it  ) = bsfn (ji,jj  )
+            bnbnd(ji,ibm ,it  ) = bsfn (ji,jj-1)
+            bnbnd(ji,ibm2,it  ) = bsfn (ji,jj-2)
+         END DO
+      END DO
+#   if defined key_mpp
+      CALL mppobc( bnbnd, jpind, jpinf, jpjnob, 3*3, 1, jpi )
+#   endif
+      ENDIF
+
+      IF( lpsouthobc ) THEN
+      ! njsob,(jpsd,jpsf)
+      IF( kt < nit000+3 .AND. .NOT.ln_rstart ) THEN
+         DO ji = nis0m1, nis1
+            ! fields itm2 <== itm
+            bsbnd(ji,ib  ,itm2) = bsbnd(ji,ib  ,itm)
+            bsbnd(ji,ibm ,itm2) = bsbnd(ji,ibm ,itm)
+            bsbnd(ji,ibm2,itm2) = bsbnd(ji,ibm2,itm)
+            bsbnd(ji,ib  ,itm ) = bsbnd(ji,ib  ,it )
+         END DO
+      ELSE
+         DO jj = fs_njs0, fs_njs1   ! vector opt.
+            DO ji = nis0m1, nis1
+               bsbnd(ji,ib  ,itm2) = bsbnd(ji,ib  ,itm)
+               bsbnd(ji,ibm ,itm2) = bsbnd(ji,ibm ,itm)
+               bsbnd(ji,ibm2,itm2) = bsbnd(ji,ibm2,itm)
+               ! fields itm <== it  plus time filter at the boundary
+               bsbnd(jj,ib  ,itm ) = atfp * ( bsbnd(jj,ib,itm) + bsfn(ji,jj) ) + atfp1 * bsbnd(jj,ib,it)
+               bsbnd(ji,ibm ,itm ) = bsbnd(ji,ibm ,it )
+               bsbnd(ji,ibm2,itm ) = bsbnd(ji,ibm2,it )
+            END DO
+         END DO
+      ENDIF
+      DO jj = fs_njs0, fs_njs1   ! vector opt.
+         DO ji = nis0m1, nis1 
+            ! fields it <== now (kt+1)
+            bsbnd(ji,ib  ,it  ) = bsfn (ji,jj  )
+            bsbnd(ji,ibm ,it  ) = bsfn (ji,jj+1)
+            bsbnd(ji,ibm2,it  ) = bsfn (ji,jj+2)
+         END DO
+      END DO
+#   if defined key_mpp
+      CALL mppobc( bsbnd, jpisd, jpisf, jpjsob, 3*3, 1, jpi )
+#   endif
+      ENDIF
+# endif
+      !
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+      
+      !  add the surface pressure trend to the general trend
+      ! -----------------------------------------------------
+      
+      DO jj = 2, jpjm1
+
+         ! update the surface pressure gradient with the barotropic trend
+         DO ji = 2, jpim1
+            spgu(ji,jj) = spgu(ji,jj) + hur(ji,jj) / e2u(ji,jj) * ( bsfd(ji,jj) - bsfd(ji  ,jj-1) )
+            spgv(ji,jj) = spgv(ji,jj) - hvr(ji,jj) / e1v(ji,jj) * ( bsfd(ji,jj) - bsfd(ji-1,jj  ) )
+         END DO
+         ! add the surface pressure gradient trend to the general trend
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ua(ji,jj,jk) = ua(ji,jj,jk) - spgu(ji,jj)
+               va(ji,jj,jk) = va(ji,jj,jk) - spgv(ji,jj)
+# if defined key_trddyn
+               ! save the surface pressure gradient trend for diagnostics
+               utrd(ji,jj,jk,8) = -spgu(ji,jj)
+               vtrd(ji,jj,jk,8) = -spgv(ji,jj)
+# endif
+            END DO
+         END DO
+
+      END DO
+
+   END SUBROUTINE dyn_spg_rl
+
+#else
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_rl'                                        NO rigid lid
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_rl = .FALSE.   ! rigid-lid flag
+CONTAINS
+   SUBROUTINE dyn_spg_rl( kt, kindic )       ! Empty routine
+      WRITE(*,*) kt, kindic
+   END SUBROUTINE dyn_spg_rl
+#endif
+   
+   !!======================================================================
+END MODULE dynspg_rl
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynvor.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 4)
@@ -0,0 +1,443 @@
+MODULE dynvor
+   !!======================================================================
+   !!                       ***  MODULE  dynvor  ***
+   !! Ocean dynamics: Update the momentum trend with the relative and
+   !!                 planetary vorticity trends
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dyn_vor_enstrophy :  enstrophy conserving scheme (ln_dynvor_ens=T)
+   !!   dyn_vor_energy    :  energy conserving scheme    (ln_dynvor_ene=T)
+   !!   dyn_vor_mixed     :  mixed enstrophy/energy conserving (ln_dynvor_mix=T)
+   !!   dyn_vor_ctl       : control of the different vorticity option
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE trddyn_oce     ! ocean momentum trends
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dyn_vor_enstrophy      ! routine called by step.F90
+   PUBLIC dyn_vor_energy         ! routine called by step.F90
+   PUBLIC dyn_vor_mixed          ! routine called by step.F90
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC ::   ln_dynvor_ene = .FALSE.   ! energy conserving scheme
+   LOGICAL, PUBLIC ::   ln_dynvor_ens = .TRUE.    ! enstrophy conserving scheme
+   LOGICAL, PUBLIC ::   ln_dynvor_mix = .FALSE.   ! mixed scheme
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_vor_energy( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_vor  ***
+      !!
+      !! ** Purpose :   Compute the now total vorticity trend and add it to 
+      !!      the general trend of the momentum equation.
+      !!
+      !! ** Method  :   Trend evaluated using now fields (centered in time) 
+      !!      and the Sadourny (1975) flux form formulation : conserves the
+      !!      horizontal kinetic energy.
+      !!      The trend of the vorticity term is given by:
+      !!       * s-coordinate (lk_sco=T), the e3. are inside the derivatives:
+      !!          voru = 1/e1u  mj-1[ (rotn+f)/e3f  mi(e1v*e3v vn) ]
+      !!          vorv = 1/e2v  mi-1[ (rotn+f)/e3f  mj(e2u*e3u un) ]
+      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
+      !!          voru = 1/e1u  mj-1[ (rotn+f)  mi(e1v vn) ]
+      !!          vorv = 1/e2v  mi-1[ (rotn+f)  mj(e2u un) ]
+      !!      Add this trend to the general momentum trend (ua,va):
+      !!          (ua,va) = (ua,va) + ( voru , vorv )
+      !!
+      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !!             - save the trends in (utrd,vtrd) in 2 parts (relative
+      !!               and planetary vorticity trends) ('key_trddyn')
+      !!
+      !! References :
+      !!      Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
+      !! History :
+      !!   5.0  !  91-11  (G. Madec)  Original code
+      !!   6.0  !  96-01  (G. Madec)  s-coord, suppress work arrays
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk               ! dummy loop indices
+      REAL(wp) ::   &
+         zfact2, zua, zva,               &  ! temporary scalars
+         zx1, zx2, zy1, zy2                 !    "         "
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zwx, zwy, zwz                      ! temporary workspace
+#if defined key_trddyn
+      REAL(wp) ::   &
+         zcu, zcv, zce3                     !    "         "
+#endif
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 )   CALL dyn_vor_ctl            ! Check options
+
+      ! Local constant initialization
+      zfact2 = 0.5 * 0.5
+      
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         
+         ! Potential vorticity and horizontal fluxes
+         ! -----------------------------------------
+         IF( lk_sco ) THEN
+            zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) / fse3f(:,:,jk)
+            zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
+            zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         ELSE
+            zwz(:,:) = rotn(:,:,jk) + ff(:,:)
+            zwx(:,:) = e2u(:,:) * un(:,:,jk)
+            zwy(:,:) = e1v(:,:) * vn(:,:,jk)
+         ENDIF
+
+         ! Compute and add the vorticity term trend
+         ! ----------------------------------------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zy1 = zwy(ji,jj-1) + zwy(ji+1,jj-1)
+               zy2 = zwy(ji,jj  ) + zwy(ji+1,jj  )
+               zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1)
+               zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1)
+               zua = zfact2 / e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+               zva =-zfact2 / e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zva
+#   if defined key_trddyn
+#      if defined key_s_coord
+               zce3= ff(ji,jj) / fse3f(ji,jj,jk)
+               zcu = zfact2 / e1u(ji,jj) * ( ff(ji  ,jj-1) / fse3f(ji,jj-1,jk) * zy1 + zce3 * zy2 )
+               zcv =-zfact2 / e2v(ji,jj) * ( ff(ji-1,jj  ) / fse3f(ji-1,jj,jk) * zx1 + zce3 * zx2 )
+#      else
+               zcu = zfact2 / e1u(ji,jj) * ( ff(ji  ,jj-1) * zy1 + ff(ji,jj) * zy2 )
+               zcv =-zfact2 / e2v(ji,jj) * ( ff(ji-1,jj  ) * zx1 + ff(ji,jj) * zx2 )
+#      endif
+               utrd(ji,jj,jk,3) = zua - zcu
+               vtrd(ji,jj,jk,3) = zva - zcv
+               utrd(ji,jj,jk,4) = zcu
+               vtrd(ji,jj,jk,4) = zcv
+#   endif
+            END DO  
+         END DO  
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' vor  - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl
+         u_ctl = zua   ;   v_ctl = zva
+      ENDIF
+
+   END SUBROUTINE dyn_vor_energy
+
+
+   SUBROUTINE dyn_vor_mixed( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE dyn_vor_mixed  ***
+      !!
+      !! ** Purpose :   Compute the now total vorticity trend and add it to
+      !!      the general trend of the momentum equation.
+      !!
+      !! ** Method  :   Trend evaluated using now fields (centered in time)
+      !!      Mixte formulation : conserves the potential enstrophy of a hori-
+      !!      zontally non-divergent flow for (rotzu x uh), the relative vor-
+      !!      ticity term and the horizontal kinetic energy for (f x uh), the
+      !!      coriolis term. the now trend of the vorticity term is given by:
+      !!       * s-coordinate (lk_sco=T), the e3. are inside the derivatives:
+      !!          voru = 1/e1u  mj-1(rotn/e3f) mj-1[ mi(e1v*e3v vn) ]
+      !!              +1/e1u  mj-1[ f/e3f          mi(e1v*e3v vn) ]
+      !!          vorv = 1/e2v  mi-1(rotn/e3f) mi-1[ mj(e2u*e3u un) ]
+      !!              +1/e2v  mi-1[ f/e3f          mj(e2u*e3u un) ]
+      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
+      !!          voru = 1/e1u  mj-1(rotn) mj-1[ mi(e1v vn) ]
+      !!              +1/e1u  mj-1[ f          mi(e1v vn) ]
+      !!          vorv = 1/e2v  mi-1(rotn) mi-1[ mj(e2u un) ]
+      !!              +1/e2v  mi-1[ f          mj(e2u un) ]
+      !!      Add this now trend to the general momentum trend (ua,va):
+      !!          (ua,va) = (ua,va) + ( voru , vorv )
+      !!
+      !! ** Action : - Update (ua,va) arrays with the now vorticity term trend
+      !!             - Save the trends in (utrd,vtrd) in 2 parts (relative
+      !!               and planetary vorticity trends) ('key_trddyn')
+      !!
+      !! References :
+      !!      Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
+      !! History :
+      !!   5.0  !  91-11  (G. Madec) Original code, enstrophy-energy-combined schemes
+      !!   6.0  !  96-01  (G. Madec) s-coord, suppress work arrays
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean timestep index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk               ! dummy loop indices
+      REAL(wp) ::   &
+         zfact1, zfact2, zua, zva,       &  ! temporary scalars
+         zcua, zcva, zx1, zx2, zy1, zy2
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zwx, zwy, zwz, zww                 ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 )   CALL dyn_vor_ctl            ! Check options
+
+      ! Local constant initialization
+      zfact1 = 0.5 * 0.25
+      zfact2 = 0.5 * 0.5
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         ! Relative and planetary potential vorticity and horizontal fluxes
+         ! ----------------------------------------------------------------
+         IF( lk_sco ) THEN        
+            zwz(:,:) = ff  (:,:)    / fse3f(:,:,jk)
+            zww(:,:) = rotn(:,:,jk) / fse3f(:,:,jk)
+            zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
+            zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         ELSE
+            zwz(:,:) = ff(:,:)
+            zww(:,:) = rotn(:,:,jk)
+            zwx(:,:) = e2u(:,:) * un(:,:,jk)
+            zwy(:,:) = e1v(:,:) * vn(:,:,jk)
+         ENDIF
+
+         ! Compute and add the vorticity term trend
+         ! ----------------------------------------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj)
+               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
+               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj)
+               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+               ! enstrophy conserving formulation for relative vorticity term
+               zua = zfact1 * ( zww(ji  ,jj-1) + zww(ji,jj) ) * ( zy1 + zy2 )
+               zva =-zfact1 * ( zww(ji-1,jj  ) + zww(ji,jj) ) * ( zx1 + zx2 )
+               ! energy conserving formulation for planetary vorticity term
+               zcua = zfact2 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+               zcva =-zfact2 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
+
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zcua + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zcva + zva
+#   if defined key_trddyn
+               utrd(ji,jj,jk,3) = zua
+               vtrd(ji,jj,jk,3) = zva
+               utrd(ji,jj,jk,4) = zcua
+               vtrd(ji,jj,jk,4) = zcva
+#   endif
+            END DO  
+         END DO  
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' vor  - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl
+         u_ctl = zua   ;   v_ctl = zva
+      ENDIF
+
+   END SUBROUTINE dyn_vor_mixed
+
+
+   SUBROUTINE dyn_vor_enstrophy( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_vor_enstrophy  ***
+      !!
+      !! ** Purpose :   Compute the now total vorticity trend and add it to
+      !!      the general trend of the momentum equation.
+      !!
+      !! ** Method  :   Trend evaluated using now fields (centered in time)
+      !!      and the Sadourny (1975) flux FORM formulation : conserves the
+      !!      potential enstrophy of a horizontally non-divergent flow. the
+      !!      trend of the vorticity term is given by:
+      !!       * s-coordinate (lk_sco=T), the e3. are inside the derivative:
+      !!          voru = 1/e1u  mj-1[ (rotn+f)/e3f ]  mj-1[ mi(e1v*e3v vn) ]
+      !!          vorv = 1/e2v  mi-1[ (rotn+f)/e3f ]  mi-1[ mj(e2u*e3u un) ]
+      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
+      !!          voru = 1/e1u  mj-1[ rotn+f ]  mj-1[ mi(e1v vn) ]
+      !!          vorv = 1/e2v  mi-1[ rotn+f ]  mi-1[ mj(e2u un) ]
+      !!      Add this trend to the general momentum trend (ua,va):
+      !!          (ua,va) = (ua,va) + ( voru , vorv )
+      !!
+      !! ** Action : - Update (ua,va) arrays with the now vorticity term trend
+      !!             - Save the trends in (utrd,vtrd) in 2 parts (relative 
+      !!               and planetary vorticity trends) ('key_trddyn')
+      !!
+      !! References :
+      !!      Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
+      !! History :
+      !!   5.0  !  91-11  (G. Madec)  Original code
+      !!   6.0  !  96-01  (G. Madec)  s-coord, suppress work arrays
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * modules used
+      USE oce, ONLY:   zwx  => ta,   & ! use ta as 3D workspace
+                       zwy  => sa      ! use sa as 3D workspace
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt    ! ocean timestep
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk          ! dummy loop indices
+      REAL(wp) ::   &
+         zfact1, zua, zva, zuav, zvau  ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zwz                           ! temporary workspace
+#   if defined key_trddyn
+      REAL(wp) ::   &
+         zcu, zcv, zce3                ! temporary scalars 
+#   endif
+      !!----------------------------------------------------------------------
+      
+      IF( kt == nit000 )   CALL dyn_vor_ctl            ! Check options
+
+      ! Local constant initialization
+      zfact1 = 0.5 * 0.25
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         ! Potential vorticity and horizontal fluxes
+         ! -----------------------------------------
+         IF( lk_sco ) THEN
+            DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop 
+               DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking
+                  zwz(ji,jj,jk) = ( rotn(ji,jj,jk) + ff(ji,jj) ) / fse3f(ji,jj,jk)
+                  zwx(ji,jj,jk) = e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk)
+                  zwy(ji,jj,jk) = e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk)
+               END DO
+            END DO
+         ELSE
+            DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop 
+               DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking
+                  zwz(ji,jj,jk) = rotn(ji,jj,jk) + ff(ji,jj)
+                  zwx(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
+                  zwy(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+
+
+         ! Compute and add the vorticity term trend
+         ! ----------------------------------------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zuav = zfact1 / e1u(ji,jj) * ( zwy(ji  ,jj-1,jk) + zwy(ji+1,jj-1,jk)   &
+                                            + zwy(ji  ,jj  ,jk) + zwy(ji+1,jj  ,jk) )
+               zvau =-zfact1 / e2v(ji,jj) * ( zwx(ji-1,jj  ,jk) + zwx(ji-1,jj+1,jk)   &
+                                            + zwx(ji  ,jj  ,jk) + zwx(ji  ,jj+1,jk) )
+
+               zua  = zuav * ( zwz(ji  ,jj-1,jk) + zwz(ji,jj,jk) )
+               zva  = zvau * ( zwz(ji-1,jj  ,jk) + zwz(ji,jj,jk) )
+
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zva
+
+#   if defined key_trddyn
+#      if defined key_s_coord
+               zce3 = ff(ji,jj) / fse3f(ji,jj,jk)
+               zcu  = zuav * ( ff(ji  ,jj-1) / fse3f(ji  ,jj-1,jk) + zce3 )
+               zcv  = zvau * ( ff(ji-1,jj  ) / fse3f(ji-1,jj  ,jk) + zce3 )
+#      else
+               zcu = zuav * ( ff(ji  ,jj-1) + ff(ji,jj) )
+               zcv = zvau * ( ff(ji-1,jj  ) + ff(ji,jj) )
+#      endif
+
+#      if defined key_trddyn_new
+               utrd(ji,jj,jk,2) = utrd(ji,jj,jk,2) + zua - zcu
+               vtrd(ji,jj,jk,3) = vtrd(ji,jj,jk,3) + zva - zcv
+#      else
+               utrd(ji,jj,jk,3) = zua - zcu
+               vtrd(ji,jj,jk,3) = zva - zcv
+#      endif
+               utrd(ji,jj,jk,4) = zcu
+               vtrd(ji,jj,jk,4) = zcv
+#   endif
+            END DO  
+         END DO  
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' vor  - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl
+         u_ctl = zua   ;   v_ctl = zva
+      ENDIF
+
+   END SUBROUTINE dyn_vor_enstrophy
+
+
+   SUBROUTINE dyn_vor_ctl
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_vor_ctl  ***
+      !!
+      !! ** Purpose :   Control the consistency between cpp options for
+      !!      tracer advection schemes
+      !!
+      !! History :
+      !!   9.0  !  03-08  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ioptio = 0      ! temporary integer
+
+      NAMELIST/nam_dynvor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist nam_dynvor : Vorticity scheme options
+      ! ------------------------
+      REWIND ( numnam )
+      READ   ( numnam, nam_dynvor )
+
+      ! Control of vorticity scheme options
+      ! -----------------------------------
+      IF( ln_dynvor_ens .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_vor_enstrophy : vorticity term : enstrophy conserving scheme'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~~~'
+         ioptio = ioptio + 1
+      ENDIF
+      IF( ln_dynvor_ene .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_vor_energy : vorticity term : energy conserving scheme'
+         WRITE(numout,*) '~~~~~~~~~~~~~~ '
+         ioptio = ioptio + 1
+      ENDIF
+      IF( ln_dynvor_mix .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_vor_mixed : vorticity term : mixed enstrophy/energy conserving scheme'
+         WRITE(numout,*) '~~~~~~~~~~~~~ '
+         ioptio = ioptio + 1
+      ENDIF
+      IF ( ioptio /= 1 .AND. .NOT. lk_esopa ) THEN
+          WRITE(numout,cform_err)
+          IF(lwp) WRITE(numout,*) ' use ONE and ONLY one vorticity scheme'
+          nstop = nstop + 1
+      ENDIF
+
+   END SUBROUTINE dyn_vor_ctl
+
+!!==============================================================================
+END MODULE dynvor
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynzad.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 4)
@@ -0,0 +1,240 @@
+MODULE dynzad
+   !!======================================================================
+   !!                       ***  MODULE  dynzad  ***
+   !! Ocean dynamics : vertical advection trend
+   !!======================================================================
+   
+   !!----------------------------------------------------------------------
+   !!   dyn_zad      : vertical advection momentum trend
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE trddyn_oce     ! dynamics trends diagnostics variables
+   USE flxrnf          ! ???
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   !! * Accessibility
+   PUBLIC dyn_zad                ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined key_autotasking
+   !!----------------------------------------------------------------------
+   !!   'key_autotasking'                              j-k-i loops (j-slab)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dyn_zad( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dynzad  ***
+      !!
+      !! ** Purpose :   Compute the now vertical momentum advection trend and 
+      !!      add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   Use j-slab (j-k-i loops) for auto-tasking
+      !!      The now vertical advection of momentum is given by:
+      !!         w dz(u) = ua + 1/(e1u*e2u*e3u) mk+1[ mi(e1t*e2t*wn) dk(un) ]
+      !!         w dz(v) = va + 1/(e1v*e2v*e3v) mk+1[ mj(e1t*e2t*wn) dk(vn) ]
+      !!      Add this trend to the general trend (ua,va):
+      !!         (ua,va) = (ua,va) + w dz(u,v)
+      !!
+      !! ** Action  : - Update (ua,va) with the vert. momentum advection trends
+      !!              - Save the trends in (utrd,vtrd) ('key_trddyn')
+      !!
+      !! History :
+      !!   6.0  !  91-01  (G. Madec) Original code
+      !!   7.0  !  91-11  (G. Madec)
+      !!   7.5  !  96-01  (G. Madec) statement function for e3
+      !!   8.5  !  02-07  (G. Madec) Free form, F90
+      !!----------------------------------------------------------------------
+      !! * modules used
+      USE oce, ONLY:   zwuw => ta,   & ! use ta as 3D workspace
+                       zwvw => sa      ! use sa as 3D workspace
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt    ! ocean time-step inedx
+      
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk         ! dummy loop indices
+      REAL(wp) ::   zvn, zua, zva      ! temporary scalars
+      REAL(wp), DIMENSION(jpi) ::   &
+         zww                           ! temporary workspace
+      !!----------------------------------------------------------------------
+      
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_zad : arakawa advection scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   Auto-tasking case, j-slab, no vector opt.'
+      ENDIF
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+
+         ! Vertical momentum advection at level w and u- and v- vertical
+         ! ----------------------------------------------------------------
+         DO jk = 2, jpkm1
+            ! vertical fluxes 
+            DO ji = 2, jpi
+               zww(ji) = 0.25 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk)
+            END DO
+            ! vertical momentum advection at w-point
+            DO ji = 2, jpim1
+               zvn = 0.25 * e1t(ji,jj+1) * e2t(ji,jj+1) * wn(ji,jj+1,jk)
+               zwuw(ji,jj,jk) = ( zww(ji+1) + zww(ji) ) * ( un(ji,jj,jk-1)-un(ji,jj,jk) )
+               zwvw(ji,jj,jk) = ( zvn       + zww(ji) ) * ( vn(ji,jj,jk-1)-vn(ji,jj,jk) )
+            END DO  
+         END DO   
+
+         ! Surface and bottom values set to zero
+         DO ji = 2, jpim1
+            zwuw(ji,jj, 1 ) = 0.e0
+            zwvw(ji,jj, 1 ) = 0.e0
+            zwuw(ji,jj,jpk) = 0.e0
+            zwvw(ji,jj,jpk) = 0.e0
+         END DO  
+
+         ! Vertical momentum advection at u- and v-points
+         ! ----------------------------------------------
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ! vertical momentum advective trends
+               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
+               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+               ! add the trends to the general momentum trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zva
+#   if defined key_trddyn
+               ! save the trends for diagnostics
+               utrd(ji,jj,jk,6) = zua
+               vtrd(ji,jj,jk,6) = zva
+#   endif
+            END DO  
+         END DO  
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' zad  - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl
+         u_ctl = zua   ;   v_ctl = zva
+      ENDIF
+
+   END SUBROUTINE dyn_zad
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                             k-j-i loop (vector opt.)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE dyn_zad ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dynzad  ***
+      !! 
+      !! ** Purpose :   Compute the now vertical momentum advection trend and 
+      !!      add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The now vertical advection of momentum is given by:
+      !!         w dz(u) = ua + 1/(e1u*e2u*e3u) mk+1[ mi(e1t*e2t*wn) dk(un) ]
+      !!         w dz(v) = va + 1/(e1v*e2v*e3v) mk+1[ mj(e1t*e2t*wn) dk(vn) ]
+      !!      Add this trend to the general trend (ua,va):
+      !!         (ua,va) = (ua,va) + w dz(u,v)
+      !!
+      !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends
+      !!              - Save the trends in (utrd,vtrd) ('key_trddyn')
+      !!
+      !! History :
+      !!   8.5  !  02-07  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * modules used
+      USE oce, ONLY:   zwuw => ta,   & ! use ta as 3D workspace
+                       zwvw => sa      ! use sa as 3D workspace
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt    ! ocean time-step inedx
+      
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk         ! dummy loop indices
+      REAL(wp) ::   zua, zva           ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zww                           ! temporary  workspace
+      !!----------------------------------------------------------------------
+      
+      IF( kt == nit000 ) THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'dyn_zad : arakawa advection scheme'
+         IF(lwp)WRITE(numout,*) '~~~~~~~   vector optimization k-j-i loop'
+      ENDIF
+      
+      ! Vertical momentum advection at level w and u- and v- vertical
+      ! -------------------------------------------------------------
+      DO jk = 2, jpkm1
+         ! vertical fluxes 
+         DO jj = 2, jpj
+            DO ji = fs_2, jpi   ! vector opt.
+               zww(ji,jj) = 0.25 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk)
+            END DO
+         END DO
+         ! vertical momentum advection at w-point
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( un(ji,jj,jk-1)-un(ji,jj,jk) )
+               zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( vn(ji,jj,jk-1)-vn(ji,jj,jk) )
+            END DO  
+         END DO   
+      END DO
+
+      ! Surface and bottom values set to zero
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwuw(ji,jj, 1 ) = 0.e0
+            zwvw(ji,jj, 1 ) = 0.e0
+            zwuw(ji,jj,jpk) = 0.e0
+            zwvw(ji,jj,jpk) = 0.e0
+         END DO  
+      END DO
+
+
+      ! Vertical momentum advection at u- and v-points
+      ! ----------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! vertical momentum advective trends
+               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
+               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+               ! add the trends to the general momentum trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zva
+#   if defined key_trddyn
+               ! save the trends for diagnostics
+               utrd(ji,jj,jk,6) = zua
+               vtrd(ji,jj,jk,6) = zva
+#   endif
+            END DO  
+         END DO  
+      END DO
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' zad  - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl
+         u_ctl = zua   ;   v_ctl = zva
+      ENDIF
+
+   END SUBROUTINE dyn_zad
+#endif
+
+!!======================================================================
+END MODULE dynzad
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 4)
@@ -0,0 +1,173 @@
+MODULE dynzdf_exp
+   !!==============================================================================
+   !!                     ***  MODULE  dynzdf_exp  ***
+   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dyn_zdf_exp  : update the momentum trend with the vertical diffu-
+   !!                  sion using an explicit time-stepping scheme.
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE taumod          ! surface ocean stress
+   USE trddyn_oce     ! dynamics trends diagnostics variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dyn_zdf_exp    ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_zdf_exp( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_zdf_exp  ***
+      !!                   
+      !! ** Purpose :   Compute the trend due to the vert. momentum diffusion
+      !!
+      !! ** Method  :   Explicit forward time stepping with a time splitting
+      !!      technique. The vertical diffusion of momentum is given by:
+      !!         diffu = dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ub) )
+      !!      Surface boundary conditions: wind stress input
+      !!      Bottom boundary conditions : bottom stress (cf zdfbfr.F90)
+      !!      Add this trend to the general trend ua :
+      !!         ua = ua + dz( avmu dz(u) )
+      !!
+      !! ** Action : - Update (ua,va) with the vertical diffusive trend
+      !!             - Save the trends in (utrd,vtrd) ('key_diatrends')
+      !!
+      !! History :
+      !!        !  90-10  (B. Blanke)  Original code
+      !!        !  97-05  (G. Madec)  vertical component of isopycnal
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk, jl         ! dummy loop indices
+      REAL(wp) ::   &
+         zrau0r, zlavmr, z2dt, zua, zva   ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         zwx, zwy, zwz, zww               ! temporary workspace arrays
+#if defined key_trddyn
+      INTEGER ::   &
+         ikbu, ikbum1 , ikbv, ikbvm1      ! temporary integers
+#endif
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_zdf_exp : vertical momentum diffusion explicit operator'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+
+      ! Local constant initialization
+      ! -----------------------------
+      zrau0r = 1. / rau0                                   ! inverse of the reference density
+      zlavmr = 1. / float( n_zdfexp )                      ! inverse of the number of sub time step
+      z2dt = 2. * rdt                                      ! Leap-frog environnement
+      IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt    ! Euler time stepping when starting from rest
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+
+         ! Surface boundary condition
+         DO ji = 2, jpim1
+            zwy(ji,1) = taux(ji,jj) * zrau0r
+            zww(ji,1) = tauy(ji,jj) * zrau0r
+         END DO  
+
+         ! Initialization of x, z and contingently trends array
+         DO jk = 1, jpk
+            DO ji = 2, jpim1
+               zwx(ji,jk) = ub(ji,jj,jk)
+               zwz(ji,jk) = vb(ji,jj,jk)
+#if defined key_trddyn
+               utrd(ji,jj,jk,7) = ua(ji,jj,jk)
+               vtrd(ji,jj,jk,7) = va(ji,jj,jk)
+#endif
+            END DO  
+         END DO  
+
+         ! Time splitting loop
+         DO jl = 1, n_zdfexp
+
+            ! First vertical derivative
+            DO jk = 2, jpk
+               DO ji = 2, jpim1
+                  zwy(ji,jk) = avmu(ji,jj,jk) * ( zwx(ji,jk-1) - zwx(ji,jk) ) / fse3uw(ji,jj,jk) 
+                  zww(ji,jk) = avmv(ji,jj,jk) * ( zwz(ji,jk-1) - zwz(ji,jk) ) / fse3vw(ji,jj,jk)
+               END DO  
+            END DO  
+
+            ! Second vertical derivative and trend estimation at kt+l*rdt/n_zdfexp
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  zua = zlavmr*( zwy(ji,jk) - zwy(ji,jk+1) ) / fse3u(ji,jj,jk)
+                  zva = zlavmr*( zww(ji,jk) - zww(ji,jk+1) ) / fse3v(ji,jj,jk)
+                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+                  va(ji,jj,jk) = va(ji,jj,jk) + zva
+
+                  zwx(ji,jk) = zwx(ji,jk) + z2dt*zua*umask(ji,jj,jk)
+                  zwz(ji,jk) = zwz(ji,jk) + z2dt*zva*vmask(ji,jj,jk)
+               END DO  
+            END DO  
+
+         END DO  
+
+#if defined key_trddyn
+         ! diagnose the vertical diffusive momentum trends
+
+         ! save the total vertical momentum diffusive trend
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               utrd(ji,jj,jk,7) = ua(ji,jj,jk) - utrd(ji,jj,jk,7)
+               vtrd(ji,jj,jk,7) = va(ji,jj,jk) - vtrd(ji,jj,jk,7)
+            END DO 
+         END DO 
+ 
+         ! subtract and save surface and momentum fluxes
+         DO ji = 2, jpim1
+            ! save the surface momentum fluxes 
+            tautrd(ji,jj,1) = zwy(ji,1) / fse3u(ji,jj,1)
+            tautrd(ji,jj,2) = zww(ji,1) / fse3v(ji,jj,1)
+            ! save bottom friction momentum fluxes 
+            ikbu   = MIN( mbathy(ji+1,jj), mbathy(ji,jj) )
+            ikbum1 = MAX( ikbu-1, 1 )
+            ikbv   = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )
+            ikbvm1 = MAX( ikbv-1, 1 )
+            tautrd(ji,jj,3) = avmu(ji,jj,ikbu) * zwx(ji,ikbum1)   &
+                            / ( fse3u(ji,jj,ikbum1) * fse3uw(ji,jj,ikbu) )
+            tautrd(ji,jj,4) = avmv(ji,jj,ikbv) * zwz(ji,ikbvm1)   &
+                            / ( fse3v(ji,jj,ikbvm1) * fse3vw(ji,jj,ikbv) )
+            ! subtract surface forcing and bottom friction trend from vertical
+            ! diffusive momentum trend
+            utrd(ji,jj,1     ,7) = utrd(ji,jj,1     ,7) - tautrd(ji,jj,1)
+            utrd(ji,jj,ikbum1,7) = utrd(ji,jj,ikbum1,7) - tautrd(ji,jj,3)
+            vtrd(ji,jj,1     ,7) = vtrd(ji,jj,1     ,7) - tautrd(ji,jj,2)
+            vtrd(ji,jj,ikbvm1,7) = vtrd(ji,jj,ikbvm1,7) - tautrd(ji,jj,4)
+         END DO
+#endif
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+   END SUBROUTINE dyn_zdf_exp
+
+   !!==============================================================================
+END MODULE dynzdf_exp
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 4)
@@ -0,0 +1,354 @@
+MODULE dynzdf_imp
+   !!==============================================================================
+   !!                    ***  MODULE  dynzdf_imp  ***
+   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dyn_zdf_imp  : update the momentum trend with the vertical diffu-
+   !!                  sion using a implicit time-stepping.
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE taumod          ! surface ocean stress
+   USE trddyn_oce     ! dynamics trends diagnostics variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dyn_zdf_imp    ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+
+   SUBROUTINE dyn_zdf_imp( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_zdf_imp  ***
+      !!                   
+      !! ** Purpose :   Compute the trend due to the vert. momentum diffusion
+      !!      and the surface forcing, and add it to the general trend of 
+      !!      the momentum equations.
+      !!
+      !! ** Method  :   The vertical momentum mixing trend is given by :
+      !!             dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ua) )
+      !!      backward time stepping
+      !!      Surface boundary conditions: wind stress input
+      !!      Bottom boundary conditions : bottom stress (cf zdfbfr.F)
+      !!      Add this trend to the general trend ua :
+      !!         ua = ua + dz( avmu dz(u) )
+      !!
+      !! ** Action : - Update (ua,va) arrays with the after vertical diffusive
+      !!               mixing trend.
+      !!             - Save the trends in (utrd,vtrd) ('key_diatrends')
+      !!
+      !! History :
+      !!        !  90-10  (B. Blanke)  Original code
+      !!        !  97-05  (G. Madec)  vertical component of isopycnal
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Modules used
+      USE oce, ONLY :  zwd   => ta,   &  ! use ta as workspace
+                       zws   => sa       ! use sa as workspace
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk            ! dummy loop indices
+      REAL(wp) ::   &
+         zrau0r, z2dt, zua, zva,      &  ! temporary scalars
+         z2dtf, zcoef, zzws, zrhs        !    "         "
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zwi                             ! temporary workspace arrays
+#if defined key_trddyn
+      INTEGER ::   &
+         ikbu, ikbum1, ikbv, ikbvm1   &  ! temporary integers
+#endif
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_zdf_imp : vertical momentum diffusion implicit operator'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      zrau0r = 1. / rau0      ! inverse of the reference density
+      z2dt   = 2. * rdt       ! Leap-frog environnement
+      ! Euler time stepping when starting from rest
+      IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt
+      ! Normalization to obtain the general momentum trend ua
+#if defined key_trddyn
+      ! Save the previously computed trend
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               utrd(ji,jj,jk,7) = ua(ji,jj,jk)
+               vtrd(ji,jj,jk,7) = va(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#endif
+
+      ! 1. Vertical diffusion on u
+      ! ---------------------------
+      ! Matrix and second member construction
+      ! bottom boundary condition: only zws must be masked as avmu can take
+      ! non zero value at the ocean bottom depending on the bottom friction
+      ! used (see zdfmix.F)
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcoef = - z2dt / fse3u(ji,jj,jk)
+               zwi(ji,jj,jk) = zcoef * avmu(ji,jj,jk  ) / fse3uw(ji,jj,jk  )
+               zzws          = zcoef * avmu(ji,jj,jk+1) / fse3uw(ji,jj,jk+1)
+               zws(ji,jj,jk) = zzws * umask(ji,jj,jk+1)
+               zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zzws
+            END DO
+         END DO
+      END DO
+
+      ! Surface boudary conditions
+      DO jj = 2, jpjm1 
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwi(ji,jj,1) = 0.
+            zwd(ji,jj,1) = 1. - zws(ji,jj,1)
+         END DO
+      END DO
+
+      ! Matrix inversion starting from the first level
+      !-----------------------------------------------------------------------
+      !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+      !
+      !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+      !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+      !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+      !        (        ...               )( ...  ) ( ...  )
+      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+      !
+      !   m is decomposed in the product of an upper and a lower triangular matrix
+      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+      !   The solution (the after velocity) is in ua
+      !-----------------------------------------------------------------------
+
+      ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      ! second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1
+      DO jj = 2, jpjm1   
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+!!! change les resultats (derniers digit, pas significativement + rapide 1* de moins)
+!!!         ua(ji,jj,1) = ub(ji,jj,1)  &
+!!!                      + z2dt * ( ua(ji,jj,1) + taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) )
+            z2dtf = z2dt / ( fse3u(ji,jj,1)*rau0 )
+            ua(ji,jj,1) = ub(ji,jj,1)  &
+                         + z2dt *  ua(ji,jj,1) + z2dtf * taux(ji,jj)
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zrhs = ub(ji,jj,jk) + z2dt * ua(ji,jj,jk)   ! zrhs=right hand side
+               ua(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      ! thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk
+      DO jj = 2, jpjm1   
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 1, -1
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) =( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+#if defined key_trddyn
+      ! diagnose surface and bottom momentum fluxes
+      DO jj = 2, jpjm1   
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! save the surface forcing momentum fluxes
+            tautrd(ji,jj,1) = taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 )
+            ! save bottom friction momentum fluxes
+            ikbu   = MIN( mbathy(ji+1,jj), mbathy(ji,jj) )
+            ikbum1 = MAX( ikbu-1, 1 )
+            tautrd(ji,jj,3) = - avmu(ji,jj,ikbu) * ua(ji,jj,ikbum1)   &
+               / ( fse3u(ji,jj,ikbum1)*fse3uw(ji,jj,ikbu) )
+            ! subtract surface forcing and bottom friction trend from vertical
+            ! diffusive momentum trend
+            utrd(ji,jj,1     ,7) = utrd(ji,jj,1     ,7) - tautrd(ji,jj,1)
+            utrd(ji,jj,ikbum1,7) = utrd(ji,jj,ikbum1,7) - tautrd(ji,jj,3)
+         END DO
+      END DO
+#endif
+
+      ! Normalization to obtain the general momentum trend ua
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zua = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) / z2dt
+#if defined key_trddyn
+               ! save the vertical diffusive momentum trend (general trend - previous one)
+               utrd(ji,jj,jk,7) = zua - utrd(ji,jj,jk,7)
+#endif
+               ua(ji,jj,jk) = zua
+            END DO
+         END DO
+      END DO
+
+
+      ! 2. Vertical diffusion on v
+      ! ---------------------------
+      ! Matrix and second member construction
+      ! bottom boundary condition: only zws must be masked as avmv can take
+      ! non zero value at the ocean bottom depending on the bottom friction
+      ! used (see zdfmix.F)
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcoef = -z2dt / fse3v(ji,jj,jk)
+               zwi(ji,jj,jk) = zcoef * avmv(ji,jj,jk  ) / fse3vw(ji,jj,jk  )
+               zzws       = zcoef * avmv(ji,jj,jk+1) / fse3vw(ji,jj,jk+1)
+               zws(ji,jj,jk) =  zzws * vmask(ji,jj,jk+1)
+               zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zzws
+            END DO
+         END DO
+      END DO
+
+      ! Surface boudary conditions
+      DO jj = 2, jpjm1   
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwi(ji,jj,1) = 0.e0
+            zwd(ji,jj,1) = 1. - zws(ji,jj,1)
+         END DO
+      END DO
+
+      ! Matrix inversion
+      !-----------------------------------------------------------------------
+      !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+      !
+      !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+      !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+      !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+      !        (        ...               )( ...  ) ( ...  )
+      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+      !
+      !   m is decomposed in the product of an upper and lower triangular
+      !   matrix
+      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+      !   The solution (after velocity) is in 2d array va
+      !-----------------------------------------------------------------------
+
+      ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zwd(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      ! second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+!!! change les resultats (derniers digit, pas significativement + rapide 1* de moins)
+!!!         va(ji,jj,1) = vb(ji,jj,1)  &
+!!!                      + z2dt * ( va(ji,jj,1) + tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) )
+            z2dtf = z2dt / ( fse3v(ji,jj,1)*rau0 )
+            va(ji,jj,1) = vb(ji,jj,1)  &
+                         + z2dt * va(ji,jj,1) + z2dtf * tauy(ji,jj)
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zrhs = vb(ji,jj,jk) + z2dt * va(ji,jj,jk)   ! zrhs=right hand side
+               va(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      ! thrid recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk
+      DO jj = 2, jpjm1   
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 1, -1
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               va(ji,jj,jk) =( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+#if defined key_trddyn
+      ! diagnose surface and bottom momentum fluxes
+      DO jj = 2, jpjm1   
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! save the surface forcing momentum fluxes
+            tautrd(ji,jj,2) = tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 )
+            ! save bottom friction momentum fluxes
+            ikbv   = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )
+            ikbvm1 = MAX( ikbv-1, 1 )
+            tautrd(ji,jj,4) = - avmv(ji,jj,ikbv) * va(ji,jj,ikbvm1)   &
+               / ( fse3v(ji,jj,ikbvm1)*fse3vw(ji,jj,ikbv) )
+            ! subtract surface forcing and bottom friction trend from vertical
+            ! diffusive momentum trend
+            vtrd(ji,jj,1     ,7) = vtrd(ji,jj,1     ,7) - tautrd(ji,jj,2)
+            vtrd(ji,jj,ikbvm1,7) = vtrd(ji,jj,ikbvm1,7) - tautrd(ji,jj,4)
+         END DO
+      END DO
+#endif
+
+      ! Normalization to obtain the general momentum trend va
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zva = ( va(ji,jj,jk) - vb(ji,jj,jk) ) / z2dt
+#if defined key_trddyn
+               ! save the vertical diffusive momentum fluxes
+               vtrd(ji,jj,jk,7) = zva - vtrd(ji,jj,jk,7)
+#endif
+               va(ji,jj,jk) = zva
+            END DO
+         END DO
+      END DO
+
+      IF( l_ctl .AND. lwp ) THEN         ! print sum trends (used for debugging)
+         zua = SUM( ua(2:jpim1,2:jpjm1,1:jpkm1) * umask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zva = SUM( va(2:jpim1,2:jpjm1,1:jpkm1) * vmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' zdf  - Ua: ', zua-u_ctl, ' Va: ', zva-v_ctl
+         u_ctl = zua   ;   v_ctl = zva
+      ENDIF
+
+   END SUBROUTINE dyn_zdf_imp
+
+   !!==============================================================================
+END MODULE dynzdf_imp
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynzdf_imp_atsk.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynzdf_imp_atsk.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynzdf_imp_atsk.F90	(revision 4)
@@ -0,0 +1,317 @@
+MODULE dynzdf_imp_atsk
+   !!==============================================================================
+   !!                    ***  MODULE  dynzdf_imp_atsk  ***
+   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dyn_zdf_imp_tsk : update the momentum trend with the vertical
+   !!                     diffusion using an implicit time-stepping and
+   !!                     j-k-i loops.
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE taumod          ! surface ocean stress
+   USE trddyn_oce     ! dynamics trends diagnostics variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dyn_zdf_imp_tsk     ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_zdf_imp_tsk( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_zdf_imp_tsk  ***
+      !!                   
+      !! ** Purpose :   Compute the trend due to the vert. momentum diffusion
+      !!      and the surface forcing, and add it to the general trend of 
+      !!      the momentum equations.
+      !!
+      !! ** Method  :   The vertical momentum mixing trend is given by :
+      !!             dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ua) )
+      !!      backward time stepping
+      !!      Surface boundary conditions: wind stress input
+      !!      Bottom boundary conditions : bottom stress (cf zdfbfr.F)
+      !!      Add this trend to the general trend ua :
+      !!         ua = ua + dz( avmu dz(u) )
+      !!
+      !! ** Action : - Update (ua,va) arrays with the after vertical diffusive
+      !!               mixing trend.
+      !!             - Save the trends in (utrd,vtrd) ('key_diatrends')
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)  auto-tasking option
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk            ! dummy loop indices
+      INTEGER ::   ikst, ikenm2, ikstp1  ! temporary integers
+      REAL(wp) ::   &
+         zrau0r, z2dt, zua, zva,      &  ! temporary scalars
+         z2dtf, zcoef, zzws
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         zwx, zwy, zwz,               &  ! workspace
+         zwd, zws, zwi, zwt
+#if defined key_trddyn
+      INTEGER ::   &
+         ikbu, ikbum1, ikbv, ikbvm1   &  ! temporary integers
+#endif
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_zdf_imp_tsk : vertical momentum diffusion implicit operator'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~   auto-task case (j-k-i loop)'
+      ENDIF
+
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      zrau0r = 1. / rau0      ! inverse of the reference density
+      z2dt   = 2. * rdt       ! Leap-frog environnement
+      ! Euler time stepping when starting from rest
+      IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+         ! 1. Vertical diffusion on u
+         ! ---------------------------
+
+         ! Matrix and second member construction
+         ! bottom boundary condition: only zws must be masked as avmu can take
+         ! non zero value at the ocean bottom depending on the bottom friction
+         ! used (see zdfmix.F)
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zcoef = - z2dt / fse3u(ji,jj,jk)
+               zwi(ji,jk) = zcoef * avmu(ji,jj,jk  ) / fse3uw(ji,jj,jk  )
+               zzws       = zcoef * avmu(ji,jj,jk+1) / fse3uw(ji,jj,jk+1)
+               zws(ji,jk) = zzws * umask(ji,jj,jk+1)
+               zwd(ji,jk) = 1. - zwi(ji,jk) - zzws
+               zwy(ji,jk) = ub(ji,jj,jk) + z2dt * ua(ji,jj,jk)
+            END DO
+         END DO
+
+         ! Surface boudary conditions
+         DO ji = 2, jpim1
+            z2dtf = z2dt / ( fse3u(ji,jj,1)*rau0 )
+            zwi(ji,1) = 0.
+            zwd(ji,1) = 1. - zws(ji,1)
+            zwy(ji,1) = zwy(ji,1) + z2dtf * taux(ji,jj)
+         END DO
+
+         ! Matrix inversion starting from the first level
+         ikst = 1
+!!----------------------------------------------------------------------
+!!         ZDF.MATRIXSOLVER
+!!       ********************
+!!----------------------------------------------------------------------
+!! Matrix inversion
+!   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+!
+!        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+!        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+!        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+!        (        ...               )( ...  ) ( ...  )
+!        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+!
+!   m is decomposed in the product of an upper and lower triangular
+!   matrix
+!   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+!   The second member is in 2d array zwy
+!   The solution is in 2d array zwx
+!   The 2d arry zwt and zwz are work space arrays
+!
+!   N.B. the starting vertical index (ikst) is equal to 1 except for
+!   the resolution of tke matrix where surface tke value is prescribed
+!   so that ikstrt=2.
+!!----------------------------------------------------------------------
+
+         ikstp1 = ikst + 1
+         ikenm2 = jpk - 2
+         DO ji = 2, jpim1
+            zwt(ji,ikst) = zwd(ji,ikst)
+         END DO
+         DO jk = ikstp1, jpkm1
+            DO ji = 2, jpim1
+               zwt(ji,jk) = zwd(ji,jk) - zwi(ji,jk) * zws(ji,jk-1) / zwt(ji,jk-1)
+            END DO
+         END DO
+         DO ji = 2, jpim1
+            zwz(ji,ikst) = zwy(ji,ikst)
+         END DO
+         DO jk = ikstp1, jpkm1
+            DO ji = 2, jpim1
+               zwz(ji,jk) = zwy(ji,jk) - zwi(ji,jk) / zwt(ji,jk-1) * zwz(ji,jk-1)
+            END DO
+         END DO
+         DO ji = 2, jpim1
+            zwx(ji,jpkm1) = zwz(ji,jpkm1) / zwt(ji,jpkm1)
+         END DO
+         DO jk = ikenm2, ikst, -1
+            DO ji = 2, jpim1
+            zwx(ji,jk) =( zwz(ji,jk) - zws(ji,jk) * zwx(ji,jk+1) ) / zwt(ji,jk)
+            END DO
+         END DO
+      
+         ! Normalization to obtain the general momentum trend ua
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zua = ( zwx(ji,jk) - ub(ji,jj,jk) ) / z2dt
+#if defined key_trddyn
+               ! save the vertical diffusive momentum trend
+               utrd(ji,jj,jk,7) = zua - ua(ji,jj,jk)
+#endif
+               ua(ji,jj,jk) = zua
+            END DO
+         END DO
+
+#if defined key_trddyn
+         ! diagnose surface and bottom momentum fluxes
+         DO ji = 2, jpim1
+            ! save the surface forcing momentum fluxes
+            tautrd(ji,jj,1) = taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 )
+            ! save bottom friction momentum fluxes
+            ikbu   = MIN( mbathy(ji+1,jj), mbathy(ji,jj) )
+            ikbum1 = MAX( ikbu-1, 1 )
+            tautrd(ji,jj,3) = - avmu(ji,jj,ikbu) * zwx(ji,ikbum1)   &
+               / ( fse3u(ji,jj,ikbum1)*fse3uw(ji,jj,ikbu) )
+            ! subtract surface forcing and bottom friction trend from vertical
+            ! diffusive momentum trend
+            utrd(ji,jj,1     ,7) = utrd(ji,jj,1     ,7) - tautrd(ji,jj,1)
+            utrd(ji,jj,ikbum1,7) = utrd(ji,jj,ikbum1,7) - tautrd(ji,jj,3)
+         END DO
+#endif
+
+         ! 2. Vertical diffusion on v
+         ! ---------------------------
+
+         ! Matrix and second member construction
+         ! bottom boundary condition: only zws must be masked as avmv can take
+         ! non zero value at the ocean bottom depending on the bottom friction
+         ! used (see zdfmix.F)
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zcoef = -z2dt/fse3v(ji,jj,jk)
+               zwi(ji,jk) = zcoef * avmv(ji,jj,jk  ) / fse3vw(ji,jj,jk  )
+               zzws       = zcoef * avmv(ji,jj,jk+1) / fse3vw(ji,jj,jk+1)
+               zws(ji,jk) =  zzws * vmask(ji,jj,jk+1)
+               zwd(ji,jk) = 1. - zwi(ji,jk) - zzws
+               zwy(ji,jk) = vb(ji,jj,jk) + z2dt * va(ji,jj,jk)
+            END DO
+         END DO
+
+         ! Surface boudary conditions
+         DO ji = 2, jpim1
+            z2dtf = z2dt / ( fse3v(ji,jj,1)*rau0 )
+            zwi(ji,1) = 0.e0
+            zwd(ji,1) = 1. - zws(ji,1)
+            zwy(ji,1) = zwy(ji,1) + z2dtf * tauy(ji,jj)
+         END DO
+
+         ! Matrix inversion starting from the first level
+         ikst = 1
+!!----------------------------------------------------------------------
+!!         ZDF.MATRIXSOLVER
+!!       ********************
+!!----------------------------------------------------------------------
+!! Matrix inversion
+!   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+!
+!        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+!        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+!        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+!        (        ...               )( ...  ) ( ...  )
+!        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+!
+!   m is decomposed in the product of an upper and lower triangular
+!   matrix
+!   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+!   The second member is in 2d array zwy
+!   The solution is in 2d array zwx
+!   The 2d arry zwt and zwz are work space arrays
+!
+!   N.B. the starting vertical index (ikst) is equal to 1 except for
+!   the resolution of tke matrix where surface tke value is prescribed
+!   so that ikstrt=2.
+!!----------------------------------------------------------------------
+
+         ikstp1 = ikst + 1
+         ikenm2 = jpk - 2
+         DO ji = 2, jpim1
+            zwt(ji,ikst) = zwd(ji,ikst)
+         END DO
+         DO jk = ikstp1, jpkm1
+            DO ji = 2, jpim1
+               zwt(ji,jk) = zwd(ji,jk) - zwi(ji,jk) * zws(ji,jk-1) / zwt(ji,jk-1)
+            END DO
+         END DO
+         DO ji = 2, jpim1
+            zwz(ji,ikst) = zwy(ji,ikst)
+         END DO
+         DO jk = ikstp1, jpkm1
+            DO ji = 2, jpim1
+               zwz(ji,jk) = zwy(ji,jk) - zwi(ji,jk) / zwt(ji,jk-1) * zwz(ji,jk-1)
+            END DO
+         END DO
+         DO ji = 2, jpim1
+            zwx(ji,jpkm1) = zwz(ji,jpkm1) / zwt(ji,jpkm1)
+         END DO
+         DO jk = ikenm2, ikst, -1
+            DO ji = 2, jpim1
+               zwx(ji,jk) =( zwz(ji,jk) - zws(ji,jk) * zwx(ji,jk+1) ) / zwt(ji,jk)
+            END DO
+         END DO
+      
+         ! Normalization to obtain the general momentum trend va
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zva = ( zwx(ji,jk) - vb(ji,jj,jk) ) / z2dt
+#if defined key_trddyn
+               ! save the vertical diffusive momentum fluxes
+               vtrd(ji,jj,jk,7) = zva - va(ji,jj,jk)
+#endif
+               va(ji,jj,jk) = zva
+            END DO
+         END DO
+
+#if defined key_trddyn
+         ! diagnose surface and bottom momentum fluxes
+         DO ji = 2, jpim1
+            ! save the surface forcing momentum fluxes
+            tautrd(ji,jj,2) = tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 )
+            ! save bottom friction momentum fluxes
+            ikbv   = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )
+            ikbvm1 = MAX( ikbv-1, 1 )
+            tautrd(ji,jj,4) = - avmv(ji,jj,ikbv) * zwx(ji,ikbvm1)   &
+               / ( fse3v(ji,jj,ikbvm1)*fse3vw(ji,jj,ikbv) )
+            ! subtract surface forcing and bottom friction trend from vertical
+            ! diffusive momentum trend
+            vtrd(ji,jj,1     ,7) = vtrd(ji,jj,1     ,7) - tautrd(ji,jj,2)
+            vtrd(ji,jj,ikbvm1,7) = vtrd(ji,jj,ikbvm1,7) - tautrd(ji,jj,4)
+         END DO
+#endif
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE dyn_zdf_imp_tsk
+
+   !!==============================================================================
+END MODULE dynzdf_imp_atsk
Index: /branches/nemo/NEMO/OPA_SRC/DYN/dynzdf_iso.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/dynzdf_iso.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/dynzdf_iso.F90	(revision 4)
@@ -0,0 +1,394 @@
+MODULE dynzdf_iso
+   !!==============================================================================
+   !!                       ***  MODULE  dynzdf_iso  ***
+   !! Ocean dynamics:  vertical component(s) of the momentum mixing trend
+   !!==============================================================================
+#if   defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                          rotation of the mixing tensor
+   !!----------------------------------------------------------------------
+   !!   dyn_zdf_iso  : update the momentum trend with the vertical diffusion
+   !!                  (vertical mixing + vertical component of lateral
+   !!                  mixing) (rotated lateral operator case)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE taumod          ! surface ocean stress
+   USE trddyn_oce     ! dynamics trends diagnostics variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dyn_zdf_iso    ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_zdf_iso( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_zdf_iso  ***
+      !!                   
+      !! ** Purpose :
+      !!         Compute the vertical momentum trend due to both vertical and
+      !!      lateral mixing (only for second order lateral operator, for
+      !!      fourth order it is already computed and add to the general trend
+      !!      in dynldf.F) and the surface forcing, and add it to the general
+      !!      trend of the momentum equations.
+      !!
+      !! ** Method :
+      !!         The vertical component of the lateral diffusive trends is
+      !!      provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      First part: vertical trends associated with the lateral mixing
+      !!      ==========  (excluding the vertical flux proportional to dk[U] )
+      !!      vertical fluxes associated with the rotated lateral mixing:
+      !!         zfuw =-ahm {  e2t*mi(wslpi) di[ mi(mk(ub)) ]
+      !!                     + e1t*mj(wslpj) dj[ mj(mk(ub)) ]  }
+      !!      update and save in zavt the vertical eddy viscosity coefficient:
+      !!         avmu = avmu + mi(wslpi)^2 + mj(wslj)^2
+      !!      take the horizontal divergence of the fluxes:
+      !!         diffu = 1/(e1u*e2u*e3u) dk[ zfuw ]
+      !!      Add this trend to the general trend (ta,sa):
+      !!         ua = ua + difft
+      !!
+      !!      Second part: vertical trend associated with the vertical physics
+      !!      ===========  (including the vertical flux proportional to dk[U]
+      !!                    associated with the lateral mixing, through the
+      !!                    update of avmu)
+      !!      The vertical diffusion of momentum is given by:
+      !!             diffu = dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ua) )
+      !!      using a backward (implicit) time stepping.
+      !!      Bottom boundary conditions : bottom stress (cf zdfbfr.F)
+      !!      Add this trend to the general trend ua :
+      !!         ua = ua + dz( avmu dz(u) )
+      !!
+      !!      'key_trddyn' defined: trend saved for futher diagnostics.
+      !!
+      !!      macro-tasked on vertical slab (jj-loop)
+      !!
+      !! ** Action :
+      !!            /comaft/ ua, va   : general momentum trend increased
+      !!                                by the after vertical diffusive trend
+      !!            /comtra/ utrd,vtrd: after vertical momentum diffusive
+      !!                                trend ('key_trddyn' defined)
+      !!
+      !! History :
+      !!      original : 90-10 (B. Blanke)
+      !!      addition : 97-05 (G. Madec) vertical component of isopycnal
+      !!---------------------------------------------------------------------
+      !! * Modules used
+      USE ldfslp    , ONLY : wslpi, wslpj
+      USE ldftra_oce, ONLY : aht0
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+      
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk             ! dummy loop indices
+      INTEGER ::   &
+         ikst, ikenm2, ikstp1             ! temporary integers
+      REAL(wp) ::   &
+         zrau0r, z2dt,                 &  ! temporary scalars
+         z2dtf, zua, zva, zcoef, zzws
+      REAL(wp) ::   &
+         zcoef0, zcoef3, zcoef4, zbu, zbv, zmkt, zmkf,   &
+         zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         zwx, zwy, zwz                 &  ! workspace
+       , zwd, zws, zwi, zwt
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         zfuw, zdiu, zdju, zdj1u,      &  ! workspace
+         zfvw, zdiv, zdjv, zdj1v
+#if defined key_trddyn
+      INTEGER ::   &
+         ikbu, ikbum1 , ikbv, ikbvm1      ! temporary integers
+#endif
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_zdf_iso : vertical momentum diffusion isopycnal operator'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      
+      ! inverse of the reference density
+      zrau0r = 1. / rau0
+      ! Leap-frog environnement
+      z2dt = 2. * rdt
+      ! Euler time stepping when starting from rest
+      IF ( neuler == 0 .AND. kt == nit000 ) z2dt = rdt
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+
+  
+         ! I. vertical trends associated with the lateral mixing
+         ! =====================================================
+         !  (excluding the vertical flux proportional to dk[t]
+
+
+         ! I.1 horizontal momentum gradient
+         ! --------------------------------
+
+         DO jk = 1, jpk
+            DO ji = 2, jpi
+               ! i-gradient of u at jj
+               zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( ub(ji,jj  ,jk) - ub(ji-1,jj  ,jk) )
+               ! j-gradient of u and v at jj
+               zdju (ji,jk) = fmask(ji,jj  ,jk) * ( ub(ji,jj+1,jk) - ub(ji  ,jj  ,jk) )
+               zdjv (ji,jk) = tmask(ji,jj  ,jk) * ( vb(ji,jj  ,jk) - vb(ji  ,jj-1,jk) )
+               ! j-gradient of u and v at jj+1
+               zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( ub(ji,jj  ,jk) - ub(ji  ,jj-1,jk) )
+               zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( vb(ji,jj+1,jk) - vb(ji  ,jj  ,jk) )
+            END DO
+         END DO
+         DO jk = 1, jpk
+            DO ji = 1, jpim1
+               ! i-gradient of v at jj
+               zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( vb(ji+1,jj,jk) - vb(ji  ,jj  ,jk) )
+            END DO
+         END DO
+
+
+         ! I.2 Vertical fluxes
+         ! -------------------
+
+         ! Surface and bottom vertical fluxes set to zero
+         DO ji = 1, jpi
+            zfuw(ji, 1 ) = 0.e0
+            zfvw(ji, 1 ) = 0.e0
+            zfuw(ji,jpk) = 0.e0
+            zfvw(ji,jpk) = 0.e0
+         END DO
+
+         ! interior (2=<jk=<jpk-1) on U field
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               zcoef0= 0.5 * aht0 * umask(ji,jj,jk)
+
+               zuwslpi = zcoef0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) )
+               zuwslpj = zcoef0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) )
+
+               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1)   &
+                             + tmask(ji,jj,jk  )+tmask(ji+1,jj,jk  ), 1. )
+               zmkf = 1./MAX(  fmask(ji,jj-1,jk-1)+fmask(ji,jj,jk-1)   &
+                             + fmask(ji,jj-1,jk  )+fmask(ji,jj,jk  ), 1. )
+
+               zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi
+               zcoef4 = - e1u(ji,jj) * zmkf * zuwslpj
+               ! vertical flux on u field
+               zfuw(ji,jk) = zcoef3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1)     &
+                                       +zdiu (ji,jk  ) + zdiu (ji+1,jk  ) )   &
+                           + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji  ,jk-1)     &
+                                       +zdj1u(ji,jk  ) + zdju (ji  ,jk  ) )
+               ! update avmu (add isopycnal vertical coefficient to avmu)
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi          &
+                                                 + zuwslpj * zuwslpj ) / aht0
+            END DO
+         END DO
+
+         ! interior (2=<jk=<jpk-1) on V field
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               zcoef0= 0.5 * aht0 * vmask(ji,jj,jk)
+
+               zvwslpi = zcoef0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) )
+               zvwslpj = zcoef0 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) )
+
+               zmkf = 1./MAX(  fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1)   &
+                             + fmask(ji-1,jj,jk  )+fmask(ji,jj,jk  ), 1. )
+               zmkt = 1./MAX(  tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1)   &
+                             + tmask(ji,jj,jk  )+tmask(ji,jj+1,jk  ), 1. )
+
+               zcoef3 = - e2v(ji,jj) * zmkf * zvwslpi
+               zcoef4 = - e1v(ji,jj) * zmkt * zvwslpj
+               ! vertical flux on v field
+               zfvw(ji,jk) = zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1)     &
+                                       +zdiv (ji,jk  ) + zdiv (ji-1,jk  ) )   &
+                           + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji  ,jk-1)     &
+                                       +zdjv (ji,jk  ) + zdj1v(ji  ,jk  ) )
+               ! update avmv (add isopycnal vertical coefficient to avmv)
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi          &
+                                                 + zvwslpj * zvwslpj ) / aht0
+            END DO
+         END DO
+
+
+         ! I.3 Divergence of vertical fluxes added to the general tracer trend
+         ! -------------------------------------------------------------------
+
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ! volume elements
+               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+               ! part of the k-component of isopycnal momentum diffusive trends
+               zuav = ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / zbu
+               zvav = ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / zbv
+               ! add the trends to the general trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zuav
+               va(ji,jj,jk) = va(ji,jj,jk) + zvav
+#if defined key_trddyn
+               ! save the trends for diagnostics
+               utrd(ji,jj,jk,5) = utrd(ji,jj,jk,5) + zuav
+               vtrd(ji,jj,jk,5) = vtrd(ji,jj,jk,5) + zvav
+#endif
+            END DO
+         END DO
+
+
+         ! 1. Vertical diffusion on u
+         ! ---------------------------
+
+         ! 1.0 Matrix and second member construction
+         ! bottom boundary condition: only zws must be masked as avmu can take
+         ! non zero value at the ocean bottom depending on the bottom friction
+         ! used (see zdfmix.F)
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zcoef = - z2dt / fse3u(ji,jj,jk)
+               zwi(ji,jk) = zcoef * avmu(ji,jj,jk  ) / fse3uw(ji,jj,jk  )
+               zzws       = zcoef * avmu(ji,jj,jk+1) / fse3uw(ji,jj,jk+1)
+               zws(ji,jk) = zzws * umask(ji,jj,jk+1)
+               zwd(ji,jk) = 1. - zwi(ji,jk) - zzws
+               zwy(ji,jk) = ub(ji,jj,jk) + z2dt * ua(ji,jj,jk)
+            END DO  
+         END DO  
+
+         ! 1.1 Surface boudary conditions
+         DO ji = 2, jpim1
+            z2dtf = z2dt / ( fse3u(ji,jj,1)*rau0 )
+            zwi(ji,1) = 0.
+            zwd(ji,1) = 1. - zws(ji,1)
+            zwy(ji,1) = zwy(ji,1) + z2dtf * taux(ji,jj)
+         END DO  
+
+         ! 1.2 Matrix inversion starting from the first level
+         ikst = 1
+#include "zdf.matrixsolver.h90"
+
+         ! 1.3 Normalization to obtain the general momentum trend ua
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zua = ( zwx(ji,jk) - ub(ji,jj,jk) ) / z2dt
+#if defined key_trddyn
+               ! save the vertical diffusive momentum trend
+               utrd(ji,jj,jk,7) = zua - ua(ji,jj,jk)
+#endif
+               ua(ji,jj,jk) = zua
+            END DO  
+         END DO  
+
+#if defined key_trddyn
+
+         ! 1.4 diagnose surface and bottom momentum fluxes
+         DO ji = 2, jpim1
+            ! save the surface forcing momentum fluxes
+            tautrd(ji,jj,1) = taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 )
+            ! save bottom friction momentum fluxes
+            ikbu   = min( mbathy(ji+1,jj), mbathy(ji,jj) )
+            ikbum1 = max( ikbu-1, 1 )
+            tautrd(ji,jj,3) = - avmu(ji,jj,ikbu) * zwx(ji,ikbum1)   &
+                            / ( fse3u(ji,jj,ikbum1)*fse3uw(ji,jj,ikbu) )
+            ! subtract surface forcing and bottom friction trend from vertical
+            ! diffusive momentum trend
+            utrd(ji,jj,1     ,7) = utrd(ji,jj,1     ,7) - tautrd(ji,jj,1)
+            utrd(ji,jj,ikbum1,7) = utrd(ji,jj,ikbum1,7) - tautrd(ji,jj,3)
+         END DO
+
+#endif
+
+         ! 2. Vertical diffusion on v
+         ! ---------------------------
+
+         ! 2.0 Matrix and second member construction
+         ! bottom boundary condition: only zws must be masked as avmv can take
+         ! non zero value at the ocean bottom depending on the bottom friction
+         ! used (see zdfmix.F)
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zcoef = -z2dt/fse3v(ji,jj,jk)
+               zwi(ji,jk) = zcoef * avmv(ji,jj,jk  ) / fse3vw(ji,jj,jk  )
+               zzws       = zcoef * avmv(ji,jj,jk+1) / fse3vw(ji,jj,jk+1)
+               zws(ji,jk) =  zzws * vmask(ji,jj,jk+1)
+               zwd(ji,jk) = 1. - zwi(ji,jk) - zzws
+               zwy(ji,jk) = vb(ji,jj,jk) + z2dt * va(ji,jj,jk)
+            END DO  
+         END DO  
+
+         ! 2.1 Surface boudary conditions
+         DO ji = 2, jpim1
+            z2dtf = z2dt / ( fse3v(ji,jj,1)*rau0 )
+            zwi(ji,1) = 0.e0
+            zwd(ji,1) = 1. - zws(ji,1)
+            zwy(ji,1) = zwy(ji,1) + z2dtf * tauy(ji,jj)
+         END DO  
+
+         ! 2.2 Matrix inversion starting from the first level
+         ikst = 1
+#include "zdf.matrixsolver.h90"
+
+         ! 2.3 Normalization to obtain the general momentum trend va
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zva = ( zwx(ji,jk) - vb(ji,jj,jk) ) / z2dt
+#if defined key_trddyn
+               ! save the vertical diffusive momentum fluxes
+               vtrd(ji,jj,jk,7) = zva - va(ji,jj,jk)
+#endif
+               va(ji,jj,jk) = zva
+            END DO    
+         END DO   
+
+#if defined key_trddyn
+         ! 2.4 diagnose surface and bottom momentum fluxes
+         DO ji = 2, jpim1
+            ! save the surface forcing momentum fluxes
+            tautrd(ji,jj,2) = tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 )
+            ! save bottom friction momentum fluxes
+            ikbv   = min( mbathy(ji,jj+1), mbathy(ji,jj) )
+            ikbvm1 = max( ikbv-1, 1 )
+            tautrd(ji,jj,4) = - avmv(ji,jj,ikbv) * zwx(ji,ikbvm1)   &
+                            / ( fse3v(ji,jj,ikbvm1)*fse3vw(ji,jj,ikbv) )
+            ! subtract surface forcing and bottom friction trend from vertical
+            ! diffusive momentum trend
+            vtrd(ji,jj,1     ,7) = vtrd(ji,jj,1     ,7) - tautrd(ji,jj,2)
+            vtrd(ji,jj,ikbvm1,7) = vtrd(ji,jj,ikbvm1,7) - tautrd(ji,jj,4)
+         END DO
+
+#endif
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE dyn_zdf_iso
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                       NO rotation of the mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE dyn_zdf_iso( kt )                        ! Dummy routine
+      WRITE(*,*) kt
+   END SUBROUTINE dyn_zdf_iso
+#endif
+
+   !!==============================================================================
+END MODULE dynzdf_iso
Index: /branches/nemo/NEMO/OPA_SRC/DYN/wzvmod.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/DYN/wzvmod.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/DYN/wzvmod.F90	(revision 4)
@@ -0,0 +1,139 @@
+MODULE wzvmod
+   !!==============================================================================
+   !!                       ***  MODULE  wzvmod  ***
+   !! Ocean diagnostic variable : vertical velocity
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   wzv        : Compute the vertical velocity
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC wzv       ! routine called by step.F90 and inidtr.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined key_autotasking
+   !!----------------------------------------------------------------------
+   !!   'key_autotasking'                               j-k-i loop (j-slab)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE wzv( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE wzv  ***
+      !!                     
+      !! ** Purpose :   Compute the now vertical velocity after the array swap
+      !!
+      !! ** Method  :   Using the incompressibility hypothesis, the vertical
+      !!     velocity is computed by integrating the horizontal divergence 
+      !!     from the bottom to the surface.
+      !!       The boundary conditions are w=0 at the bottom (no flux) and,
+      !!     in regid-lid case, w=0 at the sea surface.
+      !!
+      !! ** action  :    wn array : the now vertical velocity
+      !!
+      !! History :
+      !!   5.0  !  90-10  (C. Levy, G. Madec)  Original code
+      !!   7.0  !  96-01  (G. Madec)  Statement function for e3
+      !!   8.5  !  02-07  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   jj, jk      ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0, LODYC-IPSL (2003)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'wzv     : vertical velocity from continuity eq.'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   auto-tasking case : j-k-i loop '
+
+         ! bottom boundary condition: w=0 (set once for all)
+         wn(:,:,jpk) = 0.e0
+      ENDIF
+
+      !                                                ! ===============
+      DO jj = 1, jpj                                   !  Vertical slab
+         !                                             ! ===============
+         ! Computation from the bottom
+         DO jk = jpkm1, 1, -1
+            wn(:,jj,jk) = wn(:,jj,jk+1) - fse3t(:,jj,jk) * hdivn(:,jj,jk)
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF(l_ctl) THEN                ! print mean trends (used for debugging)
+         WRITE(numout,*) ' w**2 -   : ', SUM( wn(:,:,:) * wn   (:,:,:) )
+      ENDIF
+
+   END SUBROUTINE wzv
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                           k-j-i loop
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE wzv( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE wzv  ***
+      !!
+      !! ** Purpose :   Compute the now vertical velocity after the array swap
+      !!
+      !! ** Method  :   Using the incompressibility hypothesis, the vertical
+      !!      velocity is computed by integrating the horizontal divergence 
+      !!      from the bottom to the surface.
+      !!        The boundary conditions are w=0 at the bottom (no flux) and,
+      !!      in regid-lid case, w=0 at the sea surface.
+      !!
+      !! ** action  :   wn array : the now vertical velocity
+      !!
+      !! History :
+      !!   9.0  !  02-07  (G. Madec)  Vector optimization
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   jk          ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'wzv     : vertical velocity from continuity eq.'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
+
+         ! bottom boundary condition: w=0 (set once for all)
+         wn(:,:,jpk) = 0.e0
+      ENDIF
+
+      ! Computation from the bottom
+      DO jk = jpkm1, 1, -1
+         wn(:,:,jk) = wn(:,:,jk+1) - fse3t(:,:,jk) * hdivn(:,:,jk)
+      END DO
+
+      IF(l_ctl) THEN                ! print mean trends (used for debugging)
+         WRITE(numout,*) ' w**2 -   : ', SUM( wn(:,:,:) * wn   (:,:,:) )
+      ENDIF
+
+   END SUBROUTINE wzv
+#endif
+
+   !!======================================================================
+END MODULE wzvmod
Index: /branches/nemo/NEMO/OPA_SRC/FLO/flo4rk.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 4)
@@ -0,0 +1,499 @@
+MODULE flo4rk
+   !!======================================================================
+   !!                    ***  MODULE  flo4rk  ***
+   !! Ocean floats :   trajectory computation using a 4th order Runge-Kutta
+   !!======================================================================
+#if   defined key_floats   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                     float trajectories
+   !!----------------------------------------------------------------------
+   !!   flo_4rk        : Compute the geographical position of floats
+   !!   flo_interp     : interpolation
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE flo_oce         ! ocean drifting floats
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC flo_4rk      ! routine called by floats.F90
+
+   !! * Module variables
+   REAL(wp), DIMENSION (4) ::   &   ! RK4 and Lagrange interpolation
+      tcoef1 = /  1.0  ,  0.5  ,  0.5  ,  0.0  / ,  &  ! coeffients  for 
+      tcoef2 = /  0.0  ,  0.5  ,  0.5  ,  1.0  / ,  &  ! lagrangian interp.
+      scoef2 = /  1.0  ,  2.0  ,  2.0  ,  1.0  / ,  &  ! RK4 coefficients
+      rcoef  = /-1./6. , 1./2. ,-1./2. , 1./6. /       ! ???
+   REAL(wp), DIMENSION (3) ::   &
+      scoef1 = / .5, .5, 1. /       ! compute position with interpolated
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flo_4rk( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE flo_4rk  ***
+      !!
+      !!  ** Purpose :   Compute the geographical position (lat,lon,depth)
+      !!       of each float at each time step.
+      !! 
+      !!  ** Method  :   The position of a float is computed with a 4th order
+      !!       Runge-Kutta scheme and and Lagrange interpolation.
+      !!         We need to know the velocity field, the old positions of the
+      !!       floats and the grid defined on the domain.
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(in) ::   kt     ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::  jfl, jind           ! dummy loop indices
+      REAL(wp), DIMENSION ( jpnfl)  ::   &
+         zgifl, zgjfl, zgkfl,   &     ! index RK  positions
+         zufl, zvfl, zwfl             ! interpolated velocity at the
+      ! float position 
+      REAL(wp), DIMENSION ( jpnfl, 4 )  ::    &
+         zrkxfl, zrkyfl, zrkzfl       ! RK coefficients
+      !!---------------------------------------------------------------------
+    
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'flo_4rk : compute Runge Kutta trajectories for floats '
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      ! Verification of the floats positions. If one of them leave the domain
+      ! domain we replace the float near the border.
+      DO jfl = 1, jpnfl
+         ! i-direction
+         IF( tpifl(jfl) <= 1.5 ) THEN
+            IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
+            IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the WEST border.'
+            tpifl(jfl) = tpifl(jfl) + 1.
+            IF(lwp)WRITE(numout,*)'New initialisation for this float at i=',tpifl(jfl)
+         ENDIF
+          
+         IF( tpifl(jfl) >= jpi-.5 ) THEN
+            IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
+            IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the EAST border.'
+            tpifl(jfl) = tpifl(jfl) - 1.
+            IF(lwp)WRITE(numout,*)'New initialisation for this float at i=', tpifl(jfl)
+         ENDIF
+         ! j-direction
+         IF( tpjfl(jfl) <= 1.5 ) THEN
+            IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
+            IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the SOUTH border.'
+            tpjfl(jfl) = tpjfl(jfl) + 1.
+            IF(lwp)WRITE(numout,*)'New initialisation for this float at j=', tpjfl(jfl)
+         ENDIF
+           
+         IF( tpjfl(jfl) >= jpj-.5 ) THEN
+            IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
+            IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the NORTH border.'
+            tpjfl(jfl) = tpjfl(jfl) - 1.
+            IF(lwp)WRITE(numout,*)'New initialisation for this float at j=', tpjfl(jfl)
+         ENDIF
+         ! k-direction
+         IF( tpkfl(jfl) <= .5 ) THEN
+            IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
+            IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the TOP border.'
+            tpkfl(jfl) = tpkfl(jfl) + 1.
+            IF(lwp)WRITE(numout,*)'New initialisation for this float at k=', tpkfl(jfl)
+         ENDIF
+         
+         IF( tpkfl(jfl) >= jpk-.5 )  THEN
+            IF(lwp)WRITE(numout,*)'!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!'
+            IF(lwp)WRITE(numout,*)'The float',jfl,'is out of the domain at the BOTTOM border.'
+            tpkfl(jfl) = tpkfl(jfl) - 1.
+            IF(lwp)WRITE(numout,*)'New initialisation for this float at k=', tpkfl(jfl)
+         ENDIF
+      END DO
+      
+      ! 4 steps of Runge-Kutta algorithme
+      ! initialisation of the positions 
+      
+      DO jfl = 1, jpnfl
+         zgifl(jfl) = tpifl(jfl)
+         zgjfl(jfl) = tpjfl(jfl)
+         zgkfl(jfl) = tpkfl(jfl)
+      END DO
+       
+      DO  jind = 1, 4
+         
+         ! for each step we compute the compute the velocity with Lagrange interpolation
+         CALL flo_interp(zgifl,zgjfl,zgkfl,zufl,zvfl,zwfl,jind)
+         
+         ! computation of Runge-Kutta factor
+         
+         DO jfl = 1, jpnfl
+            zrkxfl(jfl,jind) = rdt*zufl(jfl)
+            zrkyfl(jfl,jind) = rdt*zvfl(jfl)
+            zrkzfl(jfl,jind) = rdt*zwfl(jfl)
+         END DO
+         IF( jind /= 4 ) THEN
+            DO jfl = 1, jpnfl
+               zgifl(jfl) = (tpifl(jfl)) + scoef1(jind)*zrkxfl(jfl,jind)
+               zgjfl(jfl) = (tpjfl(jfl)) + scoef1(jind)*zrkyfl(jfl,jind)
+               zgkfl(jfl) = (tpkfl(jfl)) + scoef1(jind)*zrkzfl(jfl,jind)
+            END DO
+         ENDIF
+      END DO
+      DO jind = 1, 4
+         DO jfl = 1, jpnfl
+            tpifl(jfl) = tpifl(jfl) + scoef2(jind)*zrkxfl(jfl,jind)/6.
+            tpjfl(jfl) = tpjfl(jfl) + scoef2(jind)*zrkyfl(jfl,jind)/6.
+            tpkfl(jfl) = tpkfl(jfl) + scoef2(jind)*zrkzfl(jfl,jind)/6.
+         END DO
+      END DO
+
+   END SUBROUTINE flo_4rk
+
+
+   SUBROUTINE flo_interp( pxt , pyt , pzt ,      &
+      &                   pufl, pvfl, pwfl, kind )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE flointerp  ***
+      !!
+      !! ** Purpose :   Interpolation of the velocity on the float position
+      !! 
+      !! ** Method  :   Lagrange interpolation with the 64 neighboring
+      !!      points. This routine is call 4 time at each time step to
+      !!      compute velocity at the date and the position we need to
+      !!      integrated with RK method.
+      !!
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   &
+         kind,   &
+         jfl, jind1, jind2, jind3,   &
+         zsumu, zsumv, zsumw
+      INTEGER , DIMENSION  ( jpnfl  ) ::   &
+         iilu, ijlu, iklu,     &           ! nearest neighbour INDEX-u
+         iilv, ijlv, iklv,     &           ! nearest neighbour INDEX-v
+         iilw, ijlw, iklw                  ! nearest neighbour INDEX-w
+      INTEGER , DIMENSION  ( jpnfl, 4  ) ::   &
+         iidu, ijdu, ikdu,    &            ! 64 nearest neighbour INDEX-u
+         iidv, ijdv, ikdv,    &            ! 64 nearest neighbour INDEX-v
+         iidw, ijdw, ikdw                  ! 64 nearest neighbour INDEX-w
+      REAL(wp) , DIMENSION  ( jpnfl  ) ::   &
+         pxt , pyt , pzt,     &            ! position of the float
+         pufl, pvfl, pwfl                  ! velocity at this position
+      REAL(wp) , DIMENSION  ( jpnfl, 4, 4, 4 ) ::   &
+         ztufl, ztvfl, ztwfl               ! velocity at choosen time step
+      REAL(wp) , DIMENSION  ( jpnfl, 4 ) ::   &
+         zlagxu, zlagyu, zlagzu,   &       ! Lagrange  coefficients
+         zlagxv, zlagyv, zlagzv,   &
+         zlagxw, zlagyw, zlagzw
+      !!---------------------------------------------------------------------
+      
+      ! Interpolation of U velocity
+
+      ! nearest neightboring point for computation of u       
+      DO jfl = 1, jpnfl
+         iilu(jfl) = INT(pxt(jfl)-.5)
+         ijlu(jfl) = INT(pyt(jfl)-.5)
+         iklu(jfl) = INT(pzt(jfl))
+      END DO
+      
+      !  64 neightboring points for computation of u 
+      DO jind1 = 1, 4
+         DO jfl = 1, jpnfl
+            !  i-direction
+            IF( iilu(jfl) <= 2 ) THEN
+               iidu(jfl,jind1) = jind1
+            ELSE
+               IF( iilu(jfl) >= jpi-1 ) THEN
+                  iidu(jfl,jind1) = jpi + jind1 - 4
+               ELSE
+                  iidu(jfl,jind1) = iilu(jfl) + jind1 - 2
+               ENDIF
+            ENDIF
+            !  j-direction
+            IF( ijlu(jfl) <= 2 ) THEN
+               ijdu(jfl,jind1) = jind1
+            ELSE
+               IF( ijlu(jfl) >= jpj-1 ) THEN
+                  ijdu(jfl,jind1) = jpj + jind1 - 4
+               ELSE
+                  ijdu(jfl,jind1) = ijlu(jfl) + jind1 - 2
+               ENDIF
+            ENDIF
+            ! k-direction
+            IF( iklu(jfl) <= 2 ) THEN
+               ikdu(jfl,jind1) = jind1
+            ELSE
+               IF( iklu(jfl) >= jpk-1 ) THEN
+                  ikdu(jfl,jind1) = jpk + jind1 - 4
+               ELSE
+                  ikdu(jfl,jind1) = iklu(jfl) + jind1 - 2
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      
+      ! Lagrange coefficients
+      
+      DO jfl = 1, jpnfl
+         DO jind1 = 1, 4
+            zlagxu(jfl,jind1) = 1.
+            zlagyu(jfl,jind1) = 1.
+            zlagzu(jfl,jind1) = 1.
+         END DO
+      END DO
+      
+      DO jind1 = 1, 4
+         DO jind2 = 1, 4
+            DO jfl= 1, jpnfl
+               IF( jind1 /= jind2 ) THEN
+                  zlagxu(jfl,jind1) = zlagxu(jfl,jind1) * ( pxt(jfl)-(float(iidu(jfl,jind2))+.5) )
+                  zlagyu(jfl,jind1) = zlagyu(jfl,jind1) * ( pyt(jfl)-(float(ijdu(jfl,jind2))) )
+                  zlagzu(jfl,jind1) = zlagzu(jfl,jind1) * ( pzt(jfl)-(float(ikdu(jfl,jind2))) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+      
+      ! velocity when we compute at middle time step
+      
+      DO jfl = 1, jpnfl
+         DO jind1 = 1, 4
+            DO jind2 = 1, 4
+               DO jind3 = 1, 4
+                  ztufl(jfl,jind1,jind2,jind3) =   &
+                     &   (  tcoef1(kind) * ub(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) +   &
+                     &      tcoef2(kind) * un(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) )   &
+                     &      / e1u(iidu(jfl,jind1),ijdu(jfl,jind2)) 
+               END DO
+            END DO
+         END DO
+         
+         zsumu = 0.
+         DO jind1 = 1, 4
+            DO jind2 = 1, 4
+               DO jind3 = 1, 4
+                  zsumu = zsumu + ztufl(jfl,jind1,jind2,jind3) * zlagxu(jfl,jind1) * zlagyu(jfl,jind2)   &
+                     &  * zlagzu(jfl,jind3) * rcoef(jind1)*rcoef(jind2)*rcoef(jind3) 
+               END DO
+            END DO
+         END DO
+         pufl(jfl) = zsumu
+      END DO
+      
+      ! Interpolation of V velocity 
+
+      ! nearest neightboring point for computation of v 
+      DO jfl = 1, jpnfl
+         iilv(jfl) = INT(pxt(jfl)-.5)
+         ijlv(jfl) = INT(pyt(jfl)-.5)
+         iklv(jfl) = INT(pzt(jfl))
+      END DO
+      
+      ! 64 neightboring points for computation of v 
+      DO jind1 = 1, 4
+         DO jfl = 1, jpnfl
+            ! i-direction
+            IF( iilv(jfl) <= 2 ) THEN
+               iidv(jfl,jind1) = jind1
+            ELSE
+               IF( iilv(jfl) >= jpi-1 ) THEN
+                  iidv(jfl,jind1) = jpi + jind1 - 4
+               ELSE
+                  iidv(jfl,jind1) = iilv(jfl) + jind1 - 2
+               ENDIF
+            ENDIF
+            ! j-direction
+            IF( ijlv(jfl) <= 2 ) THEN
+               ijdv(jfl,jind1) = jind1
+            ELSE
+               IF( ijlv(jfl) >= jpj-1 ) THEN
+                  ijdv(jfl,jind1) = jpj + jind1 - 4
+               ELSE
+                  ijdv(jfl,jind1) = ijlv(jfl) + jind1 - 2
+               ENDIF
+            ENDIF
+            ! k-direction
+            IF( iklv(jfl) <= 2 ) THEN
+               ikdv(jfl,jind1) = jind1
+            ELSE
+               IF( iklv(jfl) >= jpk-1 ) THEN
+                  ikdv(jfl,jind1) = jpk + jind1 - 4
+               ELSE
+                  ikdv(jfl,jind1) = iklv(jfl) + jind1 - 2
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      
+      ! Lagrange coefficients
+      
+      DO jfl = 1, jpnfl
+         DO jind1 = 1, 4
+            zlagxv(jfl,jind1) = 1.
+            zlagyv(jfl,jind1) = 1.
+            zlagzv(jfl,jind1) = 1.
+         END DO
+      END DO
+      
+      DO jind1 = 1, 4
+         DO jind2 = 1, 4
+            DO jfl = 1, jpnfl
+               IF( jind1 /= jind2 ) THEN
+                  zlagxv(jfl,jind1)= zlagxv(jfl,jind1)*(pxt(jfl) - (float(iidv(jfl,jind2))) )
+                  zlagyv(jfl,jind1)= zlagyv(jfl,jind1)*(pyt(jfl) - (float(ijdv(jfl,jind2))+.5) )
+                  zlagzv(jfl,jind1)= zlagzv(jfl,jind1)*(pzt(jfl) - (float(ikdv(jfl,jind2))) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+      
+      ! velocity when we compute at middle time step
+      
+      DO jfl = 1, jpnfl
+         DO jind1 = 1, 4
+            DO jind2 = 1, 4
+               DO jind3 = 1 ,4
+                  ztvfl(jfl,jind1,jind2,jind3)=   &
+                     &   ( tcoef1(kind) * vb(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3))  +   &
+                     &     tcoef2(kind) * vn(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3)) )    & 
+                     &     / e2v(iidv(jfl,jind1),ijdv(jfl,jind2))
+               END DO
+            END DO
+         END DO
+         
+         zsumv=0.
+         DO jind1 = 1, 4
+            DO jind2 = 1, 4
+               DO jind3 = 1, 4
+                  zsumv = zsumv + ztvfl(jfl,jind1,jind2,jind3) * zlagxv(jfl,jind1) * zlagyv(jfl,jind2)   &
+                     &  * zlagzv(jfl,jind3) * rcoef(jind1)*rcoef(jind2)*rcoef(jind3)
+               END DO
+            END DO
+         END DO
+         pvfl(jfl) = zsumv
+      END DO
+      
+      ! Interpolation of W velocity
+
+      ! nearest neightboring point for computation of w 
+      DO jfl = 1, jpnfl
+         iilw(jfl) = INT(pxt(jfl))
+         ijlw(jfl) = INT(pyt(jfl))
+         iklw(jfl) = INT(pzt(jfl)+.5)
+      END DO
+      
+      ! 64 neightboring points for computation of w 
+      DO jind1 = 1, 4
+         DO jfl = 1, jpnfl
+            ! i-direction
+            IF( iilw(jfl) <= 2 ) THEN
+               iidw(jfl,jind1) = jind1
+            ELSE
+               IF( iilw(jfl) >= jpi-1 ) THEN
+                  iidw(jfl,jind1) = jpi + jind1 - 4
+               ELSE
+                  iidw(jfl,jind1) = iilw(jfl) + jind1 - 2
+               ENDIF
+            ENDIF
+            ! j-direction
+            IF( ijlw(jfl) <= 2 ) THEN
+               ijdw(jfl,jind1) = jind1
+            ELSE
+               IF( ijlw(jfl) >= jpj-1 ) THEN
+                  ijdw(jfl,jind1) = jpj + jind1 - 4
+               ELSE
+                  ijdw(jfl,jind1) = ijlw(jfl) + jind1 - 2
+               ENDIF
+            ENDIF
+            ! k-direction
+            IF( iklw(jfl) <= 2 ) THEN
+               ikdw(jfl,jind1) = jind1
+            ELSE
+               IF( iklw(jfl) >= jpk-1 ) THEN
+                  ikdw(jfl,jind1) = jpk + jind1 - 4
+               ELSE
+                  ikdw(jfl,jind1) = iklw(jfl) + jind1 - 2
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      DO jind1 = 1, 4
+         DO jfl = 1, jpnfl
+            IF( iklw(jfl) <= 2 ) THEN
+               ikdw(jfl,jind1) = jind1
+            ELSE
+               IF( iklw(jfl) >= jpk-1 ) THEN
+                  ikdw(jfl,jind1) = jpk + jind1 - 4
+               ELSE
+                  ikdw(jfl,jind1) = iklw(jfl) + jind1 - 2
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      
+      ! Lagrange coefficients  for w interpolation
+      
+      DO jfl = 1, jpnfl
+         DO jind1 = 1, 4
+            zlagxw(jfl,jind1) = 1.
+            zlagyw(jfl,jind1) = 1.
+            zlagzw(jfl,jind1) = 1.
+         END DO
+      END DO
+       
+      DO jind1 = 1, 4
+         DO jind2 = 1, 4
+            DO jfl = 1, jpnfl
+               IF( jind1 /= jind2 ) THEN
+                  zlagxw(jfl,jind1) = zlagxw(jfl,jind1) * (pxt(jfl) - (float(iidw(jfl,jind2))) )
+                  zlagyw(jfl,jind1) = zlagyw(jfl,jind1) * (pyt(jfl) - (float(ijdw(jfl,jind2))) )
+                  zlagzw(jfl,jind1) = zlagzw(jfl,jind1) * (pzt(jfl) - (float(ikdw(jfl,jind2))-.5) )
+               ENDIF
+            END DO
+         END DO
+      END DO
+      
+      ! velocity w  when we compute at middle time step
+      
+      DO jfl = 1, jpnfl
+         DO jind1 = 1, 4
+            DO jind2 = 1, 4
+               DO jind3 = 1, 4
+                  ztwfl(jfl,jind1,jind2,jind3)=   &
+                     &   ( tcoef1(kind) * wb(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3))+   &
+                     &     tcoef2(kind) * wn(iidw(jfl,jind1),ijdw(jfl,jind2),ikdw(jfl,jind3)) )  &
+!!bug e3w instead of fse3 
+                     &   / e3w(ikdw(jfl,jind3))
+               END DO
+            END DO
+         END DO
+         
+         zsumw=0.
+         DO jind1 = 1, 4
+            DO jind2 = 1, 4
+               DO jind3 = 1, 4
+                  zsumw = zsumw + ztwfl(jfl,jind1,jind2,jind3) * zlagxw(jfl,jind1) * zlagyw(jfl,jind2)   &
+                     &  * zlagzw(jfl,jind3) * rcoef(jind1)*rcoef(jind2)*rcoef(jind3)
+               END DO
+            END DO
+         END DO
+         pwfl(jfl) = zsumw
+      END DO
+      
+   END SUBROUTINE flo_interp
+
+#  else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE flo_4rk                 ! Empty routine
+   END SUBROUTINE flo_4rk
+#endif
+   
+   !!======================================================================
+END MODULE flo4rk
Index: /branches/nemo/NEMO/OPA_SRC/FLO/flo_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 4)
@@ -0,0 +1,67 @@
+MODULE flo_oce
+   !!======================================================================
+   !!                     ***  MODULE flo_oce  ***
+   !!                
+   !! ** Purpose : - Define in memory all floats parameters and variables
+   !!
+   !! History :
+   !!   8.0  !  99-10  (CLIPPER projet)
+   !!   9.0  !  02-11  (G. Madec, A. Bozec)  F90: Free form and module
+   !!======================================================================
+   !!  OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+#if defined key_floats
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                        drifting floats
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce         ! ocean parameters
+
+   IMPLICIT NONE
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_floats = .TRUE.    ! float flag
+
+   !! float parameters
+   !! ----------------
+   INTEGER, PARAMETER ::   &
+      jpnfl      = 23 ,          &  ! total number of floats during the run
+      jpnnewfl   =  0 ,          &  ! number of floats added in a new run
+      jpnrstarfl = jpnfl-jpnnewfl   ! number of floats for the restart
+
+   !! float variables
+   !! ---------------
+   INTEGER, DIMENSION(jpnfl)  ::    &
+      nisobfl,    &  ! 0 for a isobar float
+      !              ! 1 for a float following the w velocity
+      ngrpfl         ! number to identify searcher group
+
+   REAL(wp), DIMENSION(jpnfl) ::    &
+      flxx,       &  ! longitude of float (decimal degree)
+      flyy,       &  ! latitude of float (decimal degree)
+      flzz,       &  ! depth of float (m, positive)
+      tpifl,      &  ! index of float position on zonal axe
+      tpjfl,      &  ! index of float position on meridien axe
+      tpkfl          ! index of float position on z axe
+   
+   REAL(wp), DIMENSION(jpi, jpj, jpk) ::    & 
+      wb             ! vertical velocity at previous time step (m s-1).
+   
+   ! floats unit
+   
+   LOGICAL  ::                & !!! * namelist namflo *
+      ln_rstflo = .FALSE. ,   &  ! T/F float restart 
+      ln_argo   = .FALSE. ,   &  ! T/F argo type floats
+      ln_flork4 = .FALSE.        ! T/F 4th order Runge-Kutta
+   INTEGER  ::               & !!! * namelist namflo *
+      nwritefl,              &  ! frequency of float output file 
+      nstockfl                  ! frequency of float restart file
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                 NO drifting floats
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_floats = .FALSE.   ! float flag
+#endif
+
+   !!======================================================================
+END MODULE flo_oce
Index: /branches/nemo/NEMO/OPA_SRC/FLO/floats.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/FLO/floats.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/FLO/floats.F90	(revision 4)
@@ -0,0 +1,135 @@
+MODULE floats
+   !!======================================================================
+   !!                       ***  MODULE  floats  ***
+   !! Ocean floats : floats
+   !!======================================================================
+#if   defined key_floats   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                     float trajectories
+   !!----------------------------------------------------------------------
+   !!   flo_stp   : float trajectories computation
+   !!   flo_init  : initialization of float trajectories computation
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE flo_oce         ! floats variables
+   USE lib_mpp         ! distributed memory computing
+   USE flodom          ! initialisation Module 
+   USE flowri          ! float output                     (flo_wri routine)
+   USE flo4rk          ! Trajectories, Runge Kutta scheme (flo_4rk routine)
+   USE floblk          ! Trajectories, Blanke scheme      (flo_blk routine)
+
+   IMPLICIT NONE
+   PRIVATE  
+
+   !! * Routine accessibility
+   PUBLIC flo_stp    ! routine called by step.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flo_stp( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE flo_stp  ***
+      !!                    
+      !! ** Purpose :   Compute the geographical position (lat., long., depth)
+      !!      of each float at each time step with one of the algorithm.
+      !! 
+      !! ** Method  :   The position of a float is computed with Bruno Blanke 
+      !!        algorithm by default and with a 4th order Runge-Kutta scheme
+      !!        if ln_flork4 =T
+      !!      
+      !! History :
+      !!   8.5  !  02-06  (A. Bozec, G. Madec )  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'flo_stp : call floats routine '
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+         CALL flo_init           ! read the namelist of floats             
+
+         CALL flo_dom            ! compute/read initial position of floats
+
+         ! Initialisation of wb for computation of floats trajectories at the first time step
+         wb(:,:,:) = wn(:,:,:)
+      ENDIF
+
+      IF( ln_flork4 ) THEN
+         CALL flo_4rk( kt )        ! Trajectories using a 4th order Runge Kutta scheme
+      ELSE
+         CALL flo_blk( kt )        ! Trajectories using Blanke' algorithme
+      ENDIF
+
+# if defined key_mpp
+      CALL mppsync
+# endif
+
+      ! Writing and restart      
+      
+      ! trajectories file 
+      IF( kt == nit000 .OR. MOD( kt, nwritefl ) == 0 )   CALL flo_wri( kt )
+      ! restart file 
+      IF( kt == nitend .OR. MOD( kt, nstockfl ) == 0 )   CALL flo_wri( kt )
+
+      ! Save the old vertical velocity field
+      wb(:,:,:) = wn(:,:,:)
+
+   END SUBROUTINE flo_stp
+
+
+   SUBROUTINE flo_init
+      !!----------------------------------------------------------------
+      !!                 ***  ROUTINE flo_init  ***
+      !!                   
+      !! ** Purpose :   Read the namelist of floats
+      !!      
+      !! History :
+      !!   8.0  !         (CLIPPER)   original Code
+      !!   8.5  !  02-06  (A. Bozec)  F90, Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Local declarations
+      NAMELIST/namflo/ ln_rstarfl, nwritefl, nstockfl 
+      !!---------------------------------------------------------------------
+      ! Namelist namflo : floats
+      
+      ! default values
+      ln_rstarfl  = .FALSE.
+      nwritefl  = 150
+      nstockfl  = 450
+      
+      ! lecture of namflo
+      REWIND( numnam )
+      READ  ( numnam, namflo )
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) '         Namelist floats :'
+         WRITE(numout,*) '            restart                          ln_rstarfl = ', ln_rstarfl
+         WRITE(numout,*) '            frequency of float output file   nwritefl   = ', nwritefl
+         WRITE(numout,*) '            frequency of float restart file  nstockfl   = ', nstockfl
+         WRITE(numout,*) ' '
+      ENDIF
+
+   END SUBROUTINE flo_init
+
+#  else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE flo_stp( kt )          ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE flo_stp
+#endif
+
+   !!======================================================================
+ END MODULE floats
Index: /branches/nemo/NEMO/OPA_SRC/FLO/floblk.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/FLO/floblk.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/FLO/floblk.F90	(revision 4)
@@ -0,0 +1,426 @@
+MODULE floblk
+   !!======================================================================
+   !!                     ***  MODULE  floblk  ***
+   !! Ocean floats :   trajectory computation
+   !!======================================================================
+#if   defined key_floats   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                     float trajectories
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!    flotblk     : compute float trajectories with Blanke algorithme
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE flo_oce         ! ocean drifting floats
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE lib_mpp         ! distribued memory computing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC flo_blk      ! routine called by floats.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flo_blk( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE flo_blk  ***
+      !!           
+      !! ** Purpose :   Compute the geographical position,latitude, longitude
+      !!      and depth of each float at each time step.
+      !! 
+      !! ** Method  :   The position of a float is computed with Bruno Blanke
+      !!      algorithm. We need to know the velocity field, the old positions
+      !!      of the floats and the grid defined on the domain.
+      !!
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt ! ocean time step
+
+      !! * Local declarations
+      INTEGER :: jfl              ! dummy loop arguments
+      INTEGER :: ind, ifin, iloop
+      INTEGER , DIMENSION ( jpnfl )  ::   &
+         iil, ijl, ikl,             &     ! index of nearest mesh
+         iiloc , ijloc,             &
+         iiinfl, ijinfl, ikinfl,    &     ! index of input mesh of the float.
+         iioutfl, ijoutfl, ikoutfl        ! index of output mesh of the float.
+      REAL(wp) , DIMENSION ( jpnfl )  ::    &
+         zgifl, zgjfl, zgkfl,       &     ! position of floats, index on 
+                                          ! velocity mesh.
+         ztxfl, ztyfl, ztzfl,       &     ! time for a float to quit the mesh
+                                          ! across one of the face x,y and z 
+         zttfl,                     &     ! time for a float to quit the mesh 
+         zagefl,                    &     ! time during which, trajectorie of 
+                                          ! the float has been computed
+         zagenewfl,                 &     ! new age of float after calculation 
+                                          ! of new position
+         zufl, zvfl, zwfl,          &     ! interpolated vel. at float position
+         zudfl, zvdfl, zwdfl,       &     ! velocity diff input/output of mesh
+         zgidfl, zgjdfl, zgkdfl           ! direction index of float 
+      REAL(wp)   ::       &
+         zuinfl,zvinfl,zwinfl,      &     ! transport across the input face
+         zuoutfl,zvoutfl,zwoutfl,   &     ! transport across the ouput face
+         zvol,                      &     ! volume of the mesh
+         zsurfz,                    &     ! surface of the face of the mesh 
+         zind
+      REAL(wp), DIMENSION ( 2 )  ::   &
+         zsurfx, zsurfy                   ! surface of the face of the mesh
+      !!---------------------------------------------------------------------
+      
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'flo_blk : compute Blanke trajectories for floats '
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      ! Initialisation of parameters
+      
+      DO jfl = 1, jpnfl
+         ! ages of floats are put at zero
+         zagefl(jfl) = 0.
+         ! index on the velocity grid 
+         ! We considere k coordinate negative, with this transformation 
+         ! the computation in the 3 direction is the same. 
+         zgifl(jfl) = tpifl(jfl) - 0.5
+         zgjfl(jfl) = tpjfl(jfl) - 0.5
+         zgkfl(jfl) = MIN(-1.,-(tpkfl(jfl)))
+         ! surface drift every 10 days 
+         IF( ln_argo ) THEN
+            IF( MOD(kt,150) >= 146 .OR. MOD(kt,150) == 0 )  zgkfl(jfl) = -1.
+         ENDIF
+         ! index of T mesh
+         iil(jfl) = 1 + INT(zgifl(jfl))
+         ijl(jfl) = 1 + INT(zgjfl(jfl))
+         ikl(jfl) =     INT(zgkfl(jfl))
+      END DO
+       
+      iloop = 0
+222   DO jfl = 1, jpnfl
+# if defined key_mpp
+         IF( (iil(jfl) >= (mig(nldi)-jpizoom+1)) .AND. (iil(jfl) <= (mig(nlei)-jpizoom+1)) .AND.   &
+             (ijl(jfl) >= (mjg(nldj)-jpjzoom+1)) .AND. (ijl(jfl) <= (mjg(nlej)-jpjzoom+1)) ) THEN
+            iiloc(jfl) = iil(jfl) - (mig(1)-jpizoom+1) + 1
+            ijloc(jfl) = ijl(jfl) - (mjg(1)-jpjzoom+1) + 1
+# else 
+            iiloc(jfl) = iil(jfl)
+            ijloc(jfl) = ijl(jfl)
+# endif
+            
+            ! compute the transport across the mesh where the float is.            
+            zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl)  ) * e3t(-ikl(jfl))
+            zsurfx(2) = e2u(iiloc(jfl)  ,ijloc(jfl)  ) * e3t(-ikl(jfl))
+            zsurfy(1) = e1v(iiloc(jfl)  ,ijloc(jfl)-1) * e3t(-ikl(jfl))
+            zsurfy(2) = e1v(iiloc(jfl)  ,ijloc(jfl)  ) * e3t(-ikl(jfl))
+
+            ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too.
+            zsurfz=  e1t(iiloc(jfl),ijloc(jfl)) * e2t(iiloc(jfl),ijloc(jfl))
+            zvol  =( e1t(iiloc(jfl),ijloc(jfl)) * e2t(iiloc(jfl),ijloc(jfl)) * e3t(-ikl(jfl)) )
+
+            !
+            zuinfl =( ub(iiloc(jfl)-1,ijloc(jfl),-ikl(jfl)) + un(iiloc(jfl)-1,ijloc(jfl),-ikl(jfl)) )/2.*zsurfx(1)
+            zuoutfl=( ub(iiloc(jfl)  ,ijloc(jfl),-ikl(jfl)) + un(iiloc(jfl)  ,ijloc(jfl),-ikl(jfl)) )/2.*zsurfx(2)
+            zvinfl =( vb(iiloc(jfl),ijloc(jfl)-1,-ikl(jfl)) + vn(iiloc(jfl),ijloc(jfl)-1,-ikl(jfl)) )/2.*zsurfy(1)
+            zvoutfl=( vb(iiloc(jfl),ijloc(jfl)  ,-ikl(jfl)) + vn(iiloc(jfl),ijloc(jfl)  ,-ikl(jfl)) )/2.*zsurfy(2)
+            zwinfl =-(wb(iiloc(jfl),ijloc(jfl),-(ikl(jfl)-1))    &
+               &   +  wn(iiloc(jfl),ijloc(jfl),-(ikl(jfl)-1)) )/2. *  zsurfz*nisobfl(jfl)
+            zwoutfl=-(wb(iiloc(jfl),ijloc(jfl),- ikl(jfl)   )   &
+               &   +  wn(iiloc(jfl),ijloc(jfl),- ikl(jfl)   ) )/2. *  zsurfz*nisobfl(jfl)
+            
+            ! interpolation of velocity field on the float initial position            
+            zufl(jfl)=  zuinfl  + ( zgifl(jfl) - float(iil(jfl)-1) ) * ( zuoutfl - zuinfl)
+            zvfl(jfl)=  zvinfl  + ( zgjfl(jfl) - float(ijl(jfl)-1) ) * ( zvoutfl - zvinfl)
+            zwfl(jfl)=  zwinfl  + ( zgkfl(jfl) - float(ikl(jfl)-1) ) * ( zwoutfl - zwinfl)
+            
+            ! faces of input and output
+            ! u-direction
+            IF( zufl(jfl) < 0. ) THEN
+               iioutfl(jfl) = iil(jfl) - 1.
+               iiinfl (jfl) = iil(jfl)
+               zind   = zuinfl
+               zuinfl = zuoutfl
+               zuoutfl= zind
+            ELSE
+               iioutfl(jfl) = iil(jfl)
+               iiinfl (jfl) = iil(jfl) - 1
+            ENDIF
+            ! v-direction       
+            IF( zvfl(jfl) < 0. ) THEN
+               ijoutfl(jfl) = ijl(jfl) - 1.
+               ijinfl (jfl) = ijl(jfl)
+               zind    = zvinfl
+               zvinfl  = zvoutfl
+               zvoutfl = zind
+            ELSE
+               ijoutfl(jfl) = ijl(jfl)
+               ijinfl (jfl) = ijl(jfl) - 1.
+            ENDIF
+            ! w-direction
+            IF( zwfl(jfl) < 0. ) THEN
+               ikoutfl(jfl) = ikl(jfl) - 1.
+               ikinfl (jfl) = ikl(jfl)
+               zind    = zwinfl
+               zwinfl  = zwoutfl
+               zwoutfl = zind
+            ELSE
+               ikoutfl(jfl) = ikl(jfl)
+               ikinfl (jfl) = ikl(jfl) - 1.
+            ENDIF
+            
+            ! compute the time to go out the mesh across a face
+            ! u-direction
+            zudfl (jfl) = zuoutfl - zuinfl
+            zgidfl(jfl) = float(iioutfl(jfl) - iiinfl(jfl))
+            IF( zufl(jfl)*zuoutfl <= 0. ) THEN
+               ztxfl(jfl) = 1.E99
+            ELSE
+               IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN
+                  ztxfl(jfl)= zgidfl(jfl)/zudfl(jfl) * LOG(zuoutfl/zufl (jfl))
+               ELSE
+                  ztxfl(jfl)=(float(iioutfl(jfl))-zgifl(jfl))/zufl(jfl)
+               ENDIF
+               IF( (ABS(zgifl(jfl)-float(iiinfl (jfl))) <=  1.E-7) .OR.   &
+                   (ABS(zgifl(jfl)-float(iioutfl(jfl))) <=  1.E-7) ) THEN
+                  ztxfl(jfl)=(zgidfl(jfl))/zufl(jfl)
+               ENDIF
+            ENDIF
+            ! v-direction
+            zvdfl (jfl) = zvoutfl - zvinfl
+            zgjdfl(jfl) = float(ijoutfl(jfl)-ijinfl(jfl))
+            IF( zvfl(jfl)*zvoutfl <= 0. ) THEN
+               ztyfl(jfl) = 1.E99
+            ELSE
+               IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN
+                  ztyfl(jfl) = zgjdfl(jfl)/zvdfl(jfl) * LOG(zvoutfl/zvfl (jfl))
+               ELSE
+                  ztyfl(jfl) = (float(ijoutfl(jfl)) - zgjfl(jfl))/zvfl(jfl)
+               ENDIF
+               IF( (ABS(zgjfl(jfl)-float(ijinfl (jfl))) <= 1.E-7) .OR.   &
+                   (ABS(zgjfl(jfl)-float(ijoutfl(jfl))) <=  1.E-7) ) THEN
+                  ztyfl(jfl) = (zgjdfl(jfl)) / zvfl(jfl)
+               ENDIF
+            ENDIF
+            ! w-direction        
+            IF( nisobfl(jfl) == 1. ) THEN 
+               zwdfl (jfl) = zwoutfl - zwinfl
+               zgkdfl(jfl) = float(ikoutfl(jfl) - ikinfl(jfl))
+               IF( zwfl(jfl)*zwoutfl <= 0. ) THEN
+                  ztzfl(jfl) = 1.E99
+               ELSE
+                  IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN
+                     ztzfl(jfl) = zgkdfl(jfl)/zwdfl(jfl) * LOG(zwoutfl/zwfl (jfl))
+                  ELSE
+                     ztzfl(jfl) = (float(ikoutfl(jfl)) - zgkfl(jfl))/zwfl(jfl)
+                  ENDIF
+                  IF( (ABS(zgkfl(jfl)-float(ikinfl (jfl))) <=  1.E-7) .OR.   &
+                      (ABS(zgkfl(jfl)-float(ikoutfl(jfl))) <= 1.E-7) ) THEN
+                     ztzfl(jfl) = (zgkdfl(jfl)) / zwfl(jfl)
+                  ENDIF
+               ENDIF
+            ENDIF
+            
+            ! the time to go leave the mesh is the smallest time
+                   
+            IF( nisobfl(jfl) == 1. ) THEN 
+               zttfl(jfl) = MIN(ztxfl(jfl),ztyfl(jfl),ztzfl(jfl))
+            ELSE
+               zttfl(jfl) = MIN(ztxfl(jfl),ztyfl(jfl))
+            ENDIF
+            ! new age of the FLOAT
+            zagenewfl(jfl) = zagefl(jfl) + zttfl(jfl)*zvol
+            ! test to know if the "age" of the float is not bigger than the 
+            ! time step
+            IF( zagenewfl(jfl) > rdt ) THEN
+               zttfl(jfl) = (rdt-zagefl(jfl)) / zvol
+               zagenewfl(jfl) = rdt
+            ENDIF
+            
+            ! In the "minimal" direction we compute the index of new mesh
+            ! on i-direction
+            IF( ztxfl(jfl) <=  zttfl(jfl) ) THEN
+               zgifl(jfl) = float(iioutfl(jfl))
+               ind = iioutfl(jfl)
+               IF( iioutfl(jfl) >= iiinfl(jfl) ) THEN
+                  iioutfl(jfl) = iioutfl(jfl) + 1
+               ELSE
+                  iioutfl(jfl) = iioutfl(jfl) - 1
+               ENDIF
+               iiinfl(jfl) = ind
+            ELSE
+               IF( ABS(zudfl(jfl)) >= 1.E-5 ) THEN 
+                  zgifl(jfl) = zgifl(jfl) + zgidfl(jfl)*zufl(jfl)    &
+                     &       * ( EXP( zudfl(jfl)/zgidfl(jfl)*zttfl(jfl) ) - 1. ) /  zudfl(jfl)
+               ELSE
+                  zgifl(jfl) = zgifl(jfl) + zufl(jfl) * zttfl(jfl)
+               ENDIF
+            ENDIF
+            ! on j-direction
+            IF( ztyfl(jfl) <= zttfl(jfl) ) THEN
+               zgjfl(jfl) = float(ijoutfl(jfl))
+               ind = ijoutfl(jfl)
+               IF( ijoutfl(jfl) >= ijinfl(jfl) ) THEN
+                  ijoutfl(jfl) = ijoutfl(jfl) + 1
+               ELSE
+                  ijoutfl(jfl) = ijoutfl(jfl) - 1
+               ENDIF
+               ijinfl(jfl) = ind
+            ELSE
+               IF( ABS(zvdfl(jfl)) >= 1.E-5 ) THEN 
+                  zgjfl(jfl) = zgjfl(jfl)+zgjdfl(jfl)*zvfl(jfl)   &
+                     &       * ( EXP(zvdfl(jfl)/zgjdfl(jfl)*zttfl(jfl)) - 1. ) /  zvdfl(jfl)
+               ELSE
+                  zgjfl(jfl) = zgjfl(jfl)+zvfl(jfl)*zttfl(jfl)
+               ENDIF
+            ENDIF
+            ! on k-direction
+            IF( nisobfl(jfl) == 1. ) THEN
+               IF( ztzfl(jfl) <= zttfl(jfl) ) THEN
+                  zgkfl(jfl) = float(ikoutfl(jfl))
+                  ind = ikoutfl(jfl)
+                  IF( ikoutfl(jfl) >= ikinfl(jfl) ) THEN
+                     ikoutfl(jfl) = ikoutfl(jfl)+1
+                  ELSE
+                     ikoutfl(jfl) = ikoutfl(jfl)-1
+                  ENDIF
+                  ikinfl(jfl) = ind
+               ELSE
+                  IF( ABS(zwdfl(jfl)) >= 1.E-5 ) THEN 
+                     zgkfl(jfl) = zgkfl(jfl)+zgkdfl(jfl)*zwfl(jfl)    &
+                        &       * ( EXP(zwdfl(jfl)/zgkdfl(jfl)*zttfl(jfl)) - 1. ) /  zwdfl(jfl)
+                  ELSE
+                     zgkfl(jfl) = zgkfl(jfl)+zwfl(jfl)*zttfl(jfl)
+                  ENDIF
+               ENDIF
+            ENDIF
+            
+            ! coordinate of the new point on the temperature grid
+            
+            iil(jfl) = MAX(iiinfl(jfl),iioutfl(jfl))
+            ijl(jfl) = MAX(ijinfl(jfl),ijoutfl(jfl))
+            IF( nisobfl(jfl) ==  1 ) ikl(jfl) = MAX(ikinfl(jfl),ikoutfl(jfl))
+!!Alexcadm	 write(*,*)'PE ',narea,
+!!Alexcadm     .    iiinfl(jfl),iioutfl(jfl),ijinfl(jfl)
+!!Alexcadm     .		,ijoutfl(jfl),ikinfl(jfl),
+!!Alexcadm     .	  ikoutfl(jfl),ztxfl(jfl),ztyfl(jfl)
+!!Alexcadm     .		,ztzfl(jfl),zgifl(jfl),
+!!Alexcadm     .  zgjfl(jfl) 
+!!Alexcadm	IF (jfl == 910) write(*,*)'Flotteur 910',
+!!Alexcadm     .    iiinfl(jfl),iioutfl(jfl),ijinfl(jfl)
+!!Alexcadm     .		,ijoutfl(jfl),ikinfl(jfl),
+!!Alexcadm     .	  ikoutfl(jfl),ztxfl(jfl),ztyfl(jfl)
+!!Alexcadm     .		,ztzfl(jfl),zgifl(jfl),
+!!Alexcadm     .  zgjfl(jfl) 
+            ! reinitialisation of the age of FLOAT
+            zagefl(jfl) = zagenewfl(jfl)
+# if defined key_mpp
+         ELSE
+            ! we put zgifl, zgjfl, zgkfl, zagefl
+            zgifl (jfl) = 0.
+            zgjfl (jfl) = 0.
+            zgkfl (jfl) = 0.
+            zagefl(jfl) = 0.
+            iil(jfl) = 0
+            ijl(jfl) = 0
+         ENDIF
+# endif
+      END DO
+      
+      ! synchronisation
+      ! sum of this arrays
+            
+# if defined key_mpp
+      CALL mpp_sum( zgifl , jpnfl )
+      CALL mpp_sum( zgjfl , jpnfl )
+      CALL mpp_sum( zgkfl , jpnfl )
+      CALL mpp_sum( zagefl, jpnfl )
+      CALL mpp_sum( iil   , jpnfl )
+      CALL mpp_sum( ijl   , jpnfl )
+# endif
+      
+      ! in the case of open boundaries we need to test if the floats don't
+      ! go out of the domain. If it goes out, the float is put at the 
+      ! middle of the mesh in the domain but the trajectory isn't compute 
+      ! more time.      
+# if defined key_obc
+      DO jfl = 1, jpnfl
+         IF( lpeastobc ) THEN
+            IF( jped <=  zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <=  zgifl(jfl) ) THEN
+               zgifl (jfl) = INT(zgifl(jfl)) + 0.5
+               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5
+               zagefl(jfl) = rdt
+            END IF
+         END IF
+         IF( lpwestobc ) THEN
+            IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >=  zgifl(jfl) ) THEN
+               zgifl (jfl) = INT(zgifl(jfl)) + 0.5
+               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5
+               zagefl(jfl) = rdt
+            END IF
+         END IF
+         IF( lpnorthobc ) THEN
+            IF( jpnd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >=  zgjfl(jfl) ) THEN
+               zgifl (jfl) = INT(zgifl(jfl)) + 0.5
+               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5
+               zagefl(jfl) = rdt
+            END IF
+         END IF
+         IF( lpsouthobc ) THEN
+            IF( jpsd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND.  njsob >= zgjfl(jfl) ) THEN
+               zgifl (jfl) = INT(zgifl(jfl)) + 0.5
+               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5
+               zagefl(jfl) = rdt
+            END IF
+         END IF
+      END DO
+#endif
+
+      ! Test to know if a  float hasn't integrated enought time
+      IF( ln_argo ) THEN
+         ifin = 1
+         DO jfl = 1, jpnfl
+            IF( zagefl(jfl) < rdt )   ifin = 0
+            tpifl(jfl) = zgifl(jfl) + 0.5
+            tpjfl(jfl) = zgjfl(jfl) + 0.5
+         END DO
+      ELSE
+         ifin = 1
+         DO jfl = 1, jpnfl
+            IF( zagefl(jfl) < rdt )   ifin = 0
+            tpifl(jfl) = zgifl(jfl) + 0.5
+            tpjfl(jfl) = zgjfl(jfl) + 0.5
+            IF( nisobfl(jfl) == 1 ) tpkfl(jfl) = -(zgkfl(jfl))
+         END DO
+      ENDIF
+!!Alexcadm	IF (lwp) write(numout,*) '---------'
+!!Alexcadm	IF (lwp) write(numout,*) 'before Erika:',tpifl(880),tpjfl(880),
+!!Alexcadm     .       tpkfl(880),zufl(880),zvfl(880),zwfl(880)
+!!Alexcadm	IF (lwp) write(numout,*) 'first Erika:',tpifl(900),tpjfl(900),
+!!Alexcadm     .       tpkfl(900),zufl(900),zvfl(900),zwfl(900)
+!!Alexcadm	IF (lwp) write(numout,*) 'last Erika:',tpifl(jpnfl),tpjfl(jpnfl),
+!!Alexcadm     .       tpkfl(jpnfl),zufl(jpnfl),zvfl(jpnfl),zwfl(jpnfl)
+      IF( ifin == 0 ) THEN
+         iloop = iloop + 1 
+         GO TO 222
+      ENDIF
+
+      RETURN
+   END SUBROUTINE flo_blk
+
+#  else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE flo_blk                  ! Empty routine
+   END SUBROUTINE flo_blk 
+#endif
+   
+   !!======================================================================
+END MODULE floblk 
Index: /branches/nemo/NEMO/OPA_SRC/FLO/flodom.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/FLO/flodom.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/FLO/flodom.F90	(revision 4)
@@ -0,0 +1,465 @@
+MODULE flodom
+   !!======================================================================
+   !!                       ***  MODULE  flodom  ***
+   !! Ocean floats :   domain
+   !!======================================================================
+#if   defined key_floats   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                     float trajectories
+   !!----------------------------------------------------------------------
+   !!   flo_dom        : initialization of floats
+   !!   findmesh       : compute index of position 
+   !!   dstnce         : compute distance between face mesh and floats 
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE flo_oce         ! ocean drifting floats
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE lib_mpp         ! distribued memory computing library
+
+   IMPLICIT NONE
+
+   !! * Accessibility
+   PRIVATE  dstnce
+   PUBLIC flo_dom     ! routine called by floats.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flo_dom
+      !! ---------------------------------------------------------------------
+      !!                  ***  ROUTINE flo_dom  ***
+      !!                 
+      !!  ** Purpose :   Initialisation of floats
+      !!
+      !!  ** Method  :   We put the floats  in the domain with the latitude,
+      !!       the longitude (degree) and the depth (m).
+      !!
+      !!----------------------------------------------------------------------      
+      !! * Local declarations
+      LOGICAL   :: llinmesh
+      CHARACTER (len=21) ::  clname
+      INTEGER   :: ji, jj, jk               ! DO loop index on 3 directions
+      INTEGER   :: jfl, jfl1                ! number of floats   
+      INTEGER   :: inum = 11                ! logical unit for file read
+      INTEGER , DIMENSION ( jpnfl    )  ::   &
+         iimfl, ijmfl, ikmfl,    &          ! index mesh of floats
+         idomfl,  ivtest, ihtest
+      REAL(wp)  :: zdxab,zdyad
+      REAL(wp) , DIMENSION ( jpnnewfl )  :: zgifl, zgjfl,  zgkfl
+      !!---------------------------------------------------------------------
+      
+      ! Initialisation with the geographical position or restart
+      
+      IF(lwp) WRITE(numout,*) 'flo_dom : compute initial position of floats'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+      IF(lwp) WRITE(numout,*) '           jpnfl = ',jpnfl
+      
+      IF(ln_rstarfl) THEN
+         IF(lwp) WRITE(numout,*) '        float restart file read'
+         
+         ! open the restart file 
+         clname='restart_float'
+         OPEN (inum,FILE=clname,FORM='UNFORMATTED')
+         REWIND inum
+
+         ! read of the restart file
+         READ(inum) ( tpifl  (jfl), jfl=1, jpnrstarfl),   & 
+                        ( tpjfl  (jfl), jfl=1, jpnrstarfl),   &
+                        ( tpkfl  (jfl), jfl=1, jpnrstarfl),   &
+                        ( nisobfl(jfl), jfl=1, jpnrstarfl),   &
+                        ( ngrpfl (jfl), jfl=1, jpnrstarfl)    
+         CLOSE(inum)
+
+         ! if we want a  surface drift  ( like PROVOR floats )
+         IF( ln_argo ) THEN
+            DO jfl = 1, jpnrstarfl
+               nisobfl(jfl) = 0
+            END DO
+         ENDIF
+
+         IF(lwp) WRITE(numout,*)' flo_dom: END of florstlec'
+         
+         ! It is possible to add new floats.          
+         IF(lwp) WRITE(numout,*)' flo_dom:jpnfl jpnrstarfl ',jpnfl,jpnrstarfl
+         IF( jpnfl > jpnrstarfl ) THEN
+            ! open the init file 
+            clname='init_float'
+            OPEN(inum,FILE=clname,FORM='FORMATTED')
+            DO jfl = jpnrstarfl+1, jpnfl
+               READ(inum,*) flxx(jfl),flyy(jfl),flzz(jfl), nisobfl(jfl),ngrpfl(jfl),jfl1
+            END DO
+            CLOSE(inum)
+            IF(lwp) WRITE(numout,*)' flodom: END reading init_float file'
+            
+            ! Test to find the grid point coordonate with the geographical position            
+            DO jfl = jpnrstarfl+1, jpnfl
+               ihtest(jfl) = 0
+               ivtest(jfl) = 0
+               ikmfl(jfl) = 0
+# if defined key_mpp
+               DO ji = MAX(nldi,2), nlei
+                  DO jj = MAX(nldj,2), nlej
+# else
+               DO ji = 2, jpi
+                  DO jj = 2, jpj
+# endif                     
+                     ! For each float we find the indexes of the mesh                      
+                     CALL findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1),   &
+                                   glamf(ji-1,jj  ),gphif(ji-1,jj  ),   &
+                                   glamf(ji  ,jj  ),gphif(ji  ,jj  ),   &
+                                   glamf(ji  ,jj-1),gphif(ji  ,jj-1),   &
+                                   flxx(jfl)       ,flyy(jfl)       ,   &
+                                   glamt(ji  ,jj  ),gphit(ji  ,jj  ), llinmesh)
+                     IF(llinmesh) THEN
+                        iimfl(jfl) = ji
+                        ijmfl(jfl) = jj
+                        ihtest(jfl) = ihtest(jfl)+1
+                        DO jk = 1, jpk-1
+                           IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) > flzz(jfl)) ) THEN
+                              ikmfl(jfl) = jk
+                              ivtest(jfl) = ivtest(jfl) + 1
+                           ENDIF
+                        END DO
+                     ENDIF
+                  END DO
+               END DO
+               IF(lwp) WRITE(numout,*)'   flo_dom: END findmesh'
+               
+               ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1               
+               IF( ihtest(jfl) ==  0 ) THEN
+                  iimfl(jfl) = -1
+                  ijmfl(jfl) = -1
+               ENDIF
+            END DO
+            
+            ! A zero in the sum of the arrays "ihtest" and "ivtest"             
+# if defined key_mpp
+            CALL mpp_sum(ihtest,jpnfl,iwork)
+            CALL mpp_sum(ivtest,jpnfl,iwork)
+# endif 
+            DO jfl = jpnrstarfl+1, jpnfl
+               IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1) ) THEN
+                  IF(lwp) WRITE(numout,*) 'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH'
+                  STOP
+               ENDIF
+               IF( (ihtest(jfl) == 0) ) THEN
+                  IF(lwp) WRITE(numout,*)'THE FLOAT',jfl,' IS IN NO MESH'
+                  STOP
+               ENDIF
+            END DO
+            
+            ! We compute the distance between the float and the face of the mesh            
+            DO jfl = jpnrstarfl+1, jpnfl               
+               ! Made only if the float is in the domain of the processor              
+               IF( (iimfl(jfl) >= 0) .AND. (ijmfl(jfl) >= 0) ) THEN
+                  
+                  ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST
+                  
+                  idomfl(jfl) = 0
+                  IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl) = 1
+                                           
+                  ! Computation of the distance between the float and the faces of the mesh
+                  !            zdxab
+                  !             .
+                  !        B----.---------C
+                  !        |    .         |
+                  !        |<------>flo   |
+                  !        |        ^     |
+                  !        |        |.....|....zdyad
+                  !        |        |     |
+                  !        A--------|-----D
+                  !
+             
+                  zdxab = dstnce(flxx(jfl),flyy(jfl),glamf(iimfl(jfl)-1,ijmfl(jfl)-1),flyy(jfl))
+                  zdyad = dstnce(flxx(jfl),flyy(jfl),flxx(jfl),gphif(iimfl(jfl)-1,ijmfl(jfl)-1))
+                  
+                  ! Translation of this distances (in meter) in indexes
+                  
+                  zgifl(jfl-jpnrstarfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom)
+                  zgjfl(jfl-jpnrstarfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom)
+                  zgkfl(jfl-jpnrstarfl) = (( fsdepw(ji,jj,ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))  &
+                                        / (  fsdepw(ji,jj,ikmfl(jfl)+1) - fsdepw(ji,jj,ikmfl(jfl) ) )   &
+                                        + (( flzz(jfl)-fsdepw(ji,jj,ikmfl(jfl)) ) *(ikmfl(jfl)+1))   &
+                                        / (  fsdepw(ji,jj,ikmfl(jfl)+1) - fsdepw(ji,jj,ikmfl(jfl)) ) 
+               ELSE
+                  zgifl(jfl-jpnrstarfl) = 0.
+                  zgjfl(jfl-jpnrstarfl) = 0.
+                  zgkfl(jfl-jpnrstarfl) = 0.
+               ENDIF
+            END DO
+            
+            ! The sum of all the arrays zgifl, zgjfl, zgkfl give 3 arrays with the positions of all the floats.
+# if defined key_mpp
+
+            CALL mpp_sum( zgjfl, jpnnewfl )
+            CALL mpp_sum( zgkfl, jpnnewfl )
+            IF(lwp) WRITE(numout,*) (zgifl(jfl),jfl=1,jpnnewfl)
+            IF(lwp) WRITE(numout,*) (zgjfl(jfl),jfl=1,jpnnewfl)
+            IF(lwp) WRITE(numout,*) (zgkfl(jfl),jfl=1,jpnnewfl) 
+# endif
+           
+            DO jfl = jpnrstarfl+1, jpnfl
+               tpifl(jfl) = zgifl(jfl-jpnrstarfl)
+               tpjfl(jfl) = zgjfl(jfl-jpnrstarfl)
+               tpkfl(jfl) = zgkfl(jfl-jpnrstarfl)
+            END DO
+         ENDIF
+      ELSE
+         IF(lwp) WRITE(numout,*) '                     init_float read '
+         
+         ! First initialisation of floats
+         ! the initials positions of floats are written in a file
+         ! with a variable to know if it is a isobar float a number 
+         ! to identified who want the trajectories of this float and 
+         ! an index for the number of the float         
+         ! open the init file 
+         clname='init_float'
+         OPEN(inum,FILE=clname,FORM='FORMATTED')
+         READ(inum) (flxx(jfl)   , jfl=1, jpnfl),   &
+                    (flyy(jfl)   , jfl=1, jpnfl),   &
+                    (flzz(jfl)   , jfl=1, jpnfl),   &
+                    (nisobfl(jfl), jfl=1, jpnfl),   &
+                    (ngrpfl(jfl) , jfl=1, jpnfl)
+         CLOSE(inum)
+            
+         ! Test to find the grid point coordonate with the geographical position         
+         DO jfl = 1, jpnfl
+            ihtest(jfl) = 0
+            ivtest(jfl) = 0
+            ikmfl(jfl) = 0
+# if defined key_mpp
+            DO ji = MAX(nldi,2), nlei
+               DO jj = MAX(nldj,2), nlej
+# else
+            DO ji = 2, jpi
+               DO jj = 2, jpj
+# endif                  
+                  ! for each float we find the indexes of the mesh 
+                  
+                  CALL findmesh(glamf(ji-1,jj-1),gphif(ji-1,jj-1),   &
+                                glamf(ji-1,jj  ),gphif(ji-1,jj  ),   &
+                                glamf(ji  ,jj  ),gphif(ji  ,jj  ),   &
+                                glamf(ji  ,jj-1),gphif(ji  ,jj-1),   &
+                                flxx(jfl)       ,flyy(jfl)       ,   &
+                                glamt(ji  ,jj  ),gphit(ji  ,jj  ), llinmesh)
+                  IF(llinmesh) THEN
+                     iimfl(jfl)  = ji
+                     ijmfl(jfl)  = jj
+                     ihtest(jfl) = ihtest(jfl)+1
+                     DO jk = 1, jpk-1
+                        IF( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(ji,jj,jk+1) >  flzz(jfl)) ) THEN
+                           ikmfl(jfl)  = jk
+                           ivtest(jfl) = ivtest(jfl) + 1
+                        ENDIF
+                     END DO
+                  ENDIF
+               END DO
+            END DO
+            
+            ! If the float is in a mesh computed by an other processor we put iimfl=ijmfl=-1            
+            IF( ihtest(jfl) == 0 ) THEN
+               iimfl(jfl) = -1
+               ijmfl(jfl) = -1
+            ENDIF
+         END DO
+         
+         ! A zero in the sum of the arrays "ihtest" and "ivtest"          
+# if defined key_mpp
+         CALL mpp_sum(ihtest,jpnfl,iwork)
+         CALL mpp_sum(ivtest,jpnfl,iwork)
+# endif
+
+         DO jfl = 1, jpnfl
+            IF( (ihtest(jfl) > 1 ) .OR. ( ivtest(jfl) > 1 )) THEN
+               IF(lwp) WRITE(numout,*) 'THE FLOAT',jfl,' IS NOT IN ONLY ONE MESH'
+            ENDIF
+            IF( ihtest(jfl) == 0 ) THEN 
+               IF(lwp) WRITE(numout,*)'THE FLOAT',jfl,' IS IN NO MESH'
+            ENDIF
+         END DO
+        
+         ! We compute the distance between the float and the face of  the mesh         
+         DO jfl = 1, jpnfl
+            ! Made only if the float is in the domain of the processor
+            IF( (iimfl(jfl) >= 0 ) .AND. ( ijmfl(jfl) >= 0 ) ) THEN
+               
+               ! TEST TO KNOW IF THE FLOAT IS NOT INITIALISED IN THE COAST
+               
+               idomfl(jfl) = 0
+               IF( tmask(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) == 0. ) idomfl(jfl)=1
+               
+               ! Computation of the distance between the float
+               ! and the faces of the mesh
+               !            zdxab
+               !             .
+               !        B----.---------C
+               !        |    .         |
+               !        |<------>flo   |
+               !        |        ^     |
+               !        |        |.....|....zdyad
+               !        |        |     |
+               !        A--------|-----D
+               
+               zdxab = dstnce(flxx(jfl),flyy(jfl),glamf(iimfl(jfl)-1,ijmfl(jfl)-1),flyy(jfl))                
+               zdyad = dstnce(flxx(jfl),flyy(jfl),flxx(jfl),gphif(iimfl(jfl)-1,ijmfl(jfl)-1))
+               
+               ! Translation of this distances (in meter) in indexes
+               
+               tpifl(jfl) = (iimfl(jfl)-0.5)+zdxab/ e1u(iimfl(jfl)-1,ijmfl(jfl))+(mig(1)-jpizoom)
+               tpjfl(jfl) = (ijmfl(jfl)-0.5)+zdyad/ e2v(iimfl(jfl),ijmfl(jfl)-1)+(mjg(1)-jpjzoom)
+               tpkfl(jfl) = (fsdepw(ji,jj,ikmfl(jfl)+1) - flzz(jfl))*(ikmfl(jfl))   &
+                          / (fsdepw(ji,jj,ikmfl(jfl)+1) - fsdepw(ji,jj,ikmfl(jfl)))   &
+                          + (flzz(jfl) - fsdepw(ji,jj,ikmfl(jfl)))*(ikmfl(jfl)+1)   &
+                          / (fsdepw(ji,jj,ikmfl(jfl)+1) - fsdepw(ji,jj,ikmfl(jfl)))
+            ELSE
+               tpifl (jfl) = 0.e0
+               tpjfl (jfl) = 0.e0
+               tpkfl (jfl) = 0.e0
+               idomfl(jfl) = 0
+            ENDIF
+         END DO
+         
+         ! The sum of all the arrays tpifl, tpjfl, tpkfl give 3 arrays with the positions of all the floats. 
+# if defined key_mpp
+         CALL mpp_sum( tpifl , jpnfl )
+         CALL mpp_sum( tpjfl , jpnfl )
+         CALL mpp_sum( tpkfl , jpnfl )
+         CALL mpp_sum( idomfl, jpnfl )
+# endif
+      ENDIF
+            
+      ! Print the initial positions of the floats
+      IF( .NOT. ln_rstarfl ) THEN 
+         ! WARNING : initial position not in the sea         
+         DO jfl = 1, jpnfl
+            IF( idomfl(jfl) == 1 ) THEN
+               IF(lwp) WRITE(numout,*)'*****************************'
+               IF(lwp) WRITE(numout,*)'!!!!!!!  WARNING   !!!!!!!!!!'
+               IF(lwp) WRITE(numout,*)'*****************************'
+               IF(lwp) WRITE(numout,*)'The float number',jfl,'is out of the sea.'
+               IF(lwp) WRITE(numout,*)'geographical position',flxx(jfl),flyy(jfl),flzz(jfl)
+               IF(lwp) WRITE(numout,*)'index position',tpifl(jfl),tpjfl(jfl),tpkfl(jfl)
+            ENDIF
+         END DO
+      ENDIF
+
+   END SUBROUTINE flo_dom
+
+
+   SUBROUTINE findmesh( pax, pay, pbx, pby,   &
+                        pcx, pcy, pdx, pdy,   &
+                        px  ,py  ,ptx, pty, ldinmesh )
+      !! -------------------------------------------------------------
+      !!                ***  ROUTINE findmesh  ***
+      !!      
+      !! ** Purpose :   Find the index of mesh for the point spx spy
+      !!
+      !! ** Method  : 
+      !!
+      !! History :
+      !!   8.0  !  98-07 (Y.Drillet)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp) ::   &
+         pax, pay, pbx, pby,    &     ! ???
+         pcx, pcy, pdx, pdy,    &     ! ???
+         px, py,                &     ! longitude and latitude
+         ptx, pty                     ! ???
+      LOGICAL ::  ldinmesh            ! ???
+
+      !! * local declarations
+      REAL(wp) ::   &
+         zabt, zbct, zcdt, zdat, zabpt, zbcpt, zcdpt, zdapt,  &
+         psax,psay,psbx,psby,psx,psy
+      REAL(wp) ::  fsline                ! Statement function
+
+      !! * Substitutions
+      fsline(psax, psay, psbx, psby, psx, psy) = psy  * ( psbx - psax )   &
+                                               - psx  * ( psby - psay )   &
+                                               + psax *   psby - psay * psbx
+      !!---------------------------------------------------------------------
+      
+      ! 4 semi plane defined by the 4 points and including the T point
+      zabt = fsline(pax,pay,pbx,pby,ptx,pty)
+      zbct = fsline(pbx,pby,pcx,pcy,ptx,pty)
+      zcdt = fsline(pcx,pcy,pdx,pdy,ptx,pty)
+      zdat = fsline(pdx,pdy,pax,pay,ptx,pty)
+      
+      ! 4 semi plane defined by the 4 points and including the extrememity
+      zabpt = fsline(pax,pay,pbx,pby,px,py)
+      zbcpt = fsline(pbx,pby,pcx,pcy,px,py)
+      zcdpt = fsline(pcx,pcy,pdx,pdy,px,py)
+      zdapt = fsline(pdx,pdy,pax,pay,px,py)
+       
+      ! We compare the semi plane T with the semi plane including the point
+      ! to know if it is in this  mesh.
+      ! For numerical reasons it is possible that for a point which is on
+      ! the line we don't have exactly zero with fsline function. We want 
+      ! that a point can't be in 2 mesh in the same time, so we put the 
+      ! coefficient to zero if it is smaller than 1.E-12
+      
+      IF( ABS(zabpt) <= 1.E-12 ) zabpt = 0.
+      IF( ABS(zbcpt) <= 1.E-12 ) zbcpt = 0.
+      IF( ABS(zcdpt) <= 1.E-12 ) zcdpt = 0.
+      IF( ABS(zdapt) <= 1.E-12 ) zdapt = 0.
+      IF( (zabt*zabpt >  0.) .AND. (zbct*zbcpt >= 0. ) .AND. ( zcdt*zcdpt >= 0. ) .AND. ( zdat*zdapt > 0. )   &
+         .AND. ( px <= MAX(pcx,pdx) ) .AND. ( px >= MIN(pax,pbx) )    &
+         .AND. ( py <= MAX(pby,pcy) ) .AND. ( py >= MIN(pay,pdy) ) ) THEN
+         ldinmesh=.TRUE.
+      ELSE
+         ldinmesh=.FALSE.
+      ENDIF
+
+   END SUBROUTINE findmesh
+
+
+   FUNCTION dstnce( pla1, phi1, pla2, phi2 )
+      !! -------------------------------------------------------------
+      !!                 ***  Function dstnce  ***
+      !!          
+      !! ** Purpose :   returns distance (in m) between two geographical
+      !!                points
+      !! ** Method  : 
+      !!         
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), INTENT(in) ::   pla1, phi1, pla2, phi2   ! ???
+
+      !! * Local variables
+      REAL(wp) ::   dly1, dly2, dlx1, dlx2, dlx, dls, dld, dpi
+      REAL(wp) ::   dstnce
+      !!---------------------------------------------------------------------
+      
+      dpi  = 2.* ASIN(1.)
+      dls  = dpi / 180.
+      dly1 = phi1 * dls
+      dly2 = phi2 * dls
+      dlx1 = pla1 * dls
+      dlx2 = pla2 * dls
+
+      dlx = SIN(dly1) * SIN(dly2) + COS(dly1) * COS(dly2) * COS(dlx2-dlx1)
+ 
+      IF( ABS(dlx) > 1.0 ) dlx = 1.0
+
+      dld = ATAN(DSQRT( ( 1-dlx )/( 1+dlx ) )) * 222.24 / dls
+      dstnce = dld * 1000.
+
+   END FUNCTION dstnce
+
+#  else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE flo_dom                 ! Empty routine
+   END SUBROUTINE flo_dom
+#endif
+
+   !!======================================================================
+END MODULE flodom
Index: /branches/nemo/NEMO/OPA_SRC/FLO/flowri.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/FLO/flowri.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/FLO/flowri.F90	(revision 4)
@@ -0,0 +1,304 @@
+MODULE flowri
+   !!======================================================================
+   !!                       ***  MODULE  flowri  ***
+   !! 
+   !!======================================================================
+#if   defined key_floats   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                     float trajectories
+   !!----------------------------------------------------------------------
+   !!    flowri     : write trajectories of floats in file 
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE flo_oce         ! ocean drifting floats
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE lib_mpp         ! distribued memory computing library
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+
+   !! * Accessibility
+   PRIVATE
+   PUBLIC flo_wri     ! routine called by floats.F90
+
+   !! * Module variables
+      INTEGER :: jfl              ! number of floats
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flo_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE flo_wri  ***
+      !!             
+      !! ** Purpose :   Write position of floats in "trajec_float" file
+      !!      and the temperature and salinity at this position
+      !!      
+      !! ** Method  :   The frequency is nwritefl
+      !!      
+      !!  History :
+      !!    8.0  !  99-09  (Y. Drillet)  Original code
+      !!         !  00-06  (J.-M. Molines)  Profiling floats for CLS 
+      !!    8.5  !  02-10  (A. Bozec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER  :: kt                               ! time step
+
+      !! * Local declarations
+      INTEGER ::   inum = 11       ! temporary logical unit for restart file
+      INTEGER  ::   &
+         iafl,ibfl,icfl,ia1fl,ib1fl,ic1fl,jfl,irecflo,   &
+         iafloc,ibfloc,ia1floc,ib1floc,   &
+         iafln, ibfln
+      INTEGER  ::    ic, jc , jpn
+      INTEGER, DIMENSION ( jpnij )  :: iproc
+
+      REAL(wp) :: zafl,zbfl,zcfl,zdtj
+      REAL(wp) :: zxxu, zxxu_01,zxxu_10, zxxu_11
+      REAL(wp) , DIMENSION ( jpk  , jpnfl) :: ztemp, zsal
+
+      CHARACTER (len=21) ::  clname
+      !!---------------------------------------------------------------------
+      
+      IF( kt == nit000 .OR. MOD( kt,nwritefl)== 0 ) THEN 
+
+         ! header of output floats file
+      
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'flo_wri : write in trajec_float file '
+            WRITE(numout,*) '~~~~~~~    '
+         ENDIF
+
+         ! open the file numflo 
+         clname='trajec_float'
+         OPEN (numflo,FILE=clname,FORM='UNFORMATTED')
+         !      REWIND numflo
+
+         IF( kt == nit000 ) THEN
+            irecflo = NINT( (nitend-nit000) / FLOAT(nwritefl) )
+            IF(lwp) WRITE(numflo)cexper,no,irecflo,jpnfl,nwritefl
+         ENDIF
+         zdtj = rdt/86400.      
+
+         ! translation of index position in geographical position
+
+         DO jfl = 1, jpnfl
+            iafl  = INT (tpifl(jfl))
+            ibfl  = INT (tpjfl(jfl))
+            icfl  = INT (tpkfl(jfl))
+            iafln = NINT(tpifl(jfl))
+            ibfln = NINT(tpjfl(jfl))
+            ia1fl = iafl+1
+            ib1fl = ibfl+1
+            ic1fl = icfl+1
+            zafl  = tpifl(jfl) - FLOAT(iafl)
+            zbfl  = tpjfl(jfl) - FLOAT(ibfl)
+            zcfl  = tpkfl(jfl) - FLOAT(icfl)
+# if defined key_mpp
+            IF( (iafl >= (mig(nldi)-jpizoom+1)) .AND. (iafl <= (mig(nlei)-jpizoom+1)) .AND.   &
+              (  ibfl >= (mjg(nldj)-jpjzoom+1)) .AND. (ibfl <= (mjg(nlej)-jpjzoom+1)) ) THEN
+
+               ! local index
+
+               iafloc  = iafl -(mig(1)-jpizoom+1) + 1
+               ibfloc  = ibfl -(mjg(1)-jpjzoom+1) + 1
+               ia1floc = iafloc + 1
+               ib1floc = ibfloc + 1
+               !
+               flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   &
+                         +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc)
+               flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   &
+                         +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc)
+               flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl)
+
+               ! Change  by Alexandra Bozec et Jean-Philippe Boulanger
+               ! We save  the instantaneous profile of T and S of the column     
+               ! ztemp(jfl)=tn(iafloc,ibfloc,icfl)
+               ! zsal(jfl)=sn(iafloc,ibfloc,icfl)
+               ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk)
+               zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk)            
+            ELSE
+               flxx(jfl) = 0.
+               flyy(jfl) = 0.
+               flzz(jfl) = 0.
+               ztemp(1:jpk,jfl) = 0.
+               zsal (1:jpk,jfl) = 0.
+            ENDIF
+# else
+            iafloc  = iafl
+            ibfloc  = ibfl
+            ia1floc = iafloc + 1
+            ib1floc = ibfloc + 1
+            !
+            flyy(jfl) = (1.-zafl)*(1.-zbfl)*gphit(iafloc ,ibfloc ) + (1.-zafl) * zbfl * gphit(iafloc ,ib1floc)   &
+                      +     zafl *(1.-zbfl)*gphit(ia1floc,ibfloc ) +     zafl  * zbfl * gphit(ia1floc,ib1floc)
+            flxx(jfl) = (1.-zafl)*(1.-zbfl)*glamt(iafloc ,ibfloc ) + (1.-zafl) * zbfl * glamt(iafloc ,ib1floc)   &
+                      +     zafl *(1.-zbfl)*glamt(ia1floc,ibfloc ) +     zafl  * zbfl * glamt(ia1floc,ib1floc)
+            flzz(jfl) = (1.-zcfl)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(iafloc,ibfloc,ic1fl)
+            !ALEX
+            ! Astuce pour ne pas avoir des flotteurs qui se baladent sur IDL
+            zxxu_11 = glamt(iafloc ,ibfloc )
+            zxxu_10 = glamt(iafloc ,ib1floc)
+            zxxu_01 = glamt(ia1floc,ibfloc )
+            zxxu    = glamt(ia1floc,ib1floc)
+
+            IF( iafloc == 52 )  zxxu_10 = -181
+            IF( iafloc == 52 )  zxxu_11 = -181
+            flxx(jfl)=(1.-zafl)*(1.-zbfl)* zxxu_11 + (1.-zafl)*    zbfl * zxxu_10   &
+                     +    zafl *(1.-zbfl)* zxxu_01 +     zafl *    zbfl * zxxu
+            !ALEX         
+            ! Change  by Alexandra Bozec et Jean-Philippe Boulanger
+            ! We save  the instantaneous profile of T and S of the column     
+            !     ztemp(jfl)=tn(iafloc,ibfloc,icfl)
+            !     zsal(jfl)=sn(iafloc,ibfloc,icfl)
+            ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk)
+            zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk)
+# endif
+         END DO
+
+# if defined key_mpp
+         CALL mpp_sum( flxx, jpnfl )
+         CALL mpp_sum( flyy, jpnfl )
+         CALL mpp_sum( flzz, jpnfl )
+         ! these 2 lines have accendentaly been removed from ATL6-V8 run hence
+         ! giving 0 salinity and temperature on the float trajectory
+         CALL mpp_sum( ztemp, jpk*jpnfl )
+         CALL mpp_sum( zsal , jpk*jpnfl )
+
+# endif
+         !
+         WRITE(numflo) flxx,flyy,flzz,nisobfl,ngrpfl,ztemp,zsal, FLOAT(ndastp)
+      !!
+      !! case when profiles are dumped. In order to save memory, dumps are
+      !! done level by level.
+      !      IF (mod(kt,nflclean) == 0.) THEN
+      !!     IF ( nwflo == nwprofil ) THEN
+      !        DO jk = 1,jpk
+      !         DO jfl=1,jpnfl
+      !         iafl= INT(tpifl(jfl))
+      !         ibfl=INT(tpjfl(jfl))
+      !         iafln=NINT(tpifl(jfl))
+      !         ibfln=NINT(tpjfl(jfl))
+      !# if defined key_mpp
+      !        IF ( (iafl >= (mig(nldi)-jpizoom+1)) .AND.
+      !     $       (iafl <= (mig(nlei)-jpizoom+1)) .AND.
+      !     $       (ibfl >= (mjg(nldj)-jpjzoom+1)) .AND.
+      !     $       (ibfl <= (mjg(nlej)-jpjzoom+1)) ) THEN
+      !!
+      !! local index
+      !!
+      !         iafloc=iafln-(mig(1)-jpizoom+1)+1
+      !         ibfloc=ibfln-(mjg(1)-jpjzoom+1)+1
+      !!         IF (jk == 1 ) THEN
+      !!      PRINT *,'<<<>>> ',jfl,narea, iafloc ,ibfloc, iafln, ibfln,adatrj
+      !!         ENDIF
+      !# else
+      !         iafloc=iafln
+      !         ibfloc=ibfln
+      !# endif
+      !         ztemp(jfl)=tn(iafloc,ibfloc,jk)
+      !         zsal(jfl)=sn(iaflo!,ibfloc,jk)
+      !# if defined key_mpp
+      !        ELSE
+      !         ztemp(jfl) = 0.
+      !         zsal(jfl) = 0.
+      !        ENDIF
+      !# endif
+      !! ... next float
+      !        END DO
+      !#if defined key_mpp
+      !      CALL mpp_sum( ztemp, jpnfl )
+      !      CALL mpp_sum( zsal , jpnfl )
+      !# endif
+      !      IF (lwp) THEN 
+      !         WRITE(numflo) ztemp, zsal
+      !      ENDIF
+      !! ... next level jk
+      !      END DO
+      !! ... reset nwflo to 0 for ALL processors, if profile has been written
+      !!       nwflo = 0
+      !      ENDIF
+      !!
+      !      CALL flush (numflo)
+      !! ... time of dumping floats
+      !!      END IF
+      ENDIF
+      
+      IF( (MOD(kt,nstockfl) == 0) .OR. ( kt == nitend ) ) THEN 
+         ! Writing the restart file 
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'flo_wri : write in  restart_float file '
+            WRITE(numout,*) '~~~~~~~    '
+         ENDIF
+
+         ! file is opened and closed every time it is used.
+
+         clname = 'restart.float.'
+         ic = 1
+         DO jc = 1, 16
+            IF( cexper(jc:jc) /= ' ' ) ic = jc
+         END DO
+         clname = clname(1:14)//cexper(1:ic)
+         ic = 1
+         DO jc = 1, 48
+            IF( clname(jc:jc) /= ' ' ) ic = jc
+         END DO
+
+         OPEN (inum,FILE=clname,FORM='UNFORMATTED')
+         REWIND inum
+         !
+         DO jpn = 1, jpnij
+            iproc(jpn) = 0
+         END DO
+         !
+         IF(lwp) THEN
+            REWIND(inum)
+            WRITE (inum) tpifl,tpjfl,tpkfl,nisobfl,ngrpfl
+            CLOSE (inum) 
+         ENDIF
+         !
+         ! Compute the number of trajectories for each processor
+         !
+# if defined key_mpp
+         DO jfl = 1, jpnfl
+            IF( (INT(tpifl(jfl)) >= (mig(nldi)-jpizoom+1)) .AND.   &
+              (  INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND.   &
+              (  INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND.   &
+              (  INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) THEN
+               iproc(narea) = iproc(narea)+1
+            ENDIF
+         END DO
+         CALL mpp_sum( iproc, jpnij )
+         !
+         IF(lwp) THEN 
+            WRITE(numout,*) 'DATE',adatrj
+            DO jpn = 1, jpnij
+               IF( iproc(jpn) /= 0 ) THEN
+                  WRITE(numout,*)'PROCESSOR',jpn-1,'compute',iproc(jpn), 'trajectories.'
+               ENDIF
+            END DO
+         ENDIF
+# endif
+      ENDIF 
+
+   END SUBROUTINE flo_wri
+
+#  else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE flo_wri                 ! Empty routine
+   END SUBROUTINE flo_wri
+#endif
+   
+   !!======================================================================
+END MODULE flowri
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 4)
@@ -0,0 +1,345 @@
+MODULE ldfdyn
+   !!======================================================================
+   !!                       ***  MODULE  ldfdyn  ***
+   !! Ocean physics:  lateral viscosity coefficient 
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   ldf_dyn_init : initialization, namelist read, and parameters control
+   !!   ldf_dyn_c3d   : 3D eddy viscosity coefficient initialization
+   !!   ldf_dyn_c2d   : 2D eddy viscosity coefficient initialization
+   !!   ldf_dyn_c1d   : 1D eddy viscosity coefficient initialization
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers   
+   USE dom_oce         ! ocean space and time domain 
+   USE ldfdyn_oce      ! ocean dynamics lateral physics
+   USE phycst          ! physical constants
+   USE ldfslp          ! ???
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! *  Routine accessibility
+   PUBLIC ldf_dyn_init   ! called by opa.F90
+
+  INTERFACE ldf_zpf
+     MODULE PROCEDURE ldf_zpf_1d, ldf_zpf_3d
+  END INTERFACE
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE ldf_dyn_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_dyn_init  ***
+      !!                   
+      !! ** Purpose :   set the horizontal ocean dynamics physics
+      !!
+      !! ** Method  :  
+      !!      Eddy viscosity coefficients:
+      !!         default option   : constant coef. ahm0 (namelist)
+      !!        'key_dynldf_c1d': depth dependent coef. defined in 
+      !!                        in ldf_dyn_c1d routine
+      !!        'key_dynldf_c2d': latitude and longitude dependent coef.
+      !!                        defined in ldf_dyn_c2d routine
+      !!        'key_dynldf_c3d': latitude, longitude, depth dependent coef.
+      !!                        defined in ldf_dyn_c3d routine
+      !!      N.B. User defined include files.  By default, 3d and 2d coef.
+      !!      are set to a constant value given in the namelist and the 1d
+      !!      coefficients are initialized to a hyperbolic tangent vertical
+      !!      profile.
+      !!
+      !! Reference :
+      !!      Madec, G. and M. Imbard, 1996, A global ocean mesh to overcome
+      !!      the North Pole singularity, Climate Dynamics, 12, 381-388.
+      !!
+      !! History :
+      !!        !  07-97  (G. Madec)  from inimix.F split in 2 routines
+      !!        !  08-97  (G. Madec)  multi dimensional coefficients
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Local declarations
+      INTEGER ::   ioptio         ! ???
+      LOGICAL :: ll_print = .FALSE.    ! Logical flag for printing viscosity coef.
+
+       
+      NAMELIST/nam_dynldf/ ln_dynldf_lap  , ln_dynldf_bilap,                &
+         &                 ln_dynldf_level, ln_dynldf_hor, ln_dynldf_iso,   &
+         &                 ahm0, ahmb0
+      !!----------------------------------------------------------------------
+
+
+      ! Define the lateral physics parameters
+      ! ======================================
+    
+      ! Read Namelist nam_dynldf : Lateral physics
+      REWIND( numnam )
+      READ  ( numnam, nam_dynldf )
+
+      ! Parameter print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ldf_dyn : lateral momentum physics'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '          Namelist nam_dynldf : set lateral mixing parameters'
+         WRITE(numout,*) '             laplacian operator          ln_dynldf_lap   = ', ln_dynldf_lap
+         WRITE(numout,*) '             bilaplacian operator        ln_dynldf_bilap = ', ln_dynldf_bilap
+         WRITE(numout,*) '             iso-level                   ln_dynldf_level = ', ln_dynldf_level
+         WRITE(numout,*) '             horizontal (geopotential)   ln_dynldf_hor   = ', ln_dynldf_hor
+         WRITE(numout,*) '             iso-neutral                 ln_dynldf_iso   = ', ln_dynldf_iso
+         WRITE(numout,*) '             horizontal eddy viscosity            ahm0   = ', ahm0
+         WRITE(numout,*) '             background viscosity                 ahmb0  = ', ahmb0
+         WRITE(numout,*)
+      ENDIF
+
+      ! Parameter control
+
+      ! control the input
+      ioptio = 0
+      IF( ln_dynldf_lap   )   ioptio = ioptio + 1
+      IF( ln_dynldf_bilap )   ioptio = ioptio + 1
+      IF( ioptio /= 1 )   THEN
+          IF(lwp) WRITE(numout,cform_err)
+          IF(lwp) WRITE(numout,*) '          use ONE of the 2 lap/bilap operator type on momentum'
+          nstop = nstop + 1
+      ENDIF
+      ioptio = 0
+      IF( ln_dynldf_level )   ioptio = ioptio + 1
+      IF( ln_dynldf_hor   )   ioptio = ioptio + 1
+      IF( ln_dynldf_iso   )   ioptio = ioptio + 1
+      IF( ioptio /= 1 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          use only ONE direction (level/hor/iso)'
+         nstop = nstop + 1
+      ENDIF
+
+      IF( .NOT. lk_sco ) THEN          ! horizontal = iso-level except in s-coordinate
+         ln_dynldf_level = ln_dynldf_level .OR. ln_dynldf_hor
+         ln_dynldf_hor   = .FALSE.
+         IF(lwp) WRITE(numout,*) '          horizontal mixing in z-coord or partial steps: force ln_dynldf_level = T'
+         IF(lwp) WRITE(numout,*) '             ln_dynldf_level = ', ln_dynldf_level, ' ln_dynldf_hor = ', ln_dynldf_hor
+         IF(lwp) WRITE(numout,*) '             ln_dynldf_t 1: ', .NOT. lk_ldfslp .OR. .NOT. lk_esopa   &
+                                               , '2 ' , ln_dynldf_iso .OR. .NOT. ln_dynldf_hor
+      ENDIF
+      IF( .NOT.lk_ldfslp .AND. ( ln_dynldf_iso .OR. .NOT. ln_dynldf_hor ) ) THEN
+         IF( .NOT.lk_esopa ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          the rotation of the diffusive tensor require key_ldfslp'
+            nstop = nstop + 1
+         ENDIF
+      ENDIF
+
+
+      l_dynldf_lap     =       ln_dynldf_lap   .AND. ln_dynldf_level     ! iso-level   laplacian operator
+      l_dynldf_bilap   =       ln_dynldf_bilap .AND. ln_dynldf_level     ! iso-level bilaplacian operator
+      l_dynldf_bilapg  =       ln_dynldf_bilap .AND. ln_dynldf_hor       ! geopotential bilap. (s-coord)
+      l_dynldf_iso     =       ln_dynldf_lap   .AND.                  &  ! laplacian operator
+         &                   ( ln_dynldf_iso   .OR.  ln_dynldf_hor )     ! iso-neutral (z-coord) or horizontal (s-coord)
+
+      l_dynzdf_iso    = .FALSE.
+      IF( l_dynldf_iso )   l_dynzdf_iso = .TRUE.
+
+      ioptio = 0
+      IF( l_dynldf_lap     )   ioptio = ioptio + 1
+      IF( l_dynldf_bilap   )   ioptio = ioptio + 1
+      IF( l_dynldf_bilapg  )   ioptio = ioptio + 1
+      IF( l_dynldf_iso     )   ioptio = ioptio + 1
+      IF( ioptio /= 1 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          this combination of operator and direction has not been implemented'
+         nstop = nstop + 1
+      ENDIF
+      IF( lk_esopa ) THEN
+         l_dynldf_lap = .TRUE.   ;   l_dynldf_bilap   = .TRUE.   ;   l_dynldf_bilapg  = .TRUE.
+         l_dynldf_iso = .TRUE.   ;   l_dynzdf_iso     = .TRUE.
+         IF(lwp ) WRITE(numout,*) '          esopa test: use all lateral physics options'
+      ENDIF
+
+      ! control print
+      IF( l_dynldf_lap    .AND. lwp ) WRITE(numout,*) '          iso-level laplacian momentum operator'
+      IF( l_dynldf_bilap  .AND. lwp ) WRITE(numout,*) '          iso-level bilaplacian momentum operator'
+      IF( l_dynldf_bilapg .AND. lwp ) WRITE(numout,*) '          geopotential bilaplacian momentum operator'
+      IF( l_dynldf_iso    .AND. lwp ) WRITE(numout,*) '          iso-neutral laplacian momentum operator'
+
+      ! ... Space variation of eddy coefficients
+      ioptio = 0
+#if defined key_dynldf_c3d
+      IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth)'
+      ioptio = ioptio+1
+#endif
+#if defined key_dynldf_c2d
+      IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude)'
+      ioptio = ioptio+1
+#endif
+#if defined key_dynldf_c1d
+      IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( depth )'
+      ioptio = ioptio+1
+      IF( lk_sco ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          key_dynldf_c1d cannot be used in s-coordinate (key_s_coord)'
+         nstop = nstop + 1
+      ENDIF
+#endif
+      IF( ioptio == 0 ) THEN
+          IF(lwp) WRITE(numout,*) '          momentum mixing coef. = constant  (default option)'
+        ELSEIF( ioptio > 1 ) THEN
+          IF(lwp) WRITE(numout,cform_err)
+          IF(lwp) WRITE(numout,*) '          use only one of the following keys:',   &
+                                  ' key_dynldf_c3d, key_dynldf_c2d, key_dynldf_c1d'
+          nstop = nstop + 1
+      ENDIF
+
+
+      IF( l_dynldf_bilap .OR. l_dynldf_bilapg ) THEN
+         IF(lwp) WRITE(numout,*) '          biharmonic momentum diffusion'
+         IF( ahm0 > 0 .AND. .NOT. lk_esopa ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) 'The horizontal viscosity coef. ahm0 must be negative'
+            nstop = nstop + 1
+         ENDIF
+      ELSE
+         IF(lwp) WRITE(numout,*) '          harmonic momentum diff. (default)'
+         IF( ahm0 < 0 .AND. .NOT. lk_esopa ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          The horizontal viscosity coef. ahm0 must be positive'
+            nstop = nstop + 1
+         ENDIF
+      ENDIF
+
+
+      ! Lateral eddy viscosity
+      ! ======================
+
+#if defined key_dynldf_c3d
+      CALL ldf_dyn_c3d( ll_print )   ! ahm = 3D coef. = F( longitude, latitude, depth )
+#elif defined key_dynldf_c2d
+      CALL ldf_dyn_c2d( ll_print )   ! ahm = 1D coef. = F( longitude, latitude )
+#elif defined key_dynldf_c1d
+      CALL ldf_dyn_c1d( ll_print )   ! ahm = 1D coef. = F( depth )
+#else
+                                     ! Constant coefficients
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'inildf: constant eddy viscosity coef. '
+      IF(lwp) WRITE(numout,*) '~~~~~~'
+      IF(lwp) WRITE(numout,*) '        ahm1 = ahm2 = ahm0 =  ',ahm0
+#endif
+
+   END SUBROUTINE ldf_dyn_init
+
+#if defined key_dynldf_c3d
+#   include "ldfdyn_c3d.h90"
+#elif defined key_dynldf_c2d
+#   include "ldfdyn_c2d.h90"
+#elif defined key_dynldf_c1d
+#   include "ldfdyn_c1d.h90"
+#endif
+
+
+   SUBROUTINE ldf_zpf_1d( ld_print, pdam, pwam, pbot, pdep, pah )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_zpf  ***
+      !!                   
+      !! ** Purpose :   vertical adimensional profile for eddy coefficient
+      !!
+      !! ** Method  :   1D eddy viscosity coefficients ( depth )
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      LOGICAL , INTENT (in   ) :: ld_print   ! If true, output arrays on numout
+      REAL(wp), INTENT (in   ) ::   &
+          pdam,     &  ! depth of the inflection point
+          pwam,     &  ! width of inflection
+          pbot         ! battom value (0<pbot<= 1)
+      REAL(wp), INTENT (in   ), DIMENSION(jpk) ::   &
+          pdep         ! depth of the gridpoint (T, U, V, F)
+      REAL(wp), INTENT (inout), DIMENSION(jpk) ::   &
+          pah          ! adimensional vertical profile
+
+      !! * Local variables
+      INTEGER  ::   jk           ! dummy loop indices
+      REAL(wp) ::   zm00, zm01, zmhb, zmhs       ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      zm00 = TANH( ( pdam - gdept(1    ) ) / pwam )
+      zm01 = TANH( ( pdam - gdept(jpkm1) ) / pwam )
+      zmhs = zm00 / zm01
+      zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01
+
+      DO jk = 1, jpk
+         pah(jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(jk) ) / pwam )  )
+      END DO
+
+      ! Control print
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm profile : '
+         WRITE(numout,*)
+         WRITE(numout,'("  jk      ahm       ","  depth t-level " )')
+         DO jk = 1, jpk
+            WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(jk), pdep(jk)
+         END DO
+      ENDIF
+
+   END SUBROUTINE ldf_zpf_1d
+
+
+   SUBROUTINE ldf_zpf_3d( ld_print, pdam, pwam, pbot, pdep, pah )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_zpf  ***
+      !!
+      !! ** Purpose :   vertical adimensional profile for eddy coefficient
+      !!
+      !! ** Method  :   3D for partial step or s-coordinate
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      LOGICAL , INTENT (in   ) :: ld_print   ! If true, output arrays on numout
+      REAL(wp), INTENT (in   ) ::   &
+          pdam,     &  ! depth of the inflection point
+          pwam,     &  ! width of inflection
+          pbot         ! reduction factor (surface value / bottom value)
+      REAL(wp), INTENT (in   ), DIMENSION(jpi,jpj,jpk) ::   &
+          pdep         ! dep of the gridpoint (T, U, V, F)
+      REAL(wp), INTENT (inout), DIMENSION(jpi,jpj,jpk) ::   &
+          pah          ! adimensional vertical profile
+
+      !! * Local variables
+      INTEGER  ::   jk           ! dummy loop indices
+      REAL(wp) ::   zm00, zm01, zmhb, zmhs       ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      zm00 = TANH( ( pdam - gdept(1    ) ) / pwam )   
+      zm01 = TANH( ( pdam - gdept(jpkm1) ) / pwam )
+      zmhs = zm00 / zm01
+      zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01
+
+      DO jk = 1, jpk
+         pah(:,:,jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(:,:,jk) ) / pwam )  )
+      END DO
+
+      ! Control print
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm profile : '
+         WRITE(numout,*)
+         WRITE(numout,'("  jk      ahm       ","  depth t-level " )')
+         DO jk = 1, jpk
+            WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(1,1,jk), pdep(1,1,jk)
+         END DO
+      ENDIF
+
+   END SUBROUTINE ldf_zpf_3d
+   !!======================================================================
+END MODULE ldfdyn
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_antarctic.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_antarctic.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_antarctic.h90	(revision 4)
@@ -0,0 +1,39 @@
+   !!----------------------------------------------------------------------
+   !!  ldfdyn_antarctic.h90        2D (i,j) antarctic zoom viscosity coeff.
+   !!----------------------------------------------------------------------
+
+!
+! 1.2 Modify ahm
+! --------------
+ 
+      IF(lwp)WRITE(numout,*) ' inildf: Antarctic ocean'
+      IF(lwp)WRITE(numout,*) '         no tropics, no reduction of ahm'
+      IF(lwp)WRITE(numout,*) '         north boundary increase'
+
+      ahm1(:,:) = ahm0
+      ahm2(:,:) = ahm0
+
+      ijpt0=max(1,min(49 -njmpp+1,jpj))
+      ijpt1=max(0,min(49-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*2.
+         ahm1(:,jj)=ahm0*2.
+      END DO
+      ijpt0=max(1,min(48 -njmpp+1,jpj))
+      ijpt1=max(0,min(48-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*1.9
+         ahm1(:,jj)=ahm0*1.75
+      END DO
+      ijpt0=max(1,min(47 -njmpp+1,jpj))
+      ijpt1=max(0,min(47-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*1.5
+         ahm1(:,jj)=ahm0*1.25
+      END DO
+      ijpt0=max(1,min(46 -njmpp+1,jpj))
+      ijpt1=max(0,min(46-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*1.1
+      END DO
+C
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_arctic.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_arctic.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_arctic.h90	(revision 4)
@@ -0,0 +1,39 @@
+   !!----------------------------------------------------------------------
+   !!  ldftra_arctic.h90              2D (i,j) arctic zoom viscosity coeff.
+   !!----------------------------------------------------------------------
+
+
+! 1.2 Modify ahm 
+! --------------
+      IF(lwp)WRITE(numout,*) ' inildf: Arctic ocean'
+      IF(lwp)WRITE(numout,*) '         no tropics, no reduction of ahm'
+      IF(lwp)WRITE(numout,*) '         south and west boundary increase'
+
+
+      ahm1(:,:) = ahm0
+      ahm2(:,:) = ahm0
+
+      ijpt0=max(1,min(98-jpjzoom+1-njmpp+1,jpj))
+      ijpt1=max(0,min(98-jpjzoom+1-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*2.
+         ahm1(:,jj)=ahm0*2.
+      END DO
+      ijpt0=max(1,min(99-jpjzoom+1-njmpp+1,jpj))
+      ijpt1=max(0,min(99-jpjzoom+1-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*1.9
+         ahm1(:,jj)=ahm0*1.75
+      END DO
+      ijpt0=max(1,min(100-jpjzoom+1-njmpp+1,jpj))
+      ijpt1=max(0,min(100-jpjzoom+1-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*1.5
+         ahm1(:,jj)=ahm0*1.25
+      END DO
+      ijpt0=max(1,min(101-jpjzoom+1-njmpp+1,jpj))
+      ijpt1=max(0,min(101-jpjzoom+1-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*1.1
+      END DO
+
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90	(revision 4)
@@ -0,0 +1,97 @@
+   !!----------------------------------------------------------------------
+   !!                     ***  ldfdyn_c1d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_dyn_c1d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_dyn_c1d  ***
+      !!                   
+      !! ** Purpose :   initializations of the horizontal ocean physics
+      !!
+      !! ** Method  :   1D eddy viscosity coefficients ( depth )
+      !!      ahm3, ahm4 never used
+      !!      biharmonic or harmonic operator : ahm1=ahm2 defined at T-level
+      !!      isopycnal or geopotential harmonic operator
+      !!                                      : ahm1 defined at T-level
+      !!                                      : ahm2 defined at w-level
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout
+
+      !! * Local variables
+      REAL(wp) ::   zdam, zwam, zm00, zm01, zmhf, zmhs
+      REAL(wp) ::   zahmf, zahms
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'inildf: 1D eddy viscosity coefficient'
+      IF(lwp) WRITE(numout,*) '~~~~~~  --'
+      IF(lwp) WRITE(numout,*)
+
+      ! Set ahm1=ahm2   (always at t-level)
+      ! =============
+      ! (USER: modify ahm1 following your desiderata)
+
+      ! initialization of the profile
+      ! ahms, ahmf: surface and bottom values
+      zahms = ahm0
+      zahmf = ahm0/4.
+      ! zdam, zwam: depth of the inflection pt and width of inflection
+      zdam  = -300.
+      zwam  =  300.
+      ! computation coefficients
+      zm00 = TANH( (0-zdam)/zwam )
+      zm01 = TANH( (-fsdept(1,1,jpk)-zdam)/zwam )
+      zmhf = (zahms-zahmf)/(zm00-zm01)
+      zmhs = zahms-zmhf * zm00
+
+      ! set ahm1=ahm2 at T-level
+      DO jk = 1, jpk
+         ahm1(jk) = zmhs + zmhf * TANH( (-fsdept(1,1,jk)-zdam) / zwam )
+         ahm2(jk) = ahm1(jk)
+      END DO
+
+      ! Control print
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm profile : '
+         WRITE(numout,*)
+         WRITE(numout,9100)
+         DO jk = 1, jpk
+            WRITE(numout,9110) jk, ahm1(jk), fsdept(1,1,jk)
+         END DO
+      ENDIF
+ 9100 FORMAT('  jk      ahm       ','  depth t-level ' )
+ 9110 FORMAT(i6,2f12.4,3x,2f12.4)
+
+
+      ! Set ahm3=ahm4   (always defined at w-level)
+      ! =============
+
+      ! define ahm3 from the same vertical profile used for ahm4
+      ! (always defined at w-level)
+      ! (USER: modify ahm1 following your desiderata)
+
+      DO jk = 1, jpk
+         ahm3(jk) = zmhs + zmhf * TANH( (-fsdepw(1,1,jk)-zdam) / zwam )
+         ahm4(jk) = ahm3(jk)
+      END DO
+
+      ! Control print
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm3=ahm4 profile : '
+         WRITE(numout,*)
+         WRITE(numout,9120)
+         DO jk = 1, jpk
+            WRITE(numout,9110) jk, ahm3(jk), fsdepw(1,1,jk)
+         END DO
+      ENDIF
+ 9120 FORMAT('  jk      ahm       ','  depth w-level ' )
+
+   END SUBROUTINE ldf_dyn_c1d
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90	(revision 4)
@@ -0,0 +1,308 @@
+   !!----------------------------------------------------------------------
+   !!                      ***  ldfdyn_c2d.h90  ***
+   !!----------------------------------------------------------------------
+   !!   ldf_dyn_c2d  : set the lateral viscosity coefficients
+   !!   ldf_dyn_c2d_orca : specific case for orca r2 and r4
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_dyn_c2d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_dyn_c2d  ***
+      !!                  
+      !! ** Purpose :   initializations of the horizontal ocean physics
+      !!
+      !! ** Method :
+      !!                   **** W A R N I N G ****
+      !!                     ORCA OCEAN VERSION
+      !!    This method is relevant ONLY for the grid build by the method
+      !!               given in the 'Reference' section.
+      !!                   **** W A R N I N G ****
+      !!
+      !!      2D eddy viscosity coefficients ( longitude, latitude )
+      !!
+      !!       harmonic operator   : ahm1 is defined at t-point
+      !!                             ahm2 is defined at f-point
+      !!           + isopycnal     : ahm3 is defined at u-point
+      !!           or geopotential   ahm4 is defined at v-point
+      !!           iso-model level : ahm3, ahm4 not used
+      !!
+      !!       biharmonic operator : ahm1 is defined at u-point
+      !!                             ahm2 is defined at v-point
+      !!                           : ahm3, ahm4 not used
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout
+
+      !! * Local variables
+      REAL(wp) ::   za00, zdx_max
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'ldf_dyn_c2d : 2d lateral eddy viscosity coefficient'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*)
+
+      ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operators
+      ! =================                       whatever its orientation is)
+      IF( ln_dynldf_lap ) THEN
+         ! define ahm1 and ahm2 at the right grid point position
+         ! (USER: modify ahm1 and ahm2 following your desiderata)
+
+         zdx_max = MAXVAL( e1t(:,:) )
+#if defined key_mpp
+         CALL mpp_max( zdx_max )
+#endif
+         IF(lwp) WRITE(numout,*) '              laplacian operator: ahm proportional to e1'
+         IF(lwp) WRITE(numout,*) '              Caution, here we assume your mesh is isotropic ...'
+         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zdx_max, ' maximum value for ahm = ', ahm0
+
+         za00 = ahm0 / zdx_max
+         ahm1(:,:) = za00 * e1t(:,:)
+         ahm2(:,:) = za00 * e1f(:,:)
+
+         IF( ln_dynldf_iso ) THEN
+            IF(lwp) WRITE(numout,*) '              Caution, as implemented now, the isopycnal part of momentum'
+            IF(lwp) WRITE(numout,*) '                 mixing use aht0 as eddy viscosity coefficient. Thus, it is'
+            IF(lwp) WRITE(numout,*) '                 uniform and you must be sure that your ahm is greater than'
+            IF(lwp) WRITE(numout,*) '                 aht0 everywhere in the model domain.'
+         ENDIF
+
+         ! Special case for ORCA R2 and R4 configurations (overwrite the value of ahm1 ahm2)
+         ! ==============================================
+         IF( cp_cfg == "orca" .AND. ( jp_cfg == 2 .OR. jp_cfg == 4 ) )   CALL ldf_dyn_c2d_orca( ld_print )
+
+         ! Control print
+         IF( lwp .AND. ld_print ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: 2D ahm1 array'
+            CALL prihre(ahm1,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: 2D ahm2 array'
+            CALL prihre(ahm2,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         ENDIF
+      ENDIF
+
+      ! ahm3 and ahm4 at U- and V-points (used for bilaplacian operator
+      ! ================================  whatever its orientation is)
+      IF( ln_dynldf_bilap ) THEN
+         ! (USER: modify ahm3 and ahm4 following your desiderata)
+         ! Here: ahm is proportional to the cube of the maximum of the gridspacing
+         !       in the to horizontal direction
+
+         zdx_max = MAXVAL( e1u(:,:) )
+#if defined key_mpp
+         CALL mpp_max( zdx_max )
+#endif
+         IF(lwp) WRITE(numout,*) '              bi-laplacian operator: ahm proportional to e1**3 '
+         IF(lwp) WRITE(numout,*) '              Caution, here we assume your mesh is isotropic ...'
+         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zdx_max, ' maximum value for ahm = ', ahm0
+
+         za00 = ahm0 / ( zdx_max * zdx_max * zdx_max )
+         ahm3(:,:) = za00 * e1u(:,:) * e1u(:,:) * e1u(:,:)
+         ahm4(:,:) = za00 * e1v(:,:) * e1v(:,:) * e1v(:,:)
+
+         ! Control print
+         IF( lwp .AND. ld_print ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahm3 array'
+            CALL prihre(ahm3,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahm4 array'
+            CALL prihre(ahm4,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         ENDIF
+      ENDIF
+
+
+   END SUBROUTINE ldf_dyn_c2d
+
+
+   SUBROUTINE ldf_dyn_c2d_orca( ld_print )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_dyn_c2d  ***
+      !!
+      !!                   **** W A R N I N G ****
+      !!
+      !!                ORCA R2 and R4 configurations
+      !!                  
+      !!                   **** W A R N I N G ****
+      !!                  
+      !! ** Purpose :   initializations of the lateral viscosity for orca R2
+      !!
+      !! ** Method  :   blah blah blah...
+      !!
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ldftra_oce, ONLY : aht0
+
+      !! * Arguments
+      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout
+
+      !! * Local variables
+      INTEGER :: ji, jj      ! dummy loop indices
+      INTEGER :: inumcf, iost, iim, ijm
+      INTEGER :: jn
+      INTEGER :: ifreq, il1, il2, ij, ii, inorth, isouth
+      INTEGER :: ipi, ipj, iumout, iwork, icompt, ibtest, ikmax
+      INTEGER :: ijpt0, ijpt1, iipt0, iipt1
+      INTEGER ,DIMENSION(jpidta,jpidta) :: idata
+      INTEGER ,DIMENSION(jpi   ,jpj   ) :: icof
+
+      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk
+
+      CHARACTER (len=15) ::   clexp
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient'
+      IF(lwp) WRITE(numout,*) '~~~~~~  --'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '        orca ocean model'
+      IF(lwp) WRITE(numout,*)
+
+#if defined key_antarctic
+#     include "ldfdyn_antarctic.h90"
+#elif defined key_arctic
+#     include "ldfdyn_arctic.h90"
+#else
+      ! Read 2d integer array to specify western boundary increase in the
+      ! ===================== equatorial strip (20N-20S) defined at t-points
+
+      inumcf = 15
+      OPEN( UNIT=inumcf,FILE='ahmcoef',STATUS='OLD',   &
+            FORM='FORMATTED', ACCESS='SEQUENTIAL', ERR=111 ,   &
+            IOSTAT= iost) 
+      IF( iost == 0 ) THEN
+         IF(lwp) WRITE(numout,*) '     file   : ahmcoef open ok'
+         IF(lwp) WRITE(numout,*) '     unit   = ', inumcf
+         IF(lwp) WRITE(numout,*) '     status = OLD'
+         IF(lwp) WRITE(numout,*) '     form   = FORMATTED'
+         IF(lwp) WRITE(numout,*) '     access = SEQUENTIAL'
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+ 111  CONTINUE 
+      IF( iost /= 0 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' ===>>>> : bad opening file: ahmcoef'
+         IF(lwp) WRITE(numout,*) ' =======   ===  '
+         IF(lwp) WRITE(numout,*) '           we stop. verify the file '
+         IF(lwp) WRITE(numout,*)
+         STOP 'ldfdyn_c2d.h90'
+      ENDIF
+
+      REWIND inumcf
+      READ(inumcf,9101) clexp, iim, ijm
+      READ(inumcf,'(/)')
+      ifreq = 40
+      il1 = 1
+      DO jn = 1, jpidta/ifreq+1
+         READ(inumcf,'(/)')
+         il2 = MIN( jpidta, il1+ifreq-1 )
+         READ(inumcf,9201) ( ii, ji = il1, il2, 5 )
+         READ(inumcf,'(/)')
+         DO jj = jpjdta, 1, -1
+            READ(inumcf,9202) ij, ( idata(ji,jj), ji = il1, il2 )
+         END DO
+         il1 = il1 + ifreq
+      END DO
+      
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            icof(ji,jj) = idata( mig(ji), mjg(jj) )
+         END DO
+      END DO
+      DO jj = nlcj+1, jpj
+         DO ji = 1, nlci
+            icof(ji,jj) = icof(ji,nlcj)
+         END DO
+      END DO
+      DO jj = 1, jpj
+         DO ji = nlci+1, jpi
+            icof(ji,jj) = icof(nlci,jj)
+         END DO
+      END DO
+
+ 9101 FORMAT(1x,a15,2i8)
+ 9201 FORMAT(3x,13(i3,12x))
+ 9202 FORMAT(i3,41i3)
+
+
+      ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator)
+      ! =================
+      ! define ahm1 and ahm2 at the right grid point position
+      ! (USER: modify ahm1 and ahm2 following your desiderata)
+      
+      
+      ! Decrease ahm to zahmeq m2/s in the tropics
+      ! (from 90 to 20 degre: ahm = constant
+      ! from 20 to  2.5 degre: ahm = decrease in (1-cos)/2
+      ! from  2.5 to  0 degre: ahm = constant
+      ! symmetric in the south hemisphere)
+
+      zahmeq = aht0
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS( gphif(ji,jj) ) >= 20. ) THEN
+               ahm2(ji,jj) =  ahm0
+            ELSEIF( ABS( gphif(ji,jj) ) <= 2.5 ) THEN
+               ahm2(ji,jj) =  zahmeq
+            ELSE
+               ahm2(ji,jj) = zahmeq + (ahm0-zahmeq)/2.   &
+                  * ( 1. - COS( rad * ( ABS(gphif(ji,jj))-2.5 ) * 180. / 17.5 ) )
+            ENDIF
+            IF( ABS( gphit(ji,jj) ) >= 20. ) THEN
+               ahm1(ji,jj) =  ahm0
+            ELSEIF( ABS( gphit(ji,jj) ) <= 2.5 ) THEN
+               ahm1(ji,jj) =  zahmeq
+            ELSE
+               ahm1(ji,jj) = zahmeq + (ahm0-zahmeq)/2.   &
+                  * ( 1. - COS( rad * ( ABS(gphit(ji,jj))-2.5 ) * 180. / 17.5 ) )
+            ENDIF
+         END DO
+      END DO
+
+      ! increase along western boundaries of equatorial strip
+      ! t-point
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            zcoft = FLOAT( icof(ji,jj) ) / 100.
+            ahm1(ji,jj) = zcoft * ahm0 + (1.-zcoft) * ahm1(ji,jj) 
+         END DO
+      END DO
+      ! f-point
+      icof(:,:) = icof(:,:) * tmask(:,:,1)
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            zmsk = tmask(ji,jj+1,1) + tmask(ji+1,jj+1,1) + tmask(ji,jj,1) + tmask(ji,jj+1,1)
+            IF( zmsk == 0. ) THEN
+               zcoff = 1.
+            ELSE
+               zcoff = FLOAT( icof(ji,jj+1) + icof(ji+1,jj+1) + icof(ji,jj) + icof(ji,jj+1) )   &
+                     / (zmsk * 100.)
+            ENDIF
+            ahm2(ji,jj) = zcoff * ahm0 + (1.-zcoff) * ahm2(ji,jj)
+         END DO
+      END DO
+#endif
+      
+      ! Lateral boundary conditions on ( ahm1, ahm2 )
+      !                                ==============
+      CALL lbc_lnk( ahm1, 'T', 1. )   ! T-point, unchanged sign
+      CALL lbc_lnk( ahm2, 'F', 1. )   ! F-point, unchanged sign
+
+      ! Control print
+      IF( lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: 2D ahm1 array'
+         CALL prihre(ahm1,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: 2D ahm2 array'
+         CALL prihre(ahm2,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF
+
+   END SUBROUTINE ldf_dyn_c2d_orca
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_c2d_bilap.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_c2d_bilap.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_c2d_bilap.h90	(revision 4)
@@ -0,0 +1,67 @@
+   !!----------------------------------------------------------------------
+   !!                      ***  ldfdyn_2d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_dyn_2d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_dyn_2d  ***
+      !!                  
+      !! ** Purpose :   initializations of the horizontal ocean physics
+      !!
+      !! ** Method :
+      !!             ORCA05 OCEAN VERSION with bilaplacian
+      !!
+      !!      2D eddy viscosity coefficients ( longitude, latitude )
+      !!
+      !!       biharmonic operator : ahm1 is defined at u-point
+      !!                             ahm2 is defined at v-point
+      !!                           : ahm3, ahm4 not used
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      LOGICAL, INTENT(in) :: ld_print   ! print coef. in numout
+
+      !! * Local variables
+      REAL(wp) ::   za00, zdx
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient for bilaplacian'
+      IF(lwp) WRITE(numout,*) '~~~~~~  --'
+
+      ! Read 2d integer array to specify western boundary increase in the
+      ! ===================== equatorial strip (20N-20S) defined at t-points
+
+      ! Set ahm1 and ahm2
+      ! =================
+
+      ! define ahm1 and ahm2 at the right grid point position
+      ! biharmonic : ahm1 (ahm2) defined at u- (v-) point
+      
+      zdx = ra * rad * 0.5
+      za00 = ahm0/(zdx*zdx*zdx)
+
+      IF(lwp) WRITE(numout,*) '        orca05 ocean model eq resolution = ', zdx, ' eq ahm = ' ahm0
+      IF(lwp) WRITE(numout,*) '        zdx=', zdx
+      DO jj = 1, jpj
+        DO ji = 1, jpi
+          ahm1(ji,jj) = za00 * e1u(ji,jj) * e1u(ji,jj) * e1u(ji,jj)
+          ahm2(ji,jj) = za00 * e1v(ji,jj) * e1v(ji,jj) * e1v(ji,jj)
+        END DO
+      END DO 
+
+      ! Control print
+      IF( lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: 2D ahm1 array'
+         CALL prihre(ahm1,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: 2D ahm2 array'
+         CALL prihre(ahm2,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF
+
+   END SUBROUTINE ldf_dyn_2d
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90	(revision 4)
@@ -0,0 +1,410 @@
+   !!----------------------------------------------------------------------
+   !!                        ***  ldfdyn_c3d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   'key_dynldf_c3d'             3D lateral eddy viscosity coefficients
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_dyn_c3d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_dyn_c3d  ***
+      !!                   
+      !! ** Purpose :   initializations of the horizontal ocean physics
+      !!
+      !! ** Method  :   3D eddy viscosity coef. ( longitude, latitude, depth )
+      !!       laplacian operator   : ahm1, ahm2 defined at T- and F-points
+      !!                              ahm2, ahm4 never used
+      !!       bilaplacian operator : ahm1, ahm2 never used
+      !!                           :  ahm3, ahm4 defined at U- and V-points
+      !!       ??? explanation of the default is missing
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ldftra_oce, ONLY : aht0
+
+      !! * Arguments
+      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout
+
+      !! * local variables
+      INTEGER  ::   ji, jj, jk      ! dummy loop indices
+      REAL(wp) ::   &
+         zr = 0.2 ,   &  ! maximum of the reduction factor at the bottom ocean
+         !               ! ( 0 < zr < 1 )
+         zh = 500.,   &  ! depth of at which start the reduction ( > dept(1) )
+         zdx_max  ,   &  ! maximum grid spacing over the global domain
+         za00, zc, zd    ! temporary scalars
+      REAL(wp), DIMENSION(jpk) ::   zcoef   ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'ldf_dyn_c3d : 3D lateral eddy viscosity coefficient'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+
+      
+      ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operators
+      ! =================                       whatever its orientation is)
+      IF( ln_dynldf_lap ) THEN
+         ! define ahm1 and ahm2 at the right grid point position
+         ! (USER: modify ahm1 and ahm2 following your desiderata)
+
+         zdx_max = MAXVAL( e1t(:,:) )
+#if defined key_mpp
+         CALL mpp_max( zdx_max )
+#endif
+         IF(lwp) WRITE(numout,*) '              laplacian operator: ahm proportional to e1'
+         IF(lwp) WRITE(numout,*) '              Caution, here we assume your mesh is isotropic ...'
+         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zdx_max, ' maximum value for ahm = ', ahm0
+
+
+         za00 = ahm0 / zdx_max
+
+         IF( ln_dynldf_iso ) THEN
+            IF(lwp) WRITE(numout,*) '              Caution, as implemented now, the isopycnal part of momentum'
+            IF(lwp) WRITE(numout,*) '                 mixing use aht0 as eddy viscosity coefficient. Thus, it is'
+            IF(lwp) WRITE(numout,*) '                 uniform and you must be sure that your ahm is greater than'
+            IF(lwp) WRITE(numout,*) '                 aht0 everywhere in the model domain.'
+         ENDIF
+
+         CALL ldf_zpf( .TRUE. , 1000., 500., 0.25, fsdept(:,:,:), ahm1 )   ! vertical profile
+         CALL ldf_zpf( .TRUE. , 1000., 500., 0.25, fsdept(:,:,:), ahm2 )   ! vertical profile
+         DO jk = 1,jpk
+            ahm1(:,:,jk) = za00 * e1t(:,:) * ahm1(:,:,jk)
+            ahm2(:,:,jk) = za00 * e1f(:,:) * ahm2(:,:,jk)
+         END DO
+
+
+         ! Special case for ORCA R2 and R4 configurations (overwrite the value of ahm1 ahm2)
+         ! ==============================================
+         IF( cp_cfg == "orca" .AND. ( jp_cfg == 2 .OR. jp_cfg == 4 ) ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '              ORCA R2 or R4: overwrite the previous definition of ahm'
+            IF(lwp) WRITE(numout,*) '              ============='
+            CALL ldf_dyn_c3d_orca( ld_print )
+         ENDIF
+
+      ENDIF
+      
+      ! Control print
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         3D ahm1 array (k=1)'
+         CALL prihre( ahm1(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) '         3D ahm2 array (k=1)'
+         CALL prihre( ahm2(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
+      ENDIF
+
+
+      ! ahm3 and ahm4 at U- and V-points (used for bilaplacian operator
+      ! ================================  whatever its orientation is)
+      ! (USER: modify ahm3 and ahm4 following your desiderata)
+      ! Here: ahm is proportional to the cube of the maximum of the gridspacing
+      !       in the to horizontal direction
+
+      IF( ln_dynldf_bilap ) THEN
+
+         zdx_max = MAXVAL( e1u(:,:) )
+#if defined key_mpp
+         CALL mpp_max( zdx_max )
+#endif
+         IF(lwp) WRITE(numout,*) '              bi-laplacian operator: ahm proportional to e1**3 '
+         IF(lwp) WRITE(numout,*) '              Caution, here we assume your mesh is isotropic ...'
+         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zdx_max, ' maximum value for ahm = ', ahm0
+
+         za00 = ahm0 / ( zdx_max * zdx_max * zdx_max )
+         ahm3(:,:,1) = za00 * e1u(:,:) * e1u(:,:) * e1u(:,:)
+         ahm4(:,:,1) = za00 * e1v(:,:) * e1v(:,:) * e1v(:,:)
+
+         zh = MAX( zh, fsdept(1,1,1) )   ! at least the first reach ahm0
+         IF( lk_zco ) THEN               ! z-coordinate, same profile everywhere
+            IF(lwp) WRITE(numout,'(36x," ahm ", 7x)')
+            DO jk = 1, jpk
+               IF( fsdept(1,1,jk) <= zh ) THEN
+                  zcoef(jk) = 1.e0
+               ELSE
+                  zcoef(jk) = 1.e0 + ( zr - 1.e0 )   &
+                     &               * (  1. - EXP( ( fsdept(1,1,jk   ) - zh ) / zh )  )   &
+                     &               / (  1. - EXP( ( fsdept(1,1,jpkm1) - zh ) / zh )  )
+               ENDIF
+               ahm3(:,:,jk) = ahm3(:,:,1) * zcoef(jk)
+               ahm4(:,:,jk) = ahm4(:,:,1) * zcoef(jk)
+               IF(lwp) WRITE(numout,'(34x,E7.2,8x,i3)') zcoef(jk) * ahm0, jk
+            END DO
+         ELSE                            ! partial steps or s-ccordinate
+            zc = MAXVAL( fsdept(:,:,jpkm1) )
+#if defined key_mpp
+            CALL mpp_max( zc )
+#endif
+            zc = 1. / (  1. - EXP( ( zc - zh ) / zh )  )
+            DO jk = 2, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     IF( fsdept(ji,jj,jk) <= zh ) THEN
+                        ahm3(ji,jj,jk) = ahm3(ji,jj,1)
+                        ahm4(ji,jj,jk) = ahm4(ji,jj,1)
+                     ELSE
+                        zd = 1.e0 + ( zr - 1.e0 ) * (  1. - EXP( ( fsdept(ji,jj,jk) - zh ) / zh )  ) * zc
+                        ahm3(ji,jj,jk) = ahm3(ji,jj,1) * zd
+                        ahm4(ji,jj,jk) = ahm4(ji,jj,1) * zd
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+            ahm3(:,:,jpk) = ahm3(:,:,jpkm1)
+            ahm4(:,:,jpk) = ahm4(:,:,jpkm1)
+            IF(lwp) WRITE(numout,'(36x," ahm ", 7x)')
+            DO jk = 1, jpk
+               IF(lwp) WRITE(numout,'(30x,E10.2,8x,i3)') ahm3(1,1,jk), jk
+            END DO
+         ENDIF
+
+         ! Control print
+         IF( lwp .AND. ld_print ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahm3 array at level 1'
+            CALL prihre(ahm3(:,:,1  ),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahm4 array at level 1'
+            CALL prihre(ahm4(:,:,jpk),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE ldf_dyn_c3d
+
+
+   SUBROUTINE ldf_dyn_c3d_orca( ld_print )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_dyn_c3d  ***
+      !!                   
+      !! ** Purpose :   ORCA R2 an R4 only
+      !!
+      !! ** Method  :   blah blah blah ....
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ldftra_oce, ONLY : aht0
+ 
+      !! * Arguments
+      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout
+
+      !! * local variables
+      INTEGER ::inumcf, iost, iim, ijm
+      INTEGER ::ji,jj,jk, jn
+      INTEGER ::ifreq, il1, il2, ij, ii
+      INTEGER ,DIMENSION(jpidta, jpjdta) :: idata
+      INTEGER ,DIMENSION(jpi   , jpj   ) :: icof
+
+      REAL(wp) ::   zahmeq, zcoff, zcoft, zmsk
+      REAL(wp) ::   zcoef(jpk)
+
+      CHARACTER (len=15) ::   clexp
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'ldfdyn_c3d_orca : 3D eddy viscosity coefficient'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '        orca R2 or R4 ocean model'
+      IF(lwp) WRITE(numout,*) '  reduced in the surface Eq. strip '
+      IF(lwp) WRITE(numout,*)
+
+      ! Read 2d integer array to specify western boundary increase in the
+      ! ===================== equatorial strip (20N-20S) defined at t-points
+
+      inumcf = 15
+      OPEN( UNIT=inumcf,FILE='ahmcoef',STATUS='OLD',   &
+            FORM='FORMATTED', ACCESS='SEQUENTIAL', ERR=111 ,   &
+            IOSTAT= iost)
+      IF( iost == 0 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) '     file   : ahmcoef open ok'
+            WRITE(numout,*) '     unit   = ', inumcf
+            WRITE(numout,*) '     status = OLD'
+            WRITE(numout,*) '     form   = FORMATTED'
+            WRITE(numout,*) '     access = SEQUENTIAL'
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+111   CONTINUE
+      IF( iost /= 0 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' ===>>>> : bad opening file: ahmcoef,  we stop. verify the file '
+            WRITE(numout,*) ' =======   ===  '
+         ENDIF
+         nstop = nstop + 1
+      ENDIF
+
+      REWIND inumcf
+      READ(inumcf,9101) clexp, iim, ijm
+      READ(inumcf,'(/)')
+      ifreq = 40
+      il1 = 1
+      DO jn = 1, jpidta/ifreq+1
+         READ(inumcf,'(/)')
+         il2 = MIN( jpidta, il1+ifreq-1 )
+         READ(inumcf,9201) ( ii, ji = il1, il2, 5 )
+         READ(inumcf,'(/)')
+         DO jj = jpjdta, 1, -1
+            READ(inumcf,9202) ij, ( idata(ji,jj), ji = il1, il2 )
+         END DO
+         il1 = il1 + ifreq
+      END DO
+      
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            icof(ji,jj) = idata( mig(ji), mjg(jj) )
+         END DO
+      END DO
+      DO jj = nlcj+1, jpj
+         DO ji = 1, nlci
+            icof(ji,jj) = icof(ji,nlcj)
+         END DO
+      END DO
+      DO jj = 1, jpj
+         DO ji = nlci+1, jpi
+            icof(ji,jj) = icof(nlci,jj)
+         END DO
+      END DO
+      
+9101  FORMAT(1x,a15,2i8)
+9201  FORMAT(3x,13(i3,12x))
+9202  FORMAT(i3,41i3)
+      
+      ! Set ahm1 and ahm2
+      ! =================
+      
+      ! define ahm1 and ahm2 at the right grid point position
+      ! (USER: modify ahm1 and ahm2 following your desiderata)
+      ! biharmonic : ahm1 (ahm2) defined at u- (v-) point
+      ! harmonic   : ahm1 (ahm2) defined at t- (f-) point
+      
+      ! first level : as for 2D coefficients
+      
+      ! Decrease ahm to zahmeq m2/s in the tropics
+      ! (from 90 to 20 degre: ahm = constant
+      ! from 20 to  2.5 degre: ahm = decrease in (1-cos)/2
+      ! from  2.5 to  0 degre: ahm = constant
+      ! symmetric in the south hemisphere)
+      
+      IF( jp_cfg == 4 )   zahmeq = 5.0 * aht0
+      IF( jp_cfg == 2 )   zahmeq =       aht0
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS(gphif(ji,jj)) >= 20.) THEN
+               ahm2(ji,jj,1) =  ahm0
+            ELSEIF( ABS(gphif(ji,jj)) <= 2.5) THEN
+               ahm2(ji,jj,1) =  zahmeq
+            ELSE
+               ahm2(ji,jj,1) = zahmeq    &
+                             + (ahm0-zahmeq)/2.*(1.-COS( rad*(ABS(gphif(ji,jj))-2.5)*180./17.5 ) )
+            ENDIF
+            IF( ABS(gphit(ji,jj)) >= 20.) THEN
+               ahm1(ji,jj,1) =  ahm0
+            ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN
+               ahm1(ji,jj,1) =  zahmeq
+            ELSE
+               ahm1(ji,jj,1) = zahmeq    &
+                             + (ahm0-zahmeq)/2.*(1.-COS( rad*(ABS(gphit(ji,jj))-2.5)*180./17.5 ) )
+            ENDIF
+         END DO
+      END DO
+      
+      ! increase along western boundaries of equatorial strip
+      ! t-point
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            zcoft = float( icof(ji,jj) ) / 100.
+            ahm1(ji,jj,1) = zcoft * ahm0 + (1.-zcoft) * ahm1(ji,jj,1)
+         END DO
+      END DO
+      ! f-point
+      icof(:,:) = icof(:,:) * tmask(:,:,1)
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            zmsk = tmask(ji,jj+1,1) + tmask(ji+1,jj+1,1) + tmask(ji,jj,1) + tmask(ji,jj+1,1)
+            IF( zmsk == 0. ) THEN
+               zcoff = 1.
+            ELSE
+               zcoff = FLOAT( icof(ji,jj+1) + icof(ji+1,jj+1) + icof(ji,jj) + icof(ji,jj+1) )   &
+                     / (zmsk * 100.)
+            ENDIF
+            ahm2(ji,jj,1) = zcoff * ahm0 + (1.-zcoff) * ahm2(ji,jj,1)
+         END DO
+      END DO
+
+      ! other level: re-increase the coef in the deep ocean
+      
+      DO jk = 1, 21
+         zcoef(jk) = 1.
+      END DO
+      zcoef(22) = 2.
+      zcoef(23) = 3.
+      zcoef(24) = 5.
+      zcoef(25) = 7.
+      zcoef(26) = 9.
+      DO jk = 27, jpk
+         zcoef(jk) = 10.
+      END DO
+      
+      DO jk = 2, jpk
+         ahm1(:,:,jk) = MIN( ahm0, zcoef(jk) * ahm1(:,:,1) )
+         ahm2(:,:,jk) = MIN( ahm0, zcoef(jk) * ahm2(:,:,1) )
+      END DO
+      
+      ! Lateral boundary conditions on ( ahm1, ahm2 )
+      !                                ==============
+      CALL lbc_lnk( ahm1, 'T', 1. )   ! T-point, unchanged sign
+      CALL lbc_lnk( ahm2, 'F', 1. )   ! F-point, unchanged sign
+
+      ! Control print
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         3D ahm1 array (k=1)'
+         CALL prihre( ahm1(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) '         3D ahm2 array (k=1)'
+         CALL prihre( ahm2(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) '         3D ahm2 array (k=jpk)'
+         CALL prihre( ahm2(:,:,jpk), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
+      ENDIF
+
+
+      ! Set ahm3 and ahm4
+      ! =================
+
+      ! define ahm3 and ahm4 at the right grid point position
+      ! initialization to a constant value
+      !     (USER: modify ahm3 and ahm4 following your desiderata)
+      !     harmonic isopycnal or geopotential:
+      !                          ahm3 (ahm4) defined at u- (v-) point
+      DO jk = 1, jpk
+         DO jj = 2, jpj
+            DO ji = 2, jpi
+               ahm3(ji,jj,jk) = 0.5 * ( ahm2(ji,jj,jk) + ahm2(ji  ,jj-1,jk) )
+               ahm4(ji,jj,jk) = 0.5 * ( ahm2(ji,jj,jk) + ahm2(ji-1,jj  ,jk) )
+            END DO
+         END DO
+      END DO
+      ahm3 ( :, 1, :) = ahm3 ( :, 2, :)
+      ahm4 ( :, 1, :) = ahm4 ( :, 2, :)
+      
+      ! Lateral boundary conditions on ( ahm3, ahm4 )
+      !                                ==============
+      CALL lbc_lnk( ahm3, 'U', 1. )   ! U-point, unchanged sign
+      CALL lbc_lnk( ahm4, 'V', 1. )   ! V-point, unchanged sign
+
+      ! Control print
+
+      IF( lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm3 array level 1'
+         CALL prihre(ahm3(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm4 array level 1'
+         CALL prihre(ahm4(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF
+
+   END SUBROUTINE ldf_dyn_c3d_orca
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90	(revision 4)
@@ -0,0 +1,56 @@
+MODULE ldfdyn_oce
+   !!======================================================================
+   !!                  ***  MODULE  ldfdyn_oce  ***
+   !! Ocean physics:  lateral momentum mixing coefficient defined in memory 
+   !!======================================================================
+   !!
+   !! ** Purpose :
+   !!       - Define in memory lateral momentum mixing coefficients
+   !!
+   !! History :
+   !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   !!  OPA 8.5, LODYC-IPSL (2002)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce      ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !! Lateral eddy viscosity coefficients (dynamics)
+   !!----------------------------------------------------------------------
+
+   LOGICAL  ::                      & !!! ** lateral mixing namelist (nam_dynldf) **
+      ln_dynldf_lap   = .TRUE.  ,   &  ! laplacian operator
+      ln_dynldf_bilap = .FALSE. ,   &  ! bilaplacian operator
+      ln_dynldf_level = .FALSE. ,   &  ! iso-level direction
+      ln_dynldf_hor   = .TRUE.  ,   &  ! horizontal (geopotential) direction
+      ln_dynldf_iso   = .FALSE.        ! iso-neutral direction
+
+   REAL(wp) ::                      & !!! ** lateral mixing namelist (nam_dynldf) **
+      ahm0  = 40000._wp ,   &  ! lateral eddy viscosity (m2/s)
+      ahmb0 =     0._wp        ! lateral background eddy viscosity (m2/s)
+
+   LOGICAL  ::                      &  ! flag of the lateral diff. scheme used
+      l_dynldf_lap         ,        &  ! iso-level laplacian operator
+      l_dynldf_bilap       ,        &  ! iso-level bilaplacian operator
+      l_dynldf_bilapg      ,        &  ! geopotential bilap. (s-coord)
+      l_dynldf_iso         ,        &  ! iso-neutral laplacian or horizontal lapacian (s-coord)
+      l_dynzdf_iso                     ! iso-neutral laplacian or horizontal lapacian (s-coord)
+   
+
+#if defined key_dynldf_c3d
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &  ! ** 3D coefficients **
+#elif defined key_dynldf_c2d
+   REAL(wp), DIMENSION(jpi,jpj)     ::   &  ! ** 2D coefficients **
+#elif defined key_dynldf_c1d
+   REAL(wp), DIMENSION(jpk)         ::   &  ! ** 2D coefficients **
+#else
+   REAL(wp)                         ::   &  ! ** 0D coefficients **
+#endif
+      ahm1, ahm2, ahm3, ahm4                ! ????
+
+   !!----------------------------------------------------------------------
+END MODULE ldfdyn_oce
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90	(revision 4)
@@ -0,0 +1,39 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  ldfdyn_substitute.h90  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute fsahm., the lateral eddy viscosity coeff. 
+   !!      with a constant, or 1D, or 2D or 3D array, using CPP macro.
+   !!----------------------------------------------------------------------
+#if defined key_dynldf_c3d
+!   ' key_dynldf_c3d' :                  3D coefficient
+#    define   fsahmt(i,j,k)    ahm1(i,j,k)
+#    define   fsahmf(i,j,k)    ahm2(i,j,k)
+#    define   fsahmu(i,j,k)    ahm1(i,j,k)
+#    define   fsahmv(i,j,k)    ahm2(i,j,k)
+#    define   fsahmuw(i,j,k)   ahm3(i,j,k)
+#    define   fsahmvw(i,j,k)   ahm4(i,j,k)
+#elif defined key_dynldf_c2d
+!   ' key_dynldf_c2d' :                 2D coefficient
+#  define   fsahmt(i,j,k)    ahm1(i,j)
+#  define   fsahmf(i,j,k)    ahm2(i,j)
+#  define   fsahmu(i,j,k)    ahm3(i,j)
+#  define   fsahmv(i,j,k)    ahm4(i,j)
+#  define   fsahmuw(i,j,k)   ahm3(i,j)
+#  define   fsahmvw(i,j,k)   ahm4(i,j)
+#elif defined key_dynldf_c1d
+!   'key_dynldf_c1d' :                  1D coefficient
+#  define   fsahmt(i,j,k)    ahm1(k)
+#  define   fsahmf(i,j,k)    ahm1(k)
+#  define   fsahmu(i,j,k)    ahm1(k)
+#  define   fsahmv(i,j,k)    ahm1(k)
+#  define   fsahmuw(i,j,k)   ahm2(k)
+#  define   fsahmvw(i,j,k)   ahm2(k)
+#else
+!   default option :               Constant coefficient
+#  define   fsahmt(i,j,k)   ahm0
+#  define   fsahmf(i,j,k)   ahm0
+#  define   fsahmu(i,j,k)   ahm0
+#  define   fsahmv(i,j,k)   ahm0
+#  define   fsahmu(i,j,k)   ahm0
+#  define   fsahmv(i,j,k)   ahm0
+#endif
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldfeiv.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldfeiv.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldfeiv.F90	(revision 4)
@@ -0,0 +1,346 @@
+MODULE ldfeiv
+   !!======================================================================
+   !!                     ***  MODULE  ldfeiv  ***
+   !! Ocean physics:  variable eddy induced velocity coefficients
+   !!======================================================================
+#if   defined key_traldf_eiv   &&   defined key_traldf_c2d
+   !!----------------------------------------------------------------------
+   !!   'key_traldf_eiv'      and                     eddy induced velocity
+   !!   'key_traldf_c2d'                    2D tracer lateral  mixing coef.
+   !!----------------------------------------------------------------------
+   !!   ldf_eiv      : compute the eddy induced velocity coefficients
+   !!                  Same results but not same routine if 'key_autotasking'
+   !!                  is defined or not
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE phycst          ! physical constants
+   USE ldfslp          ! iso-neutral slopes
+   USE flxrnf          ! 
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   !! * Routine accessibility
+   PUBLIC ldf_eiv               ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined key_autotasking
+   !!----------------------------------------------------------------------
+   !!   'key_autotasking' :                            autotasking (j-slab)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_eiv( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv  ***
+      !!
+      !! ** Purpose :   Compute the eddy induced velocity coefficient from the
+      !!      growth rate of baroclinic instability.
+      !!
+      !! ** Method :
+      !!
+      !! ** Action :   uslp(),   : i- and j-slopes of neutral surfaces
+      !!               vslp()      at u- and v-points, resp.
+      !!               wslpi(),  : i- and j-slopes of neutral surfaces
+      !!               wslpj()     at w-points. 
+      !!
+      !! History :
+      !!   8.1  !  99-03  (G. Madec, A. Jouzeau)  Original code
+      !!   8.5  !  02-06  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step inedx
+      
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   &
+         zfw, ze3w, zn2, zf20,       &  ! temporary scalars
+         zaht, zaht_min
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zn, zah, zhw, zross            ! workspace
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ldf_eiv : eddy induced velocity coefficients'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   key_autotasking'
+      ENDIF
+      
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+         
+         ! 0. Local initialization
+         ! -----------------------
+         zn   (:,jj) = 0.e0
+         zhw  (:,jj) = 5.e0
+         zah  (:,jj) = 0.e0
+         zross(:,jj) = 0.e0
+         
+         ! 1. Compute lateral diffusive coefficient 
+         ! ----------------------------------------
+
+!CDIR NOVERRCHK 
+         DO jk = 1, jpk
+!CDIR NOVERRCHK 
+            DO ji = 2, jpim1
+               ! Take the max of N^2 and zero then take the vertical sum 
+               ! of the square root of the resulting N^2 ( required to compute 
+               ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
+               zn2 = MAX( rn2(ji,jj,jk), 0.e0 )
+               ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+               zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)
+               ! Compute elements required for the inverse time scale of baroclinic
+               ! eddies using the isopycnal slopes calculated in ldfslp.F : 
+               ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+               zah(ji,jj) = zah(ji,jj) + zn2   &
+                              * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)    &
+                                + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) )   &
+                              * ze3w
+               zhw(ji,jj) = zhw(ji,jj) + ze3w
+            END DO 
+         END DO 
+ 
+!CDIR NOVERRCHK 
+         DO ji = 2, jpim1
+            zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 )
+            ! Rossby radius at w-point taken < 40km and  > 2km
+            zross(ji,jj) = MAX( MIN( .4 * zn(ji,jj) / zfw, 40.e3 ), 2.e3 )
+            ! Compute aeiw by multiplying Ro^2 and T^-1
+            aeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1)
+            ! Take the minimum between aeiw and 1000m^2/s for depth levels
+            ! lower than 20 (21 in w- point)
+            IF( mbathy(ji,jj) <= 21. ) aeiw(ji,jj) = MIN( aeiw(ji,jj), 1000. )
+         END DO
+
+         ! Decrease the coefficient in the tropics (20N-20S) 
+         zf20 = 2. * omega * sin( rad * 20. )
+         DO ji = 2, jpim1
+            aeiw(ji,jj) = MIN( 1., ABS( ff(ji,jj) / zf20 ) ) * aeiw(ji,jj)
+         END DO
+  
+         ! ORCA R05: Take the minimum between aeiw  and 1000m2/s
+         IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05
+            DO ji = 2, jpim1
+               aeiw(ji,jj) = MIN( aeiw(ji,jj), 1000. )
+            END DO
+         ENDIF
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+
+      ! lateral boundary condition on aeiw 
+      CALL lbc_lnk( aeiw, 'W', 1. )
+
+      ! Average the diffusive coefficient at u- v- points 
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            aeiu(ji,jj) = .5 * (aeiw(ji,jj) + aeiw(ji+1,jj  ))
+            aeiv(ji,jj) = .5 * (aeiw(ji,jj) + aeiw(ji  ,jj+1))
+         END DO 
+      END DO 
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+
+      ! lateral boundary condition on aeiu, aeiv 
+      CALL lbc_lnk( aeiu, 'U', 1. )
+      CALL lbc_lnk( aeiv, 'V', 1. )
+
+      ! ORCA R05: add a space variation on aht (=aeiv except at the equator and river mouth)
+      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN
+         zf20     = 2. * omega * SIN( rad * 20. )
+         zaht_min = 100.                              ! minimum value for aht
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zaht      = ( 1. -  MIN( 1., ABS( ff(ji,jj) / zf20 ) ) ) * ( aht0 - zaht_min )  &
+                  &      + aht0 * upsrnfh(ji,jj)                          ! enhanced near river mouths
+               ahtu(ji,jj) = MAX( zaht_min, aeiu(ji,jj) ) + zaht
+               ahtv(ji,jj) = MAX( zaht_min, aeiv(ji,jj) ) + zaht
+               ahtw(ji,jj) = MAX( zaht_min, aeiw(ji,jj) ) + zaht
+            END DO
+         END DO
+      ENDIF
+
+   END SUBROUTINE ldf_eiv
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                             k-j-i loops
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_eiv ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv  ***
+      !!
+      !! ** Purpose :   Compute the eddy induced velocity coefficient from the
+      !!      growth rate of baroclinic instability.
+      !!
+      !! ** Method :
+      !!
+      !! ** Action : - uslp(),  : i- and j-slopes of neutral surfaces
+      !!             - vslp()      at u- and v-points, resp.
+      !!             - wslpi(),  : i- and j-slopes of neutral surfaces
+      !!             - wslpj()     at w-points. 
+      !!
+      !! History :
+      !!   8.1  !  99-03  (G. Madec, A. Jouzeau)  Original code
+      !!   8.5  !  02-06  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt     ! ocean time-step inedx
+      
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   &
+         zfw, ze3w, zn2, zf20,       &  ! temporary scalars
+         zaht, zaht_min
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zn, zah, zhw, zross            ! workspace
+      !!----------------------------------------------------------------------
+      
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ldf_eiv : eddy induced velocity coefficients'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+      
+      ! 0. Local initialization
+      ! -----------------------
+      zn   (:,:) = 0.e0
+      zhw  (:,:) = 5.e0
+      zah  (:,:) = 0.e0
+      zross(:,:) = 0.e0
+
+
+      ! 1. Compute lateral diffusive coefficient 
+      ! ----------------------------------------
+
+      DO jk = 1, jpk
+#   if defined key_vectopt_loop  &&  ! defined key_autotasking
+!CDIR NOVERRCHK 
+         DO ji = 1, jpij   ! vector opt.
+            ! Take the max of N^2 and zero then take the vertical sum
+            ! of the square root of the resulting N^2 ( required to compute
+            ! internal Rossby radius Ro = .5 * sum_jpk(N) / f
+            zn2 = MAX( rn2(ji,1,jk), 0.e0 )
+            zn(ji,1) = zn(ji,1) + SQRT( zn2 ) * fse3w(ji,1,jk)
+            ! Compute elements required for the inverse time scale of baroclinic
+            ! eddies using the isopycnal slopes calculated in ldfslp.F :
+            ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+            ze3w = fse3w(ji,1,jk) * tmask(ji,1,jk)
+               zah(ji,1) = zah(ji,1) + zn2   &
+                              * ( wslpi(ji,1,jk) * wslpi(ji,1,jk)    &
+                                + wslpj(ji,1,jk) * wslpj(ji,1,jk) )   &
+                              * ze3w
+            zhw(ji,1) = zhw(ji,1) + ze3w
+         END DO
+#   else
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK 
+            DO ji = 2, jpim1
+               ! Take the max of N^2 and zero then take the vertical sum 
+               ! of the square root of the resulting N^2 ( required to compute 
+               ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
+               zn2 = MAX( rn2(ji,jj,jk), 0.e0 )
+               zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)
+               ! Compute elements required for the inverse time scale of baroclinic
+               ! eddies using the isopycnal slopes calculated in ldfslp.F : 
+               ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+               ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+               zah(ji,jj) = zah(ji,jj) + zn2   &
+                              * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)    &
+                                + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) )  &
+                              * ze3w
+               zhw(ji,jj) = zhw(ji,jj) + ze3w
+            END DO 
+         END DO 
+#   endif
+      END DO 
+
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK 
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 )
+            ! Rossby radius at w-point taken < 40km and  > 2km
+            zross(ji,jj) = MAX( MIN( .4 * zn(ji,jj) / zfw, 40.e3 ), 2.e3 )
+            ! Compute aeiw by multiplying Ro^2 and T^-1
+            aeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1)
+            ! Take the minimum between aeiw and 1000m^2/s for depth levels
+            ! lower than 20 (21 in w- point)
+            IF( mbathy(ji,jj) <= 21. ) aeiw(ji,jj) = MIN( aeiw(ji,jj), 1000. )
+         END DO
+      END DO
+
+      ! Decrease the coefficient in the tropics (20N-20S) 
+         zf20 = 2. * omega * sin( rad * 20. )
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            aeiw(ji,jj) = MIN( 1., ABS( ff(ji,jj) / zf20 ) ) * aeiw(ji,jj)
+         END DO
+      END DO
+
+      ! ORCA R05: Take the minimum between aeiw  and 1000m2/s
+      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               aeiw(ji,jj) = MIN( aeiw(ji,jj), 1000. )
+            END DO
+         END DO
+      ENDIF
+
+      ! lateral boundary condition on aeiw 
+      CALL lbc_lnk( aeiw, 'W', 1. )
+
+      ! Average the diffusive coefficient at u- v- points 
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) )
+            aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) )
+         END DO 
+      END DO 
+
+      ! lateral boundary condition on aeiu, aeiv
+      CALL lbc_lnk( aeiu, 'U', 1. )
+      CALL lbc_lnk( aeiv, 'V', 1. )
+
+      ! ORCA R05: add a space variation on aht (=aeiv except at the equator and river mouth)
+      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN
+         zf20     = 2. * omega * SIN( rad * 20. )
+         zaht_min = 100.                              ! minimum value for aht
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zaht      = ( 1. -  MIN( 1., ABS( ff(ji,jj) / zf20 ) ) ) * ( aht0 - zaht_min )  &
+                  &      + aht0 * upsrnfh(ji,jj)                          ! enhanced near river mouths
+               ahtu(ji,jj) = MAX( zaht_min, aeiu(ji,jj) ) + zaht
+               ahtv(ji,jj) = MAX( zaht_min, aeiv(ji,jj) ) + zaht
+               ahtw(ji,jj) = MAX( zaht_min, aeiw(ji,jj) ) + zaht
+            END DO
+         END DO
+      ENDIF
+
+   END SUBROUTINE ldf_eiv
+
+#endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE ldf_eiv             ! Empty routine
+   END SUBROUTINE ldf_eiv
+#endif
+
+   !!======================================================================
+END MODULE ldfeiv
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90	(revision 4)
@@ -0,0 +1,29 @@
+#if defined key_traldf_eiv
+   !!----------------------------------------------------------------------
+   !!                   ***  ldfeiv_substitute.h90  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute fsaei. the eddy induced velocity coeff.
+   !!      with a constant or 1D or 2D or 3D array, using CPP macro.
+   !!----------------------------------------------------------------------
+#  if defined key_traldf_c3d
+!   'traldf_c3d' :                           eiv: 3D coefficient
+#    define   fsaeiu(i,j,k)   aeiu(i,j,k)
+#    define   fsaeiv(i,j,k)   aeiv(i,j,k)
+#    define   fsaeiw(i,j,k)   aeiw(i,j,k)
+#  elif defined key_traldf_c2d
+!   'traldf_c2d' :                           eiv: 2D coefficient
+#    define   fsaeiu(i,j,k)   aeiu(i,j)
+#    define   fsaeiv(i,j,k)   aeiv(i,j)
+#    define   fsaeiw(i,j,k)   aeiw(i,j)
+#  elif defined key_traldf_c1d
+!   'traldf_c1d' :                           eiv: 1D coefficient
+#    define   fsaeiu(i,j,k)   aeiu(k)
+#    define   fsaeiv(i,j,k)   aeiv(k)
+#    define   fsaeiw(i,j,k)   aeiw(k)
+#  else
+!   Default option :                          eiv: Constant coefficient
+#    define   fsaeiu(i,j,k)   aeiv0
+#    define   fsaeiv(i,j,k)   aeiv0
+#    define   fsaeiw(i,j,k)   aeiv0
+#  endif
+#endif
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldfslp.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 4)
@@ -0,0 +1,821 @@
+MODULE ldfslp
+   !!======================================================================
+   !!                       ***  MODULE  ldfslp  ***
+   !! Ocean physics: slopes of neutral surfaces
+   !!======================================================================
+#if   defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                      Rotation of lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   ldf_slp      : compute the slopes of neutral surface
+   !!   ldf_slp_mxl  : compute the slopes of iso-neutral surface
+   !!   ldf_slp_init : initialization of the slopes computation
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce
+   USE ldfdyn_oce
+   USE phycst          ! physical constants
+   USE zdfmxl          ! mixed layer depth
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC ldf_slp        ! routine called by step.F90
+
+   !! * Share module variables
+   LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp = .TRUE.     ! slopes flag
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &
+      uslp, wslpi,         &  ! i_slope at U- and W-points
+      vslp, wslpj             ! j-slope at V- and W-points
+   
+   !! * Module variables
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+      omlmask                 ! mask of the surface mixed layer at T-pt
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      uslpml, wslpiml,     &  ! i_slope at U- and W-points just below
+   !                          ! the surface mixed layer
+      vslpml, wslpjml         ! j_slope at V- and W-points just below
+   !                          ! the surface mixed layer
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE ldf_slp( kt, prd, pn2 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp  ***
+      !! 
+      !! ** Purpose :   Compute the slopes of neutral surface (slope of iso-
+      !!      pycnal surfaces referenced locally) ('key_traldfiso').
+      !!
+      !! ** Method  :   The slope in the i-direction is computed at U- and 
+      !!      W-points (uslp, wslpi) and the slope in the j-direction is 
+      !!      computed at V- and W-points (vslp, wslpj).
+      !!      They are bounded by 1/100 over the whole ocean, and within the
+      !!      surface layer they are bounded by the distance to the surface
+      !!      ( slope<= depth/l  where l is the length scale of horizontal
+      !!      diffusion (here, aht=2000m2/s ==> l=20km with a typical velocity
+      !!      of 10cm/s)
+      !!        A horizontal shapiro filter is applied to the slopes
+      !!        'key_s_coord' defined: add to the previously computed slopes
+      !!      the slope of the model level surface.
+      !!        macro-tasked on horizontal slab (jk-loop)  (2, jpk-1)
+      !!      [slopes already set to zero at level 1, and to zero or the ocean
+      !!      bottom slope ('key_s_coord' defined) at level jpk in inildf]
+      !!
+      !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and  j-slopes 
+      !!               of now neutral surfaces at u-, w- and v- w-points, resp.
+      !!
+      !! History :
+      !!   7.0  !  94-12  (G. Madec, M. Imbard)  Original code
+      !!   8.0  !  97-06  (G. Madec)  optimization, lbc
+      !!   8.1  !  99-10  (A. Jouzeau)  NEW profile
+      !!   8.5  !  99-10  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce            , zgru  => ua,  &  ! use ua as workspace
+                           zgrv  => va,  &  ! use va as workspace
+                           zwy   => ta,  &  ! use ta as workspace
+                           zwz   => sa      ! use sa as workspace
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
+         prd,                            &  ! in situ density
+         pn2                                ! Brunt-Vaisala frequency (locally ref.)
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk      ! dummy loop indices
+#if defined key_partial_steps
+      INTEGER  ::   iku, ikv  ! temporary integers
+#endif
+      REAL(wp) ::   &
+         zeps, zmg, zm05g, zcoef1, zcoef2,   &  ! temporary scalars
+         zau, zbu, zav, zbv,                 &
+         zai, zbi, zaj, zbj,                &
+         zcofu, zcofv, zcofw,                &
+         z1u, z1v, z1wu, z1wv,               &
+         zalpha
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zww
+      !!----------------------------------------------------------------------
+
+      
+      ! 0. Initialization (first time-step only)
+      !    --------------
+      
+      IF( kt == nit000 ) CALL ldf_slp_init
+      
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      
+      zeps  =  1.e-20
+      zmg   = -1.0 / g
+      zm05g = -0.5 / g
+
+      zww(:,:,:) = 0.e0
+      zwz(:,:,:) = 0.e0
+
+      ! horizontal density gradient computation
+      DO jk = 1, jpk
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj  ,jk) - prd(ji,jj,jk) ) 
+               zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji  ,jj+1,jk) - prd(ji,jj,jk) ) 
+            END DO
+         END DO
+      END DO
+
+#if defined key_partial_steps
+      ! partial steps correction at the bottom ocean level (zps_hde routine)
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            ! last ocean level
+            iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1
+            ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1
+            zgru(ji,jj,iku) = gru(ji,jj) 
+            zgrv(ji,jj,ikv) = grv(ji,jj)               
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+#endif
+
+      ! Slopes of isopycnal surfaces just below the mixed layer
+      ! -------------------------------------------------------
+      
+      CALL ldf_slp_mxl( prd, pn2 )
+      
+      !-------------------synchro---------------------------------------------
+
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         ! I.  slopes at u and v point
+         ! ===========================
+         
+         
+         ! I.1. Slopes of isopycnal surfaces
+         ! ---------------------------------
+         ! uslp = d/di( prd ) / d/dz( prd )
+         ! vslp = d/dj( prd ) / d/dz( prd )
+         
+         ! Local vertical density gradient evaluated from N^2
+         ! zwy = d/dz(prd)= - ( prd ) / g * mk(pn2) -- at t point
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwy(ji,jj,jk) = zmg * ( prd(ji,jj,jk) + 1. )                &
+                  &          * ( pn2(ji,jj,jk) + pn2(ji,jj,jk+1) )       &
+                  &          / MAX( tmask(ji,jj,jk) + tmask (ji,jj,jk+1), 1. )
+            END DO
+         END DO
+         
+         ! Slope at u and v points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! horizontal and vertical density gradient at u- and v-points
+               zau = 1. / e1u(ji,jj) * zgru(ji,jj,jk)
+               zav = 1. / e2v(ji,jj) * zgrv(ji,jj,jk)
+               zbu = 0.5 * ( zwy(ji,jj,jk) + zwy(ji+1,jj  ,jk) )
+               zbv = 0.5 * ( zwy(ji,jj,jk) + zwy(ji  ,jj+1,jk) )
+               ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
+               !                   kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbu = MIN( zbu, -100.*ABS( zau ), -7.e+3/fse3u(ji,jj,jk)*ABS( zau ) )
+               zbv = MIN( zbv, -100.*ABS( zav ), -7.e+3/fse3v(ji,jj,jk)*ABS( zav ) )
+               ! uslp and vslp output in zwz and zww, resp.
+               zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
+#if defined key_s_coord 
+               zwz (ji,jj,jk) = ( zau / ( zbu - zeps ) * ( 1. - zalpha)   &
+                  &        + zalpha * uslpml(ji,jj)   &
+                  &        * ( fsdepu(ji,jj,jk) - .5*fse3u(ji,jj,1) )   &
+                  &        / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5. ) )   &
+                  &        * umask(ji,jj,jk)
+               zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )
+               zww (ji,jj,jk) = ( zav / ( zbv - zeps ) * ( 1. - zalpha)   &
+                  &        + zalpha * vslpml(ji,jj)   &
+                  &        * ( fsdepv(ji,jj,jk) - .5*fse3v(ji,jj,1) )   &
+                  &         / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) )   &
+                  &        * vmask(ji,jj,jk)
+#else
+               ! z-coord and partial steps slope computed in the same way
+               zwz (ji,jj,jk) = ( zau / ( zbu - zeps ) * ( 1. - zalpha)    &
+                  &        + zalpha * uslpml(ji,jj)    &
+                  &        * ( fsdept(ji,jj,jk) - .5*fse3u(ji,jj,1))    &
+                  &        / MAX (hmlpt(ji,jj),hmlpt(ji+1,jj),5.) )    &
+                  &        * umask (ji,jj,jk)
+               zalpha = MAX(omlmask(ji,jj,jk),omlmask(ji,jj+1,jk))
+               zww (ji,jj,jk) = ( zav / ( zbv - zeps ) * ( 1. - zalpha)    &
+                  &        + zalpha * vslpml(ji,jj)    &
+                  &        * ( fsdept(ji,jj,jk) - .5*fse3v(ji,jj,1))    &
+                  &        / MAX(hmlpt(ji,jj),hmlpt(ji,jj+1),5.) )    &
+                  &        * vmask (ji,jj,jk)
+#endif
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   end of slab
+      !                                                ! ===============
+
+
+         ! lateral boundary conditions on zww and zwz
+         CALL lbc_lnk( zwz, 'U', -1. )
+         CALL lbc_lnk( zww, 'V', -1. )
+
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         
+         ! Shapiro filter applied in the horizontal direction
+         zcofu = 1. / 16.
+         zcofv = 1. / 16.
+         DO jj = 2, jpjm1, jpj-3   ! row jj=2 and =jpjm1 only
+            DO ji = 2, jpim1  
+               !uslop
+               uslp(ji,jj,jk) = zcofu * (       zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +     zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*(zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +     zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.* zwz(ji  ,jj  ,jk)                       )
+               ! vslop
+               vslp(ji,jj,jk) = zcofv * (       zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +     zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*(zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +     zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.* zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+
+         DO jj = 3, jpj-2
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! uslop
+               uslp(ji,jj,jk) = zcofu * (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)      &
+                  &                       +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)      &
+                  &                       +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zwz(ji  ,jj  ,jk)                       )
+               ! vslop
+               vslp(ji,jj,jk) = zcofv * (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)      &
+                  &                       +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)      &
+                  &                       + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)      &
+                  &                       +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )    &
+                  &                       + 4.*  zww(ji,jj    ,jk)                       )
+            END DO
+         END DO
+
+         ! decrease along coastal boundaries
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               z1u  = ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk) )*.5
+               z1v  = ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk) )*.5
+               z1wu = ( umask(ji,jj,jk)   + umask(ji,jj,jk+1) )*.5
+               z1wv = ( vmask(ji,jj,jk)   + vmask(ji,jj,jk+1) )*.5
+               uslp(ji,jj,jk) = uslp(ji,jj,jk) * z1u * z1wu
+               vslp(ji,jj,jk) = vslp(ji,jj,jk) * z1v * z1wv
+            END DO
+         END DO
+
+
+         IF( lk_sco ) THEN
+            ! Add the slope of level surfaces
+            ! -----------------------------------
+            ! 'key_s_coord' defined but not 'key_traldfiso' the computation is done
+            ! in inildf, ldfslp never called
+            ! 'key_s_coord' and 'key_traldfiso' defined, the slope of level surfaces
+            ! is added to the slope of isopycnal surfaces.
+            ! c a u t i o n : minus sign as fsdep has positive value 
+         
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  uslp(ji,jj,jk) = uslp(ji,jj,jk) - 1. / e1u(ji,jj)   &
+                     &           * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) )
+                  vslp(ji,jj,jk) = vslp(ji,jj,jk) - 1. / e2v(ji,jj)   &
+                     &           * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) )
+               END DO
+            END DO
+         ENDIF
+
+
+         ! II. Computation of slopes at w point
+         ! ====================================
+         
+         
+         ! II.1 Slopes of isopycnal surfaces
+         ! ---------------------------------
+         ! wslpi = mij( d/di( prd ) / d/dz( prd )
+         ! wslpj = mij( d/dj( prd ) / d/dz( prd )
+         
+         
+         ! Local vertical density gradient evaluated from N^2
+         !     zwy = d/dz(prd)= - mk ( prd ) / g * pn2 -- at w point
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwy (ji,jj,jk) = zm05g * pn2 (ji,jj,jk) *   &
+                  &                     ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. )
+            END DO
+         END DO
+         
+         ! Slope at w point
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! horizontal density i-gradient at w-points
+               zcoef1 = MAX( zeps, umask(ji-1,jj,jk  )+umask(ji,jj,jk  )    &
+                  &               +umask(ji-1,jj,jk-1)+umask(ji,jj,jk-1) )
+               zcoef1 = 1. / ( zcoef1 * e1t (ji,jj) )
+               zai = zcoef1 * (  zgru(ji  ,jj,jk  ) + zgru(ji  ,jj,jk-1)   &
+                  &            + zgru(ji-1,jj,jk-1) + zgru(ji-1,jj,jk  ) ) * tmask (ji,jj,jk)
+               ! horizontal density j-gradient at w-points
+               zcoef2 = MAX( zeps, vmask(ji,jj-1,jk  )+vmask(ji,jj,jk-1)   &
+                  &               +vmask(ji,jj-1,jk-1)+vmask(ji,jj,jk  ) )
+               zcoef2 = 1.0 / ( zcoef2 *  e2t (ji,jj) )
+               zaj = zcoef2 * (  zgrv(ji,jj  ,jk  ) + zgrv(ji,jj  ,jk-1)   &
+                  &            + zgrv(ji,jj-1,jk-1) + zgrv(ji,jj-1,jk  ) ) * tmask (ji,jj,jk)
+               ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+               !                   static instability:
+               !                   kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbi = MIN( zwy (ji,jj,jk),- 100.*ABS(zai), -7.e+3/fse3w(ji,jj,jk)*ABS(zai) )
+               zbj = MIN( zwy (ji,jj,jk), -100.*ABS(zaj), -7.e+3/fse3w(ji,jj,jk)*ABS(zaj) )
+               ! wslpi and wslpj output in zwz and zww, resp.
+               zalpha = MAX(omlmask(ji,jj,jk),omlmask(ji,jj,jk-1))
+               zwz(ji,jj,jk) = ( zai / ( zbi - zeps) * ( 1. - zalpha )   &
+                  &            + zalpha * wslpiml(ji,jj)   &
+                  &            * fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj),10. ) )   &
+                  &            * tmask (ji,jj,jk)
+               zww(ji,jj,jk) = ( zaj / ( zbj - zeps) * ( 1. - zalpha )   &
+                  &            + zalpha * wslpjml(ji,jj)   &
+                  &            * fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj),10. ) )   &
+                  &            * tmask (ji,jj,jk)
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   end of slab
+      !                                                ! ===============
+
+
+      ! lateral boundary conditions on zwz and zww
+      CALL lbc_lnk( zwz, 'T', -1. )
+      CALL lbc_lnk( zww, 'T', -1. )
+
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         ! Shapiro filter applied in the horizontal direction
+
+         DO jj = 2, jpjm1, jpj-3   ! row jj=2 and =jpjm1
+            DO ji = 2, jpim1
+               zcofw = tmask(ji,jj,jk)/16.
+               wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                  &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                  &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                  &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                  &                + 4.*  zwz(ji  ,jj  ,jk)                        ) * zcofw
+
+               wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                  &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                  &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                  &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                  &                + 4.*  zww(ji  ,jj  ,jk)                        ) * zcofw
+            END DO
+         END DO
+         
+         DO jj = 3, jpj-2
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcofw = tmask(ji,jj,jk)/16.
+               wslpi(ji,jj,jk) = (        zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk)     &
+                  &                +      zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk)     &
+                  &                + 2.*( zwz(ji  ,jj-1,jk) + zwz(ji-1,jj  ,jk)     &
+                  &                +      zwz(ji+1,jj  ,jk) + zwz(ji  ,jj+1,jk) )   &
+                  &                + 4.*  zwz(ji  ,jj  ,jk)                        ) * zcofw
+
+               wslpj(ji,jj,jk) = (        zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk)     &
+                  &                +      zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk)     &
+                  &                + 2.*( zww(ji  ,jj-1,jk) + zww(ji-1,jj  ,jk)     &
+                  &                +      zww(ji+1,jj  ,jk) + zww(ji  ,jj+1,jk) )   &
+                  &                + 4.*  zww(ji  ,jj  ,jk)                        ) * zcofw
+            END DO
+         END DO
+         
+         ! decrease the slope along the boundaries
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               z1u = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) *.5
+               z1v = ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) *.5
+               wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * z1u * z1v
+               wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * z1u * z1v
+            END DO
+         END DO
+         
+         IF( lk_sco ) THEN
+         
+            ! Slope of level surfaces
+            ! -----------------------
+            ! 'key_s_coord' defined but not 'key_traldfiso' the computation is done
+            ! in inildf, ldfslp never called
+            ! 'key_s_coord' and 'key_traldfiso' defined, the slope of level surfaces
+            ! is added to the slope of isopycnal surfaces.
+         
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  wslpi(ji,jj,jk) = wslpi(ji,jj,jk) - 1. / e1t(ji,jj)   &
+                     &                                   * ( fsdepuw(ji+1,jj,jk) - fsdepuw(ji,jj,jk) )
+                  wslpj(ji,jj,jk) = wslpj(ji,jj,jk) - 1. / e2t(ji,jj)   &
+                     &                                   * ( fsdepvw(ji,jj+1,jk) - fsdepvw(ji,jj,jk) )
+               END DO
+            END DO
+         ENDIF
+         
+         ! III. Specific grid points
+         ! -------------------------
+
+         IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN
+            !                                        ! =======================
+            ! Horizontal diffusion in                !  ORCA_R4 configuration 
+            ! specific area                          ! =======================
+            !
+            !                                             ! Gibraltar Strait
+            uslp ( mi0(69):mi1(71) , mj0(50):mj1(53) , jk ) = 0.0e0
+            vslp ( mi0(68):mi1(71) , mj0(51):mj1(53) , jk ) = 0.0e0
+            wslpi( mi0(69):mi1(71) , mj0(51):mj1(53) , jk ) = 0.0e0
+            wslpj( mi0(69):mi1(71) , mj0(51):mj1(53) , jk ) = 0.0e0
+
+            !                                             ! Mediterrannean Sea
+            uslp ( mi0(71):mi1(90) , mj0(49):mj1(56) , jk ) = 0.0e0
+            vslp ( mi0(70):mi1(90) , mj0(50):mj1(56) , jk ) = 0.0e0
+            wslpi( mi0(71):mi1(90) , mj0(50):mj1(56) , jk ) = 0.0e0
+            wslpj( mi0(71):mi1(90) , mj0(50):mj1(56) , jk ) = 0.0e0
+         ENDIF
+         !                                             ! ===============
+      END DO                                           !   end of slab
+      !                                                ! ===============       
+
+      
+      ! III Lateral boundary conditions on all slopes (uslp, vslp,
+      ! -------------------------------             wslpi,wslpj )
+      CALL lbc_lnk( uslp , 'U', -1. )
+      CALL lbc_lnk( vslp , 'V', -1. )
+      CALL lbc_lnk( wslpi, 'W', -1. )
+      CALL lbc_lnk( wslpj, 'W', -1. )
+
+   END SUBROUTINE ldf_slp
+
+
+   SUBROUTINE ldf_slp_mxl( prd, pn2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_slp_mxl  ***
+      !! ** Purpose :
+      !!     Compute the slopes of iso-neutral surface (slope of isopycnal
+      !!   surfaces referenced locally) just above the mixed layer.
+      !!
+      !! ** Method :
+      !!      The slope in the i-direction is computed at u- and w-points
+      !!   (uslp, wslpi) and the slope in the j-direction is computed at
+      !!   v- and w-points (vslp, wslpj).
+      !!   They are bounded by 1/100 over the whole ocean, and within the
+      !!   surface layer they are bounded by the distance to the surface
+      !!   ( slope<= depth/l  where l is the length scale of horizontal
+      !!   diffusion (here, aht=2000m2/s ==> l=20km with a typical velocity
+      !!   of 10cm/s)
+      !!
+      !! ** Action :
+      !!      Compute uslp, wslpi, and vslp, wslpj, the i- and  j-slopes
+      !!   of now neutral surfaces at u-, w- and v- w-points, resp.
+      !!
+      !! History :
+      !!   8.1  !  99-10  (A. Jouzeau)  Original code
+      !!   8.5  !  99-10  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce           , zgru  => ua,  &  ! ua, va used as workspace and set to hor. 
+                          zgrv  => va      ! density gradient in ldf_slp
+
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
+         prd,                           &  ! in situ density
+         pn2                              ! Brunt-Vaisala frequency (locally ref.)
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk             ! dummy loop indices
+      INTEGER  ::   ik, ikm1               ! temporary integers
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zwy                               ! temporary workspace
+      REAL(wp) ::   &
+         zeps, zmg, zm05g,              &  ! temporary scalars
+         zcoef1, zcoef2,                &  !    "         "
+         zau, zbu, zav, zbv,            &  !    "         "
+         zai, zbi, zaj, zbj                !    "         "
+      !!----------------------------------------------------------------------
+
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+
+      zeps  =  1.e-20
+      zmg   = -1.0 / g
+      zm05g = -0.5 / g
+
+
+      uslpml (1,:) = 0.e0      ;      uslpml (jpi,:) = 0.e0
+      vslpml (1,:) = 0.e0      ;      vslpml (jpi,:) = 0.e0
+      wslpiml(1,:) = 0.e0      ;      wslpiml(jpi,:) = 0.e0
+      wslpjml(1,:) = 0.e0      ;      wslpjml(jpi,:) = 0.e0
+
+      ! surface mixed layer mask
+
+      ! mask for mixed layer
+      DO jk = 1, jpk
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+         jj = 1
+         DO ji = 1, jpij   ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+# endif
+               ! mixed layer interior (mask = 1) and exterior (mask = 0)
+               ik = nmln(ji,jj) - 1
+               IF( jk <= ik ) THEN
+                  omlmask(ji,jj,jk) = 1.e0
+               ELSE
+                  omlmask(ji,jj,jk) = 0.e0
+               ENDIF
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+            END DO
+# endif
+         END DO
+      END DO
+
+
+      ! Slopes of isopycnal surfaces just before bottom of mixed layer
+      ! --------------------------------------------------------------
+      ! uslpml = d/di( prd ) / d/dz( prd )
+      ! vslpml = d/dj( prd ) / d/dz( prd )
+
+      ! Local vertical density gradient evaluated from N^2
+      ! zwy = d/dz(prd)= - ( prd ) / g * mk(pn2) -- at t point
+
+      !-----------------------------------------------------------------------
+      zwy(:,jpj) = 0.e0
+      zwy(jpi,:) = 0.e0
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            ik = MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) )
+            ! if ik = jpk take jpkm1 values
+            ik = MIN( ik,jpkm1 )
+            zwy(ji,jj) = zmg * ( prd(ji,jj,ik) + 1. )   &
+               &             * ( pn2(ji,jj,ik) + pn2(ji,jj,ik+1) )   &
+               &             / MAX( tmask(ji,jj,ik) + tmask (ji,jj,ik+1), 1. )
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+      ! lateral boundary conditions on zwy
+      CALL lbc_lnk( zwy, 'U', -1. )
+
+      ! Slope at u points
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            ! horizontal and vertical density gradient at u-points
+            ik = MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) )
+            ik = MIN( ik,jpkm1 )
+            zau = 1./ e1u(ji,jj) * zgru(ji,jj,ik)
+            zbu = 0.5*( zwy(ji,jj) + zwy(ji+1,jj) )
+            ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
+            !                         kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbu = MIN( zbu, -100.*ABS(zau), -7.e+3/fse3u(ji,jj,ik)*ABS(zau) )
+            ! uslpml
+            uslpml (ji,jj) = zau / ( zbu - zeps ) * umask (ji,jj,ik)
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! lateral boundary conditions on uslpml
+      CALL lbc_lnk( uslpml, 'U', -1. )
+
+      ! Local vertical density gradient evaluated from N^2
+      !     zwy = d/dz(prd)= - ( prd ) / g * mk(pn2) -- at t point
+      zwy ( :, jpj) = 0.0e0
+      zwy ( jpi, :) = 0.0e0
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            ik = MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) )
+            ik = MIN( ik,jpkm1 )
+            zwy(ji,jj) = zmg * ( prd(ji,jj,ik) + 1. )   &
+               &             * ( pn2(ji,jj,ik) + pn2(ji,jj,ik+1) )   &
+               &             / MAX( tmask(ji,jj,ik) + tmask (ji,jj,ik+1), 1. )
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! lateral boundary conditions on zwy
+      CALL lbc_lnk( zwy, 'V', -1. )
+
+      ! Slope at v points
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            ! horizontal and vertical density gradient at v-points
+            ik = MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) )
+            ik = MIN( ik,jpkm1 )
+            zav = 1./ e2v(ji,jj) * zgrv(ji,jj,ik)
+            zbv = 0.5*( zwy(ji,jj) + zwy(ji,jj+1) )
+            ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
+            !                         kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbv = MIN( zbv, -100.*ABS(zav), -7.e+3/fse3v(ji,jj,ik)*ABS( zav ) )
+            ! vslpml
+            vslpml (ji,jj) = zav / ( zbv - zeps ) * vmask (ji,jj,ik)
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! lateral boundary conditions on vslpml
+      CALL lbc_lnk( vslpml, 'V', -1. )
+
+      ! wslpiml = mij( d/di( prd ) / d/dz( prd )
+      ! wslpjml = mij( d/dj( prd ) / d/dz( prd )
+
+
+      ! Local vertical density gradient evaluated from N^2
+      ! zwy = d/dz(prd)= - mk ( prd ) / g * pn2 -- at w point
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij   ! vector opt. (forced unrolling)
+# else
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+# endif
+            ik = nmln(ji,jj)+1
+            ik = MIN( ik,jpk )
+            ikm1 = MAX ( 1, ik-1)
+            zwy (ji,jj) = zm05g * pn2 (ji,jj,ik) *     &
+               &             ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. )
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! Slope at w point
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            ik = nmln(ji,jj)+1
+            ik = MIN( ik,jpk )
+            ikm1 = MAX ( 1, ik-1)
+            ! horizontal density i-gradient at w-points
+            zcoef1 = MAX( zeps, umask(ji-1,jj,ik  )+umask(ji,jj,ik  )   &
+               &               +umask(ji-1,jj,ikm1)+umask(ji,jj,ikm1) )
+            zcoef1 = 1. / ( zcoef1 * e1t (ji,jj) )
+            zai = zcoef1 * (  zgru(ji  ,jj,ik  ) + zgru(ji  ,jj,ikm1)   &
+               &            + zgru(ji-1,jj,ikm1) + zgru(ji-1,jj,ik  ) ) * tmask (ji,jj,ik)
+            ! horizontal density j-gradient at w-points
+            zcoef2 = MAX( zeps, vmask(ji,jj-1,ik  )+vmask(ji,jj,ikm1)    &
+               &               +vmask(ji,jj-1,ikm1)+vmask(ji,jj,ik  ) )
+            zcoef2 = 1.0 / ( zcoef2 *  e2t (ji,jj) )
+            zaj = zcoef2 * (  zgrv(ji,jj  ,ik  ) + zgrv(ji,jj  ,ikm1)   &
+               &            + zgrv(ji,jj-1,ikm1) + zgrv(ji,jj-1,ik  ) ) * tmask (ji,jj,ik)
+            ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+            !                   static instability:
+            !                   kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbi = MIN ( zwy (ji,jj),- 100.*ABS(zai), -7.e+3/fse3w(ji,jj,ik)*ABS(zai) )
+            zbj = MIN ( zwy (ji,jj), -100.*ABS(zaj), -7.e+3/fse3w(ji,jj,ik)*ABS(zaj) )
+            ! wslpiml and wslpjml
+            wslpiml (ji,jj) = zai / ( zbi - zeps) * tmask (ji,jj,ik)
+            wslpjml (ji,jj) = zaj / ( zbj - zeps) * tmask (ji,jj,ik)
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! lateral boundary conditions on wslpiml and wslpjml
+      CALL lbc_lnk( wslpiml, 'W', -1. )
+      CALL lbc_lnk( wslpjml, 'W', -1. )
+
+   END SUBROUTINE ldf_slp_mxl
+
+
+   SUBROUTINE ldf_slp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_slp_init  ***
+      !!
+      !! ** Purpose :   Initialization for the isopycnal slopes computation
+      !!
+      !! ** Method  :   read the nammbf namelist and check the parameter 
+      !!      values called by tra_dmp at the first timestep (nit000)
+      !!
+      !! History :
+      !!  8.5  ! 02-06 (G. Madec) original code
+      !!----------------------------------------------------------------------
+      !! * local declarations
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      
+      
+      ! Parameter control and print
+      ! ---------------------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ldf_slp : direction of lateral mixing'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      ! Direction of lateral diffusion (tracers and/or momentum)
+      ! ------------------------------
+      ! set the slope to zero (even in s-coordinates)
+
+      uslp (:,:,:) = 0.e0
+      vslp (:,:,:) = 0.e0
+      wslpi(:,:,:) = 0.e0
+      wslpj(:,:,:) = 0.e0
+
+      uslpml (:,:) = 0.e0
+      vslpml (:,:) = 0.e0
+      wslpiml(:,:) = 0.e0
+      wslpjml(:,:) = 0.e0
+
+      IF( ln_traldf_hor .OR. ln_dynldf_hor ) THEN
+
+         ! geopotential diffusion in s-coordinates on tracers and/or momentum
+         ! The slopes of s-surfaces are computed once (no call to ldfslp in step)
+         ! The slopes for momentum diffusion are i- or j- averaged of those on tracers
+
+         ! set the slope of diffusion to the slope of s-surfaces
+         !      ( c a u t i o n : minus sign as fsdep has positive value )
+         DO jk = 1, jpk
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  uslp (ji,jj,jk) = -1. / e1u(ji,jj) * umask(ji,jj,jk)   &
+                     &                               * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) )
+                  vslp (ji,jj,jk) = -1. / e2v(ji,jj) * vmask(ji,jj,jk)   &
+                     &                               * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) )
+                  wslpi(ji,jj,jk) = -1. / e1t(ji,jj) * tmask(ji,jj,jk)   &
+                     &                               * ( fsdepuw(ji+1,jj,jk) - fsdepuw(ji,jj,jk) )
+                  wslpj(ji,jj,jk) = -1. / e2t(ji,jj) * tmask(ji,jj,jk)   &
+                     &                               * ( fsdepvw(ji,jj+1,jk) - fsdepvw(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+
+         ! Lateral boundary conditions on the slopes
+         CALL lbc_lnk( uslp , 'U', -1. )
+         CALL lbc_lnk( vslp , 'V', -1. )
+         CALL lbc_lnk( wslpi, 'W', -1. )
+         CALL lbc_lnk( wslpj, 'W', -1. )
+      ENDIF
+
+   END SUBROUTINE ldf_slp_init
+
+#else
+   !!------------------------------------------------------------------------
+   !!   Dummy module :                 NO Rotation of lateral mixing tensor
+   !!------------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_ldfslp = .FALSE.    ! slopes flag
+CONTAINS
+   SUBROUTINE ldf_slp( kt, prd, pn2 )        ! Dummy routine
+      INTEGER, INTENT(in) :: kt 
+      REAL,DIMENSION(:,:,:), INTENT(in) :: prd, pn2
+      WRITE(*,*) kt, prd, pn2
+   END SUBROUTINE ldf_slp
+#endif
+
+   !!======================================================================
+END MODULE ldfslp
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldftra.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 4)
@@ -0,0 +1,267 @@
+MODULE ldftra
+   !!======================================================================
+   !!                       ***  MODULE  ldftra  ***
+   !! Ocean physics:  lateral diffusivity coefficient 
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   ldf_tra_init : initialization, namelist read, and parameters control
+   !!   ldf_tra_c3d   : 3D eddy viscosity coefficient initialization
+   !!   ldf_tra_c2d   : 2D eddy viscosity coefficient initialization
+   !!   ldf_tra_c1d   : 1D eddy viscosity coefficient initialization
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE ldfslp          ! ???
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! *  Routine accessibility
+   PUBLIC ldf_tra_init   ! called by opa.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE ldf_tra_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_tra_init  ***
+      !! 
+      !! ** Purpose :   initializations of the horizontal ocean tracer physics
+      !!
+      !! ** Method :
+      !!      Direction of lateral diffusion (tracers and/or momentum)
+      !!        ln_traldf_iso  = T : initialize the slope arrays to zero
+      !!        ln_traldf_geop = T : initialise the slope arrays to the i- and
+      !!                            j-slopes of s-surfaces
+      !!      Eddy diffusivity and eddy induced velocity cefficients:
+      !!         default option   : constant coef. aht0, aeiv0 (namelist)
+      !!        'key_traldf_c1d': depth dependent coef. defined in 
+      !!                            in ldf_tra_c1d routine
+      !!        'key_traldf_c2d': latitude and longitude dependent coef.
+      !!                            defined in ldf_tra_c2d routine
+      !!        'key_traldf_c3d': latitude, longitude, depth dependent coef.
+      !!                            defined in ldf_tra_c3d routine
+      !!
+      !!      N.B. User defined include files.  By default, 3d and 2d coef.
+      !!      are set to a constant value given in the namelist and the 1d
+      !!      coefficients are initialized to a hyperbolic tangent vertical
+      !!      profile.
+      !!
+      !! Reference :
+      !!      Madec, G. and M. Imbard, 1996, A global ocean mesh to overcome
+      !!      the North Pole singularity, Climate Dynamics, 12, 381-388.
+      !!
+      !! History :
+      !!        !  07-97  (G. Madec)  from inimix.F split in 2 routines
+      !!        !  08-97  (G. Madec)  multi dimensional coefficients
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Local declarations
+      INTEGER ::   ioptio               ! ???
+      LOGICAL ::   ll_print = .FALSE.   ! =T print eddy coef. in numout
+       
+      NAMELIST/nam_traldf/ ln_traldf_lap  , ln_traldf_bilap,                &
+         &                 ln_traldf_level, ln_traldf_hor, ln_traldf_iso,   &
+         &                 aht0, ahtb0, aeiv0
+      !!----------------------------------------------------------------------
+
+      !  Define the lateral tracer physics parameters
+      ! =============================================
+    
+      ! Read Namelist nam_traldf : Lateral physics on tracers
+      REWIND( numnam )
+      READ  ( numnam, nam_traldf )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'ldf_tra : lateral tracer physics'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '          Namelist nam_traldf : set lateral mixing parameters (type, direction, coefficients)'
+         WRITE(numout,*) '             laplacian operator          ln_traldf_lap   = ', ln_traldf_lap
+         WRITE(numout,*) '             bilaplacian operator        ln_traldf_bilap = ', ln_traldf_bilap
+         WRITE(numout,*) '             iso-level                   ln_traldf_level = ', ln_traldf_level
+         WRITE(numout,*) '             horizontal (geopotential)   ln_traldf_hor   = ', ln_traldf_hor
+         WRITE(numout,*) '             iso-neutral                 ln_traldf_iso   = ', ln_traldf_iso
+         WRITE(numout,*) '             lateral eddy diffusivity             aht0   = ', aht0
+         WRITE(numout,*) '             background hor. diffusivity          ahtb0  = ', ahtb0
+         WRITE(numout,*) '             eddy induced velocity coef.          aeiv0  = ', aeiv0
+         WRITE(numout,*)
+      ENDIF
+
+      ! Parameter control
+
+      ! control the input
+      ioptio = 0
+      IF( ln_traldf_lap   )   ioptio = ioptio + 1
+      IF( ln_traldf_bilap )   ioptio = ioptio + 1
+      IF( ioptio /= 1 )   THEN
+          IF(lwp) WRITE(numout,cform_err)
+          IF(lwp) WRITE(numout,*) '          use ONE of the 2 lap/bilap operator type on tracer'
+          nstop = nstop + 1
+      ENDIF
+      ioptio = 0
+      IF( ln_traldf_level )   ioptio = ioptio + 1
+      IF( ln_traldf_hor   )   ioptio = ioptio + 1
+      IF( ln_traldf_iso   )   ioptio = ioptio + 1
+      IF( ioptio /= 1 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          use only ONE direction (level/hor/iso)'
+         nstop = nstop + 1
+      ENDIF
+
+      ! ... Choice of the lateral scheme used
+      IF( lk_traldf_eiv ) THEN
+         IF(lwp) WRITE(numout,*) '          eddy induced velocity on tracers'
+            IF( .NOT.ln_traldf_iso .OR. ln_traldf_bilap ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion'
+            nstop = nstop + 1
+         ENDIF
+      ENDIF
+
+      IF( .NOT. lk_sco ) THEN          ! horizontal = iso-level except in s-coordinate
+         ln_traldf_level = ln_traldf_level .OR. ln_traldf_hor
+         ln_traldf_hor   = .FALSE.
+      ENDIF
+      IF( .NOT.lk_ldfslp .AND. ( ln_traldf_iso .OR. .NOT.ln_traldf_hor ) ) THEN
+         IF( .NOT.lk_esopa ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          the rotation of the diffusive tensor require key_ldfslp'
+            nstop = nstop + 1
+         ENDIF
+      ENDIF
+
+      l_traldf_lap     =       ln_traldf_lap   .AND. ln_traldf_level     ! iso-level   laplacian operator
+      l_traldf_bilap   =       ln_traldf_bilap .AND. ln_traldf_level     ! iso-level bilaplacian operator
+      l_traldf_bilapg  =       ln_traldf_bilap .AND. ln_traldf_hor       ! geopotential bilap. (s-coord)
+      l_traldf_iso     =       ln_traldf_lap   .AND.                  &  ! laplacian operator
+         &                   ( ln_traldf_iso   .OR.  ln_traldf_hor )  &  ! iso-neutral (z-coord) or horizontal (s-coord)
+         &                                     .AND. .NOT.lk_zps
+      l_traldf_iso_zps =       ln_traldf_lap   .AND.                  &  ! laplacian operator
+         &                   ( ln_traldf_iso   .OR.  ln_traldf_hor )  &  ! iso-neutral (partial steps)
+         &                                     .AND. lk_zps              ! or geopotential in mixed partial steps/s-coord
+      l_trazdf_iso    = .FALSE.
+      l_trazdf_iso_vo = .FALSE.
+      IF( l_traldf_iso     )   l_trazdf_iso = .TRUE.
+      IF( l_traldf_iso_zps )   l_trazdf_iso = .TRUE.
+#if defined key_vectopt_memory
+      IF( l_trazdf_iso ) THEN
+         l_trazdf_iso    = .FALSE.
+         l_trazdf_iso_vo = .TRUE.
+      ENDIF
+#endif
+
+      ioptio = 0
+      IF( l_traldf_lap     )   ioptio = ioptio + 1
+      IF( l_traldf_bilap   )   ioptio = ioptio + 1
+      IF( l_traldf_bilapg  )   ioptio = ioptio + 1
+      IF( l_traldf_iso     )   ioptio = ioptio + 1
+      IF( l_traldf_iso_zps )   ioptio = ioptio + 1
+      IF( ioptio /= 1 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          this combination of operator and direction has not been implemented'
+         nstop = nstop + 1
+      ENDIF
+      IF( lk_esopa ) THEN
+         l_traldf_lap = .TRUE.   ;   l_traldf_bilap   = .TRUE.   ;   l_traldf_bilapg  = .TRUE.
+         l_traldf_iso = .TRUE.   ;   l_traldf_iso_zps = .TRUE.
+         l_trazdf_iso = .TRUE.   ;   l_trazdf_iso_vo  = .TRUE.
+         IF(lwp ) WRITE(numout,*) '          esopa test: use all lateral physics options'
+      ENDIF
+
+
+      ! ... Space variation of eddy coefficients
+      ioptio = 0
+#if defined key_traldf_c3d
+      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth)'
+      ioptio = ioptio + 1
+#endif
+#if defined key_traldf_c2d
+      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude)'
+      ioptio = ioptio + 1
+#endif
+#if defined key_traldf_c1d
+      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )'
+      ioptio = ioptio + 1
+      IF( lk_sco ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          key_traldf_c1d cannot be used in s-coordinate (key_s_coord)'
+         nstop = nstop + 1
+      ENDIF
+#endif
+      IF( ioptio == 0 ) THEN
+          IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant (default option)'
+        ELSEIF( ioptio > 1 ) THEN
+          IF(lwp) WRITE(numout,cform_err)
+          IF(lwp) WRITE(numout,*) '          use only one of the following keys:',   &
+             &                    ' key_traldf_c3d, key_traldf_c2d, key_traldf_c1d'
+          nstop = nstop + 1
+      ENDIF
+
+      IF( l_traldf_bilap .OR. l_traldf_bilapg ) THEN
+         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion'
+         IF( aht0 > 0 .AND. .NOT. lk_esopa ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          The horizontal diffusivity coef. aht0 must be negative'
+            nstop = nstop + 1
+         ENDIF
+      ELSE
+         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)'
+         IF( aht0 < 0 .AND. .NOT. lk_esopa ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          The horizontal diffusivity coef. aht0 must be positive'
+            nstop = nstop + 1
+         ENDIF
+      ENDIF
+
+
+      !  Lateral eddy diffusivity and eddy induced velocity coefficients
+      ! ================================================================
+
+#if defined key_traldf_c3d
+      CALL ldf_tra_c3d( ll_print )           ! aht = 3D coef. = F( longitude, latitude, depth )
+#elif defined key_traldf_c2d
+      CALL ldf_tra_c2d( ll_print )           ! aht = 2D coef. = F( longitude, latitude )
+#elif defined key_traldf_c1d
+      CALL ldf_tra_c1d( ll_print )           ! aht = 1D coef. = F( depth )
+#else
+                                     ! Constant coefficients
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) ' inildf: constant eddy diffusivity coef.'
+      IF(lwp)WRITE(numout,*) ' ~~~~~~'
+      IF(lwp)WRITE(numout,*) '        ahtu = ahtv = ahtw = aht0 = ', aht0
+      IF( lk_traldf_eiv ) THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) ' inildf: constant eddy induced velocity coef.'
+         IF(lwp)WRITE(numout,*) ' ~~~~~~  '
+         IF(lwp)WRITE(numout,*) '         aeiu = aeiv = aeiw = aeiv0 = ', aeiv0
+      ENDIF
+#endif
+
+   END SUBROUTINE ldf_tra_init
+
+#if defined key_traldf_c3d
+#   include "ldftra_c3d.h90"
+#elif defined key_traldf_c2d
+#   include "ldftra_c2d.h90"
+#elif defined key_traldf_c1d
+#   include "ldftra_c1d.h90"
+#endif
+
+   !!======================================================================
+END MODULE ldftra
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_c1d.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_c1d.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_c1d.h90	(revision 4)
@@ -0,0 +1,131 @@
+   !!----------------------------------------------------------------------
+   !!                      ***  ldftra_c1d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_tra_c1d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldftra_c1d  ***
+      !!              
+      !! ** Purpose :   1D eddy diffusivity coefficient
+      !!
+      !! ** Method  :   1D eddy diffusivity coefficients ( depth )
+      !!       biharmonic operator    : ahtt = defined at T-level
+      !!                                ahtu,ahtv,ahtw never used
+      !!
+      !!       harmonic operator      : ahtt never used
+      !!          -1-  iso-model level: ahtu = ahtv defined at T-level
+      !!                                ahtw never used
+      !!          -2-  isopycnal or   : ahtu = ahtv defined at T-level
+      !!               geopotential     ahtw defined at w-level
+      !!
+      !!       eddy induced velocity
+      !!         always harmonic      : aeiu = aeiv defined at T-level
+      !!				  aeiw defined at w-level
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      LOGICAL, INTENT (in) :: ld_print   ! If true, print arrays in numout
+
+      !! * Local variables
+      INTEGER ::   jk                  ! dummy loop indices
+      REAL(wp) ::   &
+         zkah, zahr, za00 , za01,   &  ! temporary scalars
+         zahf, zahs, zahtf, zahts
+      !!----------------------------------------------------------------------
+
+      IF( lk_traldf_eiv ) THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' inildf : 1D eddy diffusivity and eddy induced velocity coefficients'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~   -- 
+         IF(lwp) WRITE(numout,*)
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' inildf : 1D eddy diffusivity coefficient '
+         IF(lwp) WRITE(numout,*) ' ~~~~~~   -- '
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      ! initialization of the profile
+
+      ! ahts, ahtf: surface and bottom values
+      zahts = aht0
+      zahtf = aht0/4. 
+      ! zkah, zahr: depth of the inflection pt and width of inflection
+      zkah =  -300.
+      zahr =   300.
+      ! computation coefficients
+      za00 = TANH( ( -fsdept(1,1,1  ) - zkah ) / zahr )
+      za01 = TANH( ( -fsdept(1,1,jpk) - zkah ) / zahr )
+      zahf = ( zahts-zahtf ) / ( za00 - za01 )
+      zahs = zahts - zahf * za00
+
+      ! biharmonic operator : (T-point)
+      ! ==================== 
+
+      ! set ahtt at T-level
+      DO jk = 1, jpk
+         ahtt(jk) = zahs + zahf * TANH( (-fsdept(1,1,jk)-zkah) / zahr )
+      END DO
+
+      ! control print
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         aht profile at T-level : '
+         WRITE(numout,*)
+         WRITE(numout,*) ' level    aht          depth t-level ' )
+         DO jk = 1, jpk
+            WRITE(numout,'(i6,2f12.4)') jk, ahtt(jk), fsdept(1,1,jk)
+         END DO
+      ENDIF
+
+      ! harmonic operator : (U-, V-, W-points)
+      ! ================== 
+
+      ! set ahtu = ahtv at T-level, and ahtw at w-level
+      DO jk = 1, jpk
+         ahtu(jk) = zahs + zahf * TANH( ( -fsdept(1,1,jk) - zkah ) / zahr )
+         ahtv(jk) = ahtu(jk)
+         ahtw(jk) = zahs + zahf * TANH( ( -fsdepw(1,1,jk) - zkah ) / zahr )
+      END DO
+
+      ! control print
+      IF(lwp .AND. ld_print ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '         aht profile at T-level : '
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' level    aht          depth t-level '
+         DO jk = 1, jpk
+            IF(lwp) WRITE(numout,"(i6,2f12.4)") jk, ahtu(jk), fsdept(1,1,jk)
+         END DO
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '         aht profile at W-level : '
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '  jk      aht          depth w-level '
+         DO jk = 1, jpk
+            IF(lwp)WRITE(numout,"(i6,2f12.4)") jk, ahtw(jk), fsdepw(1,1,jk)
+         END DO
+      ENDIF
+
+# if defined key_traldf_eiv
+      ! set aeiu = aeiv and set aeiw (here same profile as on aht)
+      aeiu(:) = ahtu(:)
+      aeiv(:) = aeiu(:)
+      aeiw(:) = ahtw(:)
+      
+      ! Control print
+      IF(lwp .AND. ld_print ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '         aeiv profile at T-level : '
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '  jk      aeiv           depth t-level '
+         DO jk = 1, jpk
+            IF(lwp) WRITE(numout,"(i6,2f12.4)") jk, aeiu(jk), fsdept(1,1,jk)
+         END DO
+      ENDIF
+#endif
+
+   END SUBROUTINE ldf_tra_c1d
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_c2d.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_c2d.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_c2d.h90	(revision 4)
@@ -0,0 +1,133 @@
+   !!----------------------------------------------------------------------
+   !!                      ***  ldftra_c2d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_tra_c2d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldftra_c2d  ***
+      !!              
+      !! ** Purpose :   initializations of horizontally non uniform eddy 
+      !!      diffusivity coefficients
+      !!
+      !! ** Method :
+      !!       biharmonic operator    : ahtt = defined at T-level
+      !!                                ahtu,ahtv,ahtw never used
+      !!       harmonic operator (ahtt never used)
+      !!           iso-model level   : ahtu, ahtv defined at u-, v-points
+      !!         isopycnal         : ahtu, ahtv, ahtw defined at u-, v-, w-pts
+      !!         or geopotential   
+      !!       eddy induced velocity
+      !!           always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts
+      !!
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      LOGICAL, INTENT (in) :: ld_print   ! If true, print arrays in numout
+
+      !! * Local variables
+# if defined key_traldf_eiv && defined key_orca_r4
+      INTEGER ::   ji, jj                  ! dummy loop indices
+# endif
+# if defined key_orca_r4
+      INTEGER :: i1, i2, j1, j2
+# endif
+      !!----------------------------------------------------------------------
+
+      IF( lk_traldf_eiv ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' inildf : 2D eddy diffusivity and eddy'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~   --  induced velocity coefficients'
+         IF(lwp) WRITE(numout,*)
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' inildf : 2D eddy diffusivity coefficient'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~   --'
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+
+      ! biharmonic operator : (T-point)
+      ! ====================
+
+      ahtt(:,:) = aht0                ! set ahtt at T-point (here no space variation)
+
+      CALL lbc_lnk( ahtt, 'T', 1. )   ! Lateral boundary conditions on ( ahtt )
+
+      ! Control print
+      IF( lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: 2D ahtt array'
+         CALL prihre( ahtt, jpi, jpj, 1, jpi, 1,   &
+            &                         1, jpj, 1, 1.e-3, numout )
+      ENDIF
+
+
+      ! harmonic operator : (U-, V-, W-points)
+      ! ==================
+
+      ahtu(:,:) = aht0                ! set ahtu = ahtv at u- and v-points,
+      ahtv(:,:) = aht0                ! and ahtw at w-point (idem T-point)
+      ahtw(:,:) = aht0                ! (here no space variation)
+
+      CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions
+      CALL lbc_lnk( ahtv, 'V', 1. )   ! (no change of sign)
+      CALL lbc_lnk( ahtw, 'W', 1. )
+
+      ! Control print
+      IF( lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtu array'
+         CALL prihre( ahtu, jpi, jpj, 1, jpi, 1,   &
+            &                         1, jpj, 1, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtv array'
+         CALL prihre( ahtv, jpi, jpj, 1, jpi, 1,   &
+            &                         1, jpj, 1, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtw array'
+         CALL prihre( ahtw, jpi, jpj, 1, jpi, 1,   &
+            &                         1, jpj, 1, 1.e-3, numout )
+      ENDIF
+
+# if defined key_traldf_eiv
+      ! set aeiu = aeiv at u- and v-points, and aeiw at w-point (idem T-point)
+      ! (here no space variation)
+      aeiu(:,:) = aeiv0
+      aeiv(:,:) = aeiv0
+      aeiw(:,:) = aeiv0
+      
+      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN
+         !                                 ! Cancel eiv in Gibraltar strait
+         aeiu( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
+         aeiv( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
+         aeiw( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
+         !                                 ! Cancel eiv in Mediterrannean sea
+         aeiu( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
+         aeiv( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
+         aeiw( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
+      ENDIF
+
+      ! Lateral boundary conditions on ( aeiu, aeiv, aeiw )
+      CALL lbc_lnk( aeiu, 'U', 1. )
+      CALL lbc_lnk( aeiv, 'V', 1. )
+      CALL lbc_lnk( aeiw, 'W', 1. )
+
+      ! Control print
+      IF( lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiu array'
+         CALL prihre(aeiu,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiv array'
+         CALL prihre(aeiv,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiw array'
+         CALL prihre(aeiw,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF
+
+# endif
+
+   END SUBROUTINE ldf_tra_c2d
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_c3d.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_c3d.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_c3d.h90	(revision 4)
@@ -0,0 +1,128 @@
+   !!----------------------------------------------------------------------
+   !!                        ***  ldftra_c3d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_tra_c3d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldftra_c3d  ***
+      !!                
+      !! ** Purpose :
+      !!     initializations of non uniform horizontal eddy diffusivity coef.
+      !!
+      !! ** Method :
+      !!      3D eddy diffusivity coefficients ( longitude, latitude, depth )
+      !!
+      !!       biharmonic operator    : ahtt = defined at T-level
+      !!                                ahtu,ahtv,ahtw never used
+      !!
+      !!       harmonic operator (ahtt never used)
+      !!         iso-model level   : ahtu, ahtv defined at u-, v-points
+      !!         isopycnal         : ahtu, ahtv, ahtw defined at u-, v-, w-pts
+      !!         or geopotential
+      !!
+      !!       eddy induced velocity
+      !!         always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts
+      !!
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Arguments
+      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk                   ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      IF( lk_traldf_eiv ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' inildf : 3D eddy diffusivity and eddy induced velocity coefficients'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~   --  '
+         IF(lwp) WRITE(numout,*)
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' inildf : 3D eddy diffusivity coefficient'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~   -- '
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+
+      ! biharmonic operator   (T-point)
+      ! -------------------
+
+      ahtt(:,:,:) = aht0              ! set ahtt at T-point (here no space variation)
+
+      CALL lbc_lnk( ahtt, 'T', 1. )   ! Lateral boundary conditions on ( ahtt )
+
+      IF(lwp .AND. ld_print ) THEN                    ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtt at k = 1'
+         CALL prihre( ahtt(:,:,1), jpi, jpj, 1, jpi, 1,   &
+            &                                1, jpj, 1, 1.e-3, numout )
+      ENDIF
+
+
+      ! harmonic operator   (U-, V-, W-points)
+      ! ----------------- 
+
+      ahtu(:,:,:) = aht0              ! set ahtu = ahtv at u- and v-points,
+      ahtv(:,:,:) = aht0              ! and ahtw at w-point
+      ahtw(:,:,:) = aht0              ! (here example: no space variation)
+      
+      CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions
+      CALL lbc_lnk( ahtv, 'V', 1. )
+      CALL lbc_lnk( ahtw, 'W', 1. )
+
+      IF(lwp .AND. ld_print ) THEN                    ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtu at k = 1'
+         CALL prihre( ahtu(:,:,1), jpi, jpj, 1, jpi, 1,   &
+            &                                1, jpj, 1, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtv at k = 1'
+         CALL prihre( ahtv(:,:,1), jpi, jpj, 1, jpi, 1,   &
+            &                                1, jpj, 1, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtw at k = 1'
+         CALL prihre( ahtw(:,:,1), jpi, jpj, 1, jpi, 1,   &
+            &                                1, jpj, 1, 1.e-3, numout )
+      ENDIF
+
+# if defined key_traldf_eiv
+      aeiu(:,:,:) = aeiv0            ! set aeiu = aeiv at u- and v-points,
+      aeiv(:,:,:) = aeiv0            ! and aeiw at w-point
+      aeiw(:,:,:) = aeiv0            ! (here example: no space variation)
+
+      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN
+         !                                 ! Cancel eiv in Gibraltar strait
+         aeiu( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
+         aeiv( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
+         aeiw( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
+         !                                 ! Cancel eiv in Mediterrannean sea
+         aeiu( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
+         aeiv( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
+         aeiw( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
+      ENDIF
+
+      CALL lbc_lnk( aeiu, 'U', 1. )   ! Lateral boundary conditions 
+      CALL lbc_lnk( aeiv, 'V', 1. )
+      CALL lbc_lnk( aeiw, 'W', 1. )
+# endif
+
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiu at k = 1'
+         CALL prihre(aeiu(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiv at k = 1'
+         CALL prihre(aeiv(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiw at k = 1'
+         CALL prihre(aeiw(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF
+
+END SUBROUTINE ldf_tra_c3d
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 4)
@@ -0,0 +1,90 @@
+MODULE ldftra_oce
+   !!=====================================================================
+   !!                      ***  MODULE  ldftra_oce  ***
+   !! Ocean physics :  lateral tracer mixing coefficient defined in memory 
+   !!=====================================================================
+   !!
+   !! ** Purpose : - Define in memory lateral tracer mixing coefficients
+   !!
+   !! History :
+   !!   9.0  !  02-11  (G. Madec)  Original code (from common.h)
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 ,  LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce         ! ocean parameters
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !!----------------------------------------------------------------------
+   !! Lateral eddy diffusivity coefficients (tracers)
+   !!----------------------------------------------------------------------
+
+   LOGICAL , PUBLIC ::              & !!! ** lateral mixing namelist (nam_traldf) **
+      ln_traldf_lap   = .TRUE.  ,   &  ! laplacian operator
+      ln_traldf_bilap = .FALSE. ,   &  ! bilaplacian operator
+      ln_traldf_level = .FALSE. ,   &  ! iso-level direction
+      ln_traldf_hor   = .FALSE. ,   &  ! horizontal (geopotential) direction
+      ln_traldf_iso   = .TRUE.         ! iso-neutral direction
+
+   REAL(wp), PUBLIC ::              & !!! ** lateral mixing namelist (namldf) **
+      aht0  = 2000._wp     ,        &  ! lateral eddy diffusivity (m2/s)
+      ahtb0 =    0._wp     ,        &  ! lateral background eddy diffusivity (m2/s)
+      aeiv0 = 2000._wp                 ! eddy induced velocity coefficient (m2/s)
+
+   LOGICAL , PUBLIC ::              &  ! flag of the lateral diff. scheme used 
+      l_traldf_lap         ,        &  ! iso-level laplacian operator
+      l_traldf_bilap       ,        &  ! iso-level bilaplacian operator
+      l_traldf_bilapg      ,        &  ! geopotential bilap. (s-coord)
+      l_traldf_iso         ,        &  ! iso-neutral laplacian or horizontal lapacian (s-coord)
+      l_trazdf_iso         ,        &  ! idem for the vertical component
+      l_trazdf_iso_vo      ,        &  ! idem with vectopt_memory
+      l_traldf_iso_zps                 ! iso-neutral laplacian (partial steps)
+
+#if defined key_traldf_c3d
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  ! ** 3D coefficients **
+#elif defined key_traldf_c2d
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   &  ! ** 2D coefficients **
+#elif defined key_traldf_c1d
+   REAL(wp), PUBLIC, DIMENSION(jpk)         ::   &  ! ** 1D coefficients **
+#else
+   REAL(wp), PUBLIC                         ::   &  ! ** 0D coefficients **
+#endif
+      ahtt, ahtu, ahtv, ahtw                ! T-, U-, V-, W-points coefficients
+
+
+#if defined key_traldf_eiv
+   !!----------------------------------------------------------------------
+   !!   'key_traldf_eiv'                              eddy induced velocity
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_traldf_eiv   = .TRUE.   ! eddy induced velocity flag
+      
+# if defined key_traldf_c3d
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  ! ** 3D coefficients **
+# elif defined key_traldf_c2d
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   &  ! ** 2D coefficients **
+# elif defined key_traldf_c1d
+   REAL(wp), PUBLIC, DIMENSION(jpk)         ::   &  ! ** 1D coefficients **
+# else
+   REAL(wp), PUBLIC                         ::   &  ! ** 0D coefficients **
+# endif
+      aeiu, aeiv, aeiw                              ! U-, V-, W-points  induced velocity coef. (m2/s)
+
+# if defined key_diaeiv
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::    &
+      u_eiv,      &  ! The three component of the eddy induced velocity (m/s)
+      v_eiv,      &  ! saved for diagnostics and/or outputs
+      w_eiv          ! 
+# endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                           NO eddy induced velocity
+   !!----------------------------------------------------------------------
+   LOGICAL , PUBLIC, PARAMETER ::   lk_traldf_eiv   = .FALSE.   ! eddy induced velocity flag
+   REAL(wp), PUBLIC ::   aeiu, aeiv, aeiw
+#endif
+
+   !!----------------------------------------------------------------------
+END MODULE ldftra_oce
Index: /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_substitute.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_substitute.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/LDF/ldftra_substitute.h90	(revision 4)
@@ -0,0 +1,31 @@
+   !!----------------------------------------------------------------------
+   !!                    *** ldftra_substitute.h90  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute fsaht. the eddy diffusivity coeff.
+   !!      with a constant or 1D or 2D or 3D array, using CPP macro.
+   !!----------------------------------------------------------------------
+#if defined key_traldf_c3d
+!   'key_traldf_c3d' :                 aht: 3D coefficient
+#       define   fsahtt(i,j,k)   ahtt(i,j,k)
+#       define   fsahtu(i,j,k)   ahtu(i,j,k)
+#       define   fsahtv(i,j,k)   ahtv(i,j,k)
+#       define   fsahtw(i,j,k)   ahtw(i,j,k)
+#elif defined key_traldf_c2d
+!   'key_traldf_c2d' :                 aht: 2D coefficient
+#       define   fsahtt(i,j,k)   ahtt(i,j)
+#       define   fsahtu(i,j,k)   ahtu(i,j)
+#       define   fsahtv(i,j,k)   ahtv(i,j)
+#       define   fsahtw(i,j,k)   ahtw(i,j)
+#elif defined key_traldf_c1d
+!   'key_traldf_c1d' :                aht: 1D coefficient
+#       define   fsahtt(i,j,k)   ahtt(k)
+#       define   fsahtu(i,j,k)   ahtu(k)
+#       define   fsahtv(i,j,k)   ahtv(k)
+#       define   fsahtw(i,j,k)   ahtw(k)
+#else
+!   Default option :             aht: Constant coefficient
+#      define   fsahtt(i,j,k)   aht0
+#      define   fsahtu(i,j,k)   aht0
+#      define   fsahtv(i,j,k)   aht0
+#      define   fsahtw(i,j,k)   aht0
+#endif
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obc_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obc_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obc_oce.F90	(revision 4)
@@ -0,0 +1,304 @@
+MODULE obc_oce
+   !!==============================================================================
+   !!                       ***  MODULE obc_oce   ***
+   !! Open Boundary Cond. :   define related variables
+   !!==============================================================================
+#if defined key_obc
+   !!----------------------------------------------------------------------
+   !!   'key_obc' :                                 Open Boundary Condition
+   !!----------------------------------------------------------------------
+   !! history :
+   !!  8.0   01/91   (CLIPPER)  Original code 
+   !!  8.5   06/02   (C. Talandier)  modules
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce         ! ocean parameters
+   USE obc_par         ! open boundary condition parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !! open boundary variables
+   !!----------------------------------------------------------------------
+   !!
+   !!General variables for open boundaries:
+   !!--------------------------------------
+   INTEGER ::              &
+      numrob = 51   ,      & ! logical units for open boundary input restart files
+      numwob = 52   ,      & ! logical units for open boundary output restart files
+                             !
+      nbobc         ,      & ! number of open boundaries ( 1=< nbobc =< 4 ) 
+      nobc_dta      ,      & !  = 0 use the initial state as obc data
+       !                     !  = 1 read obc data in obcxxx.dta files
+      nmoisold      ,      & ! number of the last read month on the OBC
+      nbef, naft             ! index of the aftera and before fields on the OBC 
+
+   REAL(wp) ::             & !!! open boundary namelist (namobc)
+      rdpein =  1.  ,      &  ! damping time scale for inflow at East open boundary
+      rdpwin =  1.  ,      &  !    "                      "   at West open boundary
+      rdpsin =  1.  ,      &  !    "                      "   at South open boundary
+      rdpnin =  1.  ,      &  !    "                      "   at North open boundary
+      rdpeob = 15.  ,      &  ! damping time scale for the climatology at East open boundary
+      rdpwob = 15.  ,      &  !    "                           "       at West open boundary
+      rdpsob = 15.  ,      &  !    "                           "       at South open boundary
+      rdpnob = 15.  ,      &  !    "                           "       at North open boundary
+      volemp =  1.            ! = 0 the total volume will have the variability of the 
+                              !     surface Flux E-P else (volemp = 1) the volume will be constant
+                              ! = 1 the volume will be constant during all the integration.
+
+   LOGICAL ::              & 
+      lfbceast, lfbcwest,  & ! logical flag for a fixed East and West open boundaries       
+      lfbcnorth, lfbcsouth   ! logical flag for a fixed North and South open boundaries       
+                             ! These logical flags are set to 'true' if damping time 
+                             ! scale are set to 0 in the namelist, for both inflow and outflow).
+
+   REAL(wp), DIMENSION(jpi,jpj) :: &
+      obctmsk                ! mask array identical to tmask, execpt along OBC where it is set to 0
+                             ! it used to calculate the cumulate flux E-P in the obcvol.F90 routine
+         
+   !!-------------------------------------------------------------------------------------------
+   !! Rigid lid case:
+   !!----------------
+   INTEGER ::   nbic ! number of isolated coastlines ( 0 <= nbic <= 3 )
+         
+   INTEGER, DIMENSION(jpnic,0:4,3) ::   &
+      miic, mjic     ! position of isolated coastlines points
+
+   INTEGER, DIMENSION(0:4,3) ::   &
+      mnic           ! number of points on isolated coastlines
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      gcbob          ! right hand side of the barotropic elliptic equation associated
+                     ! with the OBC
+                                             
+   REAL(wp), DIMENSION(jpi,jpj,3) ::   &
+      gcfobc         ! coef. associated with the contribution of isolated coastlines 
+                     ! to the right hand side of the barotropic elliptic equation
+
+   REAL(wp), DIMENSION(3) ::   &
+      gcbic          ! time variation of the barotropic stream function along the 
+                     ! isolated coastlines 
+
+   REAL(wp), DIMENSION(1) ::   &
+      bsfic0         ! barotropic stream function on isolated coastline
+         
+   REAL(wp), DIMENSION(3) ::   &
+      bsfic          ! barotropic stream function on isolated coastline
+         
+   !!-------------------------------------------------------------------------------------------
+   !! East open boundary:
+   !!--------------------
+   INTEGER ::   nie0  , nie1      ! do loop index in mpp case for jpieob
+   INTEGER ::   nie0p1, nie1p1    ! do loop index in mpp case for jpieob+1
+   INTEGER ::   nie0m1, nie1m1    ! do loop index in mpp case for jpieob-1
+   INTEGER ::   nje0  , nje1      ! do loop index in mpp case for jpjed, jpjef
+   INTEGER ::   nje0p1, nje1m1    ! do loop index in mpp case for jpjedp1,jpjefm1
+   INTEGER ::   nje1m2, nje0m1    ! do loop index in mpp case for jpjefm1-1,jpjed
+
+   REAL(wp), DIMENSION(jpj) ::    &
+      bsfeob              ! now barotropic stream fuction computed at the OBC. The corres-
+                          ! ponding bsfn will be computed by the forward time step in dynspg.
+
+   REAL(wp), DIMENSION(jpj,3,3) ::   &
+      bebnd               ! east boundary barotropic streamfunction over 3 rows
+                          ! and 3 time step (now, before, and before before)
+
+   REAL(wp), DIMENSION(jpjed:jpjef) ::   &
+      bfoe                ! now climatology of the east boundary barotropic stream function 
+     
+   REAL(wp), DIMENSION(jpj,jpk) ::   &
+      ufoe, vfoe,       & ! now climatology of the east boundary velocities 
+      tfoe, sfoe,       & ! now climatology of the east boundary temperature and salinity
+      uclie               ! baroclinic componant of the zonal velocity after radiation 
+                          ! in the obcdyn.F90 routine
+
+   REAL(wp), DIMENSION(jpjglo,jpk,1) ::   &
+      uedta, tedta, sedta ! array used for interpolating monthly data on the east boundary
+
+   !!-------------------------------------------------------------------------------------------
+   !! Arrays for radiative East OBC: 
+   !!-------------------------------
+   !!   
+   REAL(wp), DIMENSION(jpj,jpk,3,3) ::   &
+      uebnd, vebnd                  ! baroclinic u & v component of the velocity over 3 rows 
+                                    ! and 3 time step (now, before, and before before)
+
+   REAL(wp), DIMENSION(jpj,jpk,2,2) ::   &
+      tebnd, sebnd                  ! East boundary temperature and salinity over 2 rows 
+                                    ! and 2 time step (now and before)
+
+   REAL(wp), DIMENSION(jpj,jpk) ::   &
+      u_cxebnd, v_cxebnd            ! Zonal component of the phase speed ratio computed with 
+                                    ! radiation of u and v velocity (respectively) at the 
+                                    ! east open boundary (u_cxebnd = cx rdt )
+
+   REAL(wp), DIMENSION(jpj,jpk) ::   &
+      uemsk, vemsk, temsk           ! 2D mask for the East OB
+
+   ! Note that those arrays are optimized for mpp case 
+   ! (hence the dimension jpj is the size of one processor subdomain)
+
+   !!-------------------------------------------------------------------------------------------
+   !! West open boundary:
+   !!--------------------
+   INTEGER ::   niw0  , niw1       ! do loop index in mpp case for jpiwob
+   INTEGER ::   niw0p1, niw1p1     ! do loop index in mpp case for jpiwob+1
+   INTEGER ::   njw0  , njw1       ! do loop index in mpp case for jpjwd, jpjwf
+   INTEGER ::   njw0p1, njw1m1     ! do loop index in mpp case for jpjwdp1,jpjwfm1
+   INTEGER ::   njw1m2, njw0m1     ! do loop index in mpp case for jpjwfm2,jpjwd
+
+   REAL(wp), DIMENSION(jpj) ::   &
+      bsfwob              ! now barotropic stream fuction computed at the OBC. The corres-
+                          ! ponding bsfn will be computed by the forward time step in dynspg.
+
+   REAL(wp), DIMENSION(jpj,3,3) ::   &
+      bwbnd               ! West boundary barotropic streamfunction over
+                          ! 3 rows and 3 time step (now, before, and before before)
+
+   REAL(wp), DIMENSION(jpjwd:jpjwf) ::   &
+      bfow                ! now climatology of the west boundary barotropic stream function
+
+   REAL(wp), DIMENSION(jpj,jpk) ::   &
+      ufow, vfow,       & ! now climatology of the west velocities 
+      tfow, sfow,       & ! now climatology of the west temperature and salinity
+      ucliw               ! baroclinic componant of the zonal velocity after the radiation 
+                          ! in the obcdyn.F90 routine
+
+   REAL(wp), DIMENSION(jpjglo,jpk,1) ::   &
+      uwdta, twdta, swdta ! array used for interpolating monthly data on the west boundary
+
+   !!-------------------------------------------------------------------------------------------
+   !! Arrays for radiative West OBC:
+   !!-------------------------------
+   !!   
+   REAL(wp), DIMENSION(jpj,jpk,3,3) ::   &
+      uwbnd, vwbnd                  ! baroclinic u & v components of the velocity over 3 rows 
+                                    ! and 3 time step (now, before, and before before)
+
+   REAL(wp), DIMENSION(jpj,jpk,2,2) ::   &
+      twbnd, swbnd                  ! west boundary temperature and salinity over 2 rows and 
+                                    ! 2 time step (now and before)
+
+   REAL(wp), DIMENSION(jpj,jpk) ::    &
+      u_cxwbnd, v_cxwbnd            ! Zonal component of the phase speed ratio computed with 
+                                    ! radiation of zonal and meridional velocity (respectively) 
+                                    ! at the west open boundary (u_cxwbnd = cx rdt )
+
+   REAL(wp), DIMENSION(jpj,jpk) ::    &
+      uwmsk, vwmsk, twmsk           ! 2D mask for the West OB
+
+   ! Note that those arrays are optimized for mpp case 
+   ! (hence the dimension jpj is the size of one processor subdomain)
+
+   !!-------------------------------------------------------------------------------------------
+   !! North open boundary:
+   !!---------------------
+   INTEGER ::   nin0  , nin1       ! do loop index in mpp case for jpind, jpinf
+   INTEGER ::   nin0p1, nin1m1     ! do loop index in mpp case for jpindp1, jpinfm1
+   INTEGER ::   nin1m2, nin0m1     ! do loop index in mpp case for jpinfm1-1,jpind
+   INTEGER ::   njn0  , njn1       ! do loop index in mpp case for jpnob
+   INTEGER ::   njn0p1, njn1p1     ! do loop index in mpp case for jpnob+1
+   INTEGER ::   njn0m1, njn1m1     ! do loop index in mpp case for jpnob-1
+
+   REAL(wp), DIMENSION(jpi) ::   &
+      bsfnob              ! now barotropic stream fuction computed at the OBC. The corres-
+                          ! ponding bsfn will be computed by the forward time step in dynspg.
+
+   REAL(wp), DIMENSION(jpi,3,3) ::   &
+      bnbnd               ! north boundary barotropic streamfunction over
+                          ! 3 rows and 3 time step (now, before, and before before)
+
+   REAL(wp), DIMENSION(jpind:jpinf) ::   &
+      bfon                ! now climatology of the north boundary barotropic stream function
+
+   REAL(wp), DIMENSION(jpi,jpk) ::   &  
+      ufon, vfon,       & ! now climatology of the north boundary velocities
+      tfon, sfon,       & ! now climatology of the north boundary temperature and salinity
+      vclin               ! baroclinic componant of the meridian velocity after the radiation
+                          ! in yhe obcdyn.F90 routine
+
+   REAL(wp), DIMENSION(jpiglo,jpk,1) ::   &
+      vndta, tndta, sndta ! array used for interpolating monthly data on the north boundary
+
+   !!-------------------------------------------------------------------------------------------
+   !! Arrays for radiative North OBC:
+   !!--------------------------------
+   !!   
+   REAL(wp), DIMENSION(jpi,jpk,3,3) ::   & 
+      unbnd, vnbnd                  ! baroclinic u & v components of the velocity over 3
+                                    ! rows and 3 time step (now, before, and before before)
+
+   REAL(wp), DIMENSION(jpi,jpk,2,2) ::   & 
+      tnbnd, snbnd                  ! north boundary temperature and salinity over
+                                    ! 2 rows and 2 time step (now and before)
+
+   REAL(wp), DIMENSION(jpi,jpk) ::   &   
+      u_cynbnd, v_cynbnd            ! Meridional component of the phase speed ratio compu-
+                                    ! ted with radiation of zonal and meridional velocity 
+                                    ! (respectively) at the north OB (u_cynbnd = cx rdt )
+
+   REAL(wp), DIMENSION(jpi,jpk) ::   &
+      unmsk, vnmsk, tnmsk           ! 2D mask for the North OB
+
+   ! Note that those arrays are optimized for mpp case 
+   ! (hence the dimension jpj is the size of one processor subdomain)
+   
+   !!-------------------------------------------------------------------------------------------
+   !! South open boundary:
+   !!---------------------
+   INTEGER ::   nis0  , nis1       ! do loop index in mpp case for jpisd, jpisf
+   INTEGER ::   nis0p1, nis1m1     ! do loop index in mpp case for jpisdp1, jpisfm1
+   INTEGER ::   nis1m2, nis0m1     ! do loop index in mpp case for jpisfm1-1,jpisd
+   INTEGER ::   njs0  , njs1       ! do loop index in mpp case for jpsob
+   INTEGER ::   njs0p1, njs1p1     ! do loop index in mpp case for jpsob+1
+
+   REAL(wp), DIMENSION(jpi) ::    & 
+      bsfsob              ! now barotropic stream fuction computed at the OBC.The corres-
+                          ! ponding bsfn will be computed by the forward time step in dynspg.
+   REAL(wp), DIMENSION(jpi,3,3) ::   & 
+      bsbnd               ! south boundary barotropic stream function over
+                          ! 3 rows and 3 time step (now, before, and before before)
+
+   REAL(wp), DIMENSION(jpisd:jpisf) ::    & 
+      bfos                ! now climatology of the south boundary barotropic stream function
+
+   REAL(wp), DIMENSION(jpi,jpk) ::    & 
+      ufos, vfos,       & ! now climatology of the south boundary velocities 
+      tfos, sfos,       & ! now climatology of the south boundary temperature and salinity
+      vclis               ! baroclinic componant of the meridian velocity after the radiation 
+                          ! in the obcdyn.F90 routine
+
+   REAL(wp), DIMENSION(jpiglo,jpk,1) ::    &  
+      vsdta, tsdta, ssdta   ! array used for interpolating monthly data on the south boundary
+
+   !!-------------------------------------------------------------------------------------------
+   !! Arrays for radiative South OBC:
+   !!--------------------------------
+   !!                        computed by the forward time step in dynspg.
+   REAL(wp), DIMENSION(jpi,jpk,3,3) ::   & 
+      usbnd, vsbnd                  ! baroclinic u & v components of the velocity over 3 
+                                    ! rows and 3 time step (now, before, and before before)
+
+   REAL(wp), DIMENSION(jpi,jpk,2,2) ::   &
+      tsbnd, ssbnd                  ! south boundary temperature and salinity over
+                                    ! 2 rows and 2 time step (now and before)
+
+   REAL(wp), DIMENSION(jpi,jpk) ::   &
+      u_cysbnd, v_cysbnd            ! Meridional component of the phase speed ratio compu-
+                                    ! ted with radiation of zonal and meridional velocity 
+                                    ! (repsectively) at the south OB (u_cynbnd = cx rdt )
+
+   REAL(wp), DIMENSION(jpi,jpk) ::   &
+      usmsk, vsmsk, tsmsk           ! 2D mask for the South OB
+
+   ! Note that those arrays are optimized for mpp case 
+   ! (hence the dimension jpj is the size of one processor subdomain)
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+#endif
+   !!======================================================================
+END MODULE obc_oce
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obc_par.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obc_par.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obc_par.F90	(revision 4)
@@ -0,0 +1,85 @@
+MODULE obc_par
+   !!==============================================================================
+   !!                  ***  MODULE obc_par   ***
+   !! Open Boundary Cond. :   define related parameters
+   !!==============================================================================
+#if defined key_obc
+   !!----------------------------------------------------------------------
+   !!   'key_obc' :                                 Open Boundary Condition
+   !!----------------------------------------------------------------------
+   !! history :
+   !!  8.0   01/91   (CLIPPER)  Original code 
+   !!  9.0   06/02   (C. Talandier)  modules
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce         ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .TRUE.   ! Ocean Boundary Condition flag
+
+# if defined key_eel_r5
+   !!----------------------------------------------------------------------
+   !!   'key_eel_r5' :                                 EEL R5 configuration
+   !!----------------------------------------------------------------------
+#    include "obc_par_EEL_R5.h90"
+
+# else
+   !!---------------------------------------------------------------------
+   !! open boundary parameter
+   !!---------------------------------------------------------------------
+   !! * EAST open boundary
+   LOGICAL, PARAMETER ::     &
+      lpeastobc = .FALSE.       ! to active or not the East open boundary
+   INTEGER, PARAMETER ::     &
+      jpieob  = jpiglo-2,    &  ! i-localization of the East open boundary (must be ocean U-point)
+      jpjed   =        2,    &  ! j-starting indice of the East open boundary (must be land T-point)
+      jpjef   = jpjglo-1,    &  ! j-ending   indice of the East open boundary (must be land T-point)
+      jpjedp1 =  jpjed+1,    &  ! first ocean point         "                 "
+      jpjefm1 =  jpjef-1        ! last  ocean point         "                 "
+
+   !! * WEST open boundary
+   LOGICAL, PARAMETER ::     &
+      lpwestobc = .FALSE.       ! to active or not the West open boundary
+   INTEGER, PARAMETER ::     &
+      jpiwob  =	       2,    &  ! i-localization of the West open boundary (must be ocean U-point)
+      jpjwd   =	       2,    &  ! j-starting indice of the West open boundary (must be land T-point)
+      jpjwf   = jpjglo-1,    &  ! j-ending   indice of the West open boundary (must be land T-point)
+      jpjwdp1 =  jpjwd+1,    &  ! first ocean point         "                 "
+      jpjwfm1 =  jpjwf-1        ! last  ocean point         "                 "
+
+   !! * NORTH open boundary
+   LOGICAL, PARAMETER ::    &
+      lpnorthobc = .FALSE.      ! to active or not the North open boundary
+   INTEGER, PARAMETER ::     &
+      jpjnob  = jpjglo-2,    &  ! j-localization of the North open boundary (must be ocean V-point)
+      jpind   =        2,    &  ! i-starting indice of the North open boundary (must be land T-point)
+      jpinf   = jpiglo-1,    &  ! i-ending   indice of the North open boundary (must be land T-point)
+      jpindp1 =  jpind+1,    &  ! first ocean point         "                 "
+      jpinfm1 =  jpinf-1        ! last  ocean point         "                 "
+
+   !! * SOUTH open boundary
+   LOGICAL, PARAMETER ::     &
+      lpsouthobc = .FALSE.      ! to active or not the South open boundary
+   INTEGER, PARAMETER ::     &
+      jpjsob  =        2,    &  ! j-localization of the South open boundary (must be ocean V-point)
+      jpisd   =        2,    &  ! i-starting indice of the South open boundary (must be land T-point)
+      jpisf   = jpiglo-1,    &  ! i-ending   indice of the South open boundary (must be land T-point)
+      jpisdp1 =  jpisd+1,    &  ! first ocean point         "                 "
+      jpisfm1 =  jpisf-1        ! last  ocean point         "                 "
+   
+   INTEGER, PARAMETER ::     &
+      jpnic = 2700              ! maximum number of isolated coastlines points 
+
+# endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                         NO open boundary condition
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .FALSE.  ! Ocean Boundary Condition flag
+#endif
+
+   !!======================================================================
+END MODULE obc_par
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obc_par_EEL_R5.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obc_par_EEL_R5.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obc_par_EEL_R5.h90	(revision 4)
@@ -0,0 +1,48 @@
+   !!----------------------------------------------------------------------
+   !!                  ***  obc_par_EEL_R5.h90  ***
+   !!----------------------------------------------------------------------
+   !! open boundary parameter : EEL5 configuration
+   !!---------------------------------------------------------------------
+   !! * EAST open boundary
+   LOGICAL, PARAMETER ::     &
+      lpeastobc = .TRUE.       ! to active or not the East open boundary
+   INTEGER, PARAMETER ::     &
+      jpieob  = jpiglo-2,    &  ! i-localization of the East open boundary (must be ocean U-point)
+      jpjed   =        2,    &  ! j-starting indice of the East open boundary (must be land T-point)
+      jpjef   = jpjglo-1,    &  ! j-ending   indice of the East open boundary (must be land T-point)
+      jpjedp1 =  jpjed+1,    &  ! first ocean point         "                 "
+      jpjefm1 =  jpjef-1        ! last  ocean point         "                 "
+
+   !! * WEST open boundary
+   LOGICAL, PARAMETER ::     &
+      lpwestobc = .TRUE.       ! to active or not the West open boundary
+   INTEGER, PARAMETER ::     &
+      jpiwob  =	       2,    &  ! i-localization of the West open boundary (must be ocean U-point)
+      jpjwd   =	       2,    &  ! j-starting indice of the West open boundary (must be land T-point)
+      jpjwf   = jpjglo-1,    &  ! j-ending   indice of the West open boundary (must be land T-point)
+      jpjwdp1 =  jpjwd+1,    &  ! first ocean point         "                 "
+      jpjwfm1 =  jpjwf-1        ! last  ocean point         "                 "
+
+   !! * NORTH open boundary
+   LOGICAL, PARAMETER ::    &
+      lpnorthobc = .FALSE.     ! to active or not the North open boundary
+   INTEGER, PARAMETER ::     &
+      jpjnob  = jpjglo-2,    &  ! j-localization of the North open boundary (must be ocean V-point)
+      jpind   =        2,    &  ! i-starting indice of the North open boundary (must be land T-point)
+      jpinf   = jpiglo-1,    &  ! i-ending   indice of the North open boundary (must be land T-point)
+      jpindp1 =  jpind+1,    &  ! first ocean point         "                 "
+      jpinfm1 =  jpinf-1        ! last  ocean point         "                 "
+
+   !! * SOUTH open boundary
+   LOGICAL, PARAMETER ::     &
+      lpsouthobc = .FALSE.     ! to active or not the South open boundary
+   INTEGER, PARAMETER ::     &
+      jpjsob  =        2,    &  ! j-localization of the South open boundary (must be ocean V-point)
+      jpisd   =        2,    &  ! i-starting indice of the South open boundary (must be land T-point)
+      jpisf   = jpiglo-1,    &  ! i-ending   indice of the South open boundary (must be land T-point)
+      jpisdp1 =  jpisd+1,    &  ! first ocean point         "                 "
+      jpisfm1 =  jpisf-1        ! last  ocean point         "                 "
+   
+   INTEGER, PARAMETER ::     &
+      jpnic = 2700              ! maximum number of isolated coastlines points 
+   !!---------------------------------------------------------------------------------------------
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obc_vectopt_loop_substitute.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obc_vectopt_loop_substitute.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obc_vectopt_loop_substitute.h90	(revision 4)
@@ -0,0 +1,25 @@
+   !!----------------------------------------------------------------------
+   !!                 ***  obc_vectopt_loop_substitute.h90  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop starting and inding indices 
+   !!      to allow unrolling of do-loop using CPP macro.
+   !!----------------------------------------------------------------------
+#if defined key_vectopt_loop && defined key_obc
+#  define fs_niw0  jpiwob 
+#  define fs_niw1  jpiwob
+#  define fs_nie0  jpieob 
+#  define fs_nie1  jpieob
+#  define fs_njn0  jpjnob
+#  define fs_njn1  jpjnob
+#  define fs_njs0  jpjsob
+#  define fs_njs1  jpjsob
+#else
+#  define fs_niw0  niw0 
+#  define fs_niw1  niw1
+#  define fs_nie0  nie0 
+#  define fs_nie1  nie1
+#  define fs_njn0  njn0
+#  define fs_njn1  njn1
+#  define fs_njs0  njs0
+#  define fs_njs1  njs1
+#endif
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obccli.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obccli.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obccli.F90	(revision 4)
@@ -0,0 +1,289 @@
+MODULE obccli
+   !!===================================================================================
+   !!                       ***  MODULE  obccli  ***
+   !! Ocean dynamics:   Baroclinic componant of velocities on each open boundary
+   !!===================================================================================
+#if defined key_obc && ! defined key_dynspg_fsc
+   !!-----------------------------------------------------------------------------------
+   !!   'key_obc'               and 
+   !!   'key_dynspg_fsc'
+   !!-----------------------------------------------------------------------------------
+   !!   obc_cli_dyn : Compute the baroclinic componant after the radiation phase
+   !!   obc_cli_dta : Compute the baroclinic componant for the climatological velocities
+   !!-----------------------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers   
+   USE dom_oce         ! ocean space and time domain 
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC obc_cli    ! routine called in obcdyn.F90 and obcdta.F90 (rigid lid case)
+
+   INTERFACE obc_cli
+     MODULE PROCEDURE obc_cli_dyn, obc_cli_dta
+   END INTERFACE
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!-----------------------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!-----------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_cli_dyn( obvel, velcli, obd, obf, obtyp, obl)
+      !!--------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE obc_cli_dyn  ***
+      !!                   
+      !! ** Purpose :   Compute the baroclinic velocities at the open boundaries.
+      !!
+      !! ** Method  :
+      !!      - Compute de barotropic velocity along the considered Open Boundary 
+      !!        and substract it to the total velocity to have baroclinic velotity.
+      !!      - obtyp must be set to | 0 when traiting an East or West OB 
+      !!                             | 1 when traiting a North or South OB.
+      !!      - obl is the lenght of the OB (jpi or jpj) 
+      !!
+      !! History :
+      !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!--------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   & ! OB localization:jpieob or jpiwob for East or West 
+         obd, obf,               & !                 jpjnob or jpjsob for North or South 
+         obl,                    & ! Lenght of the Open Boundary
+         obtyp                     ! Type of Open Boundary: zonal or Meridional 
+      REAL(wp), DIMENSION(:,:), INTENT( out) ::   &
+         velcli                    ! Baroclinic velocity calculated
+      REAL(wp), DIMENSION(:,:,:), INTENT( in ) ::   &
+         obvel                     ! ua or va velocities from obcdyn.F90 routine
+
+      !! * Local declarations
+      INTEGER ::   &   
+         ji, jj, jk, jle, jol         ! loop indices  
+      REAL(wp) ::   zcbl              ! Temporary Baroclinic velocity 
+      REAL(wp), DIMENSION(obl) ::   & 
+         zvelbtpe,                  & ! Barotropic velocity 
+         zhinv                        ! Invert of the local depth 1/H
+      REAL(wp), DIMENSION(obl,jpk) ::   &
+         zmskob,                    & ! Velocity mask
+         zvel                         ! 2D Local velocity on OB
+# if defined key_partial_steps
+      REAL(wp), DIMENSION(obl,jpk) ::   &
+         ze3ob                        ! Vertical scale factor
+# else
+      REAL(wp), DIMENSION(jpk) ::   &
+         ze3ob                        ! Vertical scale factor
+# endif
+      !!--------------------------------------------------------------------------------
+
+      ! 0. Array initialization
+      ! -----------------------
+
+      zhinv(:) = 0.e0
+      zmskob(:,:) = 0.e0
+      zvel(:,:) = 0.e0
+# if defined key_partial_steps
+      ze3ob(:,:) = 0.e0
+# else
+      ze3ob(:) = 0.e0
+# endif
+
+      IF( obtyp == 0 ) THEN            ! Meridional Open Boundary ( East or West OB )
+         DO ji = obd, obf
+            zhinv(:) = hur(ji,:)
+            zmskob(:,:) = umask(ji,:,:)
+            zvel(:,:) = obvel(ji,:,:)
+# if defined key_partial_steps
+            ze3ob(:,:) = fse3u(ji,:,:)
+# else
+            ze3ob(:) = fse3u(:,:,:)
+# endif
+         END DO
+      ELSE                             ! Zonal Open Boundary ( North or South OB )
+         DO jj = obd, obf
+            zhinv(:) = hvr(:,jj)
+            zmskob(:,:) = vmask(:,jj,:)
+            zvel(:,:) = obvel(:,jj,:)
+# if defined key_partial_steps
+            ze3ob(:,:) = fse3v(:,jj,:)
+# else
+            ze3ob(:) = fse3v(:,:,:)
+# endif
+         END DO
+      END IF
+
+      zvelbtpe(:) = 0.e0
+
+      ! 1. vertical sum
+      ! ----------------
+# if defined key_vectopt_loop
+!CDIR NOLOOPCHG
+# endif
+      DO jol = obd, obf ! Vector opt.
+         DO jk = 1, jpkm1
+            DO jle = 1, obl
+               zvelbtpe(jle) = zvelbtpe(jle) + zvel(jle,jk)*zmskob(jle,jk) &
+# if defined key_partial_steps
+                                           * ze3ob(jol,jle,jk)
+# else
+                                           * ze3ob(jk)
+# endif
+            END DO
+         END DO
+      END DO
+
+      ! 2. divide by the depth
+      ! -----------------------
+      DO jle = 1, obl
+         zvelbtpe(jle) = zvelbtpe(jle) * zhinv(jle) * zmskob(jle,1) 
+      END DO
+
+      ! 3. substract zvelbtpe to the total velocity
+      !    and save the baroclinic velocity in velcli()
+      ! ------------------------------------------------
+      DO jk = 1, jpkm1
+         DO jle = 1, obl
+            zcbl = zvel(jle,jk) - zvelbtpe(jle)*zmskob(jle,jk)
+            velcli(jle,jk) = zcbl * zmskob(jle,jk)
+         END DO
+      END DO
+
+   END SUBROUTINE obc_cli_dyn
+
+
+   SUBROUTINE obc_cli_dta( obvel, velcli, obd, obf, obtyp, obl, mpp )
+      !!--------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE obc_cli_dta  ***
+      !!                   
+      !! ** Purpose :
+      !!      Compute the baroclinic velocities for the climatological velocities.
+      !!
+      !! ** Method  :
+      !!      - Compute de barotropic velocity along the considered Open Boundary 
+      !!        and substract it to the total velocity to have baroclinic velotity.
+      !!      - obtyp must be set to | 0 when traiting an East or West OB 
+      !!                             | 1 when traiting a North or South OB.
+      !!      - obl is the lenght of the OB (jpi or jpj) 
+      !!
+      !! History :
+      !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!--------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   & ! OB localization: jpieob or jpiwob for East or West 
+         obd, obf,               & !                  jpjnob or jpjsob for North or South 
+         obl,                    & ! Lenght of the Open Boundary
+         mpp,                    & ! MPP index
+         obtyp                     ! Type of Open Boundary: zonal or Meridional 
+      REAL(wp), INTENT( out), DIMENSION(:,:) ::   &
+         velcli                    ! Baroclinic velocity calculated
+      REAL(wp), INTENT( inout ), DIMENSION(:,:,:) ::   &
+         obvel                     ! uXdta or vXdta climatological velocities from 
+                                   ! obcdta.F90 routine
+
+      !! * Local declarations
+      INTEGER ::   &
+         ji, jj, jk, jle, jol, ij     ! loop indices  
+      REAL(wp), DIMENSION(obl) ::   & 
+         zvelbtpe,                  & ! Barotropic velocity 
+         zhinv                        ! Invert of the local depth 1/H
+      REAL(wp), DIMENSION(obl,jpk) ::   &
+         zmskob                       ! Velocity mask
+# if defined key_partial_steps
+      REAL(wp), DIMENSION(obl,jpk) ::   &
+         ze3ob                        ! Vertical scale factor
+# else
+      REAL(wp), DIMENSION(jpk) ::   &
+         ze3ob                        ! Vertical scale factor
+# endif
+      !!--------------------------------------------------------------------------------
+
+      ! 0. Array initialization
+      ! -----------------------
+
+      zhinv(:) = 0.e0
+      zmskob(:,:) = 0.e0
+# if defined key_partial_steps
+      ze3ob(:,:) = 0.e0
+# else
+      ze3ob(:) = 0.e0
+# endif
+
+      IF( obtyp == 0 ) THEN            ! Meridional Open Boundary ( East or West OB )
+         DO ji = obd, obf
+            zhinv(:) = hur(ji,:)
+            zmskob(:,:) = umask(ji,:,:)
+# if defined key_partial_steps
+            ze3ob(:,:) = fse3u(ji,:,:)
+# else
+            ze3ob(:) = fse3u(:,:,:)
+# endif
+         END DO
+      ELSE                             ! Zonal Open Boundary ( North or South OB )
+         DO jj = obd, obf
+            zhinv(:) = hvr(:,jj)
+            zmskob(:,:) = vmask(:,jj,:)
+# if defined key_partial_steps
+            ze3ob(:,:) = fse3v(:,jj,:)
+# else
+            ze3ob(:) = fse3v(:,:,:)
+# endif
+         END DO
+      END IF
+
+      zvelbtpe(:) = 0.e0
+
+      ! 1. vertical sum
+      ! ----------------
+# if defined key_vectopt_loop
+!CDIR NOLOOPCHG
+# endif
+      DO jol = obd, obf ! Vector opt.
+         DO jk = 1, jpkm1
+            DO jle = 1, obl
+               ij = jle -1 + mpp
+               zvelbtpe(jle) = zvelbtpe(jle) + obvel(ij,jk,1)*zmskob(jle,jk) &
+# if defined key_partial_steps
+                                           * ze3ob(jol,jle,jk)
+# else
+                                           * ze3ob(jk)
+# endif
+            END DO
+         END DO
+      END DO
+
+      ! 2. divide by the depth
+      ! -----------------------
+      DO jle = 1, obl
+         zvelbtpe(jle) = zvelbtpe(jle) * zhinv(jle) * zmskob(jle,1) 
+      END DO 
+
+      ! 3. substract zvelbtpe to the total velocity
+      !    and save the baroclinic velocity in velcli()
+      ! ------------------------------------------------
+      DO jk = 1, jpkm1
+         DO jle = 1, obl
+            ij = jle -1 + mpp
+            obvel(ij,jk,1) = obvel(ij,jk,1) - zvelbtpe(jle)*zmskob(jle,jk)
+            velcli(jle,jk) = obvel(ij,jk,1) * zmskob(jle,jk)
+         END DO
+      END DO
+
+   END SUBROUTINE obc_cli_dta
+
+#else
+   !!----------------------------------------------------------------------------------
+   !!   Default options :                                                  Empty module
+   !!----------------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE obc_cli_dyn       ! Empty routine
+   END SUBROUTINE obc_cli_dyn
+   SUBROUTINE obc_cli_dta       ! Empty routine
+   END SUBROUTINE obc_cli_dta
+#endif
+
+   !!==================================================================================
+END MODULE obccli
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obcdom.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obcdom.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obcdom.F90	(revision 4)
@@ -0,0 +1,550 @@
+MODULE obcdom
+   !!=================================================================================
+   !!                       ***  MODULE  obcdom  ***
+   !! Space domain  :  get all the isolated coastline points needed to resolve the 
+   !!                  barotropic streamfunction elliptic equation associated with 
+   !!                  the open boundaries.
+   !!=================================================================================
+#if defined key_obc && ! defined key_dynspg_fsc
+   !!---------------------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers   
+   USE dom_oce         ! ocean space and time domain 
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC obc_dom        ! routine called by iniobc.F90
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_dom
+      !!------------------------------------------------------------------------------
+      !!                       SUBROUTINE obc_dom
+      !!                      ********************
+      !! ** Purpose :   Initialize the array used for the computation of the part of 
+      !!        the right hand side of the barotropic streamfunction elliptic equation
+      !!        associated with the open boundaries
+      !!
+      !! **  Method :
+      !!      + The (i,j) indices of ocean grid-points round isolated coastlines
+      !!        are found (isolated coastlines = coast lines separated by an
+      !!        open boundary) from icoast array read in coastlines file.
+      !!
+      !!      + read 'coastline' file  initialize icoast()
+      !!        modify icoast() depending on the number of open boundaries 
+      !!        specified through key_obc
+      !!
+      !!      + compute zwb, an ocean/land mask defined as follows:
+      !!             zwb(i,j)  =  0. over the one isolated coastline
+      !!                       = -1, -2, -3 over the orthers
+      !!      + for example, when 4 open boundaries are specified:
+      !!
+      !!                       //|           |// 
+      !!        North          //|   North   |// -1 -1   North
+      !!         West     0  0 //| - - - - - |// -1 -1    East
+      !!                       //| open bnd  |//
+      !!              ///////////|           |/////////
+      !!              ------------            ----------
+      !!                                               
+      !!             west   |                  |    east
+      !!           open bnd                       open bnd    
+      !!                    |                  |         
+      !!              ___________             _________ 
+      !!              ///////////|           |/////////
+      !!                       //|   south   |// 
+      !!        South    -3 -3 //| - - - - - |// -2 -2   South
+      !!         West    -3 -3 //| open bnd  |// -2 -2    East
+      !!                       //|           |// 
+      !!
+      !!        With the proper boundary conditions (defined by nperio)
+      !!
+      !!        C a u t i o n :  no check, the user must enter a well defined
+      !!        coastline file. Further more, he must verify that isolated
+      !!        coastlines have been well located dans that the right potential
+      !!        is affected to the right coastline in obc.F
+      !!
+      !! History :
+      !!        !  07-97  (G. Madec)  Original code
+      !!        !  09-97  (J.M. Molines) for debuging
+      !!        !  06-99  (J.M. Molines) suppress zwb(,) for ATL6 (memory saving)
+      !!        !  02-02 (A.M. Treguier) icoast in 2 dimension
+      !!   8.5  !  02-08  (G. Madec)  F90 : free form
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj, jn, jnic, jnp, jii    ! dummy loop indices
+      INTEGER ::   inum = 11         ! temporary logical unit
+      INTEGER ::   ifreq, il1, il2, ii, ij, icheck
+      INTEGER ::   ip, ipn, ips, ipe, ipw
+      INTEGER ::   iim, ijm, iii, ijj
+      INTEGER, DIMENSION(jpidta,jpjdta) ::   icoast
+      CHARACTER (len=15) ::   clexp
+      REAL(wp) ::   zzic, zland
+      REAL(wp) ::   zwb, zwbn, zwbs, zwbe, zwbw
+      REAL(wp) ::   zglo(jpiglo,jpjglo)
+      !!---------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!---------------------------------------------------------------------
+      
+      ! 0. initialization of gcfobc to zero
+      ! -----------------------------------
+      
+      DO jn = 1, 3
+         gcfobc(:,:,jn) = 0.e0
+      END DO
+      
+      ! 1. Only 1 open boundary : gcfobc is zero, return
+      ! ------------------------------------------------
+      
+      IF( nbobc == 1 .OR. nbic == 0 ) THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' obc_dom: No isolated coastlines gcfobc is set to zero'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+         nstop = nstop + 1
+      END IF
+
+      ! 2. Lecture of 'coastlines' file
+      ! -------------------------------
+      
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'obc_dom: define isolated coastlines from "coastlines" file'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+      IF(lwp) WRITE(numout,*)
+
+      ! open coastlines file'
+      CALL ctlopn( inum, 'coastlines', 'OLD', 'FORMATTED', 'SEQUENTIAL',   &
+                   1 , numout, lwp, 1 )
+
+      ! lecture of coastlines, set icoast array
+      ! Note that this is coded for jpjdta > 1000
+      REWIND(inum)
+      READ(inum,9101) clexp, iim, ijm
+      READ(inum,'(/)')
+      ifreq = 40
+      il1 = 1
+      IF( jpjglo < 1000 ) THEN
+         DO jn = 1, jpidta/ifreq+1
+            READ(inum,'(/)')
+            il2 = min0( jpidta, il1+ifreq-1 )
+            READ(inum,9201) ( ii, ji = il1, il2, 5 )
+            READ(inum,'(/)')
+            DO jj = jpjdta, 1, -1
+               READ(inum,9202) ij, ( icoast(ji,jj), ji = il1, il2 )
+            END DO
+            il1 = il1 + ifreq
+         END DO
+      ELSE
+         DO jn = 1, jpidta/ifreq+1
+            READ(inum,'(/)')
+            il2 = min0( jpidta, il1+ifreq-1 )
+            READ(inum,9221) ( ii, ji = il1, il2, 5 )
+            READ(inum,'(/)')
+            DO jj = jpjdta, 1, -1
+               READ(inum,9222) ij, ( icoast(ji,jj), ji = il1, il2 )
+            END DO
+            il1 = il1 + ifreq
+         END DO
+      END IF
+      CLOSE(inum)
+
+   ! in case of zoom, icoast must be set to 0 on the domain border
+   ! it must be the same for the bathymetry
+   IF (lzoom-w) icoast(jpiglo            ,:) = 0 
+   IF (lzoom-e) icoast(jpiglo +jpizoom -1,:) = 0 
+   IF (lzoom-s) icoast(:,jpjzoom           ) = 0 
+   IF (lzoom-n) icoast(:,jpjglo+jpjzoom -1 ) = 0 
+
+      DO jj = 1, jpjglo
+         DO ji = 1, jpiglo
+            zglo(ji,jj) = icoast( ji+jpizoom-1, jj+jpjzoom-1)
+         END DO
+      END DO
+
+ 9101 FORMAT(1x,a15,2i8)
+ 9201 FORMAT(3x,13(i3,12x))
+ 9202 FORMAT(i3,41i3)
+ 9221 FORMAT(4x,13(i3,12x))
+ 9222 FORMAT(i4,41i3)
+
+      ! check consistency between tmask and icoast
+      
+      icheck = 0
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            icheck = icheck +  INT( tmask(ji,jj,1) ) - MAX(  0, icoast( mig(ji), mjg(jj) )  )
+         END DO
+      END DO
+# if defined key_mpp 
+      CALL mpp_sum(icheck) 
+# endif
+      IF( icheck /= 0 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) 'obc_dom : tmask and isolated coastlines mask are not equal', icheck
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         nstop = nstop + 1
+      END IF
+
+      ! 3. transfer the coastline information from T- to f-points
+      !    (i.e. from icoast to zwb with  zwb=0 over the continent
+      !     and ocean, =-n over the nth isolated coastline)
+      ! -----------------------------------------------------------
+      
+      ! east open boundary
+      IF( lpeastobc .AND. ( jpieob /= 0 ) ) THEN
+         IF(lwp) WRITE(numout,*) '         East open boundary: from coastline S.E : ', &
+                                 INT(zglo(jpieob,jpjed)),' to N.E : ',               &
+                                 INT(zglo(jpieob,jpjef))
+      END IF
+      ! west open boundary
+      IF( lpwestobc .AND. ( jpiwob /= 0 ) ) THEN
+         IF(lwp) WRITE(numout,*) '         West open boundary: from coastline S.W : ', &
+                                 INT(zglo(jpiwob,jpjwd)),' to N.W : ',               &
+                                 INT(zglo(jpiwob,jpjwf))
+      END IF
+      ! north open boundary
+      IF( lpnorthobc .AND. ( jpjnob /= 0 ) ) THEN
+         IF(lwp) WRITE(numout,*) '         North open boundary: from coastline N.W : ', &
+                                 INT(zglo(jpind,jpjnob)),' to N.E : ',                &
+                                 INT(zglo(jpinf,jpjnob))
+      END IF
+      ! south open boundary
+      IF( lpsouthobc .AND. ( jpjsob /= 0 ) ) THEN
+         IF(lwp) WRITE(numout,*) '         South open boundary: from coastline S.W : ', &
+                                 INT(zglo(jpisd,jpjsob)),' to S.E : ',                &
+                                 INT(zglo(jpisf,jpjsob))
+      END IF
+
+      ! 4. Identify the isolated coastline grid point position
+      ! ------------------------------------------------------
+
+      ! Loop over isolated coastlines
+
+      DO jnic = 1, nbobc-1
+         ! set to zero of miic, mjic of the jnic isolated coastline
+         DO jn = 0, 4
+            DO ji = 1, jpnic
+               miic(ji,jn,jnic) = 0
+               mjic(ji,jn,jnic) = 0
+            END DO
+         END DO
+         
+         ! Coastal isolated coastline grid-points (miic,mjic)
+         ip  = 0
+         ipn = 0
+         ips = 0
+         ipe = 0
+         ipw = 0
+         
+         ! Middle lines (1=<jj=<jpjm1)
+
+         !       jj+1  --zwb--v--ZWB--v--zwb--
+         !                |       |       |
+         !          jj+1  u   T   u   T   u
+         !                |       |       |
+         !       jj    --ZWB--v--ZWB--v--ZWB--
+         !                |       |       |
+         !              jj    u   T   u   T   u
+         !                |       |       |
+         !       jj-1  --zwb--v--ZWB--v--zwb--
+         !                |       |       | 
+         !                |   ii  | ii+1  |
+         !                |       |       | 
+         !               ii-1    ii      ii+1
+         
+         DO jj = 1, jpjglo-1
+            DO ji = 1, jpiglo-1
+               ii = ji
+               zwb = MIN( 0., zglo(ji,jj), zglo(ji+1,jj), zglo(ji,jj+1), zglo(ji+1,jj+1) )
+               IF( jj == jpjglo -1 ) THEN
+                  zwbn = zwb
+               ELSE
+                  zwbn= MIN( 0., zglo(ji,jj+1), zglo(ji+1,jj+1), zglo(ji,jj+2), zglo(ji+1,jj+2) )
+               END IF
+               IF( jj == 1 ) THEN
+                  zwbs = zwb
+               ELSE
+                  zwbs= MIN( 0., zglo(ji,jj-1), zglo(ji+1,jj-1), zglo(ji,jj), zglo(ji+1,jj) )
+               END IF
+               IF( ji == jpiglo -1 ) THEN
+                  zwbe = zwb
+               ELSE
+                  zwbe= MIN( 0., zglo(ji+1,jj), zglo(ji+2,jj), zglo(ji+1,jj+1), zglo(ji+2,jj+1) )
+               END IF
+               IF( ji == 1 ) THEN
+                  zwbw = zwb
+               ELSE
+                  zwbw= MIN( 0., zglo(ji-1,jj), zglo(ji,jj), zglo(ji-1,jj+1), zglo(ji,jj+1) )
+               END IF
+               
+               ! inside coastlines indicator
+               zzic  =                zwbn                 &
+                     * zwbw                       * zwbe   &
+                                    * zwbs
+               ! inside land indicator
+               zland = MAX( 0., zglo(ji,jj+1) ) + MAX( 0., zglo(ji+1,jj+1) )   &
+                     + MAX( 0., zglo(ji,jj  ) ) + MAX( 0., zglo(ji+1,jj  ) )
+               ! if isolated coastline grid-point 
+               IF( zwb == float( -jnic ) .AND.   &
+                  ! not inside the isolated coastline
+                             zzic == 0.  .AND.   &
+                  ! not inside the land
+                             zland >= 2.         ) THEN
+                  ! coastal point of the isolated coastline jnic
+                  ip = ip + 1
+                  miic(ip,0,jnic) = ii
+                  mjic(ip,0,jnic) = jj
+                  ! which has a west ocean grid point 
+                  IF( zwbw == 0. ) THEN
+                     ipw = ipw + 1
+                     miic(ipw,4,jnic) = ii
+                     mjic(ipw,4,jnic) = jj
+                  END IF
+                  ! which has a east ocean grid point
+                  IF( zwbe == 0. ) THEN
+                     ipe = ipe + 1
+                     IF( nperio == 1 .AND. ii == jpiglo-1 ) THEN
+                        miic(ipe,3,jnic) = 2
+                     ELSE
+                        miic(ipe,3,jnic) = ii + 1
+                     END IF
+                     mjic(ipe,3,jnic) = jj
+                  END IF
+                  ! which has a south ocean grid point 
+                  IF( zwbs == 0. ) THEN
+                     ips = ips + 1
+                     miic(ips,2,jnic) = ii
+                     mjic(ips,2,jnic) = jj
+                  END IF
+                  ! which has a north ocean grid point not out of north open b.
+                  IF( zwbn == 0. ) THEN
+                     ipn = ipn + 1
+                     miic(ipn,1,jnic) = ii
+                     mjic(ipn,1,jnic) = jj + 1
+                  END IF
+               END IF
+            END DO
+         END DO
+         
+         mnic(0,jnic) = ip
+         mnic(1,jnic) = ipn
+         mnic(2,jnic) = ips
+         mnic(3,jnic) = ipe
+         mnic(4,jnic) = ipw
+         
+      END DO
+
+      ! 5. Check the number of isolated coastline
+      ! -----------------------------------------
+
+      DO jnic = 1, nbobc-1
+         IF( mnic(0,jnic) > jpnic ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) 'obc_dom: isolated coastline ',jnic,   &
+               ' has ',ip,' grid-points > ',jpnic 
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+            IF(lwp) WRITE(numout,*) ' modify this dimension in obc_dom'
+            nstop = nstop + 1
+         END IF
+         IF( mnic(0,jnic) == 0 ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) 'obc_dom: isolated coastline ',jnic,   &
+               ' has 0  grid-points verify coastlines file'
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+            nstop = nstop + 1
+         END IF
+      END DO
+
+      ! 6. Print of isolated coastline parametres and arrays
+      ! -----------------------------------------------------
+
+      IF(lwp) WRITE(numout,*) '           '
+      IF(lwp) WRITE(numout,*) '         isolated coastlines found:', nbobc - 1
+
+      DO jnic = 1, nbobc-1
+         ip  = mnic(0,jnic)
+         ipn = mnic(1,jnic)
+         ips = mnic(2,jnic)
+         ipe = mnic(3,jnic)
+         ipw = mnic(4,jnic)
+         IF(lwp) THEN
+            WRITE(numout,9000) jnic
+            WRITE(numout,9010) ip, ipn, ips, ipe, ipw
+            WRITE(numout,9020)
+            DO jnp = 1, mnic(0,jnic)
+               WRITE(numout,9030) jnp,( miic(jnp,ji,jnic)+nimpp-1, mjic(jnp,ji,jnic)+njmpp-1, ji=0,4 )
+            END DO
+         END IF
+         
+         ! format
+
+ 9000 FORMAT(/,'          isolated coastline number= ',i2)
+ 9010 FORMAT(/,'          npic=',i4,' npn=',i4,' nps=',i4,' npe=',i4,' npw=',i4)
+ 9020 FORMAT(/,'              * ic  point *  point n  *  point s  *  point e ','*  point w  *')
+ 9030 FORMAT('         ',i4,' * (',i4,',',i4,') * (',i4,',',i4,') * (',i4,',',i4,') * (',i4,',',i4,') * (',i4,',',i4,') *')
+
+      END DO
+
+      ! 7. Construct the gcfobc array associated with each isolated coastline
+      ! ----------------------------------------------------------------------
+
+      DO jnic = 1, nbobc-1
+
+         ! north and south grid-points
+         DO jii = 1, 2
+            DO jnp = 1, mnic(jii,jnic)
+               ii = miic(jnp,jii,jnic)
+               ij = mjic(jnp,jii,jnic)
+               ! take only into account gridpoint of the model domain
+               IF( ii >= nldi+nimpp-1 .AND. ii <= nlci+nimpp-1 .AND.   &
+                   ij >= nldj+njmpp-1 .AND. ij <= nlcj+njmpp-1       ) THEN
+                  iii=ii-nimpp+1
+                  ijj=ij-njmpp+1
+                  gcfobc(iii,ijj-jii+1,jnic) = gcfobc(iii,ijj-jii+1,jnic)   &
+                                             - hur(iii,ijj) * e1u(iii,ijj) / e2u(iii,ijj)
+
+               END IF
+            END DO
+         END DO
+
+         ! east and west grid-points
+         DO jii = 3, 4
+            DO jnp = 1, mnic(jii,jnic)
+               ii = miic(jnp,jii,jnic)
+               ij = mjic(jnp,jii,jnic)
+               ! take only into account gridpoint of the model domain
+               IF( ii >= nldi+nimpp-1 .AND. ii <= nlci+nimpp-1 .AND.    &
+                   ij >= nldj+njmpp-1 .AND. ij <= nlcj+njmpp-1 ) THEN
+                  iii=ii-nimpp+1
+                  ijj=ij-njmpp+1
+                  IF( iii-jii+3 == 1 ) THEN
+                     ! cyclic east-west boundary
+                     gcfobc(jpim1    ,ijj,jnic) = gcfobc(jpim1    ,ijj,jnic)   &
+                                                - hvr(iii,ijj) * e2v(iii,ijj) / e1v(iii,ijj)
+                  ELSE
+                     ! interior points
+                     gcfobc(iii-jii+3,ijj,jnic) = gcfobc(iii-jii+3,ijj,jnic)   &
+                                                - hvr(iii,ijj) * e2v(iii,ijj) / e1v(iii,ijj)
+                  END IF
+               END IF
+            END DO
+         END DO
+
+         ! applied bmask to suppress coastal open boundary influence
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               gcfobc(ji,jj,jnic) = gcfobc(ji,jj,jnic) * bmask(ji,jj)
+            END DO
+         END DO
+         
+      END DO
+
+
+      ! 8. check the grid point which value controls the isolated coastline potential
+      !    Note: in order to activate those tests you need to make zwb a global array,
+      !    which is not done usually to spare memory.
+      !    n.b. here at least 2 open boundaries
+      ! ------------------------------------------------------------------------------
+!
+! east open boundary:
+!     IF( nieob /= 0 ) THEN
+!   east open & south open  :                              Ed === Sf
+!         IF( njsob /= 0 ) THEN
+!             IF( zwb(nieob,jped) /= zwb(jpsf,njsob) ) THEN
+!                 IF(lwp)WRITE(numout,*) ' E R R O R : east d # south f'
+!             END IF
+!   east open, south closed & west open :                  Ed === Wd
+!           ELSEIF( niwob /= 0 ) THEN
+!             IF( zwb(nieob,jped) /= zwb(niwob,jpwd) ) THEN
+!                 IF(lwp)WRITE(numout,*) ' E R R O R : east d # west d'
+!             END IF
+!   east open, south closed, west closed & north open :    Ed === Nd
+!           ELSEIF( njnob /= 0 ) THEN
+!             IF( zwb(nieob,jped) /= zwb(jpnd,njnob) ) THEN
+!                 IF(lwp)WRITE(numout,*) ' E R R O R : east d # north d'
+!             END IF
+!         END IF
+!   east open & north open :                               Ef === Nf
+!         IF( njnob /= 0 ) THEN
+!             IF( zwb(nieob,jpef) /= zwb(jpnf,njnob) ) THEN
+!                 IF(lwp)WRITE(numout,*) ' E R R O R : east f # north f'
+!             END IF
+!   east open, north closed & west open :                  Ef === Wf
+!           ELSEIF( niwob /= 0 ) THEN
+!             IF( zwb(nieob,jpef) /= zwb(niwob,jpwf) ) THEN
+!                 IF(lwp)WRITE(numout,*) ' E R R O R : east f # west f'
+!             END IF
+!   east open, north closed, west closed & south open :    Ef === Sd
+!           ELSEIF( njsob /= 0 ) THEN
+!             IF( zwb(nieob,jpef) /= zwb(jpsd,njnob) ) THEN
+!                 IF(lwp)WRITE(numout,*) ' E R R O R : east f # south d'
+!             END IF
+!         END IF
+!
+! east closed 
+!       ELSE
+! east closed, south open
+!         IF( njsob /= 0 ) THEN
+!   east closed, south open & west open :                  Sd === Wd
+!             IF( niwob /= 0 ) THEN
+!                 IF( zwb(jpsd,njsob) /= zwb(niwob,jpwd) ) THEN
+!                     IF(lwp)WRITE(numout,*) ' E R R O R :',
+!    $                                       ' south d # west d'
+!                 END IF
+!   east closed, south open, west closed & north open :    Sd === Nd
+!               ELSEIF( njnob /= 0 ) THEN
+!                 IF( zwb(jpsd,njsob) /= zwb(jpnd,njnob) ) THEN
+!                     IF(lwp)WRITE(numout,*) ' E R R O R : ',
+!    $                                       ' south d # north d'
+!                 END IF
+!             END IF
+!   south open, east closed & north open :                 Sf === Nf
+!             IF( njnob /= 0 ) THEN
+!                 IF( zwb(jpsf,njsob) /= zwb(jpnf,njnob) ) THEN
+!                     IF(lwp)WRITE(numout,*) ' E R R O R : ',
+!    $                                       ' south f # north f'
+!                 END IF
+!   south open, east closed, north closed & west open :    Sf === Wf
+!               ELSEIF( niwob /= 0 ) THEN
+!                 IF( zwb(jpsf,njsob) /= zwb(niwob,jpwf) ) THEN
+!                     IF(lwp)WRITE(numout,*) ' E R R O R : ',
+!    $                                       ' south f # west f'
+!                 END IF
+!             END IF
+!
+! east & south closed ==> north & west open :              Nd === Wf
+!                                                              Nf === Wd
+!           ELSE
+!             IF( zwb(jpnd,njnob) /= zwb(niwob,jpwf) ) THEN
+!                 IF(lwp)WRITE(numout,*) ' E R R O R : north d # west f'
+!             END IF
+!             IF( zwb(jpnf,njnob) /= zwb(niwob,jpwd) ) THEN
+!                 IF(lwp)WRITE(numout,*) ' E R R O R : north f # west d'
+!             END IF
+!         END IF
+!
+!     END IF
+!
+!
+
+   END SUBROUTINE obc_dom
+#else
+   !!=================================================================================
+   !!                       ***  MODULE  obcdom  ***
+   !! Space domain :  get all the isolated coastline points needed to resolve the 
+   !!                 barotropic streamfunction elliptic equation associated with 
+   !!                 the open boundaries.
+   !!=================================================================================
+CONTAINS
+
+   SUBROUTINE obc_dom                 
+
+      ! No isolated coastline OR No Open Boundaries ==> empty routine
+
+   END SUBROUTINE obc_dom
+#endif
+
+END MODULE obcdom
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obcdta.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obcdta.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obcdta.F90	(revision 4)
@@ -0,0 +1,723 @@
+MODULE obcdta
+   !!==============================================================================
+   !!                            ***  MODULE obcdta  ***
+   !! Open boundary data : read the data for the open boundaries.
+   !!==============================================================================
+#if defined key_obc
+   !!------------------------------------------------------------------------------
+   !!   'key_obc'         :                                Open Boundary Conditions
+   !!------------------------------------------------------------------------------
+   !!   obc_dta_uvt       : read u, v, t, s data along each open boundary
+   !!   obc_dta_psi       : read psi data along each open boundary (rigid lid only)
+   !!------------------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE daymod          ! calendar
+   USE in_out_manager  ! I/O logical units
+
+
+#  if ! defined key_dynspg_fsc
+   USE obccli
+#  endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC obc_dta_uvt                     ! routines called by step.F90
+   PUBLIC obc_dta_psi                     ! routines called by step.F90
+   
+   !! * Substitutions
+#  include "obc_vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_dta_uvt ( kt )
+      !!---------------------------------------------------------------------------
+      !!                         SUBROUTINE obc_dta_uvt 
+      !!                        ************************
+      !! ** Purpose :
+      !!      Find the climatological  boundary arrays for the specified date, 
+      !!      Originally this routine interpolated between monthly fields
+      !!      of a climatology.
+      !!      When using hydrological section data, we have only on snapshot
+      !!      and do not need to interpolate.
+      !!
+      !! ** Method :
+      !!      Determine the current month from kdat, and interpolate for the
+      !!      current day.
+      !!
+      !! History :
+      !!        !  98-05 (J.M. Molines) Original code
+      !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!---------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk, ii, ij        ! dummy loop indices
+      INTEGER ::   inum = 11                 ! temporary logical unit
+      INTEGER ::   imois, iman, imoisp1
+      INTEGER ::   i15
+      INTEGER ::   irecl, irec, ios
+      INTEGER, PARAMETER ::    &
+               jpmois = 1,     &
+               jpf    = 3
+      REAL(wp) ::   zxy
+      CHARACTER (len=4 ) ::   clversion
+      CHARACTER (len=80) ::   clcom
+      !!---------------------------------------------------------------------
+
+      ! 0. Initialization of date
+      !    imois is the index (1 to 12) of the first month to be used in the 
+      !    interpolation. ndastp is the date (integer format yymmdd) calculated 
+      !    in routine day.F starting from ndate0 given in namelist.
+      ! -----------------------------------------------------------------------
+
+      iman  = jpmois
+      i15 = nday/16
+      imois = nmonth + i15 - 1
+      IF( imois == 0 )   imois = iman
+      imoisp1 = MOD( imois + 1, iman )
+      IF( imoisp1 == 0 ) imoisp1 = iman 
+      ! ... zxy is the weight of the after field
+      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
+      IF( zxy > 1.01 .OR. zxy < 0. ) THEN
+         IF(lwp) WRITE(numout,*)'           '
+         IF(lwp) WRITE(numout,*)'obc_dta_uvt: Pbm with the the weight of the after field zxy '
+         IF(lwp) WRITE(numout,*)'~~~~~~~~~~~'
+         nstop = nstop + 1
+      END IF
+
+      ! 1.   First call:
+      ! ----------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)'           '
+         IF(lwp) WRITE(numout,*)'obcdta: initial step in obc_dta_uvt'
+         IF(lwp) WRITE(numout,*)'~~~~~~  months ',imois,' and', imoisp1,' read'
+
+         ! 1.1  Tangential velocities set to zero
+         ! --------------------------------------
+         IF( lpeastobc ) THEN
+            DO jk=1, jpkm1
+               vfoe(:,jk)=0.00
+            END DO
+         END IF
+
+         IF( lpwestobc ) THEN
+            DO jk=1, jpkm1
+               vfow(:,jk)=0.00
+            END DO
+         END IF
+
+         IF( lpsouthobc ) THEN
+            DO jk=1, jpkm1
+                ufos(:,jk)=0.00
+            END DO
+         END IF
+
+         IF( lpnorthobc ) THEN
+            DO jk=1, jpkm1
+               ufon(:,jk)=0.00
+            END DO
+         END IF       
+
+         ! 1.2 Set the Normal velocity and tracers data for the EAST OBC
+         ! -------------------------------------------------------------
+
+         IF( lpeastobc ) THEN
+
+            ! initialisation to zero
+            sedta(:,:,1) = 0.e0
+            tedta(:,:,1) = 0.e0
+            uedta(:,:,1) = 0.e0
+            !                                         ! ================== !
+            IF( nobc_dta == 0 )   THEN                ! initial state used
+               !                                      ! ================== !
+               DO ji = fs_nie0, fs_nie1 ! Vector opt.
+                  DO jk = 1, jpkm1
+                     DO jj = 1, jpj
+                        ij = jj -1 + njmpp
+                        sedta(ij,jk,1) = sn(ji,jj,jk)*tmask(ji,jj,jk)
+                        tedta(ij,jk,1) = tn(ji,jj,jk)*tmask(ji,jj,jk)
+                        uedta(ij,jk,1) = 0.1*umask(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO
+               
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     ij = jj -1 + njmpp
+                     sfoe(jj,jk) =  sedta(ij,jk,1)*temsk(jj,jk)  
+                     tfoe(jj,jk) =  tedta(ij,jk,1)*temsk(jj,jk)    
+                     ufoe(jj,jk) =  uedta(ij,jk,1)*uemsk(jj,jk)  
+                  END DO
+               END DO
+               !                                      ! =================== !
+            ELSE                                      ! read in obceast.dta
+               !                                      ! =================== !
+               OPEN(UNIT   = inum,       &
+                    IOSTAT = ios,          &
+                    FILE   ='obceast.dta', &
+                    FORM   ='UNFORMATTED', &
+                    ACCESS ='DIRECT',      &
+                    RECL   = 4096 )
+               IF( ios > 0 ) THEN
+                  IF(lwp) WRITE(numout,*) 'obc_dta_uvt: Pbm to OPEN the obceast.dta file '
+                  IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+                  nstop = nstop + 1
+               END IF
+               READ(inum,REC=1) clversion,clcom,irecl
+               CLOSE(inum)
+               IF(lwp) WRITE(numout,*)'       '
+               IF(lwp) WRITE(numout,*)'        opening obceast.dta  with irecl=',irecl
+               OPEN(UNIT   = inum,       &
+                    IOSTAT = ios,          &
+                    FILE   ='obceast.dta', &
+                    FORM   ='UNFORMATTED', &
+                    ACCESS ='DIRECT',      &
+                    RECL   = irecl )
+               IF( ios > 0 ) THEN
+                  IF(lwp) WRITE(numout,*) 'obc_dta_uvt: Pbm to OPEN the obceast.dta file '
+                  IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+                  nstop = nstop + 1
+               END IF
+   
+               ! ... Read datafile and set temperature, salinity and normal velocity
+               ! ... initialise the sedta, tedta arrays
+               ! ... index 1 refer to before, 2 to after
+
+               DO jk = 1, jpkm1
+                  irec = 2 +  (jk -1)* jpf
+                  READ(inum,REC=irec  )((sedta(jj,jk,1),ji=1,1),jj=jpjed, jpjef)
+                  READ(inum,REC=irec+1)((tedta(jj,jk,1),ji=1,1),jj=jpjed, jpjef)
+                  READ(inum,REC=irec+2)((uedta(jj,jk,1),ji=1,1),jj=jpjed, jpjef)
+                  ! ... set climatological temperature and salinity at the boundary
+                  ! ... do not interpolate between months : impose values of climatology
+                  DO jj = 1, jpj
+                     ij = jj -1 + njmpp
+                     sfoe(jj,jk) = sedta(ij,jk,1)*temsk(jj,jk)
+                     tfoe(jj,jk) = tedta(ij,jk,1)*temsk(jj,jk)
+                  END DO
+               END DO
+               CLOSE(inum)
+
+# if ! defined key_dynspg_fsc
+               ! ... Rigid lid case: make sure uedta is baroclinic velocity
+               ! ... In rigid lid case uedta needs to be the baroclinic component.
+
+               CALL obc_cli( uedta, uclie, fs_nie0, fs_nie1, 0, jpj, njmpp )  
+
+# endif
+               ! ... Set normal velocity (on nie0, nie1 <=> jpieob)
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     ij = jj -1 + njmpp
+                     ufoe(jj,jk) =  uedta(ij,jk,1)*uemsk(jj,jk)
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+
+         ! 1.3 Set the Normal velocity and tracers data for the WEST OBC
+         ! -------------------------------------------------------------
+
+         IF( lpwestobc) THEN
+
+            ! initialisation to zero
+            swdta(:,:,1) = 0.e0
+            twdta(:,:,1) = 0.e0
+            uwdta(:,:,1) = 0.e0
+            !                                         ! ================== !
+            IF( nobc_dta == 0 )   THEN                ! initial state used
+               !                                      ! ================== !
+            DO ji = fs_niw0, fs_niw1 ! Vector opt.
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     ij = jj -1 + njmpp
+                     swdta(ij,jk,1) = sn(ji,jj,jk)*tmask(ji,jj,jk)
+                     twdta(ij,jk,1) = tn(ji,jj,jk)*tmask(ji,jj,jk)
+                     uwdta(ij,jk,1) = 0.1*umask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  ij = jj -1 + njmpp
+                  sfow(jj,jk) = swdta(ij,jk,1)*twmsk(jj,jk)
+                  tfow(jj,jk) = twdta(ij,jk,1)*twmsk(jj,jk)
+                  ufow(jj,jk) = uwdta(ij,jk,1)*uwmsk(jj,jk)
+               END DO
+            END DO
+               !                                      ! =================== !
+            ELSE                                      ! read in obceast.dta
+               !                                      ! =================== !
+            OPEN(UNIT   = inum,       &
+                 IOSTAT = ios,          &
+                 FILE   ='obcwest.dta', &
+                 FORM   ='UNFORMATTED', &
+                 ACCESS ='DIRECT',      &
+                 RECL   = 4096 )
+            IF( ios > 0 ) THEN
+               IF(lwp) WRITE(numout,*) 'obc_dta_uvt: Pbm to OPEN the obcwest.dta file '
+               IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+               nstop = nstop + 1
+            END IF
+            READ(inum,REC=1) clversion, clcom,irecl
+            CLOSE(inum)
+            IF(lwp) WRITE(numout,*)'       '
+            IF(lwp) WRITE(numout,*)'         opening obcwest.dta  with irecl=',irecl
+            OPEN(UNIT   = inum,       &
+                 IOSTAT = ios,          &
+                 FILE   ='obcwest.dta', &
+                 FORM   ='UNFORMATTED', &
+                 ACCESS ='DIRECT',      &
+                 RECL   = irecl )
+            IF( ios > 0 ) THEN
+               IF(lwp) WRITE(numout,*) 'obc_dta_uvt: Pbm to OPEN the obcwest.dta file '
+               IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+               nstop = nstop + 1
+            END IF
+
+            ! ... Read datafile and set temperature, salinity and normal velocity
+            ! ... initialise the swdta, twdta arrays
+            ! ... index 1 refer to before, 2 to after
+            DO jk = 1, jpkm1
+               irec = 2 +  (jk -1)* jpf
+               READ(inum,REC=irec  )((swdta(jj,jk,1),ji=1,1),jj=jpjwd, jpjwf)
+               READ(inum,REC=irec+1)((twdta(jj,jk,1),ji=1,1),jj=jpjwd, jpjwf)
+               READ(inum,REC=irec+2)((uwdta(jj,jk,1),ji=1,1),jj=jpjwd, jpjwf)
+               DO jj = 1, jpj
+                  ij = jj -1 + njmpp
+                  sfow(jj,jk) = swdta(ij,jk,1)*twmsk(jj,jk)
+                  tfow(jj,jk) = twdta(ij,jk,1)*twmsk(jj,jk)
+               END DO
+            END DO
+            CLOSE(inum)
+
+#if ! defined key_dynspg_fsc
+            ! ... Rigid lid case: make sure uwdta is baroclinic velocity
+            ! ... In rigid lid case uwdta needs to be the baroclinic component.
+
+            CALL obc_cli( uwdta, ucliw, fs_niw0, fs_niw1, 0, jpj, njmpp )  
+
+# endif
+            ! ... Set normal velocity (on niw0, niw1 <=> jpiwob)
+            DO jk = 1, jpkm1
+                DO jj = 1, jpj
+                   ij = jj -1 + njmpp
+                   ufow(jj,jk) = uwdta(ij,jk,1)*uwmsk(jj,jk)
+                END DO
+            END DO
+            ENDIF
+         ENDIF
+
+         ! 1.4 Set the Normal velocity and tracers data for the NORTH OBC
+         ! ---------------------------------------------------------------
+
+         IF( lpnorthobc) THEN
+
+            ! initialisation to zero
+            sndta(:,:,1) = 0.e0
+            tndta(:,:,1) = 0.e0
+            vndta(:,:,1) = 0.e0
+
+            OPEN(UNIT   = inum,        &
+                 IOSTAT = ios,           &
+                 FILE   ='obcnorth.dta', &
+                 FORM   ='UNFORMATTED',  &
+                 ACCESS ='DIRECT',       &
+                 RECL   = 4096 )
+            IF( ios > 0 ) THEN
+               IF(lwp) WRITE(numout,*) 'obc_dta_uvt: Pbm to OPEN the obcnorth.dta file '
+               IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+               nstop = nstop + 1
+            END IF
+            READ(inum,REC=1) clversion,clcom,irecl
+            CLOSE(inum)
+            IF(lwp) WRITE(numout,*)'       '
+            IF(lwp) WRITE(numout,*)'        opening obcnorth.dta  with irecl=',irecl
+            OPEN(UNIT   = inum,        &
+                 IOSTAT = ios,           &
+                 FILE   ='obcnorth.dta', & 
+                 FORM   ='UNFORMATTED',  &
+                 ACCESS ='DIRECT',       &
+                 RECL   = irecl )
+            IF( ios > 0 ) THEN
+               IF(lwp) WRITE(numout,*) 'obc_dta_uvt: Pbm to OPEN the obcnorth.dta file '
+               IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+               nstop = nstop + 1
+            END IF
+
+            ! ... Read datafile and set temperature and salinity
+            ! ... initialise the sndta, tndta  arrays
+            ! ... index 1 refer to before, 2 to after
+            DO jk = 1, jpkm1
+               irec = 2 +  (jk -1)* jpf
+               READ(inum,REC=irec  )((sndta(jj,jk,1),ji=1,1),jj=jpind, jpinf)
+               READ(inum,REC=irec+1)((tndta(jj,jk,1),ji=1,1),jj=jpind, jpinf)
+               READ(inum,REC=irec+2)((vndta(jj,jk,1),ji=1,1),jj=jpind, jpinf)
+               ! ... do not interpolate: impose values of climatology
+               DO ji = 1, jpi
+                  ii = ji -1 + nimpp
+                  sfon(ji,jk) = sndta(ii,jk,1)*tnmsk(ji,jk)
+                  tfon(ji,jk) = tndta(ii,jk,1)*tnmsk(ji,jk)
+               END DO
+            END DO
+            CLOSE(inum)
+
+# if ! defined key_dynspg_fsc
+            ! ... Rigid lid case: make sure vndta is baroclinic velocity
+            !     In rigid lid case vndta needs to be the baroclinic component.
+            !     substract the barotropic velocity component (zvnbtpe)
+            !     from the total one (vndta).
+
+            CALL obc_cli( vndta, vclin, fs_njn0, fs_njn1, 1, jpi, nimpp )  
+# endif
+            ! ... Set normal velocity (on njn0, njn1 <=> jpjnob)
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  ii = ji -1 + nimpp
+                  vfon(ji,jk) =  vndta(ii,jk,1)*vnmsk(ji,jk)
+               END DO
+            END DO
+
+         END IF
+
+         ! 1.5 Set the Normal velocity and tracers data for the SOUTH OBC
+         ! ---------------------------------------------------------------
+
+         IF( lpsouthobc) THEN
+
+            ! initialisation to zero
+            ssdta(:,:,1) = 0.e0
+            tsdta(:,:,1) = 0.e0
+            vsdta(:,:,1) = 0.e0
+
+            OPEN(UNIT   = inum,        &
+                 IOSTAT = ios,           &
+                 FILE   ='obcsouth.dta', &
+                 FORM   ='UNFORMATTED',  &
+                 ACCESS ='DIRECT',       &
+                 RECL   = 4096 )
+            IF( ios > 0 ) THEN
+               IF(lwp) WRITE(numout,*) 'obc_dta_uvt: Pbm to OPEN the obcsouth.dta file '
+               IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+               nstop = nstop + 1
+            END IF
+            READ(inum,REC=1) clversion,clcom,irecl
+            CLOSE(inum)
+            IF(lwp) WRITE(numout,*)'       '
+            IF(lwp) WRITE(numout,*)'        opening obcsouth.dta  with irecl=',irecl
+            OPEN(UNIT   = inum,        &
+                 IOSTAT = ios,           &
+                 FILE   ='obcsouth.dta', &
+                 FORM   ='UNFORMATTED',  &
+                 ACCESS ='DIRECT',       &
+                 RECL   = irecl )
+            IF( ios > 0 ) THEN
+               IF(lwp) WRITE(numout,*) 'obc_dta_uvt: Pbm to OPEN the obcsouth.dta file '
+               IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+               nstop = nstop + 1
+            END IF
+
+            ! ... Read datafile and set temperature, salinity and normal velocity
+            ! ... initialise the ssdta, tsdta  arrays
+            ! ... index 1 refer to before, 2 to after
+            DO jk = 1, jpkm1
+               irec = 2 +  (jk -1)* jpf
+               READ(inum,REC=irec  )((ssdta(jj,jk,1),ji=1,1),jj=jpisd, jpisf)
+               READ(inum,REC=irec+1)((tsdta(jj,jk,1),ji=1,1),jj=jpisd, jpisf)
+               READ(inum,REC=irec+2)((vsdta(jj,jk,1),ji=1,1),jj=jpisd, jpisf)
+               ! ... do not interpolate: impose values of climatology
+               DO ji = 1, jpi
+                  ii = ji -1 + nimpp
+                  sfos(ji,jk) = ssdta(ii,jk,1)*tsmsk(ji,jk)
+                  tfos(ji,jk) = tsdta(ii,jk,1)*tsmsk(ji,jk)
+               END DO
+            END DO
+            CLOSE(inum)  
+
+# if ! defined key_dynspg_fsc
+            ! ... Rigid lid case: make sure vsdta is baroclinic velocity
+            ! ... In rigid lid case vsdta needs to be the baroclinic component.
+            ! ... substract the barotropic velocity component (zvsbtpe)
+            ! ... from the total one (vsdta).
+
+            CALL obc_cli( vsdta, vclis, fs_njs0, fs_njs1, 1, jpi, nimpp )  
+# endif
+            ! ... Set normal velocity (on njs0, njs1 <=> jpjsob)
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  ii = ji -1 + nimpp
+                  vfos(ji,jk) =  vsdta(ii,jk,1)*vsmsk(ji,jk)
+               END DO
+            END DO
+
+         END IF
+
+      ELSE 
+
+      ! 2.   CALL  not the first step ...
+      !      do not read but interpolate between months.
+      !      here no interpolation is done but the code is kept as a reminder
+      ! ----------------------------------------------------------------------
+
+      IF( lpeastobc) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               ij = jj -1 + njmpp
+               sfoe(jj,jk) =  sedta(ij,jk,1)*temsk(jj,jk)
+               tfoe(jj,jk) =  tedta(ij,jk,1)*temsk(jj,jk)
+               ufoe(jj,jk) =  uedta(ij,jk,1)*uemsk(jj,jk)
+            END DO
+         END DO
+      END IF
+
+      IF( lpwestobc) THEN
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               ij = jj -1 + njmpp
+               sfow(jj,jk) =  swdta(ij,jk,1)*twmsk(jj,jk)
+               tfow(jj,jk) =  twdta(ij,jk,1)*twmsk(jj,jk)
+               ufow(jj,jk) =  uwdta(ij,jk,1)*uwmsk(jj,jk)
+            END DO
+         END DO
+      END IF
+
+      IF( lpnorthobc) THEN 
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               ii = ji -1 + nimpp
+               sfon(ji,jk) =  sndta(ii,jk,1)*tnmsk(ji,jk)
+               tfon(ji,jk) =  tndta(ii,jk,1)*tnmsk(ji,jk)
+               vfon(ji,jk) =  vndta(ii,jk,1)*vnmsk(ji,jk)
+            END DO
+         END DO
+      END IF
+
+      IF( lpsouthobc) THEN 
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               ii = ji -1 + nimpp
+               sfos(ji,jk) =  ssdta(ii,jk,1)*tsmsk(ji,jk)
+               tfos(ji,jk) =  tsdta(ii,jk,1)*tsmsk(ji,jk)
+               vfos(ji,jk) =  vsdta(ii,jk,1)*vsmsk(ji,jk)
+            END DO
+         END DO
+      END IF
+
+      END IF
+
+   END SUBROUTINE obc_dta_uvt
+
+# if defined key_dynspg_fsc
+   !!-----------------------------------------------------------------------------
+   !!   'key_dynspg_fsc'                    free surface with constant volume
+   !!-----------------------------------------------------------------------------
+   SUBROUTINE obc_dta_psi ( kt )       ! Empty routine
+      !! * Arguments
+      INTEGER,INTENT(in) :: kt 
+      WRITE(*,*) kt
+   END SUBROUTINE obc_dta_psi
+#else
+   !!-----------------------------------------------------------------------------
+   !!   Default option                                                   Rigid-lid
+   !!-----------------------------------------------------------------------------
+
+   SUBROUTINE obc_dta_psi ( kt )
+      !!-----------------------------------------------------------------------------
+      !!                       ***  SUBROUTINE obc_dta_psi  ***
+      !!
+      !! ** Purpose :
+      !!      Update the climatological streamfunction OBC at each time step.
+      !!      Depends on the user's configuration.  Here data are read only once
+      !!      at the beginning of the run.
+      !!
+      !! ** Method :
+      !!      1. initialization
+      !!         kbsfstart: number of time steps over which increase bsf
+      !!         during initialization. This is provided for a smooth start
+      !!         in cases where the transport is large (like on the Antarctic
+      !!         continent). also note that when kbfstart=1, the transport
+      !!         increases a lot in one time step and the precision usually
+      !!         required for the solver may not be enough.
+      !!      2. set the time evolution of the climatological barotropic streamfunction
+      !!         along the isolated coastlines ( gcbic(jnic) ). 
+      !!      3. set the climatological barotropic streamfunction at the boundary.
+      !!
+      !!      The last two steps are done only at first step (nit000) or if kt <= kbfstart
+      !!
+      !! History :
+      !!        ! 97-08 (G. Madec, J.M. Molines)
+      !!   8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!----------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jnic, jip         ! dummy loop indices
+      INTEGER ::   ip, ii, ij, iii, ijj
+      INTEGER ::   kbsfstart
+      REAL(wp) ::   zsver1, zsver2, zsver3, z2dtr, zcoef
+      !!----------------------------------------------------------------------------
+
+      ! 1. initialisation
+      ! -----------------
+
+      kbsfstart =  1
+      zsver1 =  bsfic0(1)
+      zsver2 =  zsver1
+      IF( kt <= kbsfstart ) THEN
+         zcoef = float(kt)/float(kbsfstart)
+      ELSE
+         zcoef = 1.
+      END IF
+      bsfic(1) = zsver1*zcoef
+      IF( lwp .AND. ( kt <= kbsfstart ) ) THEN
+         IF(lwp) WRITE(numout,*)'            '
+         IF(lwp) WRITE(numout,*)'obcdta: spinup phase in obc_dta_psi routine'
+         IF(lwp) WRITE(numout,*)'~~~~~~  it=',kt,'  OBC: spinup coef: ', &
+                                           zcoef, ' and transport: ',bsfic(1)
+      END IF
+
+      zsver2 =  bsfic(1)-bsfic(2)
+      zsver3 =  bsfic(2)
+
+      ! 2. Right hand side of the barotropic elliptic equation (isolated coastlines)
+      ! ----------------------------------------------------------------------------
+
+      IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN
+         z2dtr = 1./rdt
+      ELSE
+         z2dtr = 1./2./rdt
+      END IF
+      ! ... bsfb(ii,ij) should be constant but due to the Asselin filter it
+      ! ... converges asymptotically towards bsfic(jnic)
+      ! ... However, bsfb(ii,ij) is constant along the same coastlines
+      ! ... ---> can be improved using an extra array for storing bsficb (before)
+      IF( nbobc > 1 ) THEN
+         DO jnic = 1,nbobc - 1
+            gcbic(jnic) = 0.
+            ip=mnic(0,jnic)
+            DO jip = 1,ip
+               ii = miic(jip,0,jnic) 
+               ij = mjic(jip,0,jnic) 
+               IF( ii >= nldi+ nimpp - 1 .AND. ii <= nlei+ nimpp - 1 .AND. &
+                   ij >= nldj+ njmpp - 1 .AND. ij <= nlej+ njmpp - 1 ) THEN
+                  iii=ii-nimpp+1
+                  ijj=ij-njmpp+1
+                  gcbic(jnic) = ( bsfic(jnic) - bsfb(iii,ijj) ) * z2dtr
+               END IF
+            END DO
+         END DO
+      END IF
+# if defined key_mpp
+      CALL mpprisl( gcbic, 3 )
+# endif
+
+      ! 3. Update the climatological barotropic function at the boundary 
+      ! ----------------------------------------------------------------
+
+      IF( lpeastobc ) THEN
+
+         IF( kt == nit000 .OR. kt <= kbsfstart ) THEN
+            OPEN(inum,file='obceastbsf.dta')
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*) (bfoe(jj),jj=jpjed, jpjef)
+            CLOSE(inum)
+         END IF
+         DO jj=jpjed, jpjefm1
+            bfoe(jj)=bfoe(jj)*zcoef
+         END DO
+
+      END IF
+
+      IF( lpwestobc) THEN
+
+         IF( kt == nit000 .OR. kt <= kbsfstart ) then
+            OPEN(inum,file='obcwestbsf.dta')
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*) (bfow(jj),jj=jpjwd, jpjwf)
+            CLOSE(inum)
+         END IF
+         DO jj=jpjwd, jpjwfm1
+            bfow(jj)=bfow(jj)*zcoef
+         END DO
+
+      END IF
+
+      IF( lpsouthobc) THEN
+
+         IF( kt == nit000.OR.kt <= kbsfstart ) THEN
+            OPEN(inum,file='obcsouthbsf.dta')
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*) (bfos(jj),jj=jpisd, jpisf)
+            CLOSE(inum)
+         END IF
+         DO ji=jpisd, jpisfm1
+            bfos(ji)=bfos(ji)*zcoef
+         END DO
+
+      END IF
+
+      IF( lpnorthobc) THEN
+         IF( kt == nit000.OR.kt <= kbsfstart ) THEN
+            OPEN(inum,file='obcnorthbsf.dta')
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*)
+            READ(inum,*) (bfon(jj),jj=jpind, jpinf)
+            CLOSE(inum)
+         END IF
+         DO ji=jpind, jpinfm1
+            bfon(ji)=bfon(ji)*zcoef
+         END DO
+
+      END IF
+
+   END SUBROUTINE obc_dta_psi
+# endif
+
+#else
+   !!==============================================================================
+   !!                            ***  MODULE obcdta  ***
+   !!  Empty module : no open boundary conditions
+   !!==============================================================================
+CONTAINS
+   SUBROUTINE obc_dta_uvt( kt )             ! Empty routine
+      INTEGER, INTENT (in) :: kt
+      WRITE(*,*) kt
+   END SUBROUTINE obc_dta_uvt
+
+   SUBROUTINE obc_dta_psi( kt )             ! Empty routine
+      INTEGER, INTENT (in) :: kt
+      WRITE(*,*) kt
+   END SUBROUTINE obc_dta_psi
+
+#endif
+
+END MODULE obcdta
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obcdyn.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obcdyn.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obcdyn.F90	(revision 4)
@@ -0,0 +1,818 @@
+MODULE obcdyn
+#if defined key_obc
+   !!=================================================================================
+   !!                       ***  MODULE  obcdyn  ***
+   !! Ocean dynamics:   Radiation of velocities on each open boundary
+   !!=================================================================================
+
+   !!---------------------------------------------------------------------------------
+   !!   obc_dyn        : call the subroutine for each open boundary
+   !!   obc_dyn_east   : radiation of the east open boundary velocities
+   !!   obc_dyn_west   : radiation of the west open boundary velocities
+   !!   obc_dyn_north  : radiation of the north open boundary velocities
+   !!   obc_dyn_south  : radiation of the south open boundary velocities
+   !!----------------------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE lib_mpp         ! ???
+   USE obccli          ! ocean open boundary conditions: climatology
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC obc_dyn     ! routine called in dynspg_fsc (free surface case)
+                      ! routine called in dynnxt.F90 (rigid lid case)
+
+   !! * Module variables
+   INTEGER ::   ji, jj, jk     ! dummy loop indices
+
+   INTEGER ::      & ! ... boundary space indices 
+      nib   = 1,   & ! nib   = boundary point
+      nibm  = 2,   & ! nibm  = 1st interior point
+      nibm2 = 3,   & ! nibm2 = 2nd interior point
+                     ! ... boundary time indices 
+      nit   = 1,   & ! nit    = now
+      nitm  = 2,   & ! nitm   = before
+      nitm2 = 3      ! nitm2  = before-before
+
+   REAL(wp) ::   rtaue  , rtauw  , rtaun  , rtaus  ,  &
+                 rtauein, rtauwin, rtaunin, rtausin
+
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_dyn ( kt )
+      !!------------------------------------------------------------------------------
+      !!                      SUBROUTINE obc_dyn
+      !!                     ********************
+      !! ** Purpose :
+      !!      Compute  dynamics (u,v) at the open boundaries.
+      !!      if defined key_dynspg_fsc: 
+      !!                 this routine is called by dynspg_fsc and updates
+      !!                 ua, va which are the actual velocities (not trends)
+      !!      else  (rigid lid case) , 
+      !!                 this routine is called in dynnxt.F routine and updates ua, va. 
+      !!
+      !!      The logical variable lpeastobc, and/or lpwestobc, and/or lpnorthobc, 
+      !!      and/or lpsouthobc allow the user to determine which boundary is an
+      !!      open one (must be done in the param_obc.h90 file).
+      !!
+      !! ** Reference : 
+      !!      Marchesiello P., 1995, these de l'universite J. Fourier, Grenoble, France.
+      !!
+      !! History :
+      !!        !  95-03 (J.-M. Molines) Original, SPEM
+      !!        !  97-07 (G. Madec, J.-M. Molines) addition
+      !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+
+      IF( kt == nit000 .OR. ln_rstart) THEN
+         ! ... Boundary restoring coefficient
+         rtaue = 2. * rdt / rdpeob
+         rtauw = 2. * rdt / rdpwob
+         rtaun = 2. * rdt / rdpnob
+         rtaus = 2. * rdt / rdpsob
+         ! ... Boundary restoring coefficient for inflow ( all boundaries)
+         rtauein = 2. * rdt / rdpein 
+         rtauwin = 2. * rdt / rdpwin
+         rtaunin = 2. * rdt / rdpnin
+         rtausin = 2. * rdt / rdpsin 
+      END IF
+
+      ! 1. East open boundary
+      ! ---------------------
+      
+      IF( lpeastobc )THEN
+         CALL obc_dyn_east( kt )
+      END IF
+
+      ! 2. West open boundary
+      ! ---------------------
+      
+      IF( lpwestobc )THEN
+         CALL obc_dyn_west( kt )
+      END IF
+
+      ! 3. North open boundary
+      ! ----------------------
+
+      IF( lpnorthobc )THEN
+         CALL obc_dyn_north( kt )
+      END IF
+
+      ! 4. South open boundary
+      ! ----------------------
+
+      IF( lpsouthobc )THEN
+         CALL obc_dyn_south( kt )
+      END IF
+
+# if defined key_mpp
+      !!bug ???
+      IF( kt >= nit000+3 .AND. ln_rstart ) THEN
+         CALL mpp_lnk_3d( ub, 'U', -1. )
+         CALL mpp_lnk_3d( vb, 'V', -1. )
+      END IF
+      CALL mpp_lnk_3d( ua, 'U', -1. )
+      CALL mpp_lnk_3d( va, 'V', -1. )
+# endif
+   END SUBROUTINE obc_dyn
+
+   SUBROUTINE obc_dyn_east ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_dyn_east
+      !!                    *************************
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on east OBC velocities ua, va using the 
+      !!      phase velocities calculated in obc_rad_east subroutine in obcrad.F90 module
+      !!      If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      REAL(wp) ::   z05cx, ztau, zin
+
+      !!------------------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbceast is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast ) THEN
+
+         ! 1.1 U zonal velocity    
+         ! --------------------
+         DO ji = nie0, nie1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+# if defined key_dynspg_fsc
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uemsk(jj,jk)) + &
+                                 uemsk(jj,jk)*ufoe(jj,jk)
+# else
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uemsk(jj,jk)) +                     &
+                                 uemsk(jj,jk)*( ufoe(jj,jk) - hur (ji,jj) / e2u (ji,jj) &
+                                 * ( bsfn(ji,jj) - bsfn(ji,jj-1) ) )
+# endif 
+               END DO
+            END DO
+         END DO
+
+         ! 1.2 V meridional velocity
+         ! -------------------------
+         DO ji = nie0+1, nie1+1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1.-vemsk(jj,jk)) + &
+                                 vfoe(jj,jk)*vemsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbceast is .FALSE.
+      ! -----------------------------------------------------
+ 
+         ! 2.1. u-component of the velocity
+         ! ---------------------------------
+         !
+         !          nibm2      nibm      nib
+         !            |   nibm  |   nib   |///
+         !            |    |    |    |    |///
+         !  jj-line --f----v----f----v----f---
+         !            |    |    |    |    |///
+         !            |         |         |///
+         !  jj-line   u    T    u    T    u///
+         !            |         |         |///
+         !            |    |    |    |    |///
+         !          jpieob-2   jpieob-1   jpieob
+         !                 |         |        
+         !              jpieob-1    jpieob    
+         !  
+         ! ... If free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology
+         ! ... (jpjedp1, jpjefm1),jpieob
+         DO ji = nie0, nie1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  z05cx = u_cxebnd(jj,jk)
+                  z05cx = z05cx / e1t(ji,jj)
+                  z05cx = min( z05cx, 1. )
+         ! ... z05cx=< 0, inflow  zin=0, ztau=1    
+         !           > 0, outflow zin=1, ztau=rtaue
+                  zin = sign( 1., z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+         ! ... for inflow rtauein is used for relaxation coefficient else rtaue
+                  ztau = (1.-zin ) * rtauein  + zin * rtaue
+                  z05cx = z05cx * zin
+         ! ... update ua with radiative or climatological velocity
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * ( 1. - uemsk(jj,jk) ) +          &
+                                 uemsk(jj,jk) * (  ( 1. - z05cx - ztau )         &
+                                 * uebnd(jj,jk,nib ,nitm) + 2.*z05cx               &
+                                 * uebnd(jj,jk,nibm,nit ) + ztau * ufoe (jj,jk) )  &
+                                 / (1. + z05cx)
+               END DO
+            END DO
+         END DO
+# if ! defined key_dynspg_fsc
+         ! ... ua must be a baroclinic velocity uclie() 
+         CALL obc_cli( ua, uclie, nie0, nie1, 0, jpj )  
+
+         ! ... add the correct barotropic radiative velocity (calculated from bsfn) to the 
+         !     baroclinc velocity uclie() to have the total velocity
+         DO ji = nie0, nie1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * ( 1. - uemsk(jj,jk) ) +                     &
+                                 uemsk(jj,jk) * ( uclie(jj,jk) -  hur (ji,jj) / e2u (ji,jj) &
+                                 * ( bsfn(ji,jj) - bsfn(ji,jj-1) ) )
+               END DO
+            END DO
+         END DO
+# endif
+         ! 2.2 v-component of the velocity
+         ! -------------------------------
+         !
+         !          nibm2       nibm     nib
+         !            |   nibm  |   nib///|///
+         !            |    |    |    |////|///
+         !  jj-line --v----f----v----f----v---
+         !            |    |    |    |////|///
+         !            |    |    |    |////|///
+         !            | jpieob-1 |  jpieob /|///
+         !            |         |         |   
+         !         jpieob-1    jpieob     jpieob+1
+         !
+         ! ... radiative condition
+         ! ... (jpjedp1, jpjefm1), jpieob+1
+         DO ji = nie0+1, nie1+1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  z05cx = v_cxebnd(jj,jk) 
+                  z05cx = z05cx / e1f(ji-1,jj)
+                  z05cx = min( z05cx, 1. )
+         ! ... z05cx=< 0, inflow  zin=0, ztau=1    
+         !           > 0, outflow zin=1, ztau=rtaue
+                  zin = sign( 1., z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+         ! ... for inflow rtauein is used for relaxation coefficient else rtaue
+                  ztau = (1.-zin ) * rtauein  + zin * rtaue
+                  z05cx = z05cx * zin
+         ! ... update va with radiative or climatological velocity
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1. - vemsk(jj,jk) ) +          &
+                                 vemsk(jj,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * vebnd(jj,jk,nib ,nitm) + 2.*z05cx              &
+                                 * vebnd(jj,jk,nibm,nit ) + ztau * vfoe(jj,jk) )  &
+                                 / (1. + z05cx)
+               END DO
+            END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE obc_dyn_east
+
+   SUBROUTINE obc_dyn_west ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_dyn_west
+      !!                    *************************
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on west OBC velocities ua, va using the 
+      !!      phase velocities calculated in obc_rad_west subroutine in obcrad.F90 module
+      !!      If the logical lfbcwest is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      REAL(wp) ::   z05cx, ztau, zin
+
+      !!------------------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcwest is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest ) THEN
+
+         ! 1.1 U zonal velocity
+         ! ---------------------
+         DO ji = niw0, niw1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+# if defined key_dynspg_fsc
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uwmsk(jj,jk)) + &
+                                 uwmsk(jj,jk)*ufow(jj,jk)
+# else 
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uwmsk(jj,jk)) +                     &
+                                 uwmsk(jj,jk)*( ufow(jj,jk) - hur (ji,jj) / e2u (ji,jj) &
+                                 * ( bsfn(ji,jj) - bsfn(ji,jj-1) ) )
+# endif
+               END DO
+            END DO
+         END DO
+
+         ! 1.2 V meridional velocity
+         ! -------------------------
+         DO ji = niw0, niw1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1.-vwmsk(jj,jk)) + &
+                                 vfow(jj,jk)*vwmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcwest is .FALSE.
+      ! -----------------------------------------------------
+ 
+         ! 2.1. u-component of the velocity
+         ! ---------------------------------
+         !
+         !        nib       nibm     nibm2
+         !      ///|   nib   |   nibm  |
+         !      ///|    |    |    |    |
+         !      ---f----v----f----v----f-- jj-line
+         !      ///|    |    |    |    |
+         !      ///|         |         |
+         !      ///u    T    u    T    u   jj-line
+         !      ///|         |         |
+         !      ///|    |    |    |    |
+         !       jpiwob    jpiwob+1    jpiwob+2
+         !              |         |        
+         !            jpiwob+1    jpiwob+2     
+         !
+         ! ... If free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology
+         ! ... (jpjwdp1, jpjwfm1), jpiwob
+         DO ji = niw0, niw1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  z05cx = u_cxwbnd(jj,jk)
+                  z05cx = z05cx / e1t(ji+1,jj)
+                  z05cx = max( z05cx, -1. )
+         ! ... z05c  > 0, inflow  zin=0, ztau=1    
+         !          =< 0, outflow zin=1, ztau=rtauw
+                  zin = sign( 1., -1. * z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+                  ztau = (1.-zin )* rtauwin + zin * rtauw
+                  z05cx = z05cx * zin
+         ! ... update un with radiative or climatological velocity
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * ( 1. - uwmsk(jj,jk) ) +          &
+                                 uwmsk(jj,jk) * ( ( 1. + z05cx - ztau )          &
+                                 * uwbnd(jj,jk,nib ,nitm) - 2.*z05cx               &
+                                 * uwbnd(jj,jk,nibm,nit ) + ztau  * ufow (jj,jk) ) &
+                                 / (1. - z05cx)
+               END DO
+            END DO
+         END DO
+# if ! defined key_dynspg_fsc
+         ! ... ua must be a baroclinic velocity ucliw() 
+         CALL obc_cli( ua, ucliw, niw0, niw1, 0, jpj )  
+
+         ! ... add the correct barotropic radiative velocity (calculated from bsfn)
+         !     to the baroclinc velocity ucliw() to have the total velocity
+         DO ji = niw0, niw1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * ( 1. - uwmsk(jj,jk) ) +                    &
+                                 uwmsk(jj,jk)*( ucliw(jj,jk) - hur (ji,jj) / e2u (ji,jj)   &
+                                 * ( bsfn(ji,jj) - bsfn(ji,jj-1) ) )
+               END DO
+            END DO
+         END DO
+# endif
+
+         ! 2.2 v-component of the velocity
+         ! -------------------------------
+         !
+         !    nib       nibm     nibm2
+         !  ///|///nib   |   nibm  |  nibm2
+         !  ///|////|    |    |    |    |    |
+         !  ---v----f----v----f----v----f----v-- jj-line
+         !  ///|////|    |    |    |    |    |
+         !  ///|////|    |    |    |    |    |
+         ! jpiwob     jpiwob+1    jpiwob+2
+         !          |         |         |   
+         !        jpiwob   jpiwob+1   jpiwob+2    
+         !
+         ! ... radiative condition plus Raymond-Kuo
+         ! ... (jpjwdp1, jpjwfm1),jpiwob
+         DO ji = niw0, niw1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  z05cx = v_cxwbnd(jj,jk)  
+                  z05cx = z05cx / e1f(ji,jj)
+                  z05cx = max( z05cx, -1. )
+         ! ... z05cx > 0, inflow  zin=0, ztau=1    
+         !          =< 0, outflow zin=1, ztau=rtauw
+                  zin = sign( 1., -1. * z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+                  ztau = (1.-zin )*rtauwin + zin * rtauw
+                  z05cx = z05cx * zin 
+         ! ... update va with radiative or climatological velocity
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1. - vwmsk(jj,jk) ) +          &
+                                 vwmsk(jj,jk) * ( ( 1. + z05cx - ztau )         &
+                                 * vwbnd(jj,jk,nib ,nitm) - 2.*z05cx              &
+                                 * vwbnd(jj,jk,nibm,nit ) + ztau * vfow (jj,jk) ) &
+                                 / (1. - z05cx)
+                END DO
+             END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE obc_dyn_west
+
+   SUBROUTINE obc_dyn_north ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_dyn_north
+      !!                    *************************
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on north OBC velocities ua, va using the 
+      !!      phase velocities calculated in obc_rad_north subroutine in obcrad.F90 module
+      !!      If the logical lfbcnorth is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      REAL(wp) ::   z05cx, ztau, zin
+
+      !!------------------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcnorth is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! ---------------------------------------------------------
+ 
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth ) THEN
+
+         ! 1.1 U zonal velocity
+         ! --------------------
+         DO jj = njn0+1, njn1+1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  ua(ji,jj,jk)= ua(ji,jj,jk) * (1.-unmsk(ji,jk)) + &
+                                ufon(ji,jk)*unmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+
+         ! 1.2 V meridional velocity
+         ! -------------------------
+         DO jj = njn0, njn1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+# if defined key_dynspg_fsc
+                  va(ji,jj,jk)= va(ji,jj,jk) * (1.-vnmsk(ji,jk)) + &
+                                vfon(ji,jk)*vnmsk(ji,jk)
+# else
+                  va(ji,jj,jk)= va(ji,jj,jk) * (1.-vnmsk(ji,jk)) +                       &
+                                vnmsk(ji,jk) * ( vfon(ji,jk) + hvr (ji,jj) / e1v (ji,jj) &
+                                * ( bsfn(ji,jj) - bsfn(ji-1,jj) ) )
+# endif
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcnorth is .FALSE.
+      ! ------------------------------------------------------
+
+         ! 2.1. u-component of the velocity
+         ! --------------------------------
+         !
+         !            ji-row
+         !              |
+         !       nib ///u//////  jpjnob + 1
+         !         /////|//////
+         !     nib -----f-----   jpjnob
+         !              |    
+         !      nibm--  u   ---- jpjnob
+         !              |        
+         !    nibm -----f-----   jpjnob-1
+         !              |        
+         !     nibm2--  u   ---- jpjnob-1
+         !              |        
+         !   nibm2 -----f-----   jpjnob-2
+         !              |
+         !
+         ! ... radiative condition
+         ! ... jpjnob+1,(jpindp1, jpinfm1)
+         DO jj = njn0+1, njn1+1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  z05cx= u_cynbnd(ji,jk) 
+                  z05cx = z05cx / e2f(ji, jj-1)
+                  z05cx = min( z05cx, 1. )
+         ! ... z05cx=< 0, inflow  zin=0, ztau=1    
+         !           > 0, outflow zin=1, ztau=rtaun
+                  zin = sign( 1., z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+         ! ... for inflow rtaunin is used for relaxation coefficient else rtaun
+                  ztau = (1.-zin ) * rtaunin  + zin * rtaun
+         ! ... for u, when inflow, ufon is prescribed
+                  z05cx = z05cx * zin
+         ! ... update un with radiative or climatological velocity
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-unmsk(ji,jk)) +             &
+                                 unmsk(ji,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * unbnd(ji,jk,nib ,nitm) + 2.*z05cx              &
+                                 * unbnd(ji,jk,nibm,nit ) + ztau * ufon (ji,jk) ) &
+                                 / (1. + z05cx)
+               END DO
+            END DO
+         END DO
+
+         ! 2.2 v-component of the velocity
+         ! -------------------------------
+         !
+         !                ji-row    ji-row
+         !              |         |
+         !         /////|/////////////////
+         !    nib  -----f----v----f----  jpjnob
+         !              |         |
+         !      nib  -  u -- T -- u ---- jpjnob
+         !              |         |
+         !   nibm  -----f----v----f----  jpjnob-1
+         !              |         |
+         !     nibm --  u -- T -- u ---  jpjnob-1
+         !              |         |
+         !   nibm2 -----f----v----f----  jpjnob-2
+         !              |         |
+         !
+         ! ... If rigidlid formulation:
+         ! ... radiative conditions on the baroclinic part only + relaxation toward climatology 
+         ! ... If free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology
+         ! ... jpjnob,(jpindp1, jpinfm1)
+         DO jj = njn0, njn1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+         ! ... 2* gradj(v) (T-point i=nibm, time mean)
+                  z05cx = v_cynbnd(ji,jk)
+                  z05cx = z05cx / e2t(ji,jj)
+                  z05cx = min( z05cx, 1. )
+         ! ... z05cx=< 0, inflow  zin=0, ztau=1    
+         !           > 0, outflow zin=1, ztau=rtaun
+                  zin = sign( 1., z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+         ! ... for inflow rtaunin is used for relaxation coefficient else rtaun
+                  ztau = (1.-zin ) * rtaunin + zin * rtaun
+                  z05cx = z05cx * zin
+         ! ... update va with radiative or climatological velocity
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1.-vnmsk(ji,jk)) +             &
+                                 vnmsk(ji,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * vnbnd(ji,jk,nib ,nitm) + 2.*z05cx              &
+                                 * vnbnd(ji,jk,nibm,nit ) + ztau * vfon (ji,jk) ) &
+                                 / (1. + z05cx)
+               END DO
+            END DO
+         END DO
+# if ! defined key_dynspg_fsc
+         ! ... va must be a baroclinic velocity vclin() 
+         CALL obc_cli( va, vclin, njn0, njn1, 1, jpi )  
+
+         ! ... add the correct barotropic radiative velocity (calculated from bsfn)
+         !     to the baroclinc velocity vclin() to have the total velocity
+         DO jj = njn0, njn1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1.-vnmsk(ji,jk)) +                         &
+                                 vnmsk(ji,jk) * ( vclin(ji,jk) +  hvr (ji,jj) / e1v (ji,jj) &
+                                 * ( bsfn(ji,jj) - bsfn(ji-1,jj) ) )
+               END DO
+            END DO
+         END DO
+# endif
+      END IF
+
+   END SUBROUTINE obc_dyn_north
+
+   SUBROUTINE obc_dyn_south ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_dyn_south
+      !!                    *************************
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on south OBC velocities ua, va using the 
+      !!      phase velocities calculated in obc_rad_south subroutine in obcrad.F90 module
+      !!      If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      REAL(wp) ::   z05cx, ztau, zin
+
+      !!------------------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcsouth is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! ---------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth ) THEN
+
+         ! 1.1 U zonal velocity
+         ! --------------------
+         DO jj = njs0, njs1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  ua(ji,jj,jk)= ua(ji,jj,jk) * (1.-usmsk(ji,jk)) + &
+                                usmsk(ji,jk) * ufos(ji,jk)
+               END DO
+            END DO
+         END DO
+
+         ! 1.2 V meridional velocity
+         ! -------------------------
+         DO jj = njs0, njs1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+# if defined key_dynspg_fsc
+                  va(ji,jj,jk)= va(ji,jj,jk) * (1.-vsmsk(ji,jk)) + &
+                                vsmsk(ji,jk) * vfos(ji,jk)
+# else 
+                  va(ji,jj,jk)= va(ji,jj,jk) * (1.-vsmsk(ji,jk)) +                      &
+                                vsmsk(ji,jk) * (vfos(ji,jk) + hvr (ji,jj) / e1v (ji,jj) &
+                                * ( bsfn(ji,jj) - bsfn(ji-1,jj) ) )
+# endif
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcsouth is .FALSE.
+      ! ------------------------------------------------------
+
+         ! 2.1. u-component of the velocity
+         ! --------------------------------
+         !
+         !            ji-row
+         !              |
+         !   nibm2 -----f-----   jpjsob +2
+         !              |    
+         !    nibm2 --  u   ---- jpjsob +2 
+         !              |        
+         !    nibm -----f-----   jpjsob +1
+         !              |        
+         !    nibm  --  u   ---- jpjsob +1
+         !              |        
+         !    nib  -----f-----   jpjsob
+         !         /////|//////
+         !    nib   ////u/////   jpjsob 
+         !
+         ! ... radiative condition plus Raymond-Kuo
+         ! ... jpjsob,(jpisdp1, jpisfm1)
+         DO jj = njs0, njs1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  z05cx= u_cysbnd(ji,jk) 
+                  z05cx = z05cx / e2f(ji, jj)
+                  z05cx = max( z05cx, -1. )
+         ! ... z05cx > 0, inflow  zin=0, ztau=1 
+         !          =< 0, outflow zin=1, ztau=rtaus
+                  zin = sign( 1., -1. * z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+                  ztau = (1.-zin ) * rtausin + zin * rtaus
+                  z05cx = z05cx * zin 
+         ! ... update ua with radiative or climatological velocity
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-usmsk(ji,jk)) +              &
+                                 usmsk(ji,jk) * (  ( 1. + z05cx - ztau )         &
+                                 * usbnd(ji,jk,nib ,nitm) - 2.*z05cx               &
+                                 * usbnd(ji,jk,nibm,nit ) + ztau * ufos (ji,jk) )  &
+                                 / (1. - z05cx)
+               END DO
+            END DO
+         END DO
+
+         ! 2.2 v-component of the velocity
+         ! -------------------------------
+         !
+         !                ji-row    ji-row
+         !              |         |
+         !  nibm2  -----f----v----f----  jpjsob+2
+         !              |         |
+         !    nibm   -  u -- T -- u ---- jpjsob+2
+         !              |         |
+         !   nibm  -----f----v----f----  jpjsob+1 
+         !              |         |
+         !   nib    --  u -- T -- u ---  jpjsob+1
+         !              |         |
+         !   nib   -----f----v----f----  jpjsob
+         !         /////////////////////
+         !
+         ! ... If rigidlid formulation:
+         ! ... radiative conditions on the baroclinic part only + relaxation toward climatology
+         ! ... If free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology
+         ! ... jpjsob,(jpisdp1,jpisfm1)
+         DO jj = njs0, njs1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  z05cx = v_cysbnd(ji,jk)
+                  z05cx = z05cx / e2t(ji,jj+1)
+                  z05cx = max( z05cx, -1. )
+         ! ... z05c > 0, inflow  zin=0, ztau=1 
+         !         =< 0, outflow zin=1, ztau=rtaus
+                  zin = sign( 1., -1. * z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+                  ztau = (1.-zin )*rtausin + zin * rtaus
+                  z05cx = z05cx * zin
+         ! ... update va with radiative or climatological velocity
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1.-vsmsk(ji,jk)) +             &
+                                 vsmsk(ji,jk) * ( ( 1. + z05cx - ztau )         &
+                                 * vsbnd(ji,jk,nib ,nitm) - 2.*z05cx              &
+                                 * vsbnd(ji,jk,nibm,nit ) + ztau * vfos (ji,jk) ) &
+                                 / (1. - z05cx)
+               END DO
+            END DO
+         END DO
+# if ! defined key_dynspg_fsc 
+         ! ... va must be a baroclinic velocity vclis() 
+         CALL obc_cli( va, vclis, njs0, njs1, 1, jpi )  
+
+         ! ... add the correct barotropic radiative velocity (calculated from bsfn)
+         !     to the baroclinic velocity vclis() to have the total velocity
+         DO jj = njs0, njs1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1.-vsmsk(ji,jk)) +                         &
+                                 vsmsk(ji,jk) * ( vclis(ji,jk) +  hvr (ji,jj) / e1v (ji,jj) &
+                                 * ( bsfn(ji,jj) - bsfn(ji-1,jj) ) )
+               END DO
+            END DO
+         END DO
+# endif
+      END IF
+
+   END SUBROUTINE obc_dyn_south
+#else
+   !!=================================================================================
+   !!                       ***  MODULE  obcdyn  ***
+   !! Ocean dynamics:   Radiation of velocities on each open boundary
+   !!=================================================================================
+CONTAINS
+
+   SUBROUTINE obc_dyn
+                              ! No open boundaries ==> empty routine
+   END SUBROUTINE obc_dyn
+#endif
+
+END MODULE obcdyn
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obcini.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obcini.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obcini.F90	(revision 4)
@@ -0,0 +1,923 @@
+ MODULE obcini
+#if defined key_obc
+   !!=================================================================================
+   !!                       ***  MODULE  obcini  ***
+   !! OBC initial state :  Open boundary initial state
+   !!=================================================================================
+
+   !!---------------------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE lib_mpp         ! for mpp_sum
+   USE in_out_manager  ! I/O units
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC obc_init        ! routine called by opa.F90
+
+   !! * Substitutions
+#  include "obc_vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE obc_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE obc_init  ***
+      !!         
+      !! ** Purpose :   Initialization of the dynamics and tracer fields at 
+      !!      the open boundaries.
+      !!
+      !! ** Method  :   initialization of open boundary variables
+      !!      (u, v, bsf) over 3 time step and 3 rows
+      !!      (t, s)      over 2 time step and 2 rows
+      !!      if ln_rstart = .FALSE. : no restart, fields set to zero
+      !!      if ln_rstart = .TRUE.  : restart, fields are read in file numrob
+      !!      if rdpxxx = 0 then lfbc is set true for this boundary.
+      !!
+      !! ** Input file :   restart.obc   : input restart file for open 
+      !!                                   boundaries (unit file numrob)
+      !! History :
+      !!   8.0  !  97-07  (G. Madec)  Original code
+      !!        !  97-11  (J.M. Molines)
+      !!   8.5  !  02-11  (C. Talandier, A-M. Treguier) Free surface, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE obcrst,   ONLY :   obc_rst_lec               ! Make obc_rst_lec routine available
+      USE obcdom,   ONLY :   obc_dom                   ! Make obc_dom routine available
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, istop
+      INTEGER, DIMENSION(4) ::   icorner
+      REAL(wp) ::   zbsic1, zbsic2, zbsic3
+      REAL(wp), DIMENSION(2) ::   ztestmask
+
+      NAMELIST/namobc/ rdpein, rdpwin, rdpnin, rdpsin,   &
+                       rdpeob, rdpwob, rdpnob, rdpsob,   &
+                       zbsic1, zbsic2, zbsic3,           &
+                       nbic, volemp
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'obc_init : initialization of open boundaries'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+
+
+      ! 0. read namelist parameters
+      ! ---------------------------
+      ! default values already set except:
+      zbsic1 = 0.e0
+      zbsic2 = 0.e0
+      zbsic3 = 0.e0
+
+      ! Namelist namobc : open boundaries
+      REWIND( numnam )
+      READ  ( numnam, namobc )
+
+      bsfic0(1) = zbsic1
+      bsfic (2) = zbsic2
+      bsfic (3) = zbsic3
+
+      ! By security we set rdpxin and rdpxob respectively
+      ! to 1. and 15. if the corresponding OBC is not activated
+      IF( .NOT. lpeastobc ) THEN
+         rdpein = 1.
+         rdpeob = 15.
+      END IF
+      IF( .NOT. lpwestobc ) THEN
+         rdpwin = 1.
+         rdpwob = 15.
+      END IF
+      IF( .NOT. lpnorthobc ) THEN
+         rdpnin = 1.
+         rdpnob = 15.
+      END IF
+      IF( .NOT. lpsouthobc ) THEN
+         rdpsin = 1.
+         rdpsob = 15.
+      END IF
+
+      ! number of open boudaries and open boundary indicators
+      nbobc = 0
+      IF( lpeastobc ) THEN
+         nbobc=nbobc+1
+      END IF
+      IF( lpwestobc ) THEN
+         nbobc=nbobc+1
+      END IF
+      IF( lpnorthobc ) THEN
+         nbobc=nbobc+1
+      END IF
+      IF( lpsouthobc ) THEN
+         nbobc=nbobc+1
+      END IF
+
+      IF(lwp) WRITE(numout,*) '         Number of open boundaries    nbobc = ',nbobc
+      IF(lwp) WRITE(numout,*)
+      IF( nbobc /= 0 .AND. jperio /= 0 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' E R R O R : Cyclic or symmetric,',   &
+            ' and open boundary condition are not compatible'
+         IF(lwp) WRITE(numout,*) ' ========== '
+         IF(lwp) WRITE(numout,*)
+         nstop = nstop + 1
+      END IF
+
+      ! control prints
+      IF(lwp) WRITE(numout,*) '         namobc'
+      IF(lwp) WRITE(numout,*) ' '
+      IF(lwp) WRITE(numout,*) '         data in file (=1) or     nobc_dta = ',nobc_dta
+      IF(lwp) WRITE(numout,*) '         initial state used (=0)             '
+      IF( lwp.AND.lpeastobc ) THEN
+         WRITE(numout,*) '         East open boundary :'
+         WRITE(numout,*) '              i index                    jpieob = ',jpieob
+         WRITE(numout,*) '              damping time scale (days)  rdpeob = ',rdpeob
+         WRITE(numout,*) '              damping time scale (days)  rdpein = ',rdpein
+      END IF
+
+      IF( lwp.AND.lpwestobc ) THEN
+         WRITE(numout,*) '         West open boundary :'
+         WRITE(numout,*) '              i index                    jpiwob = ',jpiwob
+         WRITE(numout,*) '              damping time scale (days)  rdpwob = ',rdpwob
+         WRITE(numout,*) '              damping time scale (days)  rdpwin = ',rdpwin
+      END IF
+
+      IF( lwp.AND.lpnorthobc ) THEN
+         WRITE(numout,*) '         North open boundary :'
+         WRITE(numout,*) '               j index                    jpjnob = ',jpjnob
+         WRITE(numout,*) '               damping time scale (days)  rdpnob = ',rdpnob
+         WRITE(numout,*) '               damping time scale (days)  rdpnin = ',rdpnin
+      END IF
+
+      IF( lwp.AND.lpsouthobc ) THEN
+         WRITE(numout,*) '         South open boundary :'
+         WRITE(numout,*) '               j index                    jpjsob = ',jpjsob
+         WRITE(numout,*) '               damping time scale (days)  rdpsob = ',rdpsob
+         WRITE(numout,*) '               damping time scale (days)  rdpsin = ',rdpsin
+         WRITE(numout,*) ' '
+      END IF
+
+      ! 1. Initialisation of constants 
+      ! ------------------------------
+
+      ! ... convert rdp$ob in seconds
+      rdpein = rdpein * rday
+      rdpwin = rdpwin * rday
+      rdpnin = rdpnin * rday
+      rdpsin = rdpsin * rday
+      rdpeob = rdpeob * rday
+      rdpwob = rdpwob * rday
+      rdpnob = rdpnob * rday
+      rdpsob = rdpsob * rday
+      lfbceast  = .FALSE.
+      lfbcwest  = .FALSE.
+      lfbcnorth = .FALSE.
+      lfbcsouth = .FALSE.
+      ! ... look for Fixed Boundaries (rdp = 0 )
+      ! ... When specified, lbcxxx flags are set to TRUE and rdpxxx are set to
+      ! ...  a small arbitrary value, (to avoid division by zero further on). 
+      ! ...  rdpxxx is not used anymore.
+      IF( lpeastobc .AND. ( rdpein == 0 .AND. rdpeob == 0 ) )  THEN
+         lfbceast = .TRUE.
+         rdpein = 1e-3
+         rdpeob = 1e-3
+      END IF
+      IF( lpwestobc .AND. ( rdpwin == 0 .AND. rdpwob == 0 ) )  THEN
+         lfbcwest = .TRUE.
+         rdpwin = 1e-3
+         rdpwob = 1e-3
+      END IF
+      IF( lpnorthobc .AND. ( rdpnin == 0 .AND. rdpnob == 0 ) )  THEN
+         lfbcnorth = .TRUE.
+         rdpnin = 1e-3
+         rdpnob = 1e-3
+      END IF
+      IF( lpsouthobc .AND. ( rdpsin == 0 .AND. rdpsob == 0 ) )  THEN
+         lfbcsouth = .TRUE.
+         rdpsin = 1e-3
+         rdpsob = 1e-3
+      END IF
+
+      ! 2.  Clever mpp indices for loops on the open boundaries. 
+      !     The loops will be performed only on the processors 
+      !     that contain a given open boundary.
+      ! --------------------------------------------------------
+
+      IF( lpeastobc ) THEN
+         ! ...   mpp initialization
+         nie0   = max( 1, min(jpieob   - nimpp+1, jpi     ) )
+         nie1   = max( 0, min(jpieob   - nimpp+1, jpi - 1 ) )
+         nie0p1 = max( 1, min(jpieob+1 - nimpp+1, jpi     ) )
+         nie1p1 = max( 0, min(jpieob+1 - nimpp+1, jpi - 1 ) )
+         nie0m1 = max( 1, min(jpieob-1 - nimpp+1, jpi     ) )
+         nie1m1 = max( 0, min(jpieob-1 - nimpp+1, jpi - 1 ) )
+         nje0   = max( 2, min(jpjed    - njmpp+1, jpj     ) )
+         nje1   = max( 0, min(jpjef    - njmpp+1, jpj - 1 ) )
+         nje0p1 = max( 1, min(jpjedp1  - njmpp+1, jpj     ) )
+         nje0m1 = max( 1, min(jpjed    - njmpp+1, jpj     ) )
+         nje1m1 = max( 0, min(jpjefm1  - njmpp+1, jpj - 1 ) )
+         nje1m2 = max( 0, min(jpjefm1-1- njmpp+1, jpj - 1 ) )
+         IF(lwp) THEN
+            IF( lfbceast ) THEN
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Specified East Open Boundary'
+            ELSE
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Radiative East Open Boundary'
+            END IF
+         END IF
+      END IF
+
+      IF( lpwestobc ) THEN
+         ! ...   mpp initialization
+         niw0   = max( 1, min(jpiwob   - nimpp+1, jpi     ) )
+         niw1   = max( 0, min(jpiwob   - nimpp+1, jpi - 1 ) )
+         niw0p1 = max( 1, min(jpiwob+1 - nimpp+1, jpi     ) )
+         niw1p1 = max( 0, min(jpiwob+1 - nimpp+1, jpi - 1 ) )
+         njw0   = max( 2, min(jpjwd    - njmpp+1, jpj     ) )
+         njw1   = max( 0, min(jpjwf    - njmpp+1, jpj - 1 ) )
+         njw0p1 = max( 1, min(jpjwdp1  - njmpp+1, jpj     ) )
+         njw0m1 = max( 1, min(jpjwd    - njmpp+1, jpj     ) )
+         njw1m1 = max( 0, min(jpjwfm1  - njmpp+1, jpj - 1 ) )
+         njw1m2 = max( 0, min(jpjwfm1-1- njmpp+1, jpj - 1 ) )
+         IF(lwp) THEN
+            IF( lfbcwest ) THEN
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Specified West Open Boundary'
+            ELSE
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Radiative West Open Boundary'
+            END IF
+         END IF
+      END IF
+ 
+      IF( lpnorthobc ) THEN
+         ! ...   mpp initialization
+         nin0   = max( 2, min(jpind    - nimpp+1, jpi     ) )
+         nin1   = max( 0, min(jpinf    - nimpp+1, jpi - 1 ) )
+         nin0p1 = max( 1, min(jpindp1  - nimpp+1, jpi     ) )
+         nin0m1 = max( 1, min(jpind    - nimpp+1, jpi     ) )
+         nin1m1 = max( 0, min(jpinfm1  - nimpp+1, jpi - 1 ) )
+         nin1m2 = max( 0, min(jpinfm1-1- nimpp+1, jpi - 1 ) )
+         njn0   = max( 1, min(jpjnob   - njmpp+1, jpj     ) )
+         njn1   = max( 0, min(jpjnob   - njmpp+1, jpj - 1 ) )
+         njn0p1 = max( 1, min(jpjnob+1 - njmpp+1, jpj     ) )
+         njn1p1 = max( 0, min(jpjnob+1 - njmpp+1, jpj - 1 ) )
+         njn0m1 = max( 1, min(jpjnob-1 - njmpp+1, jpj     ) )
+         njn1m1 = max( 0, min(jpjnob-1 - njmpp+1, jpj - 1 ) )
+         IF(lwp) THEN
+            IF( lfbcnorth ) THEN
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Specified North Open Boundary'
+            ELSE
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Radiative North Open Boundary'
+            END IF
+         END IF
+      END IF
+
+      IF( lpsouthobc ) THEN
+         ! ...   mpp initialization
+         nis0   = max( 2, min(jpisd    - nimpp+1, jpi     ) )
+         nis1   = max( 0, min(jpisf    - nimpp+1, jpi - 1 ) )
+         nis0p1 = max( 1, min(jpisdp1  - nimpp+1, jpi     ) )
+         nis0m1 = max( 1, min(jpisd    - nimpp+1, jpi     ) )
+         nis1m1 = max( 0, min(jpisfm1  - nimpp+1, jpi - 1 ) )
+         nis1m2 = max( 0, min(jpisfm1-1- nimpp+1, jpi - 1 ) )
+         njs0   = max( 1, min(jpjsob   - njmpp+1, jpj     ) )
+         njs1   = max( 0, min(jpjsob   - njmpp+1, jpj - 1 ) )
+         njs0p1 = max( 1, min(jpjsob+1 - njmpp+1, jpj     ) )
+         njs1p1 = max( 0, min(jpjsob+1 - njmpp+1, jpj - 1 ) )
+         IF(lwp) THEN
+            IF( lfbcsouth ) THEN
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Specified South Open Boundary'
+            ELSE
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Radiative South Open Boundary'
+            END IF
+         END IF
+      END IF
+
+      ! 3. mask correction for OBCs
+      ! ---------------------------
+
+      IF( lpeastobc ) THEN
+         !... (jpjed,jpjefm1),jpieob
+         DO jj = nje0, nje1m1
+# if defined key_dynspg_fsc
+            DO ji = nie0p1, nie1p1
+# else
+            DO ji = nie0, nie1
+# endif
+               bmask(ji,jj) = 0.e0
+            END DO
+         END DO
+
+         ! ... initilization to zero
+         uemsk(:,:) = 0.e0
+         vemsk(:,:) = 0.e0
+         temsk(:,:) = 0.e0
+
+         ! ... set 2D mask on East OBC,  Vopt
+         DO ji = fs_nie0, fs_nie1
+            DO jj = nje0, nje1
+               uemsk(jj,:) = umask(ji,  jj,:)
+               vemsk(jj,:) = vmask(ji+1,jj,:)
+               temsk(jj,:) = tmask(ji+1,jj,:)
+            END DO
+         END DO
+
+      END IF
+
+      IF( lpwestobc ) THEN
+         ! ... (jpjwd,jpjwfm1),jpiwob
+         DO jj = njw0, njw1m1
+            DO ji = niw0, niw1
+               bmask(ji,jj) = 0.e0
+            END DO
+         END DO
+
+         ! ... initilization to zero
+         uwmsk(:,:) = 0.e0
+         vwmsk(:,:) = 0.e0
+         twmsk(:,:) = 0.e0
+
+         ! ... set 2D mask on West OBC,  Vopt
+         DO ji = fs_niw0, fs_niw1
+            DO jj = njw0, njw1
+               uwmsk(jj,:) = umask(ji,jj,:)
+               vwmsk(jj,:) = vmask(ji,jj,:)
+               twmsk(jj,:) = tmask(ji,jj,:)
+            END DO
+         END DO
+
+      END IF
+
+      IF( lpnorthobc ) THEN
+         ! ... jpjnob,(jpind,jpisfm1)
+# if defined key_dynspg_fsc
+         DO jj = njn0p1, njn1p1
+# else
+         DO jj = njn0, njn1
+# endif
+            DO ji = nin0, nin1m1
+               bmask(ji,jj) = 0.e0
+            END DO
+         END DO
+
+         ! ... initilization to zero
+         unmsk(:,:) = 0.e0
+         vnmsk(:,:) = 0.e0
+         tnmsk(:,:) = 0.e0
+
+         ! ... set 2D mask on North OBC,  Vopt
+         DO jj = fs_njn0, fs_njn1
+            DO ji = nin0, nin1
+               unmsk(ji,:) = umask(ji,jj+1,:)
+               vnmsk(ji,:) = vmask(ji,jj  ,:)
+               tnmsk(ji,:) = tmask(ji,jj+1,:)
+            END DO
+         END DO
+
+      END IF
+
+      IF( lpsouthobc ) THEN 
+         ! ... jpjsob,(jpisd,jpisfm1)
+         DO jj = njs0, njs1
+            DO ji = nis0, nis1m1
+               bmask(ji,jj) = 0.e0
+            END DO
+         END DO
+
+         ! ... initilization to zero
+         usmsk(:,:) = 0.e0
+         vsmsk(:,:) = 0.e0
+         tsmsk(:,:) = 0.e0
+
+         ! ... set 2D mask on South OBC,  Vopt
+         DO jj = njs0, njs1
+            DO ji = nis0, nis1
+               usmsk(ji,:) = umask(ji,jj,:)
+               vsmsk(ji,:) = vmask(ji,jj,:)
+               tsmsk(ji,:) = tmask(ji,jj,:)
+            END DO
+         END DO
+
+      END IF
+
+# if defined key_dynspg_fsc
+
+      ! ... Initialize obcumask and obcvmask for the Force filtering 
+      !     boundary condition in dynspg_fsc
+      obcumask(:,:) = umask(:,:,1)
+      obcvmask(:,:) = vmask(:,:,1)
+
+      ! ... Initialize obctmsk on overlap region and obcs. This mask
+      !     is used in obcvol.F90 to calculate cumulate flux E-P. 
+      !     - no flux E-P on obcs and overlap region (jpereci = jprecj = 1)
+      obctmsk(:,:) = tmask(:,:,1)     
+      obctmsk(1  ,:) = 0.e0           
+      obctmsk(jpi,:) = 0.e0           
+      obctmsk(:  ,1) = 0.e0           
+      obctmsk(:,jpj) = 0.e0           
+
+      IF( lpeastobc ) THEN
+         ! ... East obc Force filtering mask for the grad D
+         DO ji = nie0, nie1
+            DO jj = nje0p1, nje1m1
+               obcumask(ji  ,jj)=0.e0
+               obcvmask(ji+1,jj)=0.e0
+            END DO
+         END DO
+
+         ! ... set to 0 on East OBC
+         DO jj = nje0p1, nje1m1
+            DO ji = nie0p1, nie1p1
+               obctmsk(ji,jj) = 0.e0
+            END DO
+         END DO
+      END IF
+
+      IF( lpwestobc ) THEN
+         ! ... West obc Force filtering mask for the grad D
+         DO ji = niw0, niw1
+            DO jj = njw0p1, njw1m1
+               obcumask(ji,jj)=0.e0
+               obcvmask(ji,jj)=0.e0
+            END DO
+         END DO
+
+         ! ... set to 0 on West OBC
+         DO jj = njw0p1, njw1m1
+            DO ji = niw0, niw1
+               obctmsk(ji,jj) = 0.e0
+            END DO
+         END DO
+      END IF
+
+      IF( lpnorthobc ) THEN
+         ! ... North obc Force filtering mask for the grad D
+         DO jj = njn0, njn1
+            DO ji = nin0p1, nin1m1
+               obcvmask(ji,jj  )=0.e0
+               obcumask(ji,jj+1)=0.e0
+            END DO
+         END DO
+
+         ! ... set to 0 on North OBC
+         DO jj = njn0p1, njn1p1
+            DO ji = nin0p1, nin1m1
+               obctmsk(ji,jj) = 0.e0
+            END DO
+         END DO
+      END IF
+
+      IF( lpsouthobc ) THEN
+         ! ... South obc Force filtering mask for the grad D
+         DO jj = njs0, njs1 
+            DO ji = nis0p1, nis1m1
+               obcumask(ji,jj)=0.e0
+               obcvmask(ji,jj)=0.e0
+            END DO
+         END DO
+
+         ! ... set to 0 on South OBC
+         DO jj = njs0, njs1
+            DO ji = nis0p1, nis1m1
+               obctmsk(ji,jj) = 0.e0
+            END DO
+         END DO
+      END IF
+
+      ! 3.1 Total lateral surface for each open boundary
+      ! ------------------------------------------------
+
+      ! ... West open boundary surface
+      IF( lpwestobc ) THEN
+         DO ji = niw0, niw1
+            DO jj = 1, jpj 
+               obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1)
+            END DO
+         END DO
+       END IF
+
+      ! ... East open boundary surface
+      IF( lpeastobc ) THEN
+         DO ji = nie0, nie1
+            DO jj = 1, jpj 
+               obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1)
+            END DO
+         END DO
+      END IF
+
+      ! ... North open boundary vertical surface
+      IF( lpnorthobc ) THEN
+         DO jj = njn0, njn1
+            DO ji = 1, jpi
+               obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1)
+            END DO
+         END DO
+      END IF
+
+      ! ... South open boundary vertical surface
+      IF( lpsouthobc ) THEN
+         DO jj = njs0, njs1
+            DO ji = 1, jpi
+               obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1)
+            END DO
+         END DO
+      END IF
+
+# if defined key_mpp
+      CALL mpp_sum( obcsurftot )
+# endif
+
+# endif
+
+      ! 5. Control print on mask 
+      !    The extremities of the open boundaries must be in land
+      !    or else correspond to an "ocean corner" between two open boundaries. 
+      !    corner 1 is southwest, 2 is south east, 3 is northeast, 4 is northwest. 
+      ! --------------------------------------------------------------------------
+
+      icorner(:)=0
+
+      ! ... control of the west boundary
+      IF( lpwestobc ) THEN
+         IF( jpiwob < 2 .OR.  jpiwob >= jpiglo-2 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' E R R O R : jpiwob exceed ', jpiglo-2, 'or less than 2'
+            IF(lwp) WRITE(numout,*) ' ========== '
+            IF(lwp) WRITE(numout,*)
+            nstop = nstop + 1
+         END IF
+         ztestmask(:)=0.
+         DO ji=niw0,niw1
+            IF( (njw0 + njmpp - 1) == jpjwd ) ztestmask(1)=ztestmask(1)+ tmask(ji,njw0,1)
+            IF( (njw1 + njmpp - 1) == jpjwf ) ztestmask(2)=ztestmask(2)+ tmask(ji,njw1,1)
+         END DO
+# if defined key_mpp
+         CALL mpp_sum( ztestmask, 2 )
+# endif
+         IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1
+         IF( ztestmask(2) /= 0. ) icorner(4)=icorner(4)+1
+      END IF
+
+      ! ... control of the east boundary
+      IF( lpeastobc ) THEN
+         IF( jpieob < 4 .OR.  jpieob >= jpiglo ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' E R R O R : jpieob exceed ', jpiglo, ' or less than 4'
+            IF(lwp) WRITE(numout,*) ' ========== '
+            IF(lwp) WRITE(numout,*)
+            nstop = nstop + 1
+         END IF
+         ztestmask(:)=0.
+         DO ji=nie0p1,nie1p1
+            IF( (nje0 + njmpp - 1) == jpjed ) ztestmask(1)=ztestmask(1)+ tmask(ji,nje0,1)
+            IF( (nje1 + njmpp - 1) == jpjef ) ztestmask(2)=ztestmask(2)+ tmask(ji,nje1,1)
+         END DO
+# if defined key_mpp
+         CALL mpp_sum( ztestmask, 2 )
+# endif
+        IF( ztestmask(1) /= 0. ) icorner(2)=icorner(2)+1
+        IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1
+      END IF
+
+      ! ... control of the north boundary
+      IF( lpnorthobc ) THEN
+         IF( jpjnob < 4 .OR.  jpjnob >= jpjglo ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' E R R O R : jpjnob exceed ', jpjglo, ' or less than 4'
+            IF(lwp) WRITE(numout,*) ' ========== '
+            IF(lwp) WRITE(numout,*)
+            nstop = nstop + 1
+         END IF
+         ztestmask(:)=0.
+         DO jj=njn0p1,njn1p1
+            IF( (nin0 + nimpp - 1) == jpind ) ztestmask(1)=ztestmask(1)+ tmask(nin0,jj,1)
+            IF( (nin1 + nimpp - 1) == jpinf ) ztestmask(2)=ztestmask(2)+ tmask(nin1,jj,1)
+         END DO
+# if defined key_mpp
+         CALL mpp_sum( ztestmask, 2 )
+# endif
+         IF( ztestmask(1) /= 0. ) icorner(4)=icorner(4)+1
+         IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1
+      END IF
+
+      ! ... control of the south boundary
+      IF( lpsouthobc ) THEN
+         IF( jpjsob < 2 .OR.  jpjsob >= jpjglo-2 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' E R R O R : jpjsob exceed ', jpjglo-2, ' or less than 2'
+            IF(lwp) WRITE(numout,*) ' ========== '
+            IF(lwp) WRITE(numout,*)
+            nstop = nstop + 1
+         END IF
+         ztestmask(:)=0.
+         DO jj=njs0,njs1
+            IF( (nis0 + nimpp - 1) == jpisd ) ztestmask(1)=ztestmask(1)+ tmask(nis0,jj,1)
+            IF( (nis1 + nimpp - 1) == jpisf ) ztestmask(2)=ztestmask(2)+ tmask(nis1,jj,1)
+         END DO
+# if defined key_mpp
+         CALL mpp_sum( ztestmask, 2 )
+# endif
+         IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1
+         IF( ztestmask(2) /= 0. ) icorner(2)=icorner(2)+1
+      END IF
+
+      IF( icorner(1) == 2 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' South West ocean corner, two open boudaries'
+         IF(lwp) WRITE(numout,*) ' ========== '
+         IF(lwp) WRITE(numout,*)
+         IF( jpisd /= jpiwob.OR.jpjsob /= jpjwd ) THEN
+            IF(lwp) WRITE(numout,*) ' Open boundaries do not fit, we stop'
+            nstop = nstop + 1
+         END IF
+      ELSE IF( icorner(1) == 1 ) THEN
+              IF(lwp) WRITE(numout,*) ' Open boundaries do not fit at SW corner, we stop'
+              nstop = nstop + 1
+      END IF 
+
+      IF( icorner(2) == 2 ) THEN
+          IF(lwp) WRITE(numout,*)
+          IF(lwp) WRITE(numout,*) ' South East ocean corner, two open boudaries'
+          IF(lwp) WRITE(numout,*) ' ========== '
+          IF(lwp) WRITE(numout,*)
+          IF( jpisf /= jpieob+1.OR.jpjsob /= jpjed ) THEN
+             IF(lwp) WRITE(numout,*) ' Open boundaries do not fit, we stop'
+             nstop = nstop + 1
+          END IF
+      ELSE IF( icorner(2) == 1 ) THEN
+              IF(lwp) WRITE(numout,*) ' Open boundaries do not fit at SE corner, we stop'
+              nstop = nstop + 1
+      END IF 
+
+      IF( icorner(3) == 2 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' North East ocean corner, two open boudaries'
+         IF(lwp) WRITE(numout,*) ' ========== '
+         IF(lwp) WRITE(numout,*)
+         IF( jpinf /= jpieob+1 .OR. jpjnob+1 /= jpjef ) THEN
+            IF(lwp) WRITE(numout,*) ' Open boundaries do not fit, we stop'
+            nstop = nstop + 1
+         END IF
+       ELSE IF( icorner(3) == 1 ) THEN
+               IF(lwp) WRITE(numout,*) ' Open boundaries do not fit at NE corner, we stop'
+               nstop = nstop + 1
+       END IF 
+
+      IF( icorner(4) == 2 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' North West ocean corner, two open boudaries'
+         IF(lwp) WRITE(numout,*) ' ========== '
+         IF(lwp) WRITE(numout,*)
+         IF( jpind /= jpiwob.OR.jpjnob+1 /= jpjwf ) THEN
+            IF(lwp) WRITE(numout,*) ' Open boundaries do not fit, we stop'
+            nstop = nstop + 1
+         END IF
+       ELSE IF( icorner(4) == 1 ) THEN
+               IF(lwp) WRITE(numout,*) ' Open boundaries do not fit at NW corner, we stop'
+               nstop = nstop + 1
+       END IF 
+
+      ! 6. Initialization of open boundary variables (u, v, bsf, t, s)
+      ! --------------------------------------------------------------
+
+      ! ... Restart from numrob
+      IF( ln_rstart ) THEN
+         CALL obc_rst_lec
+      ELSE
+
+          ! ... Initialization to zero of radiation arrays.
+          !     Those have dimensions of local subdomains
+
+          bebnd(:,:,:)   = 0.e0
+          uebnd(:,:,:,:) = 0.e0
+          vebnd(:,:,:,:) = 0.e0
+          tebnd(:,:,:,:) = 0.e0 
+          sebnd(:,:,:,:) = 0.e0
+
+          bwbnd(:,:,:)   = 0.e0
+          uwbnd(:,:,:,:) = 0.e0
+          vwbnd(:,:,:,:) = 0.e0
+          twbnd(:,:,:,:) = 0.e0 
+          swbnd(:,:,:,:) = 0.e0
+
+          bnbnd(:,:,:)   = 0.e0
+          unbnd(:,:,:,:) = 0.e0
+          vnbnd(:,:,:,:) = 0.e0
+          tnbnd(:,:,:,:) = 0.e0 
+          snbnd(:,:,:,:) = 0.e0
+
+          bsbnd(:,:,:)   = 0.e0
+          usbnd(:,:,:,:) = 0.e0
+          vsbnd(:,:,:,:) = 0.e0
+          tsbnd(:,:,:,:) = 0.e0 
+          ssbnd(:,:,:,:) = 0.e0
+
+      END IF
+
+# if ! defined key_dynspg_fsc
+      ! 7. Isolated coastline arrays initialization (rigid lid case only)
+      ! -----------------------------------------------------------------
+      CALL obc_dom
+# endif
+
+      ! 8. Control print
+      ! ... control of the east boundary
+      IF( lpeastobc ) THEN
+         istop = 0
+         IF( jpieob < 4 .OR.  jpieob >= jpiglo ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '            jpieob exceed ', jpim1, ' or less than 4'
+            istop = istop + 1
+         END IF
+# if defined key_mpp
+         ! ... 
+         IF( nimpp > jpieob-5) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the East OBC'
+            IF(lwp) WRITE(numout,*) '        nimpp must be < jpieob-5'
+            istop = istop + 1
+         END IF
+# else
+         IF( tmask(jpieob+1,jpjed  ,1) /= 0. .OR.    &
+             tmask(jpieob+1,jpjed+1,1) /= 1.         ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '           starting point is not a land T-point.'
+            IF(lwp) WRITE(numout,*) '      or   starting point + 1 is not a ocean T-point.'
+            istop = istop + 1
+         END IF
+         IF( tmask(jpieob+1,jpjef  ,1) /= 0. .OR.  &
+             tmask(jpieob+1,jpjef-1,1) /= 1.       ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '           ending point is not a land T-point.'
+            IF(lwp) WRITE(numout,*) '        or ending point - 1 is not a ocean T-point.'
+            istop = istop + 1
+         END IF
+
+         ! ... stop if  e r r o r (s)   detected
+         IF( istop /= 0 ) THEN
+            IF(lwp)WRITE(numout,*)
+            IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop'
+            IF(lwp)WRITE(numout,*) ' =============== '
+            IF(lwp)WRITE(numout,*)
+            nstop = nstop + 1
+         END IF
+# endif
+      END IF
+
+      ! ... control of the west boundary
+      IF( lpwestobc ) THEN
+         istop = 0
+         IF( jpiwob < 2 .OR.  jpiwob >= jpiglo ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '            jpiwob exceed ', jpim1, ' or less than 2'
+            istop = istop + 1
+         END IF
+# if defined key_mpp
+         ! ... 
+         IF( (nimpp < jpiwob+5) .AND. (nimpp > 1) ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the West OBC'
+            IF(lwp) WRITE(numout,*) '        nimpp must be > jpiwob-5 or =1'
+            istop = istop + 1
+         END IF
+# else
+         IF( tmask(jpiwob,jpjwd  ,1) /= 0. .OR.    &
+             tmask(jpiwob,jpjwd+1,1) /= 1.         ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '           starting point is not a land T-point.'
+            IF(lwp) WRITE(numout,*) '      or   starting point + 1 is not a ocean T-point.'
+            istop = istop + 1
+         END IF
+         IF ( tmask(jpieob+1,jpjef  ,1) /= 0. .OR.  &
+              tmask(jpieob+1,jpjef-1,1) /= 1.       ) THEN
+             IF(lwp) WRITE(numout,cform_err)
+             IF(lwp) WRITE(numout,*) '           ending point is not a land T-point.'
+             IF(lwp) WRITE(numout,*) '        or ending point - 1 is not a ocean T-point.'
+             istop = istop + 1
+         END IF
+
+         ! ... stop if  e r r o r (s)   detected
+         IF( istop /= 0 ) THEN
+            IF(lwp)WRITE(numout,*)
+            IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop'
+            IF(lwp)WRITE(numout,*) ' =============== '
+            IF(lwp)WRITE(numout,*)
+            nstop = nstop + 1
+         END IF
+# endif
+      END IF
+
+      ! control of the north boundary
+      IF( lpnorthobc ) THEN
+         istop = 0
+         IF( jpjnob < 4 .OR.  jpjnob >= jpjglo ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          jpjnob exceed ', jpjm1,' or less than 4'
+            istop = istop + 1
+         END IF
+# if defined key_mpp
+         ! ... 
+         IF( njmpp > jpjnob-5) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the North OBC'
+            IF(lwp) WRITE(numout,*) '        njmpp must be < jpjnob-5'
+            istop = istop + 1
+         END IF
+# else
+         IF( tmask(jpind  , jpjnob+1,1) /= 0. .OR.    &
+             tmask(jpind+1, jpjnob+1,1) /= 1.         ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '           starting point is not a land T-point.'
+            IF(lwp) WRITE(numout,*) '      or   starting point + 1 is not a ocean T-point.'
+            istop = istop + 1
+         END IF
+         IF( tmask(jpinf  ,jpjnob+1,1) /= 0. .OR.  &
+             tmask(jpinf-1,jpjnob+1,1) /= 1.       ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '           ending point is not a land T-point.'
+            IF(lwp) WRITE(numout,*) '        or ending point - 1 is not a ocean T-point.'
+            istop = istop + 1
+         END IF
+
+         ! ... stop if  e r r o r (s)   detected
+         IF( istop /= 0 ) THEN
+            IF(lwp)WRITE(numout,*)
+            IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop'
+            IF(lwp)WRITE(numout,*) ' =============== '
+            IF(lwp)WRITE(numout,*)
+            nstop = nstop + 1
+         END IF
+# endif
+      END IF
+
+      ! control of the south boundary
+      IF( lpsouthobc ) THEN
+         istop = 0
+         IF( jpjsob < 2 .OR. jpjsob >= jpjglo ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          jpjsob exceed ', jpjm1,' or less than 2'
+            istop = istop + 1
+         END IF
+# if defined key_mpp
+         ! ... 
+         IF( (njmpp < jpjsob+5) .AND. (njmpp > 1) ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the South OBC'
+            IF(lwp) WRITE(numout,*) '        njmpp must be > jpjsob+5 or =1'
+            istop = istop + 1
+         END IF
+# else
+         IF( tmask(jpisd  , jpjsob,1) /= 0. .OR.    &
+             tmask(jpisd+1, jpjsob,1) /= 1.         ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '           starting point is not a land T-point.'
+            IF(lwp) WRITE(numout,*) '      or   starting point + 1 is not a ocean T-point.'
+            istop = istop + 1
+         END IF
+         IF( tmask(jpisf  ,jpjsob,1) /= 0. .OR.  &
+             tmask(jpisf-1,jpjsob,1) /= 1.       ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '           ending point is not a land T-point.'
+            IF(lwp) WRITE(numout,*) '        or ending point - 1 is not a ocean T-point.'
+            istop = istop + 1
+         END IF
+
+         ! ... stop if  e r r o r (s)   detected
+         IF( istop /= 0 ) THEN
+            IF(lwp)WRITE(numout,*)
+            IF(lwp)WRITE(numout,*) istop,' E R R O R (S) detected : stop'
+            IF(lwp)WRITE(numout,*) ' =============== '
+            IF(lwp)WRITE(numout,*)
+            nstop = nstop + 1
+         END IF
+# endif
+      END IF
+
+   END SUBROUTINE obc_init
+#else
+   !!=================================================================================
+   !!                       ***  MODULE  obcini  ***
+   !! OBC initial state :  Open boundary initial state
+   !!=================================================================================
+CONTAINS
+
+   SUBROUTINE obc_init
+      !                 This is not an Open boundary mode ==> empty routine
+   END SUBROUTINE obc_init
+#endif
+
+END MODULE obcini
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obcrad.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obcrad.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obcrad.F90	(revision 4)
@@ -0,0 +1,1280 @@
+MODULE obcrad 
+   !!=================================================================================
+   !!                       ***  MODULE  obcrad  ***
+   !! Ocean dynamic :   Phase velocities for each open boundary
+   !!=================================================================================
+#if defined key_obc
+   !!---------------------------------------------------------------------------------
+   !!   obc_rad        : call the subroutine for each open boundary
+   !!   obc_rad_east   : compute the east phase velocities
+   !!   obc_rad_west   : compute the west phase velocities
+   !!   obc_rad_north  : compute the north phase velocities
+   !!   obc_rad_south  : compute the south phase velocities
+   !!---------------------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE lib_mpp         ! for mppobc
+   USE in_out_manager  ! I/O units
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC obc_rad        ! routine called by step.F90
+
+   !! * Module variables
+   INTEGER ::   ji, jj, jk     ! dummy loop indices
+
+   INTEGER ::      & ! ... boundary space indices 
+      nib   = 1,   & ! nib   = boundary point
+      nibm  = 2,   & ! nibm  = 1st interior point
+      nibm2 = 3,   & ! nibm2 = 2nd interior point
+                     ! ... boundary time indices 
+      nit   = 1,   & ! nit    = now
+      nitm  = 2,   & ! nitm   = before
+      nitm2 = 3      ! nitm2  = before-before
+
+   !! * Substitutions
+#  include "obc_vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_rad ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_rad
+      !!                    ********************
+      !! ** Purpose :
+      !!      Perform swap of arrays to calculate radiative phase speeds at the open 
+      !!      boundaries and calculate those phase speeds if the open boundaries are 
+      !!      not fixed. In case of fixed open boundaries does nothing.
+      !!
+      !!     The logical variable lpeastobc, and/or lpwestobc, and/or lpnorthobc,
+      !!     and/or lpsouthobc allow the user to determine which boundary is an
+      !!     open one (must be done in the param_obc.h90 file).
+      !! 
+      !! ** Reference : 
+      !!     Marchesiello P., 1995, these de l'universite J. Fourier, Grenoble, France.
+      !!
+      !!  History :
+      !!    8.5  !  02-10  (C. Talandier, A-M. Treguier) Free surface, F90 from the 
+      !!                                                 J. Molines and G. Madec version
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+      !!----------------------------------------------------------------------
+
+      ! 1. East open boundary
+      ! ---------------------
+
+      IF( lpeastobc .AND. ( .NOT. lfbceast ) ) THEN
+         CALL obc_rad_east( kt )
+      END IF
+
+      ! 2. West open boundary
+      ! ---------------------
+
+      IF( lpwestobc .AND. ( .NOT. lfbcwest ) ) THEN
+         CALL obc_rad_west( kt )
+      END IF
+
+      ! 3. North open boundary
+      ! ---------------------
+      
+      IF( lpnorthobc .AND. ( .NOT. lfbcnorth ) ) THEN
+         CALL obc_rad_north( kt )
+      END IF
+
+      ! 4. South open boundary
+      ! ---------------------
+      
+      IF( lpsouthobc .AND. ( .NOT. lfbcsouth ) ) THEN
+         CALL obc_rad_south( kt )
+      END IF
+
+   END SUBROUTINE obc_rad
+
+   SUBROUTINE obc_rad_east ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_rad_east
+      !!                    *************************
+      !! ** Purpose :
+      !!      Perform swap of arrays to calculate radiative phase speeds at the open 
+      !!      east boundary and calculate those phase speeds if this OBC is not fixed.
+      !!      In case of fixed OBC, this subrountine is not called.
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declarations
+      INTEGER ::   ij, ii
+
+      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy
+      REAL(wp) ::   zucb, zucbm, zucbm2
+
+      !!------------------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!------------------------------------------------------------------------------
+
+      ! 1. Swap arrays before calculating radiative velocities
+      ! ------------------------------------------------------
+
+      ! 1.1  zonal velocity 
+      ! -------------------
+
+      IF( kt > nit000 ) THEN 
+
+         ! ... advance in time (time filter, array swap) 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               uebnd(jj,jk,nib  ,nitm2) = uebnd(jj,jk,nib  ,nitm)*uemsk(jj,jk)
+               uebnd(jj,jk,nibm ,nitm2) = uebnd(jj,jk,nibm ,nitm)*uemsk(jj,jk)
+               uebnd(jj,jk,nibm2,nitm2) = uebnd(jj,jk,nibm2,nitm)*uemsk(jj,jk)
+            END DO
+         END DO
+         ! ... fields nitm <== nit  plus time filter at the boundary 
+         DO ji = fs_nie0, fs_nie1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  uebnd(jj,jk,nib  ,nitm) = uebnd(jj,jk,nib,  nit)*uemsk(jj,jk)
+                  uebnd(jj,jk,nibm ,nitm) = uebnd(jj,jk,nibm ,nit)*uemsk(jj,jk)
+                  uebnd(jj,jk,nibm2,nitm) = uebnd(jj,jk,nibm2,nit)*uemsk(jj,jk)
+         ! ... fields nit <== now (kt+1) 
+         ! ... Total or baroclinic velocity at b, bm and bm2
+# if ! defined key_dynspg_fsc
+                  zucb   = uclie(jj,jk)
+# else
+                  zucb   = un(ji,jj,jk)
+# endif
+# if ! defined key_dynspg_fsc
+                  zucbm  = un(ji-1,jj,jk) + hur(ji-1,jj) / e2u(ji-1,jj) &
+                           * ( bsfn(ji-1,jj) - bsfn(ji-1,jj-1) )
+# else
+                  zucbm  = un(ji-1,jj,jk)
+# endif
+# if ! defined key_dynspg_fsc
+                  zucbm2 = un(ji-2,jj,jk) + hur(ji-2,jj) / e2u(ji-2,jj) &
+                           * ( bsfn(ji-2,jj) - bsfn(ji-2,jj-1) )
+# else
+                  zucbm2 = un(ji-2,jj,jk)
+# endif
+                  uebnd(jj,jk,nib  ,nit) = zucb   *uemsk(jj,jk)
+                  uebnd(jj,jk,nibm ,nit) = zucbm  *uemsk(jj,jk) 
+                  uebnd(jj,jk,nibm2,nit) = zucbm2 *uemsk(jj,jk) 
+               END DO
+            END DO
+         END DO
+# ifdef key_mpp
+         CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj)
+# endif
+         ! ... extremeties nie0, nie1
+         ij = jpjed +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               uebnd(ij,jk,nibm,nitm) = uebnd(ij+1 ,jk,nibm,nitm)
+            END DO
+         END IF
+         ij = jpjef +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               uebnd(ij,jk,nibm,nitm) = uebnd(ij-1 ,jk,nibm,nitm)
+            END DO
+         END IF
+
+         ! 1.2 tangential velocity
+         ! -----------------------
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+         ! ... fields nitm2 <== nitm
+               vebnd(jj,jk,nib  ,nitm2) = vebnd(jj,jk,nib  ,nitm)*vemsk(jj,jk)
+               vebnd(jj,jk,nibm ,nitm2) = vebnd(jj,jk,nibm ,nitm)*vemsk(jj,jk)
+               vebnd(jj,jk,nibm2,nitm2) = vebnd(jj,jk,nibm2,nitm)*vemsk(jj,jk)
+            END DO
+         END DO
+
+         DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  vebnd(jj,jk,nib  ,nitm) = vebnd(jj,jk,nib,  nit)*vemsk(jj,jk)
+                  vebnd(jj,jk,nibm ,nitm) = vebnd(jj,jk,nibm ,nit)*vemsk(jj,jk)
+                  vebnd(jj,jk,nibm2,nitm) = vebnd(jj,jk,nibm2,nit)*vemsk(jj,jk)
+         ! ... fields nit <== now (kt+1)
+                  vebnd(jj,jk,nib  ,nit) = vn(ji  ,jj,jk)*vemsk(jj,jk)
+                  vebnd(jj,jk,nibm ,nit) = vn(ji-1,jj,jk)*vemsk(jj,jk)
+                  vebnd(jj,jk,nibm2,nit) = vn(ji-2,jj,jk)*vemsk(jj,jk)
+               END DO
+            END DO
+         END DO
+# ifdef key_mpp
+         CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj)
+# endif
+         !... extremeties nie0, nie1
+         ij = jpjed +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               vebnd(ij,jk,nibm,nitm) = vebnd(ij+1 ,jk,nibm,nitm)
+            END DO 
+         END IF 
+         ij = jpjef +1 - njmpp 
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
+            DO jk = 1,jpkm1 
+               vebnd(ij,jk,nibm,nitm) = vebnd(ij-1 ,jk,nibm,nitm)
+            END DO 
+         END IF 
+
+         ! 1.3 Temperature and salinity
+         ! ----------------------------
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+         ! ... fields nitm <== nit  plus time filter at the boundary
+               tebnd(jj,jk,nib,nitm) = tebnd(jj,jk,nib,nit)*temsk(jj,jk)
+               sebnd(jj,jk,nib,nitm) = sebnd(jj,jk,nib,nit)*temsk(jj,jk)
+            END DO
+         END DO
+
+         DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  tebnd(jj,jk,nibm,nitm) = tebnd(jj,jk,nibm,nit)*temsk(jj,jk)
+                  sebnd(jj,jk,nibm,nitm) = sebnd(jj,jk,nibm,nit)*temsk(jj,jk)
+         ! ... fields nit <== now (kt+1)
+                  tebnd(jj,jk,nib  ,nit) = tn(ji  ,jj,jk)*temsk(jj,jk)
+                  tebnd(jj,jk,nibm ,nit) = tn(ji-1,jj,jk)*temsk(jj,jk)
+                  sebnd(jj,jk,nib  ,nit) = sn(ji  ,jj,jk)*temsk(jj,jk)
+                  sebnd(jj,jk,nibm ,nit) = sn(ji-1,jj,jk)*temsk(jj,jk)
+               END DO
+            END DO
+         END DO
+# ifdef key_mpp
+         CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj)
+         CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj)
+# endif
+         ! ... extremeties nie0, nie1
+         ij = jpjed +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               tebnd(ij,jk,nibm,nitm) = tebnd(ij+1 ,jk,nibm,nitm)
+               sebnd(ij,jk,nibm,nitm) = sebnd(ij+1 ,jk,nibm,nitm)
+            END DO
+         END IF
+         ij = jpjef +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               tebnd(ij,jk,nibm,nitm) = tebnd(ij-1 ,jk,nibm,nitm)
+               sebnd(ij,jk,nibm,nitm) = sebnd(ij-1 ,jk,nibm,nitm)
+            END DO
+         END IF
+
+      END IF     ! End of array swap
+
+      ! 2 - Calculation of radiation velocities
+      ! ---------------------------------------
+
+      IF( kt >= nit000 +3 .OR. ln_rstart ) THEN
+
+         ! 2.1  Calculate the normal velocity U based on phase velocity u_cxebnd
+         ! ---------------------------------------------------------------------
+         !
+         !          nibm2      nibm      nib
+         !            |  nibm   |   nib   |///
+         !            |    |    |    |    |///
+         !  jj-line --f----v----f----v----f---
+         !            |    |    |    |    |///
+         !            |         |         |///
+         !  jj-line   u    T    u    T    u///
+         !            |         |         |///
+         !            |    |    |    |    |///
+         !          jpieob-2   jpieob-1   jpieob
+         !                 |         |        
+         !              jpieob-1    jpieob      
+         !
+         ! ... (jpjedp1, jpjefm1),jpieob
+         DO ji = fs_nie0, fs_nie1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+         ! ... 2* gradi(u) (T-point i=nibm, time mean)
+                  z2dx = ( uebnd(jj,jk,nibm ,nit) + uebnd(jj,jk,nibm ,nitm2) &
+                           - 2.*uebnd(jj,jk,nibm2,nitm) ) / e1t(ji-1,jj)
+         ! ... 2* gradj(u) (u-point i=nibm, time nitm)
+                  z2dy = ( uebnd(jj+1,jk,nibm,nitm) - uebnd(jj-1,jk,nibm,nitm) ) / e2u(ji-1,jj)
+         ! ... square of the norm of grad(u)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = uebnd(jj,jk,nibm,nitm2) - uebnd(jj,jk,nibm,nit)
+         ! ... i-phase speed ratio (bounded by 1)               
+                  IF( z4nor2 == 0. ) THEN
+                     z4nor2=.00001
+                  END IF
+                  z05cx = zdt * z2dx / z4nor2
+                  u_cxebnd(jj,jk) = z05cx*uemsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+         ! 2.2  Calculate the tangential velocity based on phase velocity v_cxebnd
+         ! -----------------------------------------------------------------------
+         !
+         !          nibm2      nibm      nib
+         !            |   nibm  |   nib///|///
+         !            |    |    |    |////|///
+         !  jj-line --v----f----v----f----v---
+         !            |    |    |    |////|///
+         !            |    |    |    |////|///
+         !            | jpieob-1| jpieob /|///
+         !            |         |         |   
+         !         jpieob-1    jpieob     jpieob+1
+         !
+         ! ... (jpjedp1, jpjefm1), jpieob+1
+         DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+         ! ... 2* i-gradient of v (f-point i=nibm, time mean)
+                  z2dx = ( vebnd(jj,jk,nibm ,nit) + vebnd(jj,jk,nibm ,nitm2) &
+                          - 2.*vebnd(jj,jk,nibm2,nitm) ) / e1f(ji-2,jj)
+         ! ... 2* j-gradient of v (v-point i=nibm, time nitm)
+                  z2dy = ( vebnd(jj+1,jk,nibm,nitm) -  vebnd(jj-1,jk,nibm,nitm) ) / e2v(ji-1,jj)
+         ! ... square of the norm of grad(v)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = vebnd(jj,jk,nibm,nitm2) - vebnd(jj,jk,nibm,nit)
+         ! ... i-phase speed ratio (bounded by 1) and save the unbounded phase
+         !     velocity ratio no divided by e1f for the tracer radiation
+                  IF( z4nor2 == 0. ) THEN
+                     z4nor2=.000001
+                  END IF
+                  z05cx = zdt * z2dx / z4nor2
+                  v_cxebnd(jj,jk) = z05cx*vemsk(jj,jk)
+               END DO
+            END DO
+         END DO
+# if defined key_mpp
+         CALL mppobc(v_cxebnd,jpjed,jpjef,jpieob+1,jpk,2,jpj)
+# endif
+         ! ... extremeties nie0, nie1
+         ij = jpjed +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               v_cxebnd(ij,jk) = v_cxebnd(ij+1 ,jk)
+            END DO
+         END IF
+         ij = jpjef +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               v_cxebnd(ij,jk) = v_cxebnd(ij-1 ,jk)
+            END DO
+         END IF
+
+      END IF
+
+   END SUBROUTINE obc_rad_east
+
+   SUBROUTINE obc_rad_west ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_rad_west
+      !!                    *************************
+      !! ** Purpose :
+      !!      Perform swap of arrays to calculate radiative phase speeds at the open 
+      !!      west boundary and calculate those phase speeds if this OBC is not fixed.
+      !!      In case of fixed OBC, this subrountine is not called.
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declarations
+      INTEGER ::   ij, ii
+
+      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy
+      REAL(wp) ::   zucb, zucbm, zucbm2
+
+      !!------------------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!------------------------------------------------------------------------------
+
+      ! 1. Swap arrays before calculating radiative velocities
+      ! ------------------------------------------------------
+
+      ! 1.1  zonal velocity 
+      ! -------------------
+
+      IF( kt > nit000 ) THEN
+
+         ! ... advance in time (time filter, array swap) 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj 
+               uwbnd(jj,jk,nib  ,nitm2) = uwbnd(jj,jk,nib  ,nitm)*uwmsk(jj,jk)
+               uwbnd(jj,jk,nibm ,nitm2) = uwbnd(jj,jk,nibm ,nitm)*uwmsk(jj,jk)
+               uwbnd(jj,jk,nibm2,nitm2) = uwbnd(jj,jk,nibm2,nitm)*uwmsk(jj,jk)
+            END DO
+         END DO
+
+         ! ... fields nitm <== nit  plus time filter at the boundary 
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  uwbnd(jj,jk,nib  ,nitm) = uwbnd(jj,jk,nib  ,nit)*uwmsk(jj,jk)
+                  uwbnd(jj,jk,nibm ,nitm) = uwbnd(jj,jk,nibm ,nit)*uwmsk(jj,jk)
+                  uwbnd(jj,jk,nibm2,nitm) = uwbnd(jj,jk,nibm2,nit)*uwmsk(jj,jk)
+         ! ... total or baroclinic velocity at b, bm and bm2
+# if ! defined key_dynspg_fsc
+                  zucb   = ucliw(jj,jk) 
+# else
+                  zucb   = un (ji,jj,jk)
+# endif
+# if ! defined key_dynspg_fsc
+                  zucbm  = un (ji+1,jj,jk) + hur (ji+1,jj) / e2u (ji+1,jj) &
+                           * ( bsfn(ji+1,jj) - bsfn(ji+1,jj-1) )
+# else
+                  zucbm  = un (ji+1,jj,jk)
+# endif
+# if ! defined key_dynspg_fsc
+                  zucbm2 = un (ji+2,jj,jk) + hur (ji+2,jj) / e2u (ji+2,jj) &
+                           * ( bsfn(ji+2,jj) - bsfn(ji+2,jj-1) )
+# else
+                  zucbm2 = un (ji+2,jj,jk)
+# endif
+
+         ! ... fields nit <== now (kt+1) 
+                  uwbnd(jj,jk,nib  ,nit) = zucb  *uwmsk(jj,jk)
+                  uwbnd(jj,jk,nibm ,nit) = zucbm *uwmsk(jj,jk)
+                  uwbnd(jj,jk,nibm2,nit) = zucbm2*uwmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+# if defined key_mpp
+         CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj)
+# endif
+         ! ... extremeties niw0, niw1
+         ij = jpjwd +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               uwbnd(ij,jk,nibm,nitm) = uwbnd(ij+1 ,jk,nibm,nitm)
+            END DO
+         END IF
+         ij = jpjwf +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               uwbnd(ij,jk,nibm,nitm) = uwbnd(ij-1 ,jk,nibm,nitm)
+            END DO
+         END IF
+
+         ! 1.2 tangential velocity
+         ! -----------------------
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj 
+         ! ... fields nitm2 <== nitm
+                  vwbnd(jj,jk,nib  ,nitm2) = vwbnd(jj,jk,nib  ,nitm)*vwmsk(jj,jk)
+                  vwbnd(jj,jk,nibm ,nitm2) = vwbnd(jj,jk,nibm ,nitm)*vwmsk(jj,jk)
+                  vwbnd(jj,jk,nibm2,nitm2) = vwbnd(jj,jk,nibm2,nitm)*vwmsk(jj,jk)
+            END DO
+         END DO
+
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  vwbnd(jj,jk,nib  ,nitm) = vwbnd(jj,jk,nib,  nit)*vwmsk(jj,jk)
+                  vwbnd(jj,jk,nibm ,nitm) = vwbnd(jj,jk,nibm ,nit)*vwmsk(jj,jk)
+                  vwbnd(jj,jk,nibm2,nitm) = vwbnd(jj,jk,nibm2,nit)*vwmsk(jj,jk)
+         ! ... fields nit <== now (kt+1)
+                  vwbnd(jj,jk,nib  ,nit) = vn(ji  ,jj,jk)*vwmsk(jj,jk)
+                  vwbnd(jj,jk,nibm ,nit) = vn(ji+1,jj,jk)*vwmsk(jj,jk)
+                  vwbnd(jj,jk,nibm2,nit) = vn(ji+2,jj,jk)*vwmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+# if defined key_mpp
+         CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj)
+# endif
+         ! ... extremeties niw0, niw1 
+         ij = jpjwd +1 - njmpp 
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
+            DO jk = 1,jpkm1 
+               vwbnd(ij,jk,nibm,nitm) = vwbnd(ij+1 ,jk,nibm,nitm)
+            END DO 
+         END IF
+         ij = jpjwf +1 - njmpp 
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
+            DO jk = 1,jpkm1 
+               vwbnd(ij,jk,nibm,nitm) = vwbnd(ij-1 ,jk,nibm,nitm)
+            END DO 
+         END IF 
+ 
+         ! 1.3 Temperature and salinity
+         ! ----------------------------
+ 
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+         ! ... fields nitm <== nit  plus time filter at the boundary
+               twbnd(jj,jk,nib,nitm) = twbnd(jj,jk,nib,nit)*twmsk(jj,jk)
+               swbnd(jj,jk,nib,nitm) = swbnd(jj,jk,nib,nit)*twmsk(jj,jk)
+            END DO
+         END DO
+ 
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  twbnd(jj,jk,nibm ,nitm) = twbnd(jj,jk,nibm ,nit)*twmsk(jj,jk)
+                  swbnd(jj,jk,nibm ,nitm) = swbnd(jj,jk,nibm ,nit)*twmsk(jj,jk)
+         ! ... fields nit <== now (kt+1)
+                  twbnd(jj,jk,nib  ,nit) = tn(ji   ,jj,jk)*twmsk(jj,jk)
+                  twbnd(jj,jk,nibm ,nit) = tn(ji+1 ,jj,jk)*twmsk(jj,jk)
+                  swbnd(jj,jk,nib  ,nit) = sn(ji   ,jj,jk)*twmsk(jj,jk)
+                  swbnd(jj,jk,nibm ,nit) = sn(ji+1 ,jj,jk)*twmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+# if defined key_mpp
+         CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj)
+         CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj)
+# endif
+         ! ... extremeties niw0, niw1
+         ij = jpjwd +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               twbnd(ij,jk,nibm,nitm) = twbnd(ij+1 ,jk,nibm,nitm)
+               swbnd(ij,jk,nibm,nitm) = swbnd(ij+1 ,jk,nibm,nitm)
+            END DO
+         END IF
+         ij = jpjwf +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               twbnd(ij,jk,nibm,nitm) = twbnd(ij-1 ,jk,nibm,nitm)
+               swbnd(ij,jk,nibm,nitm) = swbnd(ij-1 ,jk,nibm,nitm)
+            END DO
+         END IF
+ 
+      END IF     ! End of array swap
+
+      ! 2 - Calculation of radiation velocities
+      ! ---------------------------------------
+   
+      IF( kt >= nit000 +3 .OR. ln_rstart ) THEN
+  
+         ! 2.1  Calculate the normal velocity U based on phase velocity u_cxwbnd
+         ! ----------------------------------------------------------------------
+         !
+         !          nib       nibm      nibm2
+         !        ///|   nib   |   nibm  |
+         !        ///|    |    |    |    |
+         !        ---f----v----f----v----f-- jj-line
+         !        ///|    |    |    |    |
+         !        ///|         |         |
+         !        ///u    T    u    T    u   jj-line
+         !        ///|         |         |
+         !        ///|    |    |    |    |
+         !         jpiwob    jpiwob+1    jpiwob+2
+         !                |         |        
+         !              jpiwob+1    jpiwob+2     
+         !
+         ! ... If free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology
+         ! ... (jpjwdp1, jpjwfm1), jpiwob
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+         ! ... 2* gradi(u) (T-point i=nibm, time mean)
+                  z2dx = ( - uwbnd(jj,jk,nibm ,nit) -  uwbnd(jj,jk,nibm ,nitm2) &
+                           + 2.*uwbnd(jj,jk,nibm2,nitm) ) / e1t(ji+2,jj)
+         ! ... 2* gradj(u) (u-point i=nibm, time nitm)
+                  z2dy = ( uwbnd(jj+1,jk,nibm,nitm) - uwbnd(jj-1,jk,nibm,nitm) ) / e2u(ji+1,jj)
+         ! ... square of the norm of grad(u)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = uwbnd(jj,jk,nibm,nitm2) - uwbnd(jj,jk,nibm,nit)
+         ! ... i-phase speed ratio (bounded by -1)
+                  IF( z4nor2 == 0. ) THEN
+                     z4nor2=0.00001
+                  END IF
+                  z05cx = zdt * z2dx / z4nor2
+                  u_cxwbnd(jj,jk)=z05cx*uwmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+         ! 2.2  Calculate the tangential velocity based on phase velocity v_cxwbnd
+         ! -----------------------------------------------------------------------
+         !
+         !      nib       nibm     nibm2
+         !    ///|///nib   |   nibm  |  nibm2
+         !    ///|////|    |    |    |    |    |
+         !    ---v----f----v----f----v----f----v-- jj-line
+         !    ///|////|    |    |    |    |    |
+         !    ///|////|    |    |    |    |    |
+         !   jpiwob     jpiwob+1    jpiwob+2
+         !            |         |         |   
+         !          jpiwob   jpiwob+1   jpiwob+2    
+         !
+         ! ... radiative condition plus Raymond-Kuo
+         ! ... (jpjwdp1, jpjwfm1),jpiwob
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+         ! ... 2* i-gradient of v (f-point i=nibm, time mean)
+                  z2dx = ( - vwbnd(jj,jk,nibm ,nit) - vwbnd(jj,jk,nibm ,nitm2) &
+                           + 2.*vwbnd(jj,jk,nibm2,nitm) ) / e1f(ji+1,jj)
+         ! ... 2* j-gradient of v (v-point i=nibm, time nitm)
+                  z2dy = ( vwbnd(jj+1,jk,nibm,nitm) - vwbnd(jj-1,jk,nibm,nitm) ) / e2v(ji+1,jj)
+         ! ... square of the norm of grad(v)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = vwbnd(jj,jk,nibm,nitm2) - vwbnd(jj,jk,nibm,nit)
+         ! ... i-phase speed ratio (bounded by -1) and save the unbounded phase
+         !     velocity ratio no divided by e1f for the tracer radiation
+                  IF( z4nor2 == 0) THEN
+                     z4nor2=0.000001
+                  endif
+                  z05cx = zdt * z2dx / z4nor2
+                  v_cxwbnd(jj,jk) = z05cx*vwmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+# if defined key_mpp
+         CALL mppobc(v_cxwbnd,jpjwd,jpjwf,jpiwob,jpk,2,jpj)
+# endif
+         ! ... extremeties niw0, niw1
+         ij = jpjwd +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               v_cxwbnd(ij,jk) = v_cxwbnd(ij+1 ,jk)
+            END DO
+         END IF
+         ij = jpjwf +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               v_cxwbnd(ij,jk) = v_cxwbnd(ij-1 ,jk)
+            END DO
+         END IF
+
+      END IF
+
+   END SUBROUTINE obc_rad_west
+
+   SUBROUTINE obc_rad_north ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_rad_north
+      !!                    *************************
+      !! ** Purpose :
+      !!      Perform swap of arrays to calculate radiative phase speeds at the open 
+      !!      north boundary and calculate those phase speeds if this OBC is not fixed.
+      !!      In case of fixed OBC, this subrountine is not called.
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declarations
+      INTEGER ::   ij, ii
+
+      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy
+      REAL(wp) ::   zvcb, zvcbm, zvcbm2
+
+      !!------------------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!------------------------------------------------------------------------------
+
+      ! 1. Swap arrays before calculating radiative velocities
+      ! ------------------------------------------------------
+
+      ! 1.1  zonal velocity 
+      ! -------------------
+
+      IF( kt > nit000 ) THEN 
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+         ! ... fields nitm2 <== nitm
+               unbnd(ji,jk,nib  ,nitm2) = unbnd(ji,jk,nib  ,nitm)*unmsk(ji,jk)
+               unbnd(ji,jk,nibm ,nitm2) = unbnd(ji,jk,nibm ,nitm)*unmsk(ji,jk)
+               unbnd(ji,jk,nibm2,nitm2) = unbnd(ji,jk,nibm2,nitm)*unmsk(ji,jk)
+            END DO
+         END DO
+
+         DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  unbnd(ji,jk,nib  ,nitm) = unbnd(ji,jk,nib,  nit)*unmsk(ji,jk)
+                  unbnd(ji,jk,nibm ,nitm) = unbnd(ji,jk,nibm ,nit)*unmsk(ji,jk)
+                  unbnd(ji,jk,nibm2,nitm) = unbnd(ji,jk,nibm2,nit)*unmsk(ji,jk)
+         ! ... fields nit <== now (kt+1)
+                  unbnd(ji,jk,nib  ,nit) = un(ji,jj,  jk)*unmsk(ji,jk)
+                  unbnd(ji,jk,nibm ,nit) = un(ji,jj-1,jk)*unmsk(ji,jk)
+                  unbnd(ji,jk,nibm2,nit) = un(ji,jj-2,jk)*unmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+# if defined key_mpp
+         CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi)
+# endif
+         ! ... extremeties njn0,njn1 
+         ii = jpind + 1 - nimpp 
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN 
+            DO jk = 1, jpkm1
+                unbnd(ii,jk,nibm,nitm) = unbnd(ii+1,jk,nibm,nitm)
+            END DO
+         END IF 
+         ii = jpinf + 1 - nimpp 
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               unbnd(ii,jk,nibm,nitm) = unbnd(ii-1,jk,nibm,nitm)
+            END DO
+         END IF
+ 
+         ! 1.2. normal velocity 
+         ! --------------------
+
+         ! ... advance in time (time filter, array swap) 
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+         ! ... fields nitm2 <== nitm 
+               vnbnd(ji,jk,nib  ,nitm2) = vnbnd(ji,jk,nib  ,nitm)*vnmsk(ji,jk)
+               vnbnd(ji,jk,nibm ,nitm2) = vnbnd(ji,jk,nibm ,nitm)*vnmsk(ji,jk)
+               vnbnd(ji,jk,nibm2,nitm2) = vnbnd(ji,jk,nibm2,nitm)*vnmsk(ji,jk)
+            END DO
+         END DO
+
+         DO jj = fs_njn0, fs_njn1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  vnbnd(ji,jk,nib  ,nitm) = vnbnd(ji,jk,nib,  nit)*vnmsk(ji,jk)
+                  vnbnd(ji,jk,nibm ,nitm) = vnbnd(ji,jk,nibm ,nit)*vnmsk(ji,jk)
+                  vnbnd(ji,jk,nibm2,nitm) = vnbnd(ji,jk,nibm2,nit)*vnmsk(ji,jk)
+         ! ... fields nit <== now (kt+1)
+         ! ... total or baroclinic velocity at b, bm and bm2
+# if ! defined key_dynspg_fsc
+                  zvcb   = vclin(ji,jk)
+# else
+                  zvcb   = vn (ji,jj,jk)
+# endif
+# if ! defined key_dynspg_fsc
+                  zvcbm  = vn (ji,jj-1,jk) - hvr (ji,jj-1) / e1v (ji,jj-1) &
+                           * ( bsfn(ji,jj-1) - bsfn(ji-1,jj-1) )
+# else
+                  zvcbm  = vn (ji,jj-1,jk)
+# endif
+# if ! defined key_dynspg_fsc
+                  zvcbm2 = vn (ji,jj-2,jk) - hvr (ji,jj-2) / e1v (ji,jj-2) &
+                           * ( bsfn(ji,jj-2) - bsfn(ji-1,jj-2) )
+# else
+                  zvcbm2 = vn (ji,jj-2,jk)
+# endif
+         ! ... fields nit <== now (kt+1) 
+                  vnbnd(ji,jk,nib  ,nit) = zvcb  *vnmsk(ji,jk)
+                  vnbnd(ji,jk,nibm ,nit) = zvcbm *vnmsk(ji,jk)
+                  vnbnd(ji,jk,nibm2,nit) = zvcbm2*vnmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+# if defined key_mpp
+         CALL mppobc(vnbnd,jpind,jpinf,jpjnob,jpk*3*3,1,jpi)
+# endif
+         ! ... extremeties njn0,njn1
+         ii = jpind + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               vnbnd(ii,jk,nibm,nitm) = vnbnd(ii+1,jk,nibm,nitm)
+            END DO
+         END IF
+         ii = jpinf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               vnbnd(ii,jk,nibm,nitm) = vnbnd(ii-1,jk,nibm,nitm)
+            END DO
+         END IF
+
+         ! 1.3 Temperature and salinity
+         ! ----------------------------
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+         ! ... fields nitm <== nit  plus time filter at the boundary
+               tnbnd(ji,jk,nib ,nitm) = tnbnd(ji,jk,nib,nit)*tnmsk(ji,jk)
+               snbnd(ji,jk,nib ,nitm) = snbnd(ji,jk,nib,nit)*tnmsk(ji,jk)
+            END DO
+         END DO
+
+         DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  tnbnd(ji,jk,nibm ,nitm) = tnbnd(ji,jk,nibm ,nit)*tnmsk(ji,jk)
+                  snbnd(ji,jk,nibm ,nitm) = snbnd(ji,jk,nibm ,nit)*tnmsk(ji,jk)
+         ! ... fields nit <== now (kt+1)
+                  tnbnd(ji,jk,nib  ,nit) = tn(ji,jj,  jk)*tnmsk(ji,jk)
+                  tnbnd(ji,jk,nibm ,nit) = tn(ji,jj-1,jk)*tnmsk(ji,jk)
+                  snbnd(ji,jk,nib  ,nit) = sn(ji,jj,  jk)*tnmsk(ji,jk)
+                  snbnd(ji,jk,nibm ,nit) = sn(ji,jj-1,jk)*tnmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+# if defined key_mpp
+         CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi)
+         CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi)
+# endif
+         ! ... extremeties  njn0,njn1
+         ii = jpind + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               tnbnd(ii,jk,nibm,nitm) = tnbnd(ii+1,jk,nibm,nitm)
+               snbnd(ii,jk,nibm,nitm) = snbnd(ii+1,jk,nibm,nitm)
+            END DO
+         END IF
+         ii = jpinf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               tnbnd(ii,jk,nibm,nitm) = tnbnd(ii-1,jk,nibm,nitm)
+               snbnd(ii,jk,nibm,nitm) = snbnd(ii-1,jk,nibm,nitm)
+            END DO
+         END IF
+
+      END IF     ! End of array swap
+
+      ! 2 - Calculation of radiation velocities
+      ! ---------------------------------------
+
+      IF( kt >= nit000 +3 .OR. ln_rstart ) THEN
+
+         ! 2.1  Calculate the normal velocity based on phase velocity u_cynbnd
+         ! -------------------------------------------------------------------
+         !
+         !           ji-row
+         !             |
+         !     nib -///u//////  jpjnob + 1
+         !        /////|//////
+         !   nib  -----f-----   jpjnob
+         !             |    
+         !     nibm--  u   ---- jpjnob
+         !             |        
+         !  nibm  -----f-----   jpjnob-1
+         !             |        
+         !    nibm2--  u   ---- jpjnob-1
+         !             |        
+         !  nibm2 -----f-----   jpjnob-2
+         !             |
+         ! ... radiative condition
+         ! ... jpjnob+1,(jpindp1, jpinfm1)
+         DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+         ! ... 2* j-gradient of u (f-point i=nibm, time mean)
+                  z2dx = ( unbnd(ji,jk,nibm ,nit) + unbnd(ji,jk,nibm ,nitm2) &
+                        - 2.*unbnd(ji,jk,nibm2,nitm)) / e2f(ji,jj-2)
+         ! ... 2* i-gradient of u (u-point i=nibm, time nitm)
+                  z2dy = ( unbnd(ji+1,jk,nibm,nitm) - unbnd(ji-1,jk,nibm,nitm) ) / e1u(ji,jj-1)
+         ! ... square of the norm of grad(v)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = unbnd(ji,jk,nibm,nitm2) - unbnd(ji,jk,nibm,nit)
+         ! ... i-phase speed ratio (bounded by 1) and save the unbounded phase
+         !     velocity ratio no divided by e1f for the tracer radiation
+                  IF( z4nor2 == 0.) THEN
+                     z4nor2=.000001
+                  END IF
+                  z05cx = zdt * z2dx / z4nor2
+                  u_cynbnd(ji,jk) = z05cx *unmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+# if defined key_mpp
+         CALL mppobc(u_cynbnd,jpind,jpinf,jpjnob+1,jpk,1,jpi)
+# endif
+         ! ... extremeties  njn0,njn1
+         ii = jpind + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               u_cynbnd(ii,jk) = u_cynbnd(ii+1,jk)
+            END DO
+         END IF
+         ii = jpinf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               u_cynbnd(ii,jk) = u_cynbnd(ii-1,jk)
+            END DO
+         END IF
+
+         ! 2.2 Calculate the normal velocity based on phase velocity v_cynbnd 
+         ! ------------------------------------------------------------------
+         !
+         !                ji-row  ji-row
+         !                     |
+         !        /////|/////////////////
+         !   nib  -----f----v----f----  jpjnob
+         !             |         |
+         !     nib  -  u -- T -- u ---- jpjnob
+         !             |         |
+         !  nibm  -----f----v----f----  jpjnob-1
+         !             |         |
+         !    nibm --  u -- T -- u ---  jpjnob-1
+         !             |         |
+         !  nibm2 -----f----v----f----  jpjnob-2
+         !             |         |
+         ! ... If rigidlid formulation:
+         ! ... radiative conditions on the baroclinic part only + relaxation toward climatology
+         ! ... If free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology 
+         ! ... jpjnob,(jpindp1, jpinfm1)
+         DO jj = fs_njn0, fs_njn1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+         ! ... 2* gradj(v) (T-point i=nibm, time mean)
+                  ii = ji -1 + nimpp
+                  z2dx = ( vnbnd(ji,jk,nibm ,nit) + vnbnd(ji,jk,nibm ,nitm2) &
+                          - 2.*vnbnd(ji,jk,nibm2,nitm)) / e2t(ji,jj-1)
+         ! ... 2* gradi(v) (v-point i=nibm, time nitm)
+                  z2dy = ( vnbnd(ji+1,jk,nibm,nitm) - vnbnd(ji-1,jk,nibm,nitm) ) / e1v(ji,jj-1)
+         ! ... square of the norm of grad(u)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = vnbnd(ji,jk,nibm,nitm2) - vnbnd(ji,jk,nibm,nit)
+         ! ... j-phase speed ratio (bounded by 1)
+                  IF( z4nor2 == 0. ) THEN
+                     z4nor2=.00001
+                  END IF
+                  z05cx = zdt * z2dx / z4nor2
+                  v_cynbnd(ji,jk)=z05cx *vnmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE obc_rad_north
+
+   SUBROUTINE obc_rad_south ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_rad_south
+      !!                    *************************
+      !! ** Purpose :
+      !!      Perform swap of arrays to calculate radiative phase speeds at the open 
+      !!      south boundary and calculate those phase speeds if this OBC is not fixed.
+      !!      In case of fixed OBC, this subrountine is not called.
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declarations
+      INTEGER ::   ij, ii
+
+      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy
+      REAL(wp) ::   zvcb, zvcbm, zvcbm2
+
+      !!------------------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!------------------------------------------------------------------------------
+
+      ! 1. Swap arrays before calculating radiative velocities
+      ! ------------------------------------------------------
+
+      ! 1.1  zonal velocity 
+      ! --------------------
+  
+      IF( kt > nit000) THEN 
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+         ! ... fields nitm2 <== nitm
+                  usbnd(ji,jk,nib  ,nitm2) = usbnd(ji,jk,nib  ,nitm)*usmsk(ji,jk)
+                  usbnd(ji,jk,nibm ,nitm2) = usbnd(ji,jk,nibm ,nitm)*usmsk(ji,jk)
+                  usbnd(ji,jk,nibm2,nitm2) = usbnd(ji,jk,nibm2,nitm)*usmsk(ji,jk)
+            END DO
+         END DO
+ 
+         DO jj = fs_njs0, fs_njs1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  usbnd(ji,jk,nib  ,nitm) = usbnd(ji,jk,nib,  nit)*usmsk(ji,jk)
+                  usbnd(ji,jk,nibm ,nitm) = usbnd(ji,jk,nibm ,nit)*usmsk(ji,jk)
+                  usbnd(ji,jk,nibm2,nitm) = usbnd(ji,jk,nibm2,nit)*usmsk(ji,jk)
+         ! ... fields nit <== now (kt+1)
+                  usbnd(ji,jk,nib  ,nit) = un(ji,jj  ,jk)*usmsk(ji,jk)
+                  usbnd(ji,jk,nibm ,nit) = un(ji,jj+1,jk)*usmsk(ji,jk)
+                  usbnd(ji,jk,nibm2,nit) = un(ji,jj+2,jk)*usmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+# if defined key_mpp
+         CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi)
+# endif
+         ! ... extremeties njs0,njs1
+         ii = jpisd + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               usbnd(ii,jk,nibm,nitm) = usbnd(ii+1,jk,nibm,nitm)
+            END DO
+         END IF
+         ii = jpisf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               usbnd(ii,jk,nibm,nitm) = usbnd(ii-1,jk,nibm,nitm)
+            END DO
+         END IF
+ 
+         ! 1.2 normal velocity
+         ! -------------------
+ 
+         !.. advance in time (time filter, array swap) 
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+         ! ... fields nitm2 <== nitm 
+               vsbnd(ji,jk,nib  ,nitm2) = vsbnd(ji,jk,nib  ,nitm)*vsmsk(ji,jk)
+               vsbnd(ji,jk,nibm ,nitm2) = vsbnd(ji,jk,nibm ,nitm)*vsmsk(ji,jk)
+            END DO
+         END DO
+
+         DO jj = fs_njs0, fs_njs1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  vsbnd(ji,jk,nib  ,nitm) = vsbnd(ji,jk,nib,  nit)*vsmsk(ji,jk)
+                  vsbnd(ji,jk,nibm ,nitm) = vsbnd(ji,jk,nibm ,nit)*vsmsk(ji,jk)
+                  vsbnd(ji,jk,nibm2,nitm) = vsbnd(ji,jk,nibm2,nit)*vsmsk(ji,jk)
+         ! ... total or baroclinic velocity at b, bm and bm2
+# if ! defined key_dynspg_fsc
+                  zvcb   = vclis(ji,jk)
+# else
+                  zvcb   = vn (ji,jj,jk)
+# endif
+# if ! defined key_dynspg_fsc
+                  zvcbm  = vn (ji,jj+1,jk) - hvr (ji,jj+1) / e1v (ji,jj+1) & 
+                           * ( bsfn(ji,jj+1) - bsfn(ji-1,jj+1) )
+# else
+                  zvcbm  = vn (ji,jj+1,jk)
+# endif
+# if ! defined key_dynspg_fsc  
+                  zvcbm2 = vn (ji,jj+2,jk) - hvr (ji,jj+2) / e1v (ji,jj+2) &
+                           * ( bsfn(ji,jj+2) - bsfn(ji-1,jj+2) )
+# else
+                  zvcbm2 = vn (ji,jj+2,jk)
+# endif
+         ! ... fields nit <== now (kt+1) 
+                  vsbnd(ji,jk,nib  ,nit) = zvcb   *vsmsk(ji,jk)
+                  vsbnd(ji,jk,nibm ,nit) = zvcbm  *vsmsk(ji,jk)
+                  vsbnd(ji,jk,nibm2,nit) = zvcbm2 *vsmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+# if defined key_mpp
+         CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi)
+# endif
+         ! ... extremeties njs0,njs1
+         ii = jpisd + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               vsbnd(ii,jk,nibm,nitm) = vsbnd(ii+1,jk,nibm,nitm)
+            END DO
+         END IF
+         ii = jpisf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               vsbnd(ii,jk,nibm,nitm) = vsbnd(ii-1,jk,nibm,nitm)
+            END DO
+         END IF
+
+         ! 1.3 Temperature and salinity
+         ! ----------------------------
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+         ! ... fields nitm <== nit  plus time filter at the boundary
+               tsbnd(ji,jk,nib,nitm) = tsbnd(ji,jk,nib,nit)*tsmsk(ji,jk)
+               ssbnd(ji,jk,nib,nitm) = ssbnd(ji,jk,nib,nit)*tsmsk(ji,jk)
+            END DO
+         END DO
+
+         DO jj = fs_njs0, fs_njs1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  tsbnd(ji,jk,nibm ,nitm) = tsbnd(ji,jk,nibm ,nit)*tsmsk(ji,jk)
+                  ssbnd(ji,jk,nibm ,nitm) = ssbnd(ji,jk,nibm ,nit)*tsmsk(ji,jk)
+         ! ... fields nit <== now (kt+1)
+                  tsbnd(ji,jk,nib  ,nit) = tn(ji,jj   ,jk)*tsmsk(ji,jk)
+                  tsbnd(ji,jk,nibm ,nit) = tn(ji,jj+1 ,jk)*tsmsk(ji,jk)
+                  ssbnd(ji,jk,nib  ,nit) = sn(ji,jj   ,jk)*tsmsk(ji,jk)
+                  ssbnd(ji,jk,nibm ,nit) = sn(ji,jj+1 ,jk)*tsmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+# if defined key_mpp
+         CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi)
+         CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi)
+# endif 
+         ! ... extremeties  njs0,njs1
+         ii = jpisd + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               tsbnd(ii,jk,nibm,nitm) = tsbnd(ii+1,jk,nibm,nitm)
+               ssbnd(ii,jk,nibm,nitm) = ssbnd(ii+1,jk,nibm,nitm)
+            END DO
+         END IF
+         ii = jpisf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               tsbnd(ii,jk,nibm,nitm) = tsbnd(ii-1,jk,nibm,nitm)
+               ssbnd(ii,jk,nibm,nitm) = ssbnd(ii-1,jk,nibm,nitm)
+            END DO
+         END IF
+
+      END IF     ! End of array swap
+
+      ! 2 - Calculation of radiation velocities
+      ! ---------------------------------------
+
+      IF( kt >= nit000 +3 .OR. ln_rstart ) THEN
+
+         ! 2.1  Calculate the normal velocity based on phase velocity u_cysbnd
+         ! -------------------------------------------------------------------
+         !
+         !          ji-row
+         !            |
+         ! nibm2 -----f-----   jpjsob +2
+         !            |    
+         !  nibm2 --  u  ----- jpjsob +2 
+         !            |        
+         !  nibm -----f-----   jpjsob +1
+         !            |        
+         !  nibm  --  u  ----- jpjsob +1
+         !            |        
+         !  nib  -----f-----   jpjsob
+         !       /////|//////
+         !  nib   ////u/////   jpjsob 
+         !
+         ! ... radiative condition plus Raymond-Kuo
+         ! ... jpjsob,(jpisdp1, jpisfm1)
+         DO jj = fs_njs0, fs_njs1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+         ! ... 2* j-gradient of u (f-point i=nibm, time mean)
+                  z2dx = (- usbnd(ji,jk,nibm ,nit) - usbnd(ji,jk,nibm ,nitm2) &
+                          + 2.*usbnd(ji,jk,nibm2,nitm) ) / e2f(ji,jj+1)
+         ! ... 2* i-gradient of u (u-point i=nibm, time nitm)
+                  z2dy = ( usbnd(ji+1,jk,nibm,nitm) - usbnd(ji-1,jk,nibm,nitm) ) / e1u(ji, jj+1)
+         ! ... square of the norm of grad(v)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+                  IF( z4nor2 == 0.) THEN
+                     z4nor2 = 0.000001
+                  END IF
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = usbnd(ji,jk,nibm,nitm2) - usbnd(ji,jk,nibm,nit)
+         ! ... i-phase speed ratio (bounded by -1) and save the unbounded phase
+         !     velocity ratio no divided by e1f for the tracer radiation
+                  z05cx = zdt * z2dx / z4nor2
+                  u_cysbnd(ji,jk) = z05cx*usmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+# if defined key_mpp
+         CALL mppobc(u_cysbnd,jpisd,jpisf,jpjsob,jpk,1,jpi)
+# endif
+         ! ... extremeties  njs0,njs1
+         ii = jpisd + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               u_cysbnd(ii,jk) = u_cysbnd(ii+1,jk)
+            END DO
+         END IF
+         ii = jpisf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               u_cysbnd(ii,jk) = u_cysbnd(ii-1,jk)
+            END DO
+         END IF
+
+         ! 2.2 Calculate the normal velocity based on phase velocity v_cysbnd 
+         ! -------------------------------------------------------------------
+         !
+         !               ji-row  ji-row
+         !            |         |
+         ! nibm2 -----f----v----f----  jpjsob+2
+         !            |         |
+         !  nibm   -  u -- T -- u ---- jpjsob+2
+         !            |         |
+         ! nibm  -----f----v----f----  jpjsob+1 
+         !            |         |
+         ! nib    --  u -- T -- u ---  jpjsob+1
+         !            |         |
+         ! nib   -----f----v----f----  jpjsob
+         !       /////////////////////
+         !
+         ! ... If rigidlid formulation:
+         ! ... radiative conditions on the baroclinic part only + relaxation toward climatology 
+         ! ... If free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology
+         ! ... jpjsob,(jpisdp1,jpisfm1)
+         DO jj = fs_njs0, fs_njs1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+         ! ... 2* gradj(v) (T-point i=nibm, time mean)
+                  z2dx = ( - vsbnd(ji,jk,nibm ,nit) - vsbnd(ji,jk,nibm ,nitm2) &
+                           + 2.*vsbnd(ji,jk,nibm2,nitm) ) / e2t(ji,jj+1)
+         ! ... 2* gradi(v) (v-point i=nibm, time nitm)
+                  z2dy = ( vsbnd(ji+1,jk,nibm,nitm) - vsbnd(ji-1,jk,nibm,nitm) ) / e1v(ji,jj+1)
+         ! ... square of the norm of grad(u)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+                  IF( z4nor2 == 0.) THEN
+                     z4nor2 = 0.000001
+                  END IF
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = vsbnd(ji,jk,nibm,nitm2) - vsbnd(ji,jk,nibm,nit)
+         ! ... j-phase speed ratio (bounded by -1)
+                  z05cx = zdt * z2dx / z4nor2
+                  v_cysbnd(ji,jk)=z05cx*vsmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+
+      END IF
+ 
+   END SUBROUTINE obc_rad_south
+#else
+   !!=================================================================================
+   !!                       ***  MODULE  obcrad  ***
+   !! Ocean dynamic :   Phase velocities for each open boundary
+   !!=================================================================================
+CONTAINS
+   SUBROUTINE obc_rad( kt )            ! No open boundaries ==> empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) kt
+   END SUBROUTINE obc_rad
+#endif
+
+END MODULE obcrad
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obcrst.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obcrst.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obcrst.F90	(revision 4)
@@ -0,0 +1,728 @@
+MODULE obcrst
+#if defined key_obc
+   !!=================================================================================
+   !!                       ***  MODULE  obcrst  ***
+   !! Ocean dynamic :  Input/Output files for restart on OBC
+   !!=================================================================================
+
+   !!---------------------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE daymod          ! calendar
+   USE lib_mpp         ! for mppobc
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC obc_rst_lec        ! routine called by iniobc.F90
+   PUBLIC obc_rst_wri        ! routine called by step.F90
+
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_rst_wri ( kt )
+      !!--------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_rst_wri
+      !!                    ************************
+      !! ** Purpose :
+      !!      Write restart fields in numwob for open boundaries
+      !!
+      !! ** Method :
+      !!      numwob file: Direct access non formatted file.
+      !!      Each nstock time step , save fields which are necessary for restart.
+      !!      - This routine is called if at least the key_obc is defined. It is called
+      !!        at the same time step than rstwri.
+      !!      - First record holds OBC parameters nbobc,jpieob,jpiwob,jpjnob,jpjsob and 
+      !!        the OBC layout jpjed, jpjef ... for checking purposes.
+      !!      - Following records hold the boundary arrays, in the order east west north
+      !!        south, if they exist.
+      !!      - The writing is realised by vertical slab across the boundary, for bsf, u,
+      !!        v, t, and s boundary arrays. Each record hold a vertical slab.
+      !!      - For mpp, this allows each processor to write only the correct informations
+      !!        it hold. If a processor has no valid informations on boundary, it just 
+      !!        skip the writing part (automatically).
+      !!      - Special care is taken for dumping the starting point of a boundary (jpjed,
+      !!        jpjwd, jpind, jpisd) because of the general definition of nje0 njw0,nin0,
+      !!        nis0. This is done to avoid records to be written by 2 adjacent processors.
+      !!
+      !!  History :
+      !!         ! 97-11 (J.M. Molines) Original code
+      !!         ! 98-11 (J.M. Molines) Bug fix for adjacent processors
+      !!   8.5   ! 02-10 (C. Talandier, A-M. Treguier) F90
+      !!         ! 03-06 (J.M. Molines) Bug fix for adjacent processors
+      !!-----------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk, ios
+      INTEGER ::   ibloc, nreclo, jrec, jt, jb 
+      INTEGER ::   jfoe, jfow, ifon, ifos
+      INTEGER ::   ino0, it0
+      !!-----------------------------------------------------------------------------
+      !!   OPA 8.5, LODYC-IPSL (2002)
+      !!-----------------------------------------------------------------------------
+
+      ! 1. Output of restart fields (numwob)
+      ! ------------------------------------
+ 
+      IF( ( mod(kt,nstock) == 0 ) .OR. ( kt == nitend ) ) THEN
+
+         ! 1.0 Initializations
+         ! -------------------
+         IF(lwp) THEN
+              WRITE(numout,*) ' '
+              WRITE(numout,*) 'obcrst: OBC output for restart with obc_rst_wri routine'
+              WRITE(numout,*) '~~~~~~'
+              WRITE(numout,*) '        output done in numwob = ', numwob,' at it= ',kt, & 
+                              ' date= ',ndastp
+         END IF
+
+         ino0 = no
+         it0  = kt
+         ibloc  = 4096*4
+         nreclo = ibloc*( ( ( 26 *jpk + 9 )*jpbyt -1)/ibloc + 1)
+         IF(lwp) WRITE(numout,*) '             '
+         IF(lwp) WRITE(numout,*) '        OBC restart file opened with nreclo = ',nreclo
+
+         ! 1.1 Open file
+         ! -------------
+         OPEN( UNIT   =  numwob,              &
+               IOSTAT = ios,                  &
+               FILE   = 'restart.obc.output', &
+               ACCESS = 'DIRECT',             &
+               RECL   =  nreclo,              &
+               FORM   = 'UNFORMATTED' )
+         IF( ios > 0 ) THEN
+            IF(lwp) WRITE(numout,*) '      '
+            IF(lwp) WRITE(numout,*) '        Pbm to OPEN the restart.obc.output file ' 
+            IF(lwp) WRITE(numout,*) '      '
+            nstop = nstop + 1   
+         END IF
+
+         ! 1.2 Write header
+         ! ----------------
+         WRITE (numwob,REC=1) ino0,it0,nbobc,jpieob,jpiwob,jpjnob,jpjsob,     &
+                              jpjed,jpjef,jpjwd,jpjwf,jpind,jpinf,jpisd,jpisf
+
+         ! 1.3 Write east boundary array if any.
+         ! -------------------------------------
+         IF( lpeastobc ) THEN
+            IF( lfbceast ) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*) ' '
+                  WRITE(numout,*) '        No restart file for the fixed east OBC'
+               END IF
+            ELSE
+               IF( jpieob /= 0 ) THEN
+                  IF( nje0+njmpp-1  == jpjed .AND. nie1 >= nie0 ) THEN
+            ! ... dump of jpjed if it is on this proc.
+                     jrec = 2
+                     jfoe = jpjed - njmpp + 1
+                     PRINT *,'Narea =',narea,' write jrec =2 east'
+                     WRITE(numwob,REC=jrec)                                    &
+# if ! defined key_dynspg_fsc
+                           ((  bebnd(jfoe,   jb,jt),          jb=1,3),jt=1,3), &
+# endif
+                           ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                           ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                  ENDIF
+                  DO ji = nie0, nie1
+                     DO jj = nje0, nje1
+            ! ... only interested processors go through the following lines
+            !           jfoe = jj + njmpp -1
+                        jfoe = jj 
+                        jrec = 2 + jj + njmpp -1 -jpjed
+                        WRITE (numwob,REC=jrec)                                   &
+# if ! defined key_dynspg_fsc
+                              ((  bebnd(jfoe,   jb,jt),          jb=1,3),jt=1,3), &
+# endif
+                              ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                              ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                     END DO
+                  END DO
+               END IF
+            END IF
+         END IF
+ 
+         ! 1.4 Write west boundary arrays if any
+         ! -------------------------------------
+         IF( lpwestobc ) THEN
+            IF( lfbcwest ) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*) ' '
+                  WRITE(numout,*) '        No restart file for the fixed west OBC'
+               END IF
+            ELSE
+               IF( jpiwob /= 0 ) THEN
+                  IF( njw0+njmpp+1 == jpjwd .AND. niw1 >= niw0 ) THEN
+            ! ... dump of jpjwd if it is on this proc.
+                     jrec = 3 + jpjef - jpjed
+            !        jfow = jpjwd
+                     jfow = jpjwd -njmpp + 1
+                     PRINT *,'Narea =',narea,' write jrec =',jrec,' west'
+                     WRITE (numwob,REC=jrec)                                   &
+# if ! defined key_dynspg_fsc
+                           ((  bwbnd(jfow,   jb,jt),          jb=1,3),jt=1,3), &
+# endif
+                           ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                           ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                  END IF
+                  DO ji = niw0, niw1
+                     DO jj = njw0, njw1
+            ! ... only interested processors go through the following lines
+            !           jfow = jj + njmpp -1
+                        jfow = jj 
+                        jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd
+                        WRITE (numwob,REC=jrec)                                   &
+# if ! defined key_dynspg_fsc
+                              ((  bwbnd(jfow,   jb,jt),          jb=1,3),jt=1,3), &
+# endif
+                              ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                              ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                     END DO
+                  END DO
+               END IF
+            END IF
+         END IF
+ 
+         ! 1.5 Write north boundary arrays if any
+         ! --------------------------------------
+         IF( lpnorthobc ) THEN
+            IF( lfbcnorth ) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*) ' '
+                  WRITE(numout,*) '        No restart file for the fixed north OBC'
+               END IF
+            ELSE
+               IF( jpjnob /= 0) THEN
+                  IF( nin0+nimpp-1 == jpind .AND. njn1 >= njn0 ) THEN
+            ! ... dump of jpind if it is on this proc.
+                     jrec = 4 + jpjef -jpjed + jpjwf -jpjwd
+            !        ifon = jpind
+                     ifon = jpind -nimpp +1
+                     WRITE (numwob,REC=jrec)                                   &
+# if ! defined key_dynspg_fsc
+                           ((  bnbnd(ifon,   jb,jt),          jb=1,3),jt=1,3), &
+# endif
+                           ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                           ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                  END IF
+                  DO jj = njn0, njn1
+                     DO ji = nin0, nin1
+            ! ... only interested processors go through the following lines
+            !           ifon = ji + nimpp -1
+                        ifon = ji 
+                        jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1  -jpind
+                        WRITE (numwob,REC=jrec)                                   &
+# if ! defined key_dynspg_fsc
+                              ((  bnbnd(ifon,   jb,jt),          jb=1,3),jt=1,3), &
+# endif
+                              ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                              ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                     END DO
+                  END DO
+               END IF
+            END IF
+         END IF
+ 
+         ! 1.6 Write south boundary arrays if any
+         ! --------------------------------------
+         IF( lpsouthobc ) THEN
+            IF( lfbcsouth ) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*) ' '
+                  WRITE(numout,*) '        No restart file for the fixed south OBC'
+                  WRITE(numout,*) ' '
+               END IF
+            ELSE
+               IF( jpjsob /= 0 ) THEN
+                  IF( nis0+nimpp-1 == jpisd .AND. njs1 >= njs0 ) THEN
+            ! ... dump of jpisd if it is on this proc.
+                     jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind
+            !        ifos = jpisd
+                     ifos = jpisd -nimpp + 1
+                     WRITE (numwob,REC=jrec)                                   &
+# if ! defined key_dynspg_fsc
+                           ((  bsbnd(ifos,   jb,jt),          jb=1,3),jt=1,3), &
+# endif
+                           ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                           ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                  END IF
+                  DO jj = njs0, njs1
+                     DO ji = nis0, nis1
+            ! ... only interested processors go through the following lines
+            !           ifos = ji + nimpp -1
+                        ifos = ji 
+                        jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind + &
+                              ji + nimpp -1 -jpisd
+                        WRITE (numwob,REC=jrec) &
+# if ! defined key_dynspg_fsc
+                              ((  bsbnd(ifos,   jb,jt),          jb=1,3),jt=1,3), &
+# endif 
+                              ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                              ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                     END DO
+                  END DO
+               END IF
+            END IF
+         END IF
+      END IF
+      CLOSE(numwob)
+
+   END SUBROUTINE obc_rst_wri
+
+   SUBROUTINE obc_rst_lec
+      !!----------------------------------------------------------------------------
+      !!                      SUBROUTINE obc_rst_lec
+      !!                     ************************
+      !! ** Purpose :
+      !!      Read files for restart at open boundaries
+      !!
+      !! ** Method :
+      !!      Read the previous boundary arrays on unit numrob
+      !!      The first record indicates previous characterics
+      !!
+      !! History :
+      !!        ! 97-11 (J.M. Molines) Original code
+      !!   8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
+      !!----------------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji,jj,jk,ios
+      INTEGER ::   ino0,it0,nbobc0,jpieob0,jpiwob0,jpjnob0,jpjsob0
+      INTEGER ::   ino1,it1,nbobc1,jpieob1,jpiwob1,jpjnob1,jpjsob1
+      INTEGER ::   ied0,ief0,iwd0,iwf0,ind0,inf0,isd0,isf0
+      INTEGER ::   ied1,ief1,iwd1,iwf1,ind1,inf1,isd1,isf1
+      INTEGER ::   ibloc, nreclo, jrec, jt, jb
+      INTEGER ::   jfoe, jfow, ifon, ifos
+      !!-----------------------------------------------------------------------------
+      !!   OPA 8.5, LODYC-IPSL (2002)
+      !!-----------------------------------------------------------------------------
+
+      ! 0. Initialisations
+      ! ------------------
+ 
+      ino0    = no
+      it0     = nit000
+      nbobc0  = nbobc
+      jpieob0 = jpieob
+      jpiwob0 = jpiwob
+      jpjnob0 = jpjnob
+      jpjsob0 = jpjsob
+ 
+      ied0   = jpjed
+      ief0   = jpjef
+      iwd0   = jpjwd
+      iwf0   = jpjwf
+      ind0   = jpind
+      inf0   = jpinf
+      isd0   = jpisd
+      isf0   = jpisf
+ 
+      ibloc  = 4096*4
+      nreclo = ibloc *( ( ( 26 *jpk + 9 )*jpbyt -1)/ibloc + 1)
+ 
+      IF(lwp) THEN
+         WRITE(numout,*) 'obcrst: beginning of restart with obc_rst_lec routine'
+         WRITE(numout,*) '~~~~~~'
+         WRITE(numout,*) ' '
+         WRITE(numout,*) '        The present run :'
+         WRITE(numout,*) '        number job is  : ',no 
+         WRITE(numout,*) '        with the time nit000 : ',nit000
+         WRITE(numout,*) '        OBC restart file opened with nreclo = ',nreclo 
+      END IF
+ 
+      ! 0.1 Open files
+      ! ---------------
+      OPEN( UNIT   =  numrob,       &
+            IOSTAT =  ios,          &
+            FILE   = 'restart.obc', &
+            ACCESS = 'DIRECT',      &
+            RECL   =  nreclo,       &
+            FORM   = 'UNFORMATTED' )
+      IF( ios > 0 ) THEN
+         IF(lwp) WRITE(numout,*) '        Pbm to OPEN the restart.obc file ' 
+         nstop = nstop + 1   
+      END IF
+
+      ! 1. Read
+      ! -------
+ 
+      ! 1.1 First record
+      ! -----------------
+      READ(numrob,REC=1) ino1,it1,nbobc1,jpieob1,jpiwob1,jpjnob1,     &
+                         jpjsob1,ied1,ief1,iwd1,iwf1,ind1,inf1,isd1,isf1
+ 
+      IF(lwp) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) '        READ numrob with number job : ',ino1,' with the time it: ',it1
+         WRITE(numout,*) ' '
+      END IF
+ 
+      ! 1.2 Control of date
+      ! --------------------
+      IF( ( it0-it1 ) /= 1 .AND. abs(nrstdt) == 1 ) THEN
+          IF(lwp) THEN
+             WRITE(numout,*) '        ===>>>> : problem with nit000 for the restart'
+             WRITE(numout,*) '        =============='
+             WRITE(numout,*) '        we stop in obc_rst_lec routine. Verify the file or rerun with the value'
+             WRITE(numout,*) '        0 for the control of time parameter nrstdt'
+             WRITE(numout,*) ' ' 
+          END IF
+          nstop = nstop + 1
+      END IF
+ 
+      ! 1.3 Control of number of open boundaries
+      ! ----------------------------------------
+      IF( nbobc1 /= nbobc0 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) '        ===> W A R N I N G: The number of OBC have changed:'
+            WRITE(numout,*) '        Last run : ',nbobc0,' obcs'
+            WRITE(numout,*) '        This run : ',nbobc1,' obcs'
+         END IF
+      END IF
+ 
+      ! 1.4 Control of which boundary is open
+      ! -------------------------------------
+      IF( ( lpeastobc ) .AND. ( jpieob1 /= 0 ) ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) '         '
+            WRITE(numout,*) '        East open boundary'
+            IF( jpieob0 /= jpieob1 ) THEN
+               WRITE(numout,*) '         ==>>>> : Problem in obc_rst_lec, jpieob have changed'
+               nstop = nstop + 1
+            END IF
+         END IF
+      END IF
+ 
+      IF( ( lpwestobc ) .AND. ( jpiwob1 /= 0 ) ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) '         '
+            WRITE(numout,*) '        West open boundary'
+            IF( jpiwob0 /= jpiwob1 ) THEN
+               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpiwob has changed'
+               nstop = nstop + 1
+            END IF
+         END IF
+      END IF
+ 
+      IF( ( lpnorthobc ) .AND. ( jpjnob1 /= 0 ) ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) '         '
+            WRITE(numout,*) '        North open boundary'
+            IF( jpjnob0 /= jpjnob1 ) THEN
+               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjnob has changed'
+               nstop = nstop + 1
+            END IF
+         END IF
+      END IF
+ 
+      IF( ( lpsouthobc ) .AND. ( jpjsob1 /= 0 ) ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) '         '
+            WRITE(numout,*) '        South open boundary'
+            IF( jpjsob0 /= jpjsob1) THEN
+               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjsob has changed'
+               nstop = nstop + 1
+            END IF
+         END IF
+      END IF
+ 
+ 
+      ! 1.5 Control of the limit of the boundaries
+      ! ------------------------------------------
+      IF( ( lpeastobc ) .AND. ( jpieob1 /= 0 ) ) THEN
+         IF(lwp) THEN
+            IF( ied1 /= ied0 ) THEN
+               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjed has changed'
+               nstop = nstop + 1
+            END IF
+            IF( ief1 /= ief0 ) THEN
+               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjef has changed'
+               nstop = nstop + 1
+            END IF
+         END IF
+      END IF
+
+      IF( ( lpwestobc ) .AND. ( jpiwob1 /= 0 ) ) THEN
+         IF(lwp) THEN
+            IF( iwd1 /= iwd0 ) THEN
+               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjwd has changed'
+               nstop = nstop + 1
+            END IF
+            IF( iwf1 /= iwf0 ) THEN
+               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpjwf has changed'
+               nstop = nstop + 1
+            END IF
+         END IF
+      END IF
+ 
+      IF( ( lpnorthobc ) .AND. ( jpjnob1 /= 0 ) ) THEN
+         IF(lwp) THEN
+            IF( ind1 /= ind0 ) THEN
+               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpind has changed'
+               nstop = nstop + 1
+            END IF
+            IF( inf1 /= inf0 ) THEN
+               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpinf has changed'
+               nstop = nstop + 1
+             END IF
+          END IF
+      END IF
+ 
+      IF( ( lpsouthobc ) .AND. ( jpjsob1 /= 0 ) ) THEN
+         IF(lwp) THEN
+            IF( isd1 /= isd0 ) THEN
+               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpisd has changed'
+               nstop = nstop + 1
+            END IF
+            IF( isf1 /= isf0 ) THEN
+               WRITE(numout,*) '        ==>>>> : Problem in obc_rst_lec, jpisf has changed'
+               nstop = nstop + 1
+            END IF
+         END IF
+      END IF
+ 
+ 
+      ! 2. Now read the boundary arrays
+      ! -------------------------------
+ 
+      ! 2.1 Read east boundary array if any.
+      ! ------------------------------------
+      IF( lpeastobc ) THEN
+         IF( jpieob1 /= 0) THEN
+            IF( nje0+njmpp-1 == jpjed .AND. nie1 >= nie0 ) THEN
+      ! ... read of jpjed if it is on this proc.
+               jrec = 2
+      !        jfoe = jpjed
+               jfoe = jpjed -njmpp + 1
+               READ (numrob,REC=jrec)                                   &
+# if ! defined key_dynspg_fsc
+                    ((  bebnd(jfoe,   jb,jt),          jb=1,3),jt=1,3), &
+# endif 
+                    ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                    ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+            END IF
+            DO ji = nie0, nie1
+               DO jj = nje0, nje1
+      ! ... only interested processors go through the following lines
+      !           jfoe = jj + njmpp -1
+                  jfoe = jj 
+                  jrec = 2 + jj + njmpp -1 -jpjed
+                  READ (numrob,REC=jrec)                                   &
+# if ! defined key_dynspg_fsc
+                       ((  bebnd(jfoe,   jb,jt),          jb=1,3),jt=1,3), &
+# endif
+                       ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                       ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+               END DO
+            END DO
+
+         ELSE
+
+            !  lpeastobc was not TRUE previously
+         END IF
+
+      END IF
+ 
+      ! 2.2 Read west boundary arrays if any.
+      ! -------------------------------------
+      IF( lpwestobc ) THEN
+         IF( jpiwob1 /= 0) THEN
+            IF( njw0+njmpp-1 == jpjwd .AND. niw1 >= niw0 ) THEN
+      ! ... read of jpjwd if it is on this proc.
+               jrec = 3 + jpjef - jpjed
+      !        jfow = jpjwd
+               jfow = jpjwd -njmpp + 1
+               READ (numrob,REC=jrec)                                   &
+# if ! defined key_dynspg_fsc
+                    ((  bwbnd(jfow,   jb,jt),          jb=1,3),jt=1,3), &
+# endif
+                    ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                    ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+            END IF
+            DO ji = niw0, niw1
+               DO jj = njw0, njw1
+      ! ... only interested processors go through the following lines
+      !           jfow = jj + njmpp -1
+                  jfow = jj 
+                  jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd
+                  READ (numrob,REC=jrec)                                   &
+# if ! defined key_dynspg_fsc
+                       ((  bwbnd(jfow,   jb,jt),          jb=1,3),jt=1,3), &
+# endif
+                       ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                       ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+               END DO
+            END DO
+
+         ELSE
+
+            !  lpwestobc was not TRUE previously
+         END IF
+
+      END IF
+ 
+      ! 2.3 Read north boundary arrays if any.
+      ! --------------------------------------
+      IF( lpnorthobc ) THEN
+         IF( jpjnob1 /= 0) THEN
+            IF( nin0+nimpp-1 == jpind .AND. njn1 >= njn0 ) THEN
+      ! ... read of jpind if it is on this proc.
+               jrec = 4 + jpjef -jpjed + jpjwf -jpjwd
+      !        ifon = jpind
+               ifon = jpind -nimpp +1
+               READ (numrob,REC=jrec)                                   &
+# if ! defined key_dynspg_fsc
+                    ((  bnbnd(ifon,   jb,jt),          jb=1,3),jt=1,3), &
+# endif
+                    ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 
+                    ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+            END IF
+            DO jj = njn0, njn1
+               DO ji = nin0, nin1
+      ! ... only interested processors go through the following lines
+      !           ifon = ji + nimpp -1
+                  ifon = ji 
+                  jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1  -jpind
+                  READ (numrob,REC=jrec)                                   & 
+# if ! defined key_dynspg_fsc
+                       ((  bnbnd(ifon,   jb,jt),          jb=1,3),jt=1,3), &
+# endif  
+                       ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                       ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+               END DO
+            END DO
+
+         ELSE
+
+           !  lpnorthobc was not TRUE previously
+         END IF
+
+      END IF
+ 
+      ! 2.4 Read south boundary arrays if any.
+      ! -------------------------------------
+      IF( lpsouthobc ) THEN
+         IF( jpjsob1 /= 0) THEN
+            IF( nis0+nimpp-1 == jpisd .AND. njs1 >= njs0 ) THEN
+      ! ... read of jpisd if it is on this proc.
+               jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind
+      !        ifos = jpisd
+               ifos = jpisd -nimpp + 1
+               READ (numrob,REC=jrec)                                   &
+# if ! defined key_dynspg_fsc
+                    ((  bsbnd(ifos,   jb,jt),          jb=1,3),jt=1,3), &
+# endif
+                    ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                    ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+            END IF
+            DO jj = njs0, njs1
+               DO ji = nis0, nis1
+      ! ... only interested processors go through the following lines
+      !           ifos = ji + nimpp -1
+                  ifos = ji 
+                  jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind +  &
+                        ji + nimpp -1 -jpisd
+                  READ (numrob,REC=jrec)                                   & 
+# if ! defined key_dynspg_fsc
+                       ((  bsbnd(ifos,   jb,jt),          jb=1,3),jt=1,3), &
+# endif
+                       ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                       ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+               END DO
+            END DO
+         ELSE
+            !  lpsouthobc was not TRUE previously
+         END IF
+
+      END IF
+      CLOSE(numrob)
+
+# if defined key_mpp
+      IF( lpeastobc ) THEN
+         CALL mppobc(bebnd,jpjed,jpjef,jpieob,3*3,2,jpj)
+         CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj)
+         CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj)
+         CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj)
+         CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj)
+      END IF
+      IF( lpwestobc ) THEN
+         CALL mppobc(bwbnd,jpjwd,jpjwf,jpiwob,3*3,2,jpj)
+         CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj)
+         CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj)
+         CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj)
+         CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj)
+      END IF
+      IF( lpnorthobc ) THEN 
+         CALL mppobc(bnbnd,jpind,jpinf,jpjnob  ,3*3    ,1,jpi)
+         CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi)
+         CALL mppobc(vnbnd,jpind,jpinf,jpjnob  ,jpk*3*3,1,jpi)
+         CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi)
+         CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi)
+      END IF
+      IF( lpsouthobc ) THEN
+         CALL mppobc(bsbnd,jpisd,jpisf,jpjsob,    3*3,1,jpi)
+         CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi)
+         CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi)
+         CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi)
+         CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi)
+      END IF
+# endif
+ 
+   END SUBROUTINE obc_rst_lec
+#else
+   !!=================================================================================
+   !!                       ***  MODULE  obcrst  ***
+   !! Ocean dynamic :  Input/Output files for restart on OBC
+   !!=================================================================================
+CONTAINS
+   SUBROUTINE obc_rst_wri( kt )           !  No Open boundary ==> empty routine
+      INTEGER,INTENT(in) :: kt
+      WRITE(*,*) kt
+   END SUBROUTINE obc_rst_wri
+   SUBROUTINE obc_rst_lec                 !  No Open boundary ==> empty routine
+   END SUBROUTINE obc_rst_lec
+#endif
+
+   !!=================================================================================
+END MODULE obcrst
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obcspg.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obcspg.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obcspg.F90	(revision 4)
@@ -0,0 +1,649 @@
+MODULE obcspg 
+   !!======================================================================
+   !!                       ***  MODULE  obcspg  ***
+   !! Open Boundaries  :   Radiation of barotropic stream function on each
+   !!                      open boundary
+   !!======================================================================
+#if defined key_obc && defined key_dynspg_rl
+   !!----------------------------------------------------------------------
+   !!   'key_obc'    and                            Open Boundary Condition
+   !!   'key_dynspg_rl'                                 Rigid-Lid
+   !!----------------------------------------------------------------------
+   !!   obc_spg       : call the subroutine for each open boundary
+   !!   obc_spg_east  : radiation of the east open boundary streamfunction
+   !!   obc_spg_west  : radiation of the west open boundary streamfunction
+   !!   obc_spg_north : radiation of the north open boundary streamfunction
+   !!   obc_spg_south : radiation of the south open boundary streamfunction
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE lib_mpp         ! for mppobc
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC obc_spg     ! routine called in step.F90 (rigid lid case)
+
+   !! * Module variables
+   INTEGER ::   ji, jj, jk, jnic   ! dummy loop indices
+
+   INTEGER ::      & ! ... boundary space indices 
+      nib   = 1,   & ! nib   = boundary point
+      nibm  = 2,   & ! nibm  = 1st interior point
+      nibm2 = 3,   & ! nibm2 = 2nd interior point
+      !              ! ... boundary time indices 
+      nit   = 1,   & ! nit    = now
+      nitm  = 2,   & ! nitm   = before
+      nitm2 = 3      ! nitm2  = before-before
+
+   REAL(wp) ::   rtaue  , rtauw  , rtaun  , rtaus  ,   &  !
+                 rtauein, rtauwin, rtaunin, rtausin       !
+
+   !! * Substitutions
+#  include "obc_vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_spg ( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obc_spg  ***
+      !!
+      !! **  Purpose :
+      !!       Compute now barotropic stream function at the open boundaries.
+      !!       (lpeastobc, and/or lpwestobc, and/or lpnorthobc, and/or lpsouthobc).
+      !!       Deduce the correct bsf trend on the open boundaries and isolated 
+      !!       coastlines previous to the call to the barotropic solver.
+      !!
+      !! ** Method :
+      !!      In case of open boundaries, there can be a net barotropic flow
+      !!      through the boundaries, hence the potential on the coastlines
+      !!      on each side of the OBC is different.
+      !!      This routine:
+      !!           1. compute the contribution of the isolated coastlines to the
+      !!              rhs of the barotropic equation
+      !!           2. compute the contribution of the OBC to the rhs of the
+      !!              barotropic equation using a radiation equation as explained
+      !!              in the OBC routine.
+      !!
+      !! Reference : 
+      !!   Marchesiello P., 1995, these de l'universite J. Fourier, Grenoble, France.
+      !! History :
+      !!        ! 95-03 (J.-M. Molines) Original, SPEM
+      !!        ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!   8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+      !!----------------------------------------------------------------------
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+
+      IF( kt == nit000 .OR. ln_rstart ) THEN
+         ! ... Boundary restoring coefficient
+         rtaue = 2. * rdt / rdpeob
+         rtauw = 2. * rdt / rdpwob
+         rtaun = 2. * rdt / rdpnob
+         rtaus = 2. * rdt / rdpsob
+         ! ... Boundary restoring coefficient for inflow ( all boundaries)
+         rtauein = 2. * rdt / rdpein 
+         rtauwin = 2. * rdt / rdpwin
+         rtaunin = 2. * rdt / rdpnin
+         rtausin = 2. * rdt / rdpsin 
+      END IF
+
+      ! ... right hand side of the barotropic elliptic equation
+      gcbob(:,:) = 0.e0
+
+      ! 1. Isolated coastline contribution to the RHS of the barotropic Eq.
+      ! -------------------------------------------------------------------
+      DO jnic = 1, nbobc-1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               gcbob(ji,jj) = gcbob(ji,jj) + gcfobc(ji,jj,jnic) * gcbic(jnic)
+            END DO
+         END DO
+      END DO
+
+      ! 2. East open boundary
+      ! ---------------------
+
+      IF( lpeastobc ) THEN
+         CALL obc_spg_east( kt )
+      END IF
+
+      ! 3. West open boundary
+      ! ---------------------
+
+      IF( lpwestobc ) THEN
+         CALL obc_spg_west( kt )
+      END IF
+        
+      ! 4. North open boundary
+      ! ----------------------
+
+      IF( lpnorthobc ) THEN
+         CALL obc_spg_north( kt )
+      END IF
+ 
+      ! 5. South open boundary
+      ! ----------------------
+
+      IF( lpsouthobc ) THEN
+         CALL obc_spg_south( kt )
+      END IF
+ 
+# if defined key_mpp
+      CALL mpp_lnk_2d( gcbob, 'G', 1. )
+# endif
+ 
+   END SUBROUTINE obc_spg
+
+   SUBROUTINE obc_spg_east ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_spg_east
+      !!                    *************************
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on east OBC stream function.
+      !!      If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M Treguier) F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declarations
+      INTEGER ::   ij
+
+      REAL(wp) ::   z2dtr, ztau, zin
+      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy
+
+      !!------------------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbceast is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000 + 3 .AND. .NOT.ln_rstart) .OR. lfbceast ) THEN
+
+         ! 1.1 Fixed barotropic stream function
+         ! ------------------------------------
+         DO jj = nje0m1, nje1 
+            ij = jj -1 + njmpp
+            bsfeob(jj)=bfoe(ij)
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbceast is .FALSE.
+      ! -----------------------------------------------------
+
+         ! 2.1. Barotropic stream function radiation
+         ! ----------------------------------------
+         !
+         !          nibm2      nibm      nib
+         !            |   nibm  |   nib   |///
+         !            |    |    |    |    |///
+         !  jj-line --f----v----f----v----f---
+         !            |         |         |///
+         !            |    |    |    |    |///
+         !         jpieob-2   jpieob-1    jpieob
+         !                 |         |        
+         !              jpieob-1    jpieob      
+         !
+         ! ... radiative conditions plus restoring term toward climatology
+         ! ... Initialize bsfeob to clim in any case, at the first step
+         !     to ensure proper values at the ends of the open line.
+         ! ... Take care that the j indices starts at nje0 (jpjed) and finish 
+         !     at nje1 (jpjef) to be sure that jpjefm1 and jpjef are set OK.
+         DO ji = fs_nie0-1, fs_nie1-1 ! Vector opt.
+            DO jj = nje0p1, nje1m2 
+               ij = jj -1 + njmpp
+         ! ... 2* gradi(bsf) (v-point i=nibm, time mean)
+               z2dx = ( bebnd(jj,nibm ,nit) + bebnd(jj,nibm ,nitm2) - 2.*bebnd(jj,nibm2,nitm) ) &
+                      / e1v(ji,jj)
+         ! ... 2* gradj(bsf) (f-point i=nibm, time nitm)
+               z2dy = ( bebnd(jj+1,nibm,nitm) - bebnd(jj-1,nibm,nitm) ) / e2f(ji,jj)
+         ! ... square of the norm of grad(bsf)
+               z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+               zdt = bebnd(jj,nibm,nitm2) - bebnd(jj,nibm,nit)
+         ! ... i-phase speed ratio (bounded by 1) and MASKED!
+               IF( z4nor2 == 0 ) THEN
+                  IF(lwp) WRITE(numout,*)' PB dans obc_spg_east au pt ',jj,' : z4nor=0'
+                  z4nor2 = 0.001
+               END IF
+               z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj)
+               z05cx = z05cx / e1v(ji+1,jj)
+               z05cx = min( z05cx, 1. )
+         ! ... z05cx < 0, inflow  zin=0, ztau=1  
+         !          => 0, outflow zin=1, ztau=rtaue
+               zin = sign( 1., z05cx )
+               zin = 0.5*( zin + abs(zin) )
+         ! ... Modification JM:  We maintain a restoring term toward
+         !                   bsfb even in case of inflow 
+         ! But restoring is stronger when in flow (10 days) (ztau in set in obcspg.F)
+               ztau = (1.-zin ) * rtauein + zin * rtaue
+               z05cx = z05cx * zin
+         ! ... update bsfn with radiative or climatological bsf (not mask!)
+               bsfeob(jj) = ( ( 1. - z05cx - ztau ) * bebnd(jj,nib ,nitm) + 2.*z05cx  &
+                               * bebnd(jj,nibm,nit) + ztau * bfoe (ij) )              &
+                            / (1. + z05cx)
+            END DO
+         END DO
+
+      END IF
+# if defined key_mpp
+      CALL mppobc(bsfeob,jpjed,jpjef,jpieob-1,1,2,jpj)
+# endif
+
+      ! 3. right hand side of the barotropic elliptic equation
+      ! ------------------------------------------------------
+ 
+      IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN
+         z2dtr=1./rdt
+      ELSE
+         z2dtr=1./2./rdt
+      END IF
+      DO ji = fs_nie0-1, fs_nie1-1 ! Vector opt.
+         DO jj = nje0m1, nje1 
+            gcbob(ji,jj) = gcbob(ji,jj) - hvr(ji+1,jj) * e2v(ji+1,jj) / e1v(ji+1,jj) &
+                           * ( bsfeob(jj) - bsfb(ji+1,jj) ) * z2dtr * bmask(ji,jj) 
+         END DO
+      END DO
+
+   END SUBROUTINE obc_spg_east
+
+   SUBROUTINE obc_spg_west ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_spg_west
+      !!                    *************************
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on west OBC stream function.
+      !!      If the logical lfbcwest is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M Treguier) F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declarations
+      INTEGER ::   ij
+
+      REAL(wp) ::   z2dtr, ztau, zin
+      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy
+
+      !!------------------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcwest is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000 + 3 .AND. .NOT.ln_rstart ) .OR. lfbcwest ) THEN
+
+         ! 1.1 Fixed barotropic stream function
+         ! ------------------------------------
+         DO jj = njw0m1, njw1
+            ij = jj -1 + njmpp
+            bsfwob(jj)=bfow(ij)
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcwest is .FALSE.
+      ! -----------------------------------------------------
+
+         ! 2.1. Barotropic stream function radiation
+         ! ----------------------------------------
+         !
+         !         nib       nibm     nibm2
+         !       ///|   nib   |   nibm  |
+         !       ///|    |    |    |    |
+         !       ---f----v----f----v----f-- jj-line
+         !       ///|         |         |
+         !       ///|    |    |    |    |
+         !        jpiwob    jpiwob+1    jpiwob+2
+         !               |         |        
+         !             jpiwob+1    jpiwob+2     
+         !
+         ! ... radiative conditions plus restoring term toward climatology
+         ! ... Initialize bsfwob to clim in any case, at the first step
+         !     to ensure proper values at the ends of the open line.
+         ! ... Take care that the j indices starts at njw0 (jpjwd) and finish
+         ! ... at njw1 (jpjwf) to be sure that jpjwfm1 and jpjwf are set OK.
+         DO ji = fs_niw0+1, fs_niw1+1 ! Vector opt.
+            DO jj = njw0p1, njw1m2
+               ij = jj -1 + njmpp
+         ! ... 2* gradi(bsf) (v-point i=nibm, time mean)
+               z2dx = ( -  bwbnd(jj,nibm ,nit ) - bwbnd(jj,nibm ,nitm2) + 2.*bwbnd(jj,nibm2,nitm ) ) &
+                      / e1v(ji+1,jj)
+         ! ... 2* gradj(bsf) (f-point i=nibm, time nitm)
+               z2dy = ( bwbnd(jj+1,nibm,nitm) - bwbnd(jj-1,nibm,nitm) ) / e2f(ji,jj)
+         ! ... square of the norm of grad(bsf)
+               z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+               zdt = bwbnd(jj,nibm,nitm2) - bwbnd(jj,nibm,nit)
+         ! ... i-phase speed ratio (bounded by 1) and MASKED!
+               IF( z4nor2 == 0 ) THEN
+                  IF(lwp) WRITE(numout,*)' PB dans obc_spg_west au pt ',jj,' : z4nor =0'
+                  z4nor2=0.0001
+               END IF
+               z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj)
+               z05cx = z05cx / e1v(ji,jj)
+               z05cx = max( z05cx, -1. )
+         ! ... z05cx => 0, inflow  zin=0, ztau=1  
+         !           <  0, outflow zin=1, ztau=rtauw
+               zin = sign( 1., -1. * z05cx )
+               zin = 0.5*( zin + abs(zin) )
+               ztau = (1.-zin )*rtauwin + zin * rtauw
+               z05cx = z05cx * zin
+         !  ... update bsfn with radiative or climatological bsf (not mask!)
+               bsfwob(jj) = ( ( 1. + z05cx - ztau ) * bwbnd(jj,nib ,nitm) - 2.*z05cx &
+                               * bwbnd(jj,nibm,nit) + ztau * bfow (ij) )             &
+                            / (1. - z05cx)
+            END DO
+         END DO
+
+      END IF
+# if defined key_mpp 
+      CALL mppobc(bsfwob,jpjwd,jpjwf,jpiwob+1,1,2,jpj) 
+# endif 
+
+      ! 3. right hand side of the barotropic elliptic equation
+      ! -------------------------------------------------------
+
+      IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN
+         z2dtr=1./rdt
+      ELSE
+         z2dtr=1./2./rdt
+      END IF
+      DO ji = fs_niw0+1, fs_niw1+1 ! Vector opt.
+         DO jj = njw0m1, njw1
+            gcbob(ji,jj) = gcbob(ji,jj) - hvr(ji,jj) * e2v(ji,jj) / e1v(ji,jj)     &
+                           * ( bsfwob(jj) - bsfb(ji-1,jj) ) * z2dtr * bmask(ji,jj)
+         END DO
+      END DO
+
+   END SUBROUTINE obc_spg_west
+
+   SUBROUTINE obc_spg_north ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_spg_north
+      !!                    *************************
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on north OBC stream function.
+      !!      If the logical lfbcnorth is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M Treguier) F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declarations
+      INTEGER ::   ii
+
+      REAL(wp) ::   z2dtr, ztau, zin
+      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy
+
+      !!------------------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcnorth is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000 + 3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth ) THEN
+
+         ! 1.1 Fixed barotropic stream function
+         ! ------------------------------------
+         DO ji = nin0m1, nin1
+            ii = ji -1 + nimpp
+            bsfnob(ji)=bfon(ii)
+         END DO
+
+      ELSE      
+
+      ! 2. Beyond the fourth time step if lfbcnorth is .FALSE.
+      ! -----------------------------------------------------
+
+         ! 2.1. Barotropic stream function radiation
+         ! -----------------------------------------
+         !
+         !           ji-row
+         !             |
+         !        ////////////
+         !        ////////////
+         !   nib  -----f------  jpjnob
+         !             |    
+         !      nib--  u   ---- jpjnob
+         !             |        
+         !  nibm  -----f-----   jpjnob-1
+         !             |        
+         !     nibm--  u   ---- jpjnob-1
+         !             |        
+         !  nibm2 -----f-----   jpjnob-2
+         !             |
+         !
+         ! ... radiative conditions plus restoring term toward climatology
+         ! ... z05cx is always the cross boundary phase velocity
+         ! ... Initialize bsfnob to clim in any case, at the first step
+         !     to ensure proper values at the ends of the open line.
+         ! ... Take care that the i indices starts at nin0 (jpind) and finish
+         ! ... at nin1 (jpinf) to be sure that jpinfm1 and jpinf are set OK.
+         DO jj = fs_njn0-1, fs_njn1-1 ! Vector opt.
+            DO ji = nin0p1, nin1m2
+               ii = ji -1 + nimpp
+         ! ... 2* gradj(bsf) (u-point i=nibm, time mean)
+               z2dx = ( bnbnd(ji,nibm ,nit) + bnbnd(ji,nibm ,nitm2) - 2.*bnbnd(ji,nibm2,nitm) ) &
+                      / e2u(ji,jj)
+         ! ... 2* gradi(bsf) (f-point i=nibm, time nitm)
+               z2dy = ( bnbnd(ji+1,nibm,nitm) - bnbnd(ji-1,nibm,nitm) ) / e1f(ji,jj)
+         ! ... square of the norm of grad(bsf)
+               z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+               zdt = bnbnd(ji,nibm,nitm2) - bnbnd(ji,nibm,nit)
+         ! ... j-phase speed ratio (bounded by 1) and MASKED!
+               IF( z4nor2 == 0 ) THEN
+                  IF(lwp) WRITE(numout,*)' PB dans obc_spg_north au pt',ji,' : z4nor =0'
+               END IF
+               z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj)
+               z05cx = z05cx / e2u(ji,jj+1)
+               z05cx = min( z05cx, 1. )
+         ! ... z05cx < 0, inflow  zin=0, ztau=1 
+         !          => 0, outflow zin=1, ztau=rtaun
+               zin = sign( 1., z05cx )
+               zin = 0.5*( zin + abs(zin) )
+               ztau = (1.-zin ) * rtaunin + zin * rtaun
+               z05cx = z05cx * zin
+         ! ... update bsfn with radiative or climatological bsf (not mask!)
+               bsfnob(ji) = ( ( 1. - z05cx - ztau ) * bnbnd(ji,nib ,nitm) + 2.*z05cx  &
+                               * bnbnd(ji,nibm,nit) + ztau * bfon (ii) )              &
+                            / (1. + z05cx)
+            END DO
+         END DO
+
+      END IF
+# if defined key_mpp
+      call mppobc(bsfnob,jpind,jpinf,jpjnob-1,1,1,jpi)
+# endif
+
+      ! 3. right hand side of the barotropic elliptic equation
+      !-------------------------------------------------------
+
+      IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN
+         z2dtr=1./rdt
+      ELSE
+         z2dtr=1./2./rdt
+      END IF
+      DO jj = fs_njn0-1, fs_njn1-1 ! Vector opt.
+         DO ji = nin0m1, nin1
+            gcbob(ji,jj) = gcbob(ji,jj) - hur(ji,jj+1) *  e1u(ji,jj+1) / e2u(ji,jj+1) &
+                           * ( bsfnob(ji) - bsfb(ji,jj+1) ) * z2dtr * bmask(ji,jj)
+         END DO
+      END DO
+
+   END SUBROUTINE obc_spg_north
+
+   SUBROUTINE obc_spg_south ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_spg_south
+      !!                    *************************
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on south OBC stream function.
+      !!      If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M Treguier) F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(in) ::   kt  ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER  ::   ii             ! temporary integers
+      REAL(wp) ::   &
+         z2dtr, ztau, zin   ,   &  ! temporary scalars
+         z05cx, zdt , z4nor2,   &  !    "         "
+         z2dx , z2dy               !    "         "
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcsouth is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+      
+      IF( ( kt < nit000 + 3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth ) THEN
+
+         ! 1.1 Fixed barotropic stream function
+         ! ------------------------------------
+         DO ji = nis0m1, nis1 
+            ii = ji -1 + nimpp 
+            bsfsob(ji)=bfos(ii)
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcsouth is .FALSE.
+      ! -----------------------------------------------------
+
+         ! 2.1. Barotropic stream function radiation
+         ! -----------------------------------------
+         !
+         !           ji-row
+         !             |
+         ! nibm2  -----f------  jpjsob + 2
+         !             |    
+         !   nibm  --  u  ----- jpjsob + 2
+         !             |        
+         !  nibm  -----f-----   jpjsob + 1
+         !             |        
+         !    nib  --  u  ----- jpjsob + 1
+         !             |        
+         !    nib -----f-----   jpjsob
+         !        ///////////     
+         !        ///////////
+         !
+         ! ... radiative conditions plus restoring term toward climatology
+         ! ... z05cx is always the cross boundary phase velocity
+         ! ... Initialize bsfsob to clim in any case, at the first step
+         !     to ensure proper values at the ends of the open line.
+         ! ... Take care that the i indices starts at nis0 (jpisd) and finish
+         ! ... at nis1 (jpisf) to be sure that jpisfm1 and jpisf are set OK.
+         DO jj = fs_njs0+1, fs_njs1+1 ! Vector opt.
+            DO ji = nis0p1, nis1m2
+               ii = ji -1 + nimpp
+         ! ... 2* gradj(bsf) (u-point i=nibm, time mean)
+               z2dx = ( - bsbnd(ji,nibm ,nit) - bsbnd(ji,nibm ,nitm2) + 2.*bsbnd(ji,nibm2,nitm) ) &
+                      / e2u(ji,jj+1)
+         ! ... 2* gradi(bsf) (f-point i=nibm, time nitm)
+               z2dy = ( bsbnd(ji+1,nibm,nitm) - bsbnd(ji-1,nibm,nitm) ) / e1f(ji,jj)
+         ! ... square of the norm of grad(bsf)
+               z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+               zdt = bsbnd(ji,nibm,nitm2) - bsbnd(ji,nibm,nit)
+         ! ... j-phase speed ratio (bounded by -1) and MASKED!
+               IF( z4nor2 == 0 ) THEN
+                  IF(lwp) WRITE(numout,*)' PB dans obc_spg_south au pt ',ji,' : z4nor =0'
+               END IF
+               z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj)
+               z05cx = z05cx / e2u(ji,jj)
+               z05cx = max( z05cx, -1. )
+         ! ... z05cx => 0, inflow  zin=0, ztau=1
+         !           <  0, outflow zin=1, ztau=rtaus
+               zin = sign( 1., -1. * z05cx )
+               zin = 0.5*( zin + abs(zin) )
+               ztau = (1.-zin ) *rtausin  + zin * rtaus
+               z05cx = z05cx * zin
+         ! ... update bsfn with radiative or climatological bsf (not mask!)
+               bsfsob(ji) = ( ( 1. + z05cx - ztau ) * bsbnd(ji,nib ,nitm) - 2.*z05cx  & 
+                               * bsbnd(ji,nibm,nit) + ztau * bfos (ii) )              &
+                            / (1. - z05cx)
+            END DO
+         END DO
+
+      END IF
+# if defined key_mpp
+      CALL mppobc(bsfsob,jpisd,jpisf,jpjsob+1,1,1,jpi)
+# endif
+ 
+      ! 3. right hand side of the barotropic elliptic equation
+      ! -------------------------------------------------------
+
+      IF( ( neuler == 0 ) .and. ( kt == nit000 ) ) THEN
+         z2dtr=1./rdt
+      ELSE
+         z2dtr=1./2./rdt
+      END IF
+      DO jj = fs_njs0+1, fs_njs1+1 ! Vector opt.
+         DO ji = nis0m1, nis1 
+            gcbob(ji,jj) = gcbob(ji,jj) - hur(ji,jj) * e1u(ji,jj) / e2u(ji,jj) &
+                           * ( bsfsob(ji) - bsfb(ji,jj-1) ) * z2dtr * bmask(ji,jj)
+         END DO
+      END DO
+
+   END SUBROUTINE obc_spg_south
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case :                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE obc_spg( kt )        ! Empty routine
+      INTEGER, INTENT( in ) :: kt
+      WRITE(*,*) kt
+   END SUBROUTINE obc_spg
+#endif
+
+   !!======================================================================
+END MODULE obcspg
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obctra.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obctra.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obctra.F90	(revision 4)
@@ -0,0 +1,542 @@
+MODULE obctra
+   !!=================================================================================
+   !!                       ***  MODULE  obctra  ***
+   !! Ocean tracers:   Radiation of tracers on each open boundary
+   !!=================================================================================
+#if defined key_obc
+   !!---------------------------------------------------------------------------------
+   !!   'key_obc'      :                                      Open Boundary Conditions
+   !!---------------------------------------------------------------------------------
+   !!   obc_tra        : call the subroutine for each open boundary
+   !!   obc_tra_east   : radiation of the east open boundary tracers
+   !!   obc_tra_west   : radiation of the west open boundary tracers
+   !!   obc_tra_north  : radiation of the north open boundary tracers
+   !!   obc_tra_south  : radiation of the south open boundary tracers
+   !!----------------------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE lib_mpp         ! ???
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC obc_tra     ! routine called in tranxt.F90 
+
+   !! * Module variables
+   INTEGER ::   ji, jj, jk      ! dummy loop indices
+
+   INTEGER ::      & ! ... boundary space indices 
+      nib   = 1,   & ! nib   = boundary point
+      nibm  = 2,   & ! nibm  = 1st interior point
+      nibm2 = 3,   & ! nibm2 = 2nd interior point
+                     ! ... boundary time indices 
+      nit   = 1,   & ! nit    = now
+      nitm  = 2,   & ! nitm   = before
+      nitm2 = 3      ! nitm2  = before-before
+
+   REAL(wp) ::     &
+      rtaue  , rtauw  , rtaun  , rtaus  ,  &  ! Boundary restoring coefficient
+      rtauein, rtauwin, rtaunin, rtausin      ! Boundary restoring coefficient for inflow 
+
+   !! * Substitutions
+#  include "obc_vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_tra( kt )
+      !!-------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE obc_tra  ***
+      !!                    
+      !! ** Purpose :   Compute tracer fields (t,s) along the open boundaries.
+      !!      This routine is called by the tranxt.F routine and updates ta,sa
+      !!      which are the actual temperature and salinity fields.
+      !!        The logical variable lpeastobc, and/or lpwestobc, and/or lpnorthobc,
+      !!      and/or lpsouthobc allow the user to determine which boundary is an
+      !!      open one (must be done in the param_obc.h90 file).
+      !!
+      !! Reference : 
+      !!   Marchesiello P., 1995, these de l'universite J. Fourier, Grenoble, France.
+      !!
+      !!  History :
+      !!        !  95-03 (J.-M. Molines) Original, SPEM
+      !!        !  97-07 (G. Madec, J.-M. Molines) addition
+      !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) F90
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+      !!----------------------------------------------------------------------
+
+      ! 0. Local constant initialization
+
+      IF( kt == nit000 .OR. ln_rstart) THEN
+         ! ... Boundary restoring coefficient
+         rtaue = 2. * rdt / rdpeob
+         rtauw = 2. * rdt / rdpwob
+         rtaun = 2. * rdt / rdpnob
+         rtaus = 2. * rdt / rdpsob
+         ! ... Boundary restoring coefficient for inflow ( all boundaries)
+         rtauein = 2. * rdt / rdpein 
+         rtauwin = 2. * rdt / rdpwin
+         rtaunin = 2. * rdt / rdpnin
+         rtausin = 2. * rdt / rdpsin 
+      END IF
+
+      ! 1. East open boundary
+      ! ---------------------
+
+      IF( lpeastobc )THEN
+         CALL obc_tra_east( kt )
+      END IF
+
+      ! 2. West open boundary
+      ! ---------------------
+
+      IF( lpwestobc )THEN
+         CALL obc_tra_west( kt )
+      END IF
+
+      ! 3. North open boundary
+      ! ---------------------
+
+      IF( lpnorthobc )THEN
+         CALL obc_tra_north( kt )
+      END IF
+
+      ! 4. South open boundary
+      ! ---------------------
+
+      IF( lpsouthobc )THEN
+         CALL obc_tra_south( kt )
+      END IF
+
+# if defined key_mpp
+      !! bug ???
+      IF( kt >= nit000+3 .AND. ln_rstart ) THEN
+         CALL mpp_lnk_3d( tb, 'T', 1. )
+         CALL mpp_lnk_3d( sb, 'T', 1. )
+      END IF
+      CALL mpp_lnk_3d( ta, 'T', 1. )
+      CALL mpp_lnk_3d( sa, 'T', 1. )
+# endif
+
+   END SUBROUTINE obc_tra
+
+
+   SUBROUTINE obc_tra_east ( kt )
+      !!------------------------------------------------------------------------------
+      !!                ***  SUBROUTINE obc_tra_east  ***
+      !!                  
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on east OBC tracers ta, sa using the 
+      !!      phase velocities calculated in obc_rad_east subroutine in obcrad.F90 module
+      !!      If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      REAL(wp) ::   z05cx, ztau, zin
+
+      !!------------------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbceast is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast ) THEN
+         DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - temsk(jj,jk)) + &
+                                 tfoe(jj,jk)*temsk(jj,jk)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - temsk(jj,jk)) + &
+                                 sfoe(jj,jk)*temsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbceast is .FALSE.
+      ! -----------------------------------------------------
+
+         ! Temperature and salinity radiation
+         ! ----------------------------------
+         !
+         !            nibm2      nibm      nib
+         !              |   nibm  |   nib///|///
+         !              |    |    |    |////|///
+         !  jj   line --v----f----v----f----v---
+         !              |    |    |    |////|///
+         !                   |         |///   //
+         !  jj   line   T    u    T    u/// T //
+         !                   |         |///   //
+         !              |    |    |    |////|///
+         !  jj-1 line --v----f----v----f----v---
+         !              |    |    |    |////|///
+         !                jpieob-1    jpieob / ///
+         !              |         |         |
+         !           jpieob-1    jpieob     jpieob+1
+         !
+         ! ... radiative conditions + relaxation toward a climatology
+         !     the phase velocity is taken as the phase velocity of the tangen-
+         !     tial velocity (here vn), which have been saved in (u_cxebnd,v_cxebnd)
+         ! ... (jpjedp1, jpjefm1), jpieob+1
+         DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+         ! ... i-phase speed ratio (from averaged of v_cxebnd)
+                  z05cx = ( 0.5 * ( v_cxebnd(jj,jk) + v_cxebnd(jj-1,jk) ) ) / e1t(ji-1,jj)
+                  z05cx = min( z05cx, 1. )
+         ! ... z05cx=< 0, inflow  zin=0, ztau=1    
+         !           > 0, outflow zin=1, ztau=rtaue
+                  zin = sign( 1., z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+         ! ... for inflow rtauein is used for relaxation coefficient else rtaue
+                  ztau = (1.-zin ) * rtauein  + zin * rtaue
+                  z05cx = z05cx * zin
+         ! ... update ( ta, sa ) with radiative or climatological (t, s)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - temsk(jj,jk)) +           & 
+                                 temsk(jj,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * tebnd(jj,jk,nib ,nitm) + 2.*z05cx              &
+                                 * tebnd(jj,jk,nibm,nit ) + ztau * tfoe (jj,jk) ) &
+                                 / (1. + z05cx)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - temsk(jj,jk)) +           & 
+                                 temsk(jj,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * sebnd(jj,jk,nib ,nitm) + 2.*z05cx              &
+                                 * sebnd(jj,jk,nibm,nit ) + ztau * sfoe (jj,jk) ) &
+                                 / (1. + z05cx)
+               END DO
+            END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE obc_tra_east
+
+
+   SUBROUTINE obc_tra_west ( kt )
+      !!------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE obc_tra_west  ***
+      !!           
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on west OBC tracers ta, sa using the 
+      !!      phase velocities calculated in obc_rad_west subroutine in obcrad.F90 module
+      !!      If the logical lfbcwest is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      REAL(wp) ::   z05cx, ztau, zin
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcwest is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest ) THEN
+
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - twmsk(jj,jk)) + &
+                                 tfow(jj,jk)*twmsk(jj,jk)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - twmsk(jj,jk)) + &
+                                 sfow(jj,jk)*twmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcwest is .FALSE.
+      ! -----------------------------------------------------
+          
+         ! Temperature and salinity radiation
+         ! ----------------------------------
+         !
+         !          nib       nibm     nibm2
+         !     nib///|   nibm  |  nibm2  |
+         !   ///|////|    |    |    |    |   
+         !   ---v----f----v----f----v----f-- jj   line
+         !   ///|////|    |    |    |    |   
+         !   //   ///|         |         |   
+         !   // T ///u    T    u    T    u   jj   line
+         !   //   ///|         |         |   
+         !   ///|////|    |    |    |    |   
+         !   ---v----f----v----f----v----f-- jj-1 line
+         !   ///|////|    |    |    |    |   
+         !         jpiwob    jpiwob+1    jpiwob+2
+         !      |         |         |        
+         !    jpiwob    jpiwob+1   jpiwob+2
+         !
+         ! ... radiative conditions + relaxation toward a climatology
+         ! ... the phase velocity is taken as the phase velocity of the tangen-
+         ! ... tial velocity (here vn), which have been saved in (v_cxwbnd)
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+         ! ... i-phase speed ratio (from averaged of v_cxwbnd)
+                  z05cx = (  0.5 * ( v_cxwbnd(jj,jk) + v_cxwbnd(jj-1,jk) ) ) / e1t(ji+1,jj)
+                  z05cx = max( z05cx, -1. )
+         ! ... z05cx > 0, inflow  zin=0, ztau=1    
+         !           < 0, outflow zin=1, ztau=rtauw
+                  zin = sign( 1., -1.* z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+                  ztau = (1.-zin )*rtauwin + zin * rtauw
+                  z05cx = z05cx * zin
+         ! ... update (ta,sa) with radiative or climatological (t, s)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - twmsk(jj,jk)) +           &
+                                 twmsk(jj,jk) * ( ( 1. + z05cx - ztau )         &
+                                 * twbnd(jj,jk,nib ,nitm) - 2.*z05cx              &
+                                 * twbnd(jj,jk,nibm,nit ) + ztau * tfow (jj,jk) ) &
+                                 / (1. - z05cx)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - twmsk(jj,jk)) +           &
+                                 twmsk(jj,jk) * ( ( 1. + z05cx - ztau )         &
+                                 * swbnd(jj,jk,nib ,nitm) - 2.*z05cx              &
+                                 * swbnd(jj,jk,nibm,nit ) + ztau * sfow (jj,jk) ) &
+                                 / (1. - z05cx)
+               END DO
+            END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE obc_tra_west
+
+
+   SUBROUTINE obc_tra_north ( kt )
+      !!------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE obc_tra_north  ***
+      !!
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on north OBC tracers ta, sa using the 
+      !!      phase velocities calculated in obc_rad_north subroutine in obcrad.F90 module
+      !!      If the logical lfbcnorth is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      REAL(wp) ::   z05cx, ztau, zin
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcnorth is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth ) THEN
+
+         DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  ta(ji,jj,jk)= ta(ji,jj,jk) * (1.-tnmsk(ji,jk)) + &
+                                tnmsk(ji,jk) * tfon(ji,jk)
+                  sa(ji,jj,jk)= sa(ji,jj,jk) * (1.-tnmsk(ji,jk)) + &
+                                tnmsk(ji,jk) * sfon(ji,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcnorth is .FALSE.
+      ! -------------------------------------------------------
+          
+         ! Temperature and salinity radiation
+         ! ----------------------------------
+         !
+         !           ji-1   ji   ji   ji +1
+         !             |
+         !    nib //// u // T // u // T //   jpjnob + 1
+         !        /////|//////////////////
+         !    nib  ----f----v----f----v---   jpjnob
+         !             |         |       
+         !      nibm-- u -- T -- u -- T --   jpjnob
+         !             |         |            
+         !   nibm  ----f----v----f----v---  jpjnob-1
+         !             |         |      
+         !     nibm2-- u -- T -- T -- T --  jpjnob-1
+         !             |         |    
+         !   nibm2 ----f----v----f----v---  jpjnob-2
+         !             |         |
+         !
+         ! ... radiative conditions + relaxation toward a climatology
+         ! ... the phase velocity is taken as the normal phase velocity of the tangen-
+         ! ... tial velocity (here un), which has been saved in (u_cynbnd)
+         ! ... jpjnob+1,(jpindp1, jpinfm1)
+         DO jj = fs_njn0+1, fs_njn1+1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+         ! ... j-phase speed ratio (from averaged of vtnbnd)
+         !        (bounded by 1)
+                  z05cx = ( 0.5 * ( u_cynbnd(ji,jk) + u_cynbnd(ji-1,jk) ) ) / e2t(ji,jj-1)
+                  z05cx = min( z05cx, 1. )
+         ! ... z05cx=< 0, inflow  zin=0, ztau=1    
+         !           > 0, outflow zin=1, ztau=rtaun
+                  zin = sign( 1., z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+         ! ... for inflow rtaunin is used for relaxation coefficient else rtaun
+                  ztau = (1.-zin ) * rtaunin + zin * rtaun
+                  z05cx = z05cx * zin
+         ! ... update (ta,sa) with radiative or climatological (t, s)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) * (1.-tnmsk(ji,jk)) +             &
+                                 tnmsk(ji,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * tnbnd(ji,jk,nib ,nitm) + 2.*z05cx              &
+                                 * tnbnd(ji,jk,nibm,nit ) + ztau * tfon (ji,jk) ) &
+                                 / (1. + z05cx)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) * (1.-tnmsk(ji,jk)) +             &
+                                 tnmsk(ji,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * snbnd(ji,jk,nib ,nitm) + 2.*z05cx              &
+                                 * snbnd(ji,jk,nibm,nit ) + ztau * sfon (ji,jk) ) &
+                                 / (1. + z05cx)
+               END DO
+            END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE obc_tra_north
+
+
+   SUBROUTINE obc_tra_south ( kt )
+      !!------------------------------------------------------------------------------
+      !!                ***  SUBROUTINE obc_tra_south  ***
+      !!     
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on south OBC tracers ta, sa using the 
+      !!      phase velocities calculated in obc_rad_south subroutine in obcrad.F90 module
+      !!      If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M Treguier) F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      REAL(wp) ::   z05cx, ztau, zin
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcsouth is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth ) THEN
+
+         DO jj = fs_njs0, fs_njs1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  ta(ji,jj,jk)= ta(ji,jj,jk) * (1.-tsmsk(ji,jk)) + &
+                                tsmsk(ji,jk) * tfos(ji,jk)
+                  sa(ji,jj,jk)= sa(ji,jj,jk) * (1.-tsmsk(ji,jk)) + &
+                                tsmsk(ji,jk) * sfos(ji,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcsouth is .FALSE.
+      ! -------------------------------------------------------
+          
+         ! Temperature and salinity radiation
+         ! ----------------------------------
+         !
+         !           ji-1   ji   ji   ji +1
+         !             |         |
+         !   nibm2 ----f----v----f----v---   jpjsob+2
+         !             |         |       
+         !   nibm2 --  u -- T -- u -- T --   jpjsob+2
+         !             |         |            
+         !   nibm  ----f----v----f----v---   jpjsob+1
+         !             |         |      
+         !    nibm --  u -- T -- T -- T --   jpjsob+1
+         !             |         |    
+         !   nib  -----f----v----f----v---   jpjsob
+         !       //////|/////////|//////// 
+         !    nib //// u // T // u // T //   jpjsob 
+         !
+         !... radiative conditions + relaxation toward a climatology
+         !... the phase velocity is taken as the phase velocity of the tangen-
+         !... tial velocity (here un), which has been saved in (u_cysbnd)
+         !... jpjsob,(jpisdp1, jpisfm1)
+         DO jj = fs_njs0, fs_njs1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+         !... j-phase speed ratio (from averaged of u_cysbnd)
+         !       (bounded by 1)
+                  z05cx = ( 0.5 * ( u_cysbnd(ji,jk) + u_cysbnd(ji-1,jk) ) ) / e2t(ji,jj+1)
+                  z05cx = max( z05cx, -1. )
+         !... z05cx > 0, inflow  zin=0, ztau=1
+         !          < 0, outflow zin=1, ztau=rtaus
+                  zin = sign( 1., -1.* z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+                  ztau = (1.-zin ) + zin * rtaus
+                  z05cx = z05cx * zin
+         !... update (ta,sa) with radiative or climatological (t, s)
+                  ta(ji,jj,jk) = ta(ji,jj,jk) * (1.-tsmsk(ji,jk)) +             &
+                                 tsmsk(ji,jk) * ( ( 1. + z05cx - ztau )         &
+                                 * tsbnd(ji,jk,nib ,nitm) - 2.*z05cx              &
+                                 * tsbnd(ji,jk,nibm,nit ) + ztau * tfos (ji,jk) ) &
+                                 / (1. - z05cx)
+                  sa(ji,jj,jk) = sa(ji,jj,jk) * (1.-tsmsk(ji,jk)) +             &
+                                 tsmsk(ji,jk) * (  ( 1. + z05cx - ztau )        &
+                                 * ssbnd(ji,jk,nib ,nitm) - 2.*z05cx              &
+                                 * ssbnd(ji,jk,nibm,nit ) + ztau * sfos (ji,jk) ) &
+                                 / (1. - z05cx)
+               END DO
+            END DO
+         END DO
+
+      END IF   
+
+   END SUBROUTINE obc_tra_south
+
+#else
+   !!---------------------------------------------------------------------------------
+   !!   Default option                                                    Empty module
+   !!---------------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE obc_tra      ! Empty routine
+   END SUBROUTINE obc_tra
+#endif
+
+   !!=================================================================================
+END MODULE obctra
Index: /branches/nemo/NEMO/OPA_SRC/OBC/obcvol.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/OBC/obcvol.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/OBC/obcvol.F90	(revision 4)
@@ -0,0 +1,316 @@
+MODULE obcvol
+   !!=================================================================================
+   !!                       ***  MODULE  obcvol  ***
+   !! Ocean dynamic :  Volume constraint when OBC and Free surface are activated
+   !!=================================================================================
+#if defined key_obc && defined key_dynspg_fsc
+   !!---------------------------------------------------------------------------------
+   !!   'key_obc'               and                           open boundary conditions
+   !!   'key_dynspg_fsc'                                  constant volume free surface
+   !!---------------------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain 
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE lib_mpp         ! for mppsum
+   USE in_out_manager  ! I/O manager
+   USE ocesbc          ! ocean surface boundary conditions
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC obc_vol        ! routine called by dynspg_fsc.h90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "obc_vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_vol ( kt )
+      !!------------------------------------------------------------------------------
+      !!                      ***  ROUTINE obcvol  ***
+      !!
+      !! ** Purpose : 
+      !!      This routine is called in dynspg_fsc to control 
+      !!      the volume of the system. A correction velocity is calculated
+      !!      to correct the total transport through the OBC. 
+      !!      The total depth used is constant (H0) to be consistent with the 
+      !!      linear free surface coded in OPA 8.2
+      !!
+      !! ** Method :  
+      !!      The correction velocity (zubtpecor here) is defined calculating
+      !!      the total transport through all open boundaries (trans_obc) minus
+      !!      the cumulate E-P flux (zCflxemp) divided by the total lateral 
+      !!      surface (obcsurftot) of these OBC. 
+      !!
+      !!      zubtpecor = [trans_obc - zCflxemp ]*(1./obcsurftot)
+      !!
+      !!      with zCflxemp => sum of (Evaporation minus Precipitation)
+      !!                       over all the domain in m3/s at each time step.
+      !!
+      !!      zCflxemp < 0 when precipitation dominate
+      !!      zCflxemp > 0 when evaporation dominate
+      !!
+      !!      There are 2 options (user's desiderata): 
+      !!
+      !!         1/ The volume changes according to E-P, this is the default
+      !!            option. In this case the cumulate E-P flux are setting to
+      !!            zero (zCflxemp=0) to calculate the correction velocity. So
+      !!            it will only balance the flux through open boundaries.
+      !!            (set volemp to 0 in tne namelist for this option)
+      !!
+      !!         2/ The volume is constant even with E-P flux. In this case
+      !!            the correction velocity must balance both the flux 
+      !!            through open boundaries and the ones through the free
+      !!            surface. 
+      !!            (set volemp to 1 in tne namelist for this option)
+      !!
+      !! History :
+      !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) Original
+      !!----------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk
+      REAL(wp) ::   zubtpecor
+      REAL(wp) ::   zCflxemp
+      REAL(wp) ::   ztransw, ztranse, ztransn, ztranss, ztranst
+      !!-----------------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN 
+         IF(lwp) WRITE(numout,*)'        '
+         IF(lwp) WRITE(numout,*)'obc_vol : Correction of velocities along OBC'
+         IF(lwp) WRITE(numout,*)'~~~~~~~'
+         IF(lwp) WRITE(numout,*)'        '
+      END IF 
+
+      ! 1. Calculate the cumulate surface Flux zCflxemp (m3/s) over all the domain.
+      ! ---------------------------------------------------------------------------
+ 
+      zCflxemp = 0.e0
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zCflxemp = zCflxemp + ( (emp(ji,jj)*obctmsk(ji,jj) )/rauw)*e1v(ji,jj)*e2u(ji,jj)
+         END DO
+      END DO
+
+# if defined key_mpp
+      CALL mpp_sum( zCflxemp )
+# endif
+
+      ! 2. Barotropic velocity for each open boundary
+      ! ---------------------------------------------
+
+      zubtpecor = 0.e0
+
+      ! ... West open boundary
+      IF( lpwestobc ) THEN
+
+         ! ... Total transport through the West OBC
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  zubtpecor = zubtpecor + ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) &
+                                        * uwmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+      END IF 
+
+      ! ... East open boundary
+      IF( lpeastobc ) THEN
+
+         ! ... Total transport through the East OBC
+         DO ji = fs_nie0, fs_nie1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  zubtpecor = zubtpecor - ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) &
+                                        * uemsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+      END IF 
+
+      ! ... North open boundary
+      IF( lpnorthobc ) THEN
+
+         ! ... Total transport through the North OBC
+         DO jj = fs_njn0, fs_njn1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  zubtpecor = zubtpecor - va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) &
+                                        * vnmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+
+      END IF 
+
+      ! ... South open boundary
+      IF( lpsouthobc ) THEN
+
+         ! ... Total transport through the South OBC
+         DO jj = fs_njs0, fs_njs1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  zubtpecor = zubtpecor + va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) &
+                                        * vsmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+
+      END IF 
+
+# if defined key_mpp
+      CALL mpp_sum( zubtpecor )
+# endif
+
+      ! 3. The normal velocity correction
+      ! ---------------------------------
+
+      zubtpecor = (zubtpecor - zCflxemp*volemp)*(1./obcsurftot)
+
+      IF( lwp .and. mod( kt, nwrite ) == 0) THEN
+         IF(lwp) WRITE(numout,*)'        '
+         IF(lwp) WRITE(numout,*)'obc_vol : time step :', kt
+         IF(lwp) WRITE(numout,*)'~~~~~~~ '
+         IF(lwp) WRITE(numout,*)'        '
+         IF(lwp) WRITE(numout,*)'          cumulate flux EMP :', zCflxemp,' (m3/s)'
+         IF(lwp) WRITE(numout,*)'          total lateral surface of OBC :',obcsurftot,'(m2)'
+         IF(lwp) WRITE(numout,*)'          correction velocity zubtpecor :',zubtpecor,'(m/s)'
+         IF(lwp) WRITE(numout,*)'        '
+      END IF 
+
+      ! 4. Correction of the total velocity on each open 
+      !    boundary torespect the mass flux conservation
+      ! -------------------------------------------------
+
+      ztransw = 0.e0
+      ztranse = 0.e0
+      ztransn = 0.e0
+      ztranss = 0.e0
+      ztranst = 0.e0
+
+      IF( lpwestobc ) THEN
+
+         ! ... correction of the west velocity
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  ua(ji,jj,jk) = ua(ji,jj,jk) - zubtpecor*uwmsk(jj,jk)
+                  ztransw= ztransw + ua(ji,jj,jk)*fse3u(ji,jj,jk)*e2u(ji,jj)*uwmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+# if defined key_mpp
+         CALL mpp_sum( ztransw )
+# endif
+
+         IF( lwp .and. mod( kt, nwrite ) == 0) THEN
+            IF(lwp) WRITE(numout,*)'          West OB transport ztransw :', ztransw,'(m3/s)'
+         END IF 
+
+      END IF 
+
+      IF( lpeastobc ) THEN
+
+         ! ... correction of the east velocity
+         DO ji = fs_nie0, fs_nie1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  ua(ji,jj,jk) = ua(ji,jj,jk) + zubtpecor*uemsk(jj,jk)
+                  ztranse= ztranse + ua(ji,jj,jk)*fse3u(ji,jj,jk)*e2u(ji,jj)*uemsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+# if defined key_mpp
+         CALL mpp_sum( ztranse )
+# endif
+
+         IF( lwp .and. mod( kt, nwrite ) == 0) THEN
+            IF(lwp) WRITE(numout,*)'          East OB transport ztranse :', ztranse,'(m3/s)'
+         END IF 
+
+      END IF 
+
+      IF( lpnorthobc ) THEN
+
+         ! ... correction of the north velocity
+         DO jj = fs_njn0, fs_njn1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji =  1, jpi
+                  va(ji,jj,jk) = va(ji,jj,jk) + zubtpecor*vnmsk(ji,jk)
+                  ztransn= ztransn + va(ji,jj,jk)*fse3v(ji,jj,jk)*e1v(ji,jj)*vnmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+
+# if defined key_mpp
+         CALL mpp_sum( ztransn )
+# endif
+
+         IF( lwp .and. mod( kt, nwrite ) == 0) THEN
+            IF(lwp) WRITE(numout,*)'          North OB transport ztransn :', ztransn,'(m3/s)'
+         END IF 
+
+      END IF 
+
+      IF( lpsouthobc ) THEN
+
+         ! ... correction of the south velocity
+         DO jj = fs_njs0, fs_njs1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji =  1, jpi
+                  va(ji,jj,jk) = va(ji,jj,jk) - zubtpecor*vsmsk(ji,jk)
+                  ztranss= ztranss + va(ji,jj,jk)*fse3v(ji,jj,jk)*e1v(ji,jj)*vsmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+ 
+# if defined key_mpp
+         CALL mpp_sum( ztranss )
+# endif
+
+         IF( lwp .and. mod( kt, nwrite ) == 0) THEN
+            IF(lwp) WRITE(numout,*)'          South OB transport ztranss :', ztranss,'(m3/s)'
+         END IF 
+
+      END IF 
+
+      ! 5. Check the cumulate transport through OBC
+      !    once barotropic velocities corrected
+      ! -------------------------------------------
+
+      ztranst = ztransw - ztranse + ztranss - ztransn
+
+      IF( lwp .and. mod( kt, nwrite ) == 0) THEN
+         IF(lwp) WRITE(numout,*)'        '
+         IF(lwp) WRITE(numout,*)'          Cumulate transport ztranst =', ztranst,'(m3/s)'
+         IF(lwp) WRITE(numout,*)'        '
+      END IF 
+
+   END SUBROUTINE obc_vol
+
+#else
+   !!---------------------------------------------------------------------------------
+   !!  Default option :                                                   Empty module
+   !!---------------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE obc_vol        ! Empty routine
+   END SUBROUTINE obc_vol
+#endif
+
+   !!=================================================================================
+END MODULE obcvol
Index: /branches/nemo/NEMO/OPA_SRC/SBC/blk_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/blk_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/blk_oce.F90	(revision 4)
@@ -0,0 +1,49 @@
+MODULE blk_oce
+   !!======================================================================
+   !!                 ***  MODULE  blk_oce  ***
+   !! Bulk   :  bulk parameter and  variables defined in memory 
+   !!======================================================================
+   !! History :
+   !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+   !!----------------------------------------------------------------------
+   !! ' key_flx_bulk_monthly or defined key_flx_bulk_daily             bulk
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce          ! ocean parameters
+
+   IMPLICIT NONE
+   LOGICAL, PUBLIC ::   l_bulk = .TRUE.   
+   
+   !!----------------------------------------------------------------------
+   !! bulk common variables
+   !!----------------------------------------------------------------------
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   & 
+      watm     ,      &   ! precipitation
+      tatm     ,      &   ! atmospheric temperature
+      hatm     ,      &   ! relative humidity
+      vatm     ,      &   ! wind speed
+      catm                ! percent of cloud cover
+
+   REAL(wp), DIMENSION(jpi,jpj)    ::   &
+      gsst     ,      &  ! SST mean on nfbulk ocean time step
+      gsss               ! SSS mean on nfbulk ocean time step
+
+   REAL(wp) ::        &
+      yearday  ,      &  ! number of days per year
+      rdtbs2             ! bulk time step divide by 2
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC ::   l_bulk = .FALSE.  
+#endif
+   
+   INTEGER ::         & !!! namdom : space/time domain (namlist)
+      nfbulk =  5         ! bulk computation frequency 
+   !!----------------------------------------------------------------------
+END MODULE blk_oce
Index: /branches/nemo/NEMO/OPA_SRC/SBC/bulk.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/bulk.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/bulk.F90	(revision 4)
@@ -0,0 +1,114 @@
+MODULE bulk
+   !!======================================================================
+   !!                           ***  bulk  ***
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   bulk          : computation of fluxes using bulk formulation
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ice_oce         ! bulk variable  
+   USE ocfzpt          ! ocean freezing point
+   USE flxblk          ! bulk formulae
+   USE blk_oce         ! bulk variable 
+   USE taumod
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC blk        ! called by flx.F90   
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE blk( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE blk  ***
+      !!        
+      !! ** Purpose :   provide the heat fluxes on ice and ocean 
+      !!                using bulk formulation
+      !!
+      !! History :
+      !!   9.0  !  03-11  (C. Ethe and G. Madec)  F90: Free form and MODULE 
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * Local declarations    
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zsst , zsss
+# if ! defined key_ice_lim
+      INTEGER  ::   ji, jj         ! dummy loop indices  
+      REAL(wp) ::   ztgel, zicopa
+# endif
+      !!---------------------------------------------------------------------
+
+     ! Initialisation
+     IF( kt == nit000) THEN
+      ! computation of rdtbs2
+        IF( nacc == 1 ) THEN
+           rdtbs2 = nfbulk * rdtmin * 0.5
+        ELSE
+           rdtbs2 = nfbulk * rdt * 0.5
+        ENDIF
+        IF ( .NOT.ln_rstart ) THEN
+           gsst(:,:) =  ( nfbulk - 1 ) * ( tn(:,:,1) + rt0 )
+           gsss(:,:) =  ( nfbulk - 1 ) *   sn(:,:,1)
+        ENDIF
+     ENDIF
+
+# if ! defined key_ice_lim
+      ! opa model ice freeze()      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ztgel  = fzptn(ji,jj)
+            zicopa = tmask(ji,jj,1)
+            IF( tn(ji,jj,1) >= ztgel ) zicopa = 0.
+            freeze(ji,jj) = zicopa
+         END DO
+      END DO
+# endif
+
+      gsst(:,:) = gsst(:,:) + tn(:,:,1) + rt0  
+      gsss(:,:) = gsss(:,:) + sn(:,:,1)
+
+      !  Computation of the fluxes       
+      IF( MOD( kt - 1 , nfbulk ) == 0 ) THEN
+
+!i       zsst(:,:) = gsst(:,:) / REAL( nfbulk ) 
+         zsst(:,:) = gsst(:,:) / REAL( nfbulk ) * tmask(:,:,1)
+         zsss(:,:) = gsss(:,:) / REAL( nfbulk )
+         CALL flx_blk( kt, zsst )    
+     
+         gsst(:,:) = 0.    
+         gsss(:,:) = 0.  
+
+# if ! defined key_ice_lim
+         IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging)
+            WRITE(numout,*) ' Forcings '
+            WRITE(numout,*) ' qsr_oce  : ', SUM( qsr_oce (:,:) * tmask(:,:,1) )
+            WRITE(numout,*) ' qsr_ice  : ', SUM( qsr_ice (:,:) * tmask(:,:,1) )
+            WRITE(numout,*) ' qnsr_oce : ', SUM( qnsr_oce(:,:) * tmask(:,:,1) )
+            WRITE(numout,*) ' qnsr_ice : ', SUM( qnsr_ice(:,:) * tmask(:,:,1) )
+            WRITE(numout,*) ' evap     : ', SUM( evap    (:,:) * tmask(:,:,1) )
+            WRITE(numout,*) ' precip   : ', SUM( tprecip (:,:) * tmask(:,:,1) ) / rday
+            WRITE(numout,*) ' Snow     : ', SUM( sprecip (:,:) * tmask(:,:,1) ) / rday
+            WRITE(numout,*) ' u-stress : ', SUM( taux    (:,:) * umask(:,:,1) )
+            WRITE(numout,*) ' v-stress : ', SUM( tauy    (:,:) * vmask(:,:,1) )
+            WRITE(numout,*) ' sst      : ', SUM( zsst    (:,:) * tmask(:,:,1) )
+            WRITE(numout,*) ' sss      : ', SUM( zsss    (:,:) * tmask(:,:,1) )
+            WRITE(numout,*)
+         ENDIF
+# endif   
+      ENDIF
+ 
+   END SUBROUTINE blk
+ 
+   !!======================================================================
+END MODULE bulk
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flx_bulk_daily.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flx_bulk_daily.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flx_bulk_daily.h90	(revision 4)
@@ -0,0 +1,296 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  flx_bulk_daily  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   bulk          : reading 
+   !!----------------------------------------------------------------------
+   !! * Modules used     C A U T I O N  already defined in flxmod.F90
+
+   !! * Module variables
+   
+   INTEGER ::          &
+      numfl1, numfl2,  &  ! logical units for surface fluxes data
+      numfl3,          &  ! 
+      nflx1, nflx2,    &  !  first and second record used
+      nflx11, nflx12 , &  ! ???
+      ndayflx
+
+   REAL(wp), DIMENSION(jpi,jpj,2,7) ::   &
+      flxdta              ! 2 consecutive set of CLIO/CMAP monthly fluxes
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flx( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE flx  ***
+      !!        
+      !! ** Purpose :   provide the thermohaline fluxes (heat and freshwater)
+      !!      to the ocean at each time step.
+      !!
+      !! ** Method :
+      !!       ORCA FORCED VERSION WITH :
+      !!       Daily climatological NCEP temperature
+      !!       monthly climatological CLIO winds, humidity and clouds
+      !!       monthly climatological CMAP precipitation
+      !!       Read several AGCM daily and monthly fluxes file
+      !!             temperature at 2m   tatm   (K)
+      !!             relative humidite   hatm   (%)
+      !!             wind speed          vatm   (m/s)
+      !!             monthly precip      watm   (kg/m2/day)  from Xie/Arkin
+      !!             clouds              catm   (%)
+      !!
+      !! caution : now, in the opa global model, the net upward water flux is
+      !! -------   with mm/day unit.
+      !!
+      !! History :
+      !!        !  91-03  (O. Marti and Ph Dandin)  Original code
+      !!        !  92-07  (M. Imbard)
+      !!        !  96-11  (E. Guilyardi)  Daily AGCM input files
+      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl
+      !!        !  00-05  (K. Rodgers) Daily Netcdf
+      !!   8.5  !  02-09  (C. Ethe and G. Madec)  F90: Free form and MODULE 
+      !!----------------------------------------------------------------------
+      !! * modules used
+      USE ioipsl          ! NetCDF IPSL library
+      USE blk_oce         ! bulk variable
+      USE bulk            ! bulk module
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt ! ocean time step
+
+      !! * Local declarations      
+      INTEGER , PARAMETER :: jpday  = 365, jpmois = 12
+      INTEGER                    :: ji,jj
+      INTEGER                    :: i15,iday, idy
+      INTEGER , DIMENSION(jpday) :: istep_n
+      INTEGER , DIMENSION(jpmois):: istep_c, istep_x
+      INTEGER                    :: itime
+      REAL(wp) ::  zdate0
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zsst,       &  ! ???
+         zlon    ,   &  ! ???
+         zlat           ! ???
+
+      REAL(wp), DIMENSION(jpk) ::   &
+         zlev           ! ???
+      REAL(wp) ::   zxy
+      INTEGER  :: ipi,ipj,ipk
+      INTEGER  :: iman,imois,imois2
+      CHARACTER(len=45)  ::  &
+         clname_n = 'NCEP_1d_0101_0112_tair.nc',   &
+         clname_c = 'CLIO_1m_0101_0112_flx.nc' ,   &
+         clname_x = 'CMAP_1m_0101_0112_rain.nc'
+      !!---------------------------------------------------------------------
+
+
+      ! Initialization
+      ! --------------
+
+      i15 = INT(2*FLOAT(nday)/(FLOAT(nobis(nmonth))+0.5))
+      itime = jpday
+      ipi = jpiglo
+      ipj = jpjglo
+      ipk = jpk
+      idy = 365
+      IF(nleapy == 1) idy = 366
+
+      iman = 12
+      imois = nmonth + i15 - 1
+      IF (imois == 0) imois = iman
+      imois2 = nmonth
+
+
+      ! 1. first call kt = nit000
+      ! -----------------------
+      
+      IF( kt == nit000 ) THEN
+         
+         nflx1 = 0
+         nflx11 = 0
+         
+         IF(lwp) THEN
+            WRITE(numout,*) ' '
+            WRITE(numout,*) ' **** Routine flx.forced.ncep_clio_xie.h90'
+            WRITE(numout,*) ' **** global NCEP flx  daily fields '
+            WRITE(numout,*) ' **** global CLIO flx  monthly fields '
+            WRITE(numout,*) ' **** global XIE  flx  monthly fields '
+            WRITE(numout,*) ' --------------------------------'
+            WRITE(numout,*) ' NetCDF FORMAT'
+            WRITE(numout,*) ' '
+         ENDIF
+         
+         ! open NCEP file
+          CALL flinopen(clname_n,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj &
+             ,ipk,zlon,zlat,zlev,itime,istep_n,zdate0,rdt,numfl1)
+
+          IF( itime /= jpday .AND. itime /= jpday+1 ) THEN
+             IF(lwp) THEN
+                WRITE(numout,*) ' '
+                WRITE(numout,*) 'problem with time coordinates '
+                WRITE(numout,*) ' itime ',itime,' jpday ',jpday
+                WRITE(numout,*) ' Check in file', clname_n
+             ENDIF
+             STOP 'flx.forced.ncep_clio_xie.h'
+          ENDIF
+          IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN
+          IF(lwp) THEN
+             WRITE(numout,*) ' '
+             WRITE(numout,*) 'problem with dimensions'
+             WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
+             WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
+             WRITE(numout,*) ' ipk ',ipk,' =? 1'
+             WRITE(numout,*) ' Check in file', clname_n
+          ENDIF
+          STOP 'flx.forced.ncep_clio_xie.h'
+       ENDIF
+
+       ! open CLIO file
+       CALL flinopen(clname_c,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj &
+          ,ipk,zlon,zlat,zlev,itime,istep_c,zdate0,rdt,numfl2)
+       
+       IF( itime /= jpmois ) THEN
+          IF(lwp) THEN
+             WRITE(numout,*) ' '
+             WRITE(numout,*) 'problem with time coordinates '
+             WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
+             WRITE(numout,*) ' Check in file', clname_c
+          ENDIF
+          STOP 'flx.forced.ncep_clio_xie.h'
+       ENDIF
+       IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN
+          IF(lwp) THEN
+             WRITE(numout,*) ' '
+             WRITE(numout,*) 'problem with dimensions'
+             WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
+             WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
+             WRITE(numout,*) ' ipk ',ipk,' =? 1'
+             WRITE(numout,*) ' Check in file', clname_c
+          ENDIF
+          STOP 'flx.forced.ncep_clio_xie.h'
+       ENDIF
+       
+       ! open CMAP FILE
+       CALL flinopen(clname_x,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj &
+          ,ipk,zlon,zlat,zlev,itime,istep_x,zdate0,rdt,numfl3)
+
+       IF( itime /= jpmois ) THEN
+          IF(lwp) THEN
+             WRITE(numout,*) ' '
+             WRITE(numout,*) 'problem with time coordinates '
+             WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois
+             WRITE(numout,*) ' Check in file', clname_x
+          ENDIF
+          STOP 'flx.forced.ncep_clio_xie.h'
+       ENDIF
+       IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN
+          IF(lwp) THEN
+             WRITE(numout,*) ' '
+             WRITE(numout,*) 'problem with dimensions'
+             WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
+             WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
+             WRITE(numout,*) ' ipk ',ipk,' =? 1'
+             WRITE(numout,*) ' Check in file', clname_x
+          ENDIF
+          STOP 'flx.forced.ncep_clio_xie.h'
+       ENDIF
+
+    ENDIF
+
+
+    ! 2. Read daily DATA Temperature from NCEP
+    ! ---------------------------------------
+
+    IF( ndayflx /= nday ) THEN 
+
+       ndayflx = nday
+       iday    = nday_year
+
+       ! read T 2m (Caution in K)
+       CALL flinget(numfl1,'air',jpidta,jpjdta,1,jpday,iday, &
+          iday,mig(1),nlci,mjg(1),nlcj,tatm(1:nlci,1:nlcj))
+
+       IF(lwp) WRITE (numout,*)' Lecture daily flx record OK :',iday
+       IF(lwp) WRITE (numout,*)' '
+
+       ! conversion of temperature Kelvin --> Celsius  [rt0=273.15]
+       tatm(:,:) = ( tatm(:,:) - rt0 ) 
+         
+    ENDIF
+
+
+    !  3. Read monthly data from CLIO and From Xie
+    !  -------------------------------------------
+
+      IF( kt == nit000 .OR. imois /= nflx1 ) THEN
+
+         ! calendar computation
+
+         ! nflx1 number of the first file record used in the simulation
+         ! flx2 number of the last  file record
+
+         nflx1 = imois
+         nflx2 = nflx1+1
+         nflx1 = MOD(nflx1,iman)
+         IF ( nflx1 == 0 ) nflx1 = iman
+         nflx2 = MOD(nflx2,iman)
+         IF ( nflx2 == 0 ) nflx2 = iman
+         IF(lwp)WRITE(numout,*) 'first record file used nflx1 ',nflx1
+         IF(lwp)WRITE(numout,*) 'last  record file used nflx2 ',nflx2
+
+         ! Read monthly fluxes data Esbensen Kushnir 
+
+         ! humidity
+         CALL flinget(numfl2,'socliohu',jpidta,jpjdta,jpk,jpmois,nflx1, &
+            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,1))
+         CALL flinget(numfl2,'socliohu',jpidta,jpjdta,jpk,jpmois,nflx2, &
+            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,1))
+         ! wind
+         CALL flinget(numfl2,'socliowi',jpidta,jpjdta,jpk,jpmois,nflx1, &
+            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,2))
+         CALL flinget(numfl2,'socliowi',jpidta,jpjdta,jpk,jpmois,nflx2, &
+            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,2))
+         ! clouds
+         CALL flinget(numfl2,'socliocl',jpidta,jpjdta,jpk,jpmois,nflx1, &
+            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,3))
+         CALL flinget(numfl2,'socliocl',jpidta,jpjdta,jpk,jpmois,nflx2, &
+            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,3))
+
+         ! Read monthly precipitations ds flxdta(:,:,1 ou 2,4) 
+
+         CALL flinget(numfl3,'rain',jpidta,jpjdta,jpk,jpmois,nflx1, &
+            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,4))
+         CALL flinget(numfl3,'rain',jpidta,jpjdta,jpk,jpmois,nflx2, &
+            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,4))
+                  
+      ENDIF
+
+
+      ! 3. at every time step linear interpolation of precipitation fluxes
+      ! -----------------------------------------------------------
+      
+      zxy = FLOAT(nday) / FLOAT(nobis(nflx1)) + 0.5 - i15
+
+      hatm(:,:) = ( (1.-zxy) * flxdta(:,:,1,1) + zxy  * flxdta(:,:,2,1) ) 
+      vatm(:,:) = ( (1.-zxy) * flxdta(:,:,1,2) + zxy  * flxdta(:,:,2,2) )  
+      catm(:,:) = ( (1.-zxy )* flxdta(:,:,1,3) + zxy  * flxdta(:,:,2,3) )  
+      watm(:,:) = ( (1.-zxy) * flxdta(:,:,1,4) + zxy  * flxdta(:,:,2,4) ) 
+
+
+      ! 4. Closing all files
+      ! --------------------
+
+      IF( kt == nitend ) THEN
+         CALL flinclo(numfl1)
+         CALL flinclo(numfl2)
+         CALL flinclo(numfl3)
+      ENDIF
+
+      CALL blk(kt)
+      
+      CALL FLUSH(numout)
+      
+   END SUBROUTINE flx
+   
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flx_bulk_monthly.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flx_bulk_monthly.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flx_bulk_monthly.h90	(revision 4)
@@ -0,0 +1,273 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  flx_blulk_monthly.h90  ***
+   !!----------------------------------------------------------------------
+   !!   flx     : update surface thermohaline fluxes using bulk formulae
+   !!             and fields read in a NetCDF file
+   !!----------------------------------------------------------------------
+   !! * Modules used     C A U T I O N  already defined in flxmod.F90
+
+   !! * Module variables
+   
+   INTEGER ::          &
+      numflx,          &  ! logical unit for surface fluxes data
+      nflx1, nflx2,    &  !  first and second record used
+      nflx11, nflx12      ! ???
+
+   REAL(wp), DIMENSION(jpi,jpj,2,7) ::   &
+      flxdta              ! 2 consecutive set of CLIO monthly fluxes
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flx( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE flx  ***
+      !!                   
+      !! ** Purpose :   provide the thermohaline fluxes (heat and freshwater) 
+      !!      to the ocean at each time step.
+      !!
+      !! ** Method  :   Read monthly climatological fluxes in a NetCDF file
+      !!          the net downward radiative flux qsr      1 (watt/m2)
+      !!          the net downward heat flux      q        2 (watt/m2)
+      !!          the net upward water            emp      3 (mm/month)
+      !!              (evaporation - precipitation)
+      !!          the climatological ice cover    rclice   4 (0 or 1)
+      !!
+      !!     Qsr and q is obtained from Esbensen-Kushnir data (opal file) with
+      !!   some corrections :
+      !!          - Data are extended over the polar area and for the net heat
+      !!            flux, values are put at 200 w/m2 on the ice regions
+      !!          - Red sea and Mediterranean values are imposed.
+      !! 
+      !!     emp is the Oberhuber climatology with a function of Levitus 
+      !!   salinity
+      !! 
+      !!     rclice is an handmade climalological ice cover on the polar 
+      !!   regions.
+      !! 
+      !!     runoff is an handmade climalological runoff.
+      !!
+      !! caution : now, in the opa global model, the net upward water flux is
+      !! -------   with mm/day unit.
+      !!
+      !! History :
+      !!        !  91-03  (O. Marti and Ph Dandin)  Original code
+      !!        !  92-07  (M. Imbard)
+      !!        !  96-11  (E. Guilyardi)  Daily AGCM input files
+      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl
+      !!        !  00-10  (J.-P. Boulanger)  adjusted for reading any
+      !!                         daily wind stress data including a climatology
+      !!        !  01-09  (A. Lazar and C. Levy)  Daily NetCDF by default
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * modules used
+      USE ioipsl
+      USE blk_oce         ! bulk variable
+      USE bulk            ! bulk module
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * Local declarations
+      INTEGER, PARAMETER ::   &
+         jpmois = 12,               &  ! number of months
+         jpf    =  7                   ! ??? !bug ?
+      INTEGER ::   jm, jt      ! dummy loop indices
+      INTEGER ::   &
+         imois, imois2, itime,      &  ! temporary integers
+         i15  , iman  ,             &  !    "          "
+         ipi  , ipj   , ipk            !    "          "
+      INTEGER, DIMENSION(jpmois) ::   &
+         istep                         ! ???
+      REAL(wp) ::   &
+         zsecond, zdate0,           &  ! temporary scalars
+         zxy    , zdtt  ,           &  !    "         "
+         zdatet , zttbt ,           &  !    "         "
+         zttat  , zdtts6               !    "         "
+      REAL(wp), DIMENSION(jpk) ::   &
+         zlev                          ! ???
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zlon   , zlat                 ! ???
+      CHARACTER (len=32) ::   &
+         clname = 'flx.nc'             ! flux filename
+      !!---------------------------------------------------------------------
+
+
+      ! Initialization
+      ! --------------
+
+      i15 = INT( 2 * FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) )
+      iman  = 12
+      imois = nmonth + i15 - 1
+      IF( imois == 0 ) imois = iman
+      imois2 = nmonth
+
+      ipi = jpiglo
+      ipj = jpjglo
+
+
+      ! 1. first call kt=nit000
+      ! -----------------------
+
+      IF( kt == nit000 ) THEN
+         nflx1  = 0
+         nflx11 = 0
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' global CLIO flx monthly fields in NetCDF format'
+            WRITE(numout,*) ' ------------------------------'
+            WRITE(numout,*)
+         ENDIF
+         
+         ! Read first records
+
+         ! title, dimensions and tests
+         CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj,   &
+            &          .FALSE., ipi, ipj, ipk, zlon, zlat, zlev,   &
+            &          itime, istep, zdate0, zsecond, numflx )
+         
+         ! temperature
+         ! Utilisation d'un spline, on lit le champ a mois=1
+         CALL flinget( numflx, 'socliot1', jpidta, jpjdta, jpk,   &
+            &          jpmois, 1, 1, mig(1), nlci,   &
+            &          mjg(1), nlcj, flxdta(1:nlci,1:nlcj,1,5) )
+      ENDIF
+
+
+      ! Read monthly file
+      ! ----------------
+
+      IF( kt == nit000 .OR. imois /= nflx1 ) THEN
+
+         ! Calendar computation
+
+         ! nflx1 number of the first file record used in the simulation
+         ! nflx2 number of the last  file record
+
+         nflx1 = imois
+         nflx2 = nflx1+1
+         nflx1 = MOD( nflx1, iman )
+         nflx2 = MOD( nflx2, iman )
+         IF( nflx1 == 0 )   nflx1 = iman
+         IF( nflx2 == 0 )   nflx2 = iman
+         IF(lwp) WRITE(numout,*) 'first record file used nflx1 ',nflx1
+         IF(lwp) WRITE(numout,*) 'last  record file used nflx2 ',nflx2
+         
+         ! Read monthly fluxes data
+
+         ! humidity
+         CALL flinget(numflx,'socliohu',jpidta,jpjdta,jpk,jpmois,nflx1,   &
+            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,1))
+         CALL flinget(numflx,'socliohu',jpidta,jpjdta,jpk,jpmois,nflx2,   &
+            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,1))
+         ! 10m wind module
+         CALL flinget(numflx,'socliowi',jpidta,jpjdta,jpk,jpmois,nflx1,   &
+            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,2))
+         CALL flinget(numflx,'socliowi',jpidta,jpjdta,jpk,jpmois,nflx2,   &
+            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,2))
+         ! cloud cover
+         CALL flinget(numflx,'socliocl',jpidta,jpjdta,jpk,jpmois,nflx1,   &
+            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,3))
+         CALL flinget(numflx,'socliocl',jpidta,jpjdta,jpk,jpmois,nflx2,   &
+            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,3))
+         ! precipitations
+         CALL flinget(numflx,'socliopl',jpidta,jpjdta,jpk,jpmois,nflx1,   &
+            nflx1,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,4))
+         CALL flinget(numflx,'socliopl',jpidta,jpjdta,jpk,jpmois,nflx2,   &
+            nflx2,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,4))
+         
+         IF(lwp .AND. nitend-nit000 <= 100 ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' read clio flx ok'
+            WRITE(numout,*)
+            DO jm = 1, 4
+               WRITE(numout,*)
+               WRITE(numout,*) 'Clio mounth: ',nflx1,'  field: ',jm,' multiply by ',0.1
+               CALL prihre(flxdta(1,1,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
+            END DO
+         ENDIF
+
+      ENDIF
+
+      ! ------------------- !
+      ! Last call kt=nitend !
+      ! ------------------- !
+
+      ! Closing of the numflx file (required in mpp)
+      IF( kt == nitend ) CALL flinclo(numflx)
+
+
+      IF( kt == nit000 .OR. imois2 /= nflx11 ) THEN
+
+         ! calendar computation
+         
+         ! nflx1 number of the first file record used in the simulation
+         ! nflx2 number of the last  file record
+         
+         nflx11 = imois2
+         nflx12 = nflx11 + 1
+         nflx11 = MOD( nflx11, iman )
+         nflx12 = MOD( nflx12, iman )
+         IF( nflx11 == 0 )   nflx11 = iman
+         IF( nflx12 == 0 )   nflx12 = iman
+         IF(lwp) WRITE(numout,*) 'first record file used nflx11 ',nflx11
+         IF(lwp) WRITE(numout,*) 'last  record file used nflx12 ',nflx12
+         
+         ! Read monthly fluxes data Esbensen Kushnir 
+         
+         ! air temperature
+         ! Utilisation d'un spline, on lit le champ a mois=nflx1 et nflx2
+         CALL flinget(numflx,'socliot1',jpidta,jpjdta,jpk,jpmois,nflx11,   &
+            nflx11,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,6))
+         CALL flinget(numflx,'socliot1',jpidta,jpjdta,jpk,jpmois,nflx12,   &
+            nflx12,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,6))
+         ! air temperature derivative (to reconstruct a daily field)
+         CALL flinget(numflx,'socliot2',jpidta,jpjdta,jpk,jpmois,nflx11,   &
+            nflx11,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1,7))
+         CALL flinget(numflx,'socliot2',jpidta,jpjdta,jpk,jpmois,nflx12,   &
+            nflx12,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2,7))
+         
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' read CLIO flx ok'
+            WRITE(numout,*)
+            DO jm = 6, jpf
+               WRITE(numout,*) 'jpf =  ', jpf !C a u t i o n : information need for SX5NEC compilo bug
+               WRITE(numout,*) 'Clio mounth: ',nflx11,'  field: ',jm,' multiply by ',0.1
+               CALL prihre(flxdta(1,1,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
+               WRITE(numout,*)
+            END DO
+         ENDIF
+         
+      ENDIF
+
+
+      ! 3. at every time step interpolation of fluxes
+      ! ---------------------------------------------
+
+      zxy = FLOAT( nday ) / FLOAT( nobis(nflx1) ) + 0.5 - i15
+
+      zdtt = raajj / raamo
+      zdatet = 0.
+      DO jt = 1, nmonth-1
+         zdatet = zdatet + nobis(jt)
+      END DO 
+      zdatet = ( zdatet + FLOAT(nday) -1. )/zdtt
+      zttbt = zdatet - INT(zdatet)
+      zttat = 1. - zttbt
+      zdtts6 = zdtt/6.
+
+      hatm(:,:) = ( (1.-zxy) * flxdta(:,:,1,1) + zxy * flxdta(:,:,2,1) )
+      vatm(:,:) = ( (1.-zxy) * flxdta(:,:,1,2) + zxy * flxdta(:,:,2,2) )
+      catm(:,:) = ( (1.-zxy )* flxdta(:,:,1,3) + zxy * flxdta(:,:,2,3) )
+      watm(:,:) = ( (1.-zxy) * flxdta(:,:,1,4) + zxy * flxdta(:,:,2,4) )
+      tatm(:,:) = ( flxdta(:,:,2,6) - flxdta(:,:,1,6) )/zdtt   &
+                - ((3. * zttat * zttat - 1.) * flxdta(:,:,1,7)   &
+                - ( 3. * zttbt * zttbt - 1.) * flxdta(:,:,2,7) ) * zdtts6   &
+                + flxdta(:,:,1,5)
+ 
+      CALL blk( kt )                ! bulk formulea fluxes 
+
+   END SUBROUTINE flx
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flx_bulk_monthly_fdir.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flx_bulk_monthly_fdir.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flx_bulk_monthly_fdir.h90	(revision 4)
@@ -0,0 +1,282 @@
+   !!----------------------------------------------------------------------
+   !!                 ***  flx_bulk_monthly_fdir.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   flx          : define the thermohaline fluxes for the ocean using
+   !!                  bulk formulea and monthly mean fields read in direct
+   !!                  access files.
+   !!----------------------------------------------------------------------
+   !! * Modules used     C A U T I O N  already defined in flxmod.F90
+
+   !! * Module variables
+   INTEGER ::          &
+      numfl1, numfl2,  &  ! logical units for surface fluxes data
+      numfl3, numfl4,  &  !
+      numfl5,          &  !
+      nflx1, nflx2,    &  !  first and second record used
+      nflx11, nflx12      ! ???
+   REAL(wp), DIMENSION(jpi,jpj,2,7) ::   &
+      flxdta              ! 2 consecutive set of CLIO monthly fluxes
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flx( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE flx  ***
+      !!                  
+      !! ** Purpose :   provide the thermohaline fluxes (heat and freshwater)
+      !!      to the ocean at each time step.
+      !!
+      !! ** Method  :   bulk formulae with monthly mean fields read in direct
+      !!      access file
+      !!
+      !! ** Method :
+      !!
+      !! History :
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE bulk
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt ! ocean time step
+
+      !! * Local declarations
+      INTEGER, PARAMETER ::   jpnk=1, jpmois=12, jpf=7
+      INTEGER ::   ji, jj, jm, ios, jt
+      INTEGER ::   iimlu, ijmlu, ikmlu, ilmlu, immlu
+      INTEGER ::   imois, iman, imois2, i15
+
+      REAL(wp) ::   zpdtan,zman,zpdtmo,zdemi
+      REAL(wp) ::   zxy,zdtt,zdatet,zttbt,zttat
+      REAL(wp) ::   zdtts6
+      INTEGER  ::   ildta,ibloc,ilseq
+
+      CHARACTER (len=30) ::   cltit
+      CHARACTER (len=21) ::   clunf,clold,cldir
+      CHARACTER (len=32) ::   clname
+      !!---------------------------------------------------------------------
+
+
+      ! Initialization
+      ! --------------
+
+      ! Open specifier
+
+      clold='OLD'
+      clunf='UNFORMATTED'
+      cldir='DIRECT'
+
+      ilseq = 1
+
+      ! computation of the record length for direct access file
+      ! this length depend of 4096 (device specification)
+
+      ibloc = 4096
+      ildta = ibloc*((jpidta*jpjdta*jpbytda-1 )/ibloc+1)
+
+      zpdtan= raass/rdttra(1)
+      zman  = 12.
+      iman  = int(zman)
+      zpdtmo= zpdtan/zman
+      zdemi = zpdtmo/2.
+
+      i15 = INT( 2.* FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) )
+
+      imois = nmonth + i15 - 1
+      IF( imois == 0 ) imois = iman
+      imois2 = nmonth
+      numfl2=81
+      numfl3=82
+      numfl4=83
+      numfl5=84
+
+
+      ! First call kt=nit000
+      ! --------------------
+
+      IF( kt == nit000 ) THEN
+         nflx1 = 0
+         nflx11 = 0
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' **** flx '
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'read global ocean fluxes '
+         IF(lwp) WRITE(numout,9100) zpdtmo,zdemi
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' read global ocean monthly fields'
+         IF(lwp) WRITE(numout,*) ' --------------------------------'
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'opal file numfl1 = ',numfl1
+ 9100    FORMAT (' esbensen : zpdtmo,zdemi :',2f12.3)
+
+
+         ! Read first records
+
+         ! title, dimensions and tests
+         clname='humidata_clio_orca'
+         CALL ctlopn(numfl1,clname,clold,clunf,cldir,ildta,numout,lwp,1)
+         READ (numfl1,REC=1,IOSTAT=ios) cltit,iimlu,ijmlu,ikmlu,ilmlu,immlu
+         
+         clname='winddata_clio_orca'
+         CALL ctlopn(numfl2,clname,clold,clunf,cldir,ildta,numout,lwp,1)
+         READ (numfl2,REC=1,IOSTAT=ios) cltit,iimlu,ijmlu,ikmlu,ilmlu,immlu
+         
+         clname='berdata_clio_orca'
+         CALL ctlopn(numfl3,clname,clold,clunf,cldir,ildta,numout,lwp,1)
+         READ (numfl3,REC=1,IOSTAT=ios) cltit,iimlu,ijmlu,ikmlu,ilmlu,immlu
+         
+         clname='xuedata_clio_orca'
+         CALL ctlopn(numfl4,clname,clold,clunf,cldir,ildta,numout,lwp,1)
+         READ (numfl4,REC=1,IOSTAT=ios) cltit,iimlu,ijmlu,ikmlu,ilmlu,immlu
+         
+         clname='ncardata_spline_orca'
+         CALL ctlopn(numfl5,clname,clold,clunf,cldir,ildta,numout,lwp,1)
+         READ (numfl5,REC=1,IOSTAT=ios) cltit,iimlu,ijmlu,ikmlu,ilmlu,immlu
+         ! temperature
+         ! Utilisation d'un spline, on lit le champ a mois=1
+         CALL read2D(numfl5,flxdta(1,1,1,5),1,3)
+         
+      ENDIF
+
+
+      ! Read monthly file
+      ! ----------------
+
+      IF( kt == nit000 .OR. imois /= nflx1 ) THEN
+
+         ! Calendar computation
+
+         ! nflx1 number of the first file record used in the simulation
+         ! nflx2 number of the last  file record
+
+         nflx1 = imois
+         nflx2 = nflx1+1
+         nflx1 = MOD(nflx1,iman)
+         IF( nflx1 == 0 ) nflx1 = iman
+         nflx2 = MOD(nflx2,iman)
+         IF( nflx2 == 0 ) nflx2 = iman
+         IF(lwp) WRITE(numout,*) 'first record file used nflx1 ',nflx1
+         IF(lwp) WRITE(numout,*) 'last  record file used nflx2 ',nflx2
+         
+         ! Read monthly fluxes data Esbensen Kushnir 
+
+         ! humidite
+         CALL read2D(numfl1,flxdta(1,1,1,1),1,nflx1+1)
+         CALL read2D(numfl1,flxdta(1,1,2,1),1,nflx2+1)
+         ! vent
+         CALL read2D(numfl2,flxdta(1,1,1,2),1,nflx1+1)
+         CALL read2D(numfl2,flxdta(1,1,2,2),1,nflx2+1)
+         ! nuages
+         CALL read2D(numfl3,flxdta(1,1,1,3),1,nflx1+1)
+         CALL read2D(numfl3,flxdta(1,1,2,3),1,nflx2+1)
+         ! precipitations
+         CALL read2D(numfl4,flxdta(1,1,1,4),1,nflx1+1)
+         CALL read2D(numfl4,flxdta(1,1,2,4),1,nflx2+1)
+         ! temperature
+         ! Utilisation d'un spline, on lit le champ a mois=nflx1 et nflx2
+         ! CALL read2D(numfl5,flxdta(1,1,1,6),1,3*(nflx1-1)+3)
+         ! CALL read2D(numfl5,flxdta(1,1,2,6),1,3*(nflx2-1)+3)
+         ! on lit la derivee
+         ! CALL read2D(numfl5,flxdta(1,1,1,7),1,3*(nflx1-1)+4)
+         ! CALL read2D(numfl5,flxdta(1,1,2,7),1,3*(nflx2-1)+4)
+
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' read clio flx ok'
+            WRITE(numout,*)
+            DO jm = 1, 4
+               WRITE(numout,*)
+               WRITE(numout,*) 'Clio mounth: ',nflx1,'  field: ',jm,' multiply by ',0.1
+               CALL prihre(flxdta(1,1,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
+            END DO
+         ENDIF
+
+      ENDIF
+
+      IF( kt == nit000 .OR. imois2 /= nflx11 ) THEN
+
+         ! calendar computation
+         
+         ! nflx1 number of the first file record used in the simulation
+         ! nflx2 number of the last  file record
+         
+         nflx11 = imois2
+         nflx12 = nflx11+1
+         nflx11 = MOD(nflx11,iman)
+         IF( nflx11 == 0 ) nflx11 = iman
+         nflx12 = MOD(nflx12,iman)
+         IF( nflx12 == 0 ) nflx12 = iman
+         IF(lwp) WRITE(numout,*) 'first record file used nflx11 ',nflx11
+         IF(lwp) WRITE(numout,*) 'last  record file used nflx12 ',nflx12
+         
+         ! Read monthly fluxes data Esbensen Kushnir 
+         
+         ! temperature
+         ! Utilisation d'un spline, on lit le champ a mois=nflx1 et nflx2
+         CALL read2D(numfl5,flxdta(1,1,1,6),1,3*(nflx11-1)+3)
+         CALL read2D(numfl5,flxdta(1,1,2,6),1,3*(nflx12-1)+3)
+         ! on lit la derivee
+         CALL read2D(numfl5,flxdta(1,1,1,7),1,3*(nflx11-1)+4)
+         CALL read2D(numfl5,flxdta(1,1,2,7),1,3*(nflx12-1)+4)
+
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' read CLIO flx ok'
+            WRITE(numout,*)
+            DO jm = 6, jpf
+               WRITE(numout,*)
+               WRITE(numout,*) 'Clio mounth: ',nflx11,'  field: ',jm,' multiply by ',0.1
+               CALL prihre(flxdta(1,1,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
+            END DO
+         ENDIF
+         
+      ENDIF
+
+
+      ! 3. at every time step interpolation of fluxes
+      ! ---------------------------------------------
+
+      zxy = FLOAT(nday) / FLOAT(nobis(nflx1)) + 0.5 - i15
+
+      zdtt = raajj/raamo
+      zdatet = 0.
+      DO jt = 1, nmonth-1
+         zdatet = zdatet + nobis(jt)
+      END DO 
+      zdatet = ( zdatet + FLOAT(nday) -1. )/zdtt
+      zttbt = zdatet - int(zdatet)
+      zttat = 1. - zttbt
+      zdtts6 = zdtt/6.
+
+      hatm(:,:) = ( (1.-zxy) * flxdta(:,:,1,1) + zxy * flxdta(:,:,2,1) )
+      vatm(:,:) = ( (1.-zxy) * flxdta(:,:,1,2) + zxy * flxdta(:,:,2,2) )
+      catm(:,:) = ( (1.-zxy )* flxdta(:,:,1,3) + zxy * flxdta(:,:,2,3) )
+      watm(:,:) = ( (1.-zxy) * flxdta(:,:,1,4) + zxy * flxdta(:,:,2,4) )
+      tatm(:,:) = ( flxdta(:,:,2,6) - flxdta(:,:,1,6) )/zdtt     &
+                - ((3. * zttat * zttat - 1.) * flxdta(:,:,1,7)   &
+                - ( 3. * zttbt * zttbt - 1.) * flxdta(:,:,2,7) ) * zdtts6   &
+                + flxdta(:,:,1,5)
+
+      CALL blk(kt)
+
+      CALL FLUSH(numout)
+
+      ! ------------------- !
+      ! Last call kt=nitend !
+      ! ------------------- !
+
+      ! Closing of the 5 files (required in mpp) ????? it smells bug ...
+      IF( kt == nitend ) THEN
+          CALL flinclo(numfl1)
+          CALL flinclo(numfl2)
+          CALL flinclo(numfl3)
+          CALL flinclo(numfl4)
+          CALL flinclo(numfl5)
+      ENDIF
+
+   END SUBROUTINE flx
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flx_coupled_ice.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flx_coupled_ice.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flx_coupled_ice.h90	(revision 4)
@@ -0,0 +1,248 @@
+   !!----------------------------------------------------------------------
+   !!                     ***  flx_coupled_ice.h90  ***
+   !!----------------------------------------------------------------------
+   !!   flx          : define the thermohaline fluxes for the ocean in
+   !!                  coupled ocean/atmosphere case with sea-ice
+   !!----------------------------------------------------------------------
+   !! * Modules used     C A U T I O N  already defined in flxmod.F90
+
+   !! * Module variables
+   LOGICAL :: lfirstf=.TRUE.
+   INTEGER :: nhoridcf, nidcf
+   INTEGER, DIMENSION(jpi*jpj) :: ndexcf
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flx( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE flx  ***
+      !!                   
+      !! ** Purpose :   provide the thermohaline fluxes (heat and freshwater) 
+      !!      to the ocean at each time step.
+      !!
+      !! ** Method  :   Read fluxes from a coupled Atmospheric model 
+      !!
+      !! References : The OASIS User Guide, Version 2.0, CERFACS/TR 95/46
+      !!
+      !! History :
+      !!        !         (O. Marti)  Original code
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+      USE ice_oce
+      USE cpl_oce
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * Local declarations
+      INTEGER :: ji, jj, jf
+      INTEGER :: itm1,isize,iflag,icpliter
+      INTEGER :: info, inuread, index
+      REAL(wp) ::   zfacflx,zfacwat
+      REAL(wp) ::   ztgel,zice
+      REAL(wp) ::   znsolc (jpiglo,jpjglo),zqsrc (jpiglo,jpjglo)
+      REAL(wp) ::   zrunoff(jpiglo,jpjglo),zec   (jpiglo,jpjglo)
+      REAL(wp) ::   zqsrice (jpiglo,jpjglo),zqsrwat (jpiglo,jpjglo)
+      REAL(wp) ::   znsolice(jpiglo,jpjglo),znsolwat(jpiglo,jpjglo)
+      REAL(wp) ::   znsicedt(jpiglo,jpjglo),zevice  (jpiglo,jpjglo)
+      REAL(wp) ::   zevwat  (jpiglo,jpjglo),zpliq   (jpiglo,jpjglo)
+      REAL(wp) ::   zpsol   (jpiglo,jpjglo),zruncot (jpiglo,jpjglo)
+      REAL(wp) ::   zrunriv (jpiglo,jpjglo),zcalving(jpiglo,jpjglo)
+      REAL(wp) ::   zevap (jpiglo,jpjglo)
+      CHARACTER (len=80) ::   clcplfnam
+      REAL(wp) ::   zjulian
+
+      ! Addition for SIPC CASE
+      CHARACTER (len=3) ::   clmodinf       ! Header or not
+      CHARACTER (len=3) ::   cljobnam_r    ! Experiment name in the field brick, if any 
+      INTEGER ::   infos(3)          ! infos in the field brick, if any
+      !!---------------------------------------------------------------------
+
+
+      ! Initialization
+      ! --------------
+
+      isize = jpiglo * jpjglo
+      itm1 = ( kt - nit000 + 1 ) - 1
+
+      ! initialisation for output
+
+      IF( lfirstf ) THEN 
+         lfirstf = .FALSE.
+         ndexcf(:) = 0
+         clcplfnam = "cpl_oce_flx"
+
+         ! Compute julian date from starting date of the run
+         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian )
+         CALL histbeg(clcplfnam, jpiglo,glamt,jpjglo,gphit,1,jpiglo,1   &
+              ,jpjglo,0,zjulian,rdt,nhoridcf,nidcf)
+         ! no vertical axis
+         DO jf = 1, nflxc2o
+            CALL histdef(nidcf, cpl_readflx(jf),cpl_readflx(jf),   &
+                "-",jpi, jpj, nhoridcf, 1, 1, 1, -99, 32, "inst",   &
+                rdt,rdt)
+         END DO
+         CALL histend(nidcf)
+      ENDIF
+
+      ! caution, I presume that you have good UNIT system from coupler to OPA
+      ! that is :
+      ! watt/m2 for znsolc and zqsrc
+      ! kg/m2/s for evaporation, precipitation and runoff
+      zfacflx = 1.e0
+      ! water should be in kg/m2/day
+      zfacwat = 1.e0  ! 86400.0e0
+
+      ! Test if we couple at the current timestep
+      ! -----------------------------------------
+
+      IF( MOD(kt,nexco) == 1 ) THEN
+
+         ! Test what kind of message passing we are using
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*)'FLX: Read fields from CPL, itm1=',itm1
+         IF(lwp) WRITE(numout,*)
+         CALL FLUSH (numout)
+         
+         IF( cchan == 'PIPE' ) THEN
+            ! pipe mode 
+
+            ! UNIT number for fields
+
+            inuread = 99
+
+            ! exchanges from to atmosphere=CPL to ocean
+
+            DO jf = 1, nflxc2o
+               ! CALL PIPE_Model_Recv(cpl_readflx(jf), icpliter, numout)
+               OPEN (inuread, FILE=cpl_f_readflx(jf), FORM='UNFORMATTED')
+               IF(jf == 1) CALL locread(cpl_readflx(jf),znsolc ,isize,inuread,iflag,numout)
+               IF(jf == 2) CALL locread(cpl_readflx(jf),zqsrc  ,isize,inuread,iflag,numout)
+               IF(jf == 3) CALL locread(cpl_readflx(jf),zec    ,isize,inuread,iflag,numout)
+               IF(jf == 4) CALL locread(cpl_readflx(jf),zrunoff,isize,inuread,iflag,numout)
+               CLOSE (inuread)
+            END DO
+
+         ELSE IF( cchan == 'SIPC' ) THEN
+            ! SIPC mode
+
+            ! Define IF a header must be encapsulated within the field brick :
+            clmodinf = 'NOT'   ! as $MODINFO in namcouple  
+
+            ! reading of input field non solar flux SONSHLDO
+            index = 1
+            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, znsolc )
+
+            ! reading of input field solar heat flux SOSHFLDO
+            index = 2
+            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zqsrc  )
+            
+            ! reading of input field water flux SOWAFLDO
+            index = 3
+            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zec    )
+            
+            ! reading of input field runoff SORUNOFF
+            index = 4
+            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zrunoff)
+            
+         ELSE IF( cchan == 'CLIM' ) THEN
+            ! CLIM mode
+            IF(lwp) WRITE (numout,*) 'Reading flux from coupler '
+            ! exchanges from atmosphere=CPL to ocean
+            DO jf = 1, nflxc2o
+               IF(jf ==  1) CALL CLIM_Import (cpl_readflx(jf),itm1,zqsrice ,info)
+               IF(jf ==  2) CALL CLIM_Import (cpl_readflx(jf),itm1,zqsrwat ,info)
+               IF(jf ==  3) CALL CLIM_Import (cpl_readflx(jf),itm1,znsolice,info)
+               IF(jf ==  4) CALL CLIM_Import (cpl_readflx(jf),itm1,znsolwat,info)
+               IF(jf ==  5) CALL CLIM_Import (cpl_readflx(jf),itm1,znsicedt,info)
+               IF(jf ==  6) CALL CLIM_Import (cpl_readflx(jf),itm1,zevice  ,info)
+               IF(jf ==  7) CALL CLIM_Import (cpl_readflx(jf),itm1,zevwat  ,info)
+               IF(jf ==  8) CALL CLIM_Import (cpl_readflx(jf),itm1,zpliq   ,info)
+               IF(jf ==  9) CALL CLIM_Import (cpl_readflx(jf),itm1,zpsol   ,info)
+               IF(jf == 10) CALL CLIM_Import (cpl_readflx(jf),itm1,zruncot ,info)
+               IF(jf == 11) CALL CLIM_Import (cpl_readflx(jf),itm1,zrunriv ,info)
+               IF(jf == 12) CALL CLIM_Import (cpl_readflx(jf),itm1,zcalving,info)
+               IF( info /= CLIM_Ok ) THEN
+                  IF(lwp) WRITE(numout,*)'Pb in reading ', cpl_readflx(jf), jf
+                  IF(lwp) WRITE(numout,*)'Couplage itm1 is = ',itm1
+                  IF(lwp) WRITE(numout,*)'CLIM error code is = ', info
+                  IF(lwp) WRITE(numout,*)'STOP in Flx'
+                  CALL abort('flx.coupled.h')
+               ENDIF
+            END DO
+         ENDIF
+
+         ! netcdf outputs
+
+         DO jf = 1, nflxc2o
+            IF(jf ==  1) CALL histwrite(nidcf,cpl_readflx(jf), kt, zqsrice ,jpi*jpj,ndexcf)
+            IF(jf ==  2) CALL histwrite(nidcf,cpl_readflx(jf), kt, zqsrwat ,jpi*jpj,ndexcf)
+            IF(jf ==  3) CALL histwrite(nidcf,cpl_readflx(jf), kt, znsolice,jpi*jpj,ndexcf)
+            IF(jf ==  4) CALL histwrite(nidcf,cpl_readflx(jf), kt, znsolwat,jpi*jpj,ndexcf)
+            IF(jf ==  5) CALL histwrite(nidcf,cpl_readflx(jf), kt, znsicedt,jpi*jpj,ndexcf)
+            IF(jf ==  6) CALL histwrite(nidcf,cpl_readflx(jf), kt, zevice  ,jpi*jpj,ndexcf)
+            IF(jf ==  7) CALL histwrite(nidcf,cpl_readflx(jf), kt, zevwat  ,jpi*jpj,ndexcf)
+            IF(jf ==  8) CALL histwrite(nidcf,cpl_readflx(jf), kt, zpliq   ,jpi*jpj,ndexcf)
+            IF(jf ==  9) CALL histwrite(nidcf,cpl_readflx(jf), kt, zpsol   ,jpi*jpj,ndexcf)
+            IF(jf == 10) CALL histwrite(nidcf,cpl_readflx(jf), kt, zruncot ,jpi*jpj,ndexcf)
+            IF(jf == 11) CALL histwrite(nidcf,cpl_readflx(jf), kt, zrunriv ,jpi*jpj,ndexcf)
+            IF(jf == 12) CALL histwrite(nidcf,cpl_readflx(jf), kt, zcalving,jpi*jpj,ndexcf)
+         END DO
+         CALL histsync(nidcf)
+         IF( nitend-kt < nexco ) CALL histclo(nidcf)
+
+         ! Compute average evaporation
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               zevap( mig(ji), mjg(jj)) = zevwat( mig(ji), mjg(jj)) * ( 1.e0 - freeze(ji,jj) )   &
+                  &                     + zevice( mig(ji), mjg(jj)) *          freeze(ji,jj)
+            END DO
+         END DO
+         ! copy in the subdomain
+     
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               !  1: Net short wave heat flux on free ocean (positive downward)
+               qsr_oce(ji,jj) =  zqsrwat  ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
+               !  2: Net short wave het flux on sea ice (positive downward)
+               qsr_ice(ji,jj) =  zqsrice  ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
+               !  3: Net longwave heat flux on free ocean (positive downward)
+               qnsr_oce(ji,jj)=  znsolwat ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
+               !  4: Net longwave heat flux on sea ice
+               qnsr_ice(ji,jj)=  znsolice ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
+               !  5: Water flux (liquid precipitation - evaporation)  (positive upward)
+               tprecip(ji,jj) = (  zpliq ( mig(ji), mjg(jj))   &
+                  &                + zpsol ( mig(ji), mjg(jj))   &
+                  &                + zevap ( mig(ji), mjg(jj)) ) * tmask(ji,jj,1) * zfacwat
+               !  6: Solid precipitation  (positive upward)
+               sprecip(ji,jj) =  zpsol    ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacwat
+               !  7: runoff      (positive upward)
+               srunoff(ji,jj) = ( zruncot ( mig(ji), mjg(jj))   &
+                  &              +  zrunriv ( mig(ji), mjg(jj)) ) * tmask(ji,jj,1) * zfacwat
+               !  8: Derivative of non solar heat flux on sea ice
+               dqns_ice(ji,jj) =  znsicedt ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacflx
+               !  13: Iceberg calving (positive upward)
+               calving(ji,jj) =  zcalving ( mig(ji), mjg(jj)) * tmask(ji,jj,1) * zfacwat
+              END DO
+           END DO
+ 
+
+         CALL lbc_lnk( qsr_oce , 'T', 1. )
+         CALL lbc_lnk( qsr_ice , 'T', 1. )
+         CALL lbc_lnk( qnsr_oce, 'T', 1. )
+         CALL lbc_lnk( qnsr_ice, 'T', 1. )
+         CALL lbc_lnk( tprecip , 'T', 1. )
+         CALL lbc_lnk( sprecip , 'T', 1. )
+         CALL lbc_lnk( srunoff , 'T', 1. )
+         CALL lbc_lnk( dqns_ice, 'T', 1. )
+         CALL lbc_lnk( calving , 'T', 1. )
+
+      ENDIF
+
+   END SUBROUTINE flx
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flx_coupled_noice.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flx_coupled_noice.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flx_coupled_noice.h90	(revision 4)
@@ -0,0 +1,183 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  flx_coupled.h90  ***
+   !!----------------------------------------------------------------------
+   !!   flx          : define the thermohaline fluxes for the ocean in
+   !!                  coupled ocean/atmosphere case without sea-ice
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flx ( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE flx  ***
+      !!            
+      !! ** Purpose :   provide the thermohaline fluxes (heat and freshwater)
+      !!      to the ocean at each time step.
+      !!
+      !! ** Method  :   Read fluxes from a coupled Atmospheric model 
+      !!
+      !! References : The OASIS User Guide, Version 2.0, CERFACS/TR 95/46
+      !!
+      !! History :
+      !!        !  92-06  (L.Terray)  Original code
+      !!   8.0  !  96-11  (E.Guilyardi)
+      !!        !  98-04  (M.A Foujols, S. Valcke, M. Imbard)  OASIS2.2
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! CAUTION : not checked for MPP  : J.M.M
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+      USE cpl_oce 
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt ! ocean time step
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jf
+      INTEGER  ::   itm1, isize, iflag, icpliter
+      INTEGER  ::   info, inuread, index
+
+      REAL(wp) ::   zfacflx,zfacwat
+      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
+         znsolc  , zqsrc   ,   &  ! ???
+         zrunoff , zec     ,   &  !
+         zqsrice , zqsrwat ,   &  !
+         znsolice, znsolwat,   &  !
+         znsicedt, zevice  ,   &  !
+         zevwat  , zpliq   ,   &  !
+         zpsol   , zruncot ,   &  !
+         zrunriv 
+
+      ! Addition for SIPC CASE
+      CHARACTER (len=3) ::   clmodinf       ! Header or not
+      CHARACTER (len=3) ::   cljobnam_r    ! Experiment name in the field brick, if any 
+      INTEGER infos(3)          ! infos in the field brick, if any
+      !!---------------------------------------------------------------------
+
+
+      ! Initialization
+      ! --------------
+
+      isize = jpiglo * jpjglo
+      itm1 = ( kt - nit000 + 1 ) - 1
+
+      ! caution, I presume that you have good UNIT system from coupler to OPA
+      ! that is :
+      ! watt/m2 for znsolc and zqsrc
+      ! kg/m2/s for evaporation, precipitation and runoff
+
+      zfacflx = 1.
+      zfacwat = 1.
+
+
+      ! Test if we couple at the current timestep
+      ! -----------------------------------------
+
+      IF( MOD( kt, nexco ) == 1 ) THEN
+
+         ! Test what kind of message passing we are using
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*)'FLX: Read fields from CPL, itm1=',itm1
+         IF(lwp) WRITE(numout,*)
+         CALL FLUSH (numout)
+         
+         IF( cchan == 'PIPE' ) THEN
+            ! pipe mode 
+
+            ! UNIT number for fields
+
+            inuread = 99
+
+            ! exchanges from to atmosphere=CPL to ocean
+
+            DO jf = 1, nflxc2o
+               ! CALL PIPE_Model_Recv(cpl_readflx(jf), icpliter, numout)
+               OPEN (inuread, FILE=cpl_f_readflx(jf), FORM='UNFORMATTED')
+               IF(jf == 1) CALL locread(cpl_readflx(jf),znsolc ,isize,inuread,iflag,numout)
+               IF(jf == 2) CALL locread(cpl_readflx(jf),zqsrc  ,isize,inuread,iflag,numout)
+               IF(jf == 3) CALL locread(cpl_readflx(jf),zec    ,isize,inuread,iflag,numout)
+               IF(jf == 4) CALL locread(cpl_readflx(jf),zrunoff,isize,inuread,iflag,numout)
+               CLOSE (inuread)
+            END DO
+
+         ELSE IF( cchan == 'SIPC' ) THEN
+            ! SIPC mode
+
+            ! Define IF a header must be encapsulated within the field brick :
+            clmodinf = 'NOT'   ! as $MODINFO in namcouple  
+
+            ! reading of input field non solar flux SONSHLDO
+            index = 1
+            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, znsolc )
+
+            ! reading of input field solar heat flux SOSHFLDO
+            index = 2
+            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zqsrc  )
+            
+            ! reading of input field water flux SOWAFLDO
+            index = 3
+            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zec    )
+            
+            ! reading of input field runoff SORUNOFF
+            index = 4
+            ! CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, zrunoff)
+            
+         ELSE IF( cchan == 'CLIM' ) THEN
+            ! CLIM mode
+            IF(lwp) WRITE (numout,*) 'Reading flux from coupler '
+            ! exchanges from atmosphere=CPL to ocean
+            DO jf = 1, nflxc2o
+               IF(jf ==  1) CALL CLIM_Import (cpl_readflx(jf),itm1,zqsrice ,info)
+               IF(jf ==  2) CALL CLIM_Import (cpl_readflx(jf),itm1,zqsrwat ,info)
+               IF(jf ==  3) CALL CLIM_Import (cpl_readflx(jf),itm1,znsolice,info)
+               IF(jf ==  4) CALL CLIM_Import (cpl_readflx(jf),itm1,znsolwat,info)
+               IF(jf ==  5) CALL CLIM_Import (cpl_readflx(jf),itm1,znsicedt,info)
+               IF(jf ==  6) CALL CLIM_Import (cpl_readflx(jf),itm1,zevice  ,info)
+               IF(jf ==  7) CALL CLIM_Import (cpl_readflx(jf),itm1,zevwat  ,info)
+               IF(jf ==  8) CALL CLIM_Import (cpl_readflx(jf),itm1,zpliq   ,info)
+               IF(jf ==  9) CALL CLIM_Import (cpl_readflx(jf),itm1,zpsol   ,info)
+               IF(jf == 10) CALL CLIM_Import (cpl_readflx(jf),itm1,zruncot ,info)
+               IF(jf == 11) CALL CLIM_Import (cpl_readflx(jf),itm1,zrunriv ,info)
+               IF( info /= CLIM_Ok ) THEN
+                  IF(lwp) WRITE(numout,*)'Pb in reading ', cpl_readflx(jf), jf
+                  IF(lwp) WRITE(numout,*)'Couplage itm1 is = ',itm1
+                  IF(lwp) WRITE(numout,*)'CLIM error code is = ', info
+                  IF(lwp) WRITE(numout,*)'STOP in Flx'
+                  CALL abort('flx.coupled.h')
+               ENDIF
+            END DO
+         ENDIF
+         
+         ! copy in the subdomain
+
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+
+               !  qc = total flux add znsolc and zqsrc
+               
+               ! water fluxes input : P-E
+               
+               ! caution, I presume that you have the good UNIT system for OPA
+               ! that is :
+               ! watt/m2 for znsolc and zqsrc
+               ! mm/sec for evaporation, precipitation and runoff 
+               ! to give ec and runoff in mm/day
+
+              qc    (ji,jj) = zfacflx * tmask(ji,jj,1) * (        znsolwat( mig(ji), mjg(jj) )   &
+                 &                                              + zqsrwat ( mig(ji), mjg(jj) )   )
+              qsrc  (ji,jj) = zfacflx * tmask(ji,jj,1) *          zqsrwat ( mig(ji), mjg(jj) )
+              ec    (ji,jj) = zfacwat * tmask(ji,jj,1) * ( - ABS( zevwat  ( mig(ji), mjg(jj) ) )   &
+                 &                                         + ABS( zpliq   ( mig(ji), mjg(jj) ) )   &
+                 &                                         + ABS( zpsol   ( mig(ji), mjg(jj) ) )   )
+              runoff(ji,jj) = zfacwat * tmask(ji,jj,1) *     ABS( zruncot ( mig(ji), mjg(jj) )   &
+                 &                                              + zrunriv ( mig(ji), mjg(jj) ) )
+           END DO
+        END DO
+
+      ENDIF
+
+   END SUBROUTINE flx
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flx_forced_daily.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flx_forced_daily.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flx_forced_daily.h90	(revision 4)
@@ -0,0 +1,205 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  flx_forced_daily  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   flx          : define the thermohaline fluxes for the ocean
+   !!                  in forced mode using flux formulation (not bulk)
+   !!                  (read in NetCDF file)
+   !!----------------------------------------------------------------------
+   !! * Modules used     C A U T I O N  already defined in flxmod.F90
+
+   !! * Module variables
+   INTEGER ::          &
+      numflx,          &  ! logical unit for surface fluxes data
+      nflx1, nflx2,    &  !  first and second record used
+      nflx11, nflx12,  &  ! ???
+      ndayflx,         &  ! new day for ecmwf flx forcing
+      nyearflx            ! new year for ecmwf flx forcing
+   REAL(wp), DIMENSION(jpi,jpj,3) ::   &
+      flxdta              ! 3 consecutive daily fluxes
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flx( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE flx  ***
+      !!                   
+      !! ** Purpose :   provide the thermohaline fluxes (heat and freshwater) 
+      !!      to the ocean at each time step.
+      !!
+      !! ** Method  :   READ daily flux file in NetCDF files
+      !!      the net downward radiative flux qsr      1 (watt/m2)
+      !!      the net downward heat flux      q        2 (watt/m2)
+      !!      the net upward water            emp      3 (kg/m2/s)
+      !!      (evaporation - precipitation)
+      !!
+      !! History :
+      !!        !  90-03  (O. Marti and P. Dandin)  Original code
+      !!        !  92-07  (M. Imbard)
+      !!        !  96-11  (E. Guilyardi)  Daily AGCM input files
+      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl
+      !!        !  00-10  (J.-P. Boulanger)  adjusted for reading any
+      !!                         daily wind stress data including a climatology
+      !!        !  01-09  (A. Lazar and C. Levy)  config with no ice model
+      !!   8.5  !  03-07  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+      USE flx_oce
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt ! ocean time step
+
+      !! * local declarations
+      INTEGER ::   ji, jj, jk        ! dummy loop arguments
+      INTEGER ::   iprint
+      INTEGER ::   i15, iy, iday, idy, ipi, ipj, ipk
+      INTEGER ,DIMENSION(366) :: istep
+
+      REAL(wp), DIMENSION(jpi,jpj) :: zlon, zlat
+      REAL(wp), DIMENSION(jpi,jpj) :: zeri, zerps, ziclim
+      REAL(wp), DIMENSION(jpk)     :: zlev
+      REAL(wp) ::   zdate0, zdt
+
+      CHARACTER (len=40) :: clname
+      !!---------------------------------------------------------------------
+
+
+#if defined key_mpp
+      == >> forced compile error:
+      flx_forced_daily : Reading Netcdf file in mpp Not yet implemented
+#endif
+
+      ! Initialization
+      ! -----------------
+      
+      ! year month day
+      i15 = INT( 2.* FLOAT(nday) / (FLOAT( nobis(nmonth) ) + 0.5) )
+      ipi = jpiglo
+      ipj = jpjglo
+      ipk = jpk
+      IF( nleapy == 0 ) THEN
+         idy = 365
+      ELSE IF( nleapy == 1 ) THEN
+         IF( MOD( nyear ,4 ) == 0 ) THEN
+            idy = 366
+         ELSE
+            idy = 365
+         ENDIF
+      ELSE IF( nleapy == 30 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*)'flx.forced.h : nleapy = 30 is non compatible'
+         IF(lwp) WRITE(numout,*)'               with existing files'
+         nstop = nstop + 1
+      ENDIF
+
+
+      ! First call kt=nit000
+      ! --------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'flx   : daily fluxes Q, Qsr, EmP'
+         IF(lwp) WRITE(numout,*) '~~ '
+         ndayflx  = 0
+         nyearflx = 0
+      ENDIF
+
+
+      ! Open files if nyearflx
+      ! ----------------------
+
+      IF( nyearflx /= nyear ) THEN
+         nyearflx = nyear
+         iprint   = 1
+
+         ! Define file name and record
+         
+         ! Close/open file if new year 
+
+         IF( nyearflx /= 0 )   CALL flinclo(numflx)
+
+         iy = nyear
+         IF(lwp) WRITE (numout,*) iy
+         WRITE(clname,'("flx_1d.nc")') 
+         IF(lwp) WRITE (numout,*)' open flx file = ',clname
+         CALL FLUSH(numout)
+         
+         CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj   &
+              ,ipk,zlon,zlat,zlev,idy,istep,zdate0,zdt,numflx)
+
+         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'problem with dimensions'
+            IF(lwp) WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta
+            IF(lwp) WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta
+            IF(lwp) WRITE(numout,*) ' ipk ',ipk,' =? 1'
+            nstop = nstop + 1
+         ENDIF
+         IF(lwp) WRITE(numout,*) idy,istep,zdate0,zdt,numflx
+      ELSE
+         iprint = 0
+      ENDIF
+
+      ! Read daily fluxes in flxdta(1,1,jm) 
+      !     1. Qtot    (w/m2)
+      !     2. Qsr     (w/m2)
+      !     3. emp     (kg/m2/s)
+      
+      IF( ndayflx /= nday ) THEN 
+         ndayflx = nday
+         
+         iday = nday_year
+         
+         ! read Qtot
+         CALL flinget(numflx,'sohefldo',jpidta,jpjdta,1,idy,iday,   &
+              iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1))
+         ! read qsr
+         CALL flinget(numflx,'soshfldo',jpidta,jpjdta,1,idy,iday,   &
+              iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2))
+         ! read emp
+         CALL flinget(numflx,'sowaflup',jpidta,jpjdta,1,idy,iday,   &
+              iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,3))
+
+         IF(lwp) WRITE (numout,*)'Lecture flx record :',iday
+
+         IF( nit000 == 1 ) THEN 
+            IF( kt == nit000 ) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*) ' read daily fluxes ok'
+                  WRITE(numout,*)
+                  WRITE(numout,*) ' Q * .1, day: ',ndastp
+                  CALL prihre(flxdta(1,1,1),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
+                  WRITE(numout,*)
+                  WRITE(numout,*) ' QSR * .1, day: ',ndastp
+                  CALL prihre(flxdta(1,1,2),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout)
+                  WRITE(numout,*)
+                  WRITE(numout,*) ' E-P *86400, day: ',ndastp
+                  CALL prihre(flxdta(1,1,3),jpi,jpj,1,jpi,20,1,jpj,10,86400.,numout)
+                  WRITE(numout,*) ' '
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDIF
+
+      p_qt (:,:) = flxdta(:,:,1)
+      p_qsr(:,:) = flxdta(:,:,2)
+      p_emp(:,:) = flxdta(:,:,3)
+ 
+      ! Boundary condition on emp for free surface option
+      ! -------------------------------------------------
+      CALL lbc_lnk( p_emp, 'T', 1. )
+ 
+ 
+      ! Closing all files
+      ! -----------------
+ 
+      IF( kt == nitend ) CALL flinclo( numflx )
+ 
+   END SUBROUTINE flx
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flx_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flx_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flx_oce.F90	(revision 4)
@@ -0,0 +1,58 @@
+MODULE flx_oce
+   !!======================================================================
+   !!                 ***  MODULE  flx_oce  ***
+   !!        parameter and  variables defined in memory in forced mode
+   !!======================================================================
+   !! History :
+   !!   8.5  !  02-11  (C. Ethe)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce          ! ocean parameters
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! fluxes common variables
+   !!----------------------------------------------------------------------
+#if defined key_flx_forced_daily
+   !!----------------------------------------------------------------------
+   !! 'key_flx_forced_daily'
+   !!----------------------------------------------------------------------
+   REAL(wp), DIMENSION(jpi,jpj,3) ::   &
+      p_qt ,        &   ! total heat flux ( solar + non solar)
+      p_qsr,        &   ! solar heat flux
+      p_emp             ! evaporation minus precipitation            
+
+#elif defined key_ice_lim || defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+   REAL(wp), DIMENSION(jpi,jpj)    ::   &
+      qsr_ice  ,      &  ! solar flux over ice
+      qsr_oce  ,      &  ! solar flux over ocean
+      qnsr_oce ,      &  ! total non solar heat flux (Longwave downward radiation) over ocean 
+      qnsr_ice ,      &  ! total non solar heat flux (Longwave downward radiation) over ice
+      tprecip  ,      &  ! total precipitation ( or liquid precip minus evaporation in coupled mode)
+      sprecip  ,      &  ! solid (snow) precipitation
+      dqns_ice ,      &  ! total non solar sensibility over ice (LW+SEN+LA)
+      tn_ice   ,      &  ! ice surface temperature
+#if ! defined key_coupled
+      fr1_i0   ,      &  ! 1st part of the fraction of sol. rad.  which penetrate inside the ice cover
+      fr2_i0   ,      &  ! 2nd part of the fraction of sol. rad.  which penetrate inside the ice cover 
+      qla_ice  ,      &  ! latent flux over ice  
+      dqla_ice ,      &  ! latent sensibility over ice
+      evap               ! evaporation over ocean
+#else
+      rrunoff  ,      &  ! runoff
+      calving  ,         ! calving
+      alb_ice            ! albedo of ice      
+#endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+   
+#endif
+
+   !!----------------------------------------------------------------------
+END MODULE flx_oce
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flxblk.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flxblk.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flxblk.F90	(revision 4)
@@ -0,0 +1,928 @@
+MODULE flxblk
+   !!======================================================================
+   !!                       ***  MODULE  flxblk  ***
+   !! Ocean forcing:  bulk thermohaline forcing of the ocean (or ice)
+   !!=====================================================================
+#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+   !!----------------------------------------------------------------------
+   !!   'key_flx_bulk_monthly'   or                            MONTHLY bulk
+   !!   'key_flx_bulk_daily'                                     DAILY bulk
+   !!----------------------------------------------------------------------
+   !!   flx_blk        : thermohaline fluxes from bulk
+   !!   flx_blk_albedo : albedo for ocean and ice (clear and overcast skies)
+   !!   flx_blk_declin : solar declinaison
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE daymod
+   USE blk_oce         ! bulk variables
+   USE flx_oce         ! forcings variables
+   USE ocfzpt          ! ???
+   USE in_out_manager
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC flx_blk        ! routine called by flx.F90 
+   PUBLIC flx_blk_albedo ! routine called by limflx.F90 
+
+   !! * Module variables
+      INTEGER, PARAMETER  ::   &
+         jpintsr = 24          ! number of time step between sunrise and sunset
+         !                     ! uses for heat flux computation
+      LOGICAL ::   &
+         lbulk_init = .TRUE.   ! flag, bulk initialization done or not)
+
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         stauc            ,  &   ! cloud optical depth 
+         sbudyko   
+
+      !! * constants for bulk computation (flx_blk)
+      REAL(wp), DIMENSION(19)  ::  &
+         budyko                  ! BUDYKO's coefficient
+      ! BUDYKO's coefficient (cloudiness effect on LW radiation):
+      DATA budyko / 1.00, 0.98, 0.95, 0.92, 0.89, 0.86, 0.83, 0.80, 0.78, 0.75,  &
+                    0.72, 0.69, 0.67, 0.64, 0.61, 0.58, 0.56, 0.53, 0.50 /
+      REAL(wp), DIMENSION(20)  :: &
+         tauco                  ! cloud optical depth coefficient
+      ! Cloud optical depth coefficient
+      DATA tauco / 6.6, 6.6, 7.0, 7.2, 7.1, 6.8, 6.5, 6.6, 7.1, 7.6,   &
+                   6.6, 6.1, 5.6, 5.5, 5.8, 5.8, 5.6, 5.6, 5.6, 5.6 /
+      REAL(wp)  ::            &  ! constant values
+         zeps    = 1e-20   ,  &
+         zeps0   = 1e-13   ,  &
+         zeps1   = 1e-06   ,  &
+         zzero   = 0.0     ,  &
+         zone    = 1.0
+
+      !! * constants for albedo computation (flx_blk_albedo)
+      REAL(wp) ::   &
+         c1     = 0.05  ,     &   ! constants values
+         c2     = 0.1   ,     &
+         albice = 0.50  ,     &   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers)
+         cgren  = 0.06  ,     &   !  correction of the snow or ice albedo to take into account
+                                  !  effects of cloudiness (Grenfell & Perovich, 1984)
+         alphd  = 0.80  ,     &   !  coefficients for linear interpolation used to compute
+         alphdi = 0.72  ,     &   !  albedo between two extremes values (Pyane, 1972)
+         alphc  = 0.65  ,     &
+         zmue   = 0.4             !  cosine of local solar altitude
+
+      !! * constants for solar declinaison computation (flx_blk_declin)
+      REAL(wp) ::                &
+         a0  =  0.39507671   ,   &  ! coefficients
+         a1  = 22.85684301   ,   &
+         a2  = -0.38637317   ,   &
+         a3  =  0.15096535   ,   &
+         a4  = -0.00961411   ,   &
+         b1  = -4.29692073   ,   &
+         b2  =  0.05702074   ,   &
+         b3  = -0.09028607   ,   &
+         b4  =  0.00592797
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flx_blk( kt, psst )
+      !!---------------------------------------------------------------------------
+      !!                     ***  ROUTINE flx_blk  ***
+      !!                 
+      !!  ** Purpose :   Computation of the heat fluxes at ocean and snow/ice
+      !!       surface the solar heat at ocean and snow/ice surfaces and the 
+      !!       sensitivity of total heat fluxes to the SST variations
+      !!         
+      !!  ** Method  :   The flux of heat at the ice and ocean surfaces are derived
+      !!       from semi-empirical ( or bulk ) formulae which relate the flux to 
+      !!       the properties of the surface and of the lower atmosphere. Here, we
+      !!       follow the work of Oberhuber, 1988   
+      !!
+      !!  ** Action  :   call flx_blk_albedo to compute ocean and ice albedo 
+      !!          computation of snow precipitation
+      !!          computation of solar flux at the ocean and ice surfaces
+      !!          computation of the long-wave radiation for the ocean and sea/ice
+      !!          computation of turbulent heat fluxes over water and ice
+      !!          computation of evaporation over water
+      !!          computation of total heat fluxes sensitivity over ice (dQ/dT)
+      !!          computation of latent heat flux sensitivity over ice (dQla/dT)
+      !!
+      !! History :
+      !!   8.0  !  97-06  (Louvain-La-Neuve)  Original code
+      !!   8.5  !  02-09  (C. Ethe , G. Madec )  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER , INTENT( in  )  ::   kt        ! time step
+      REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) ::   &
+         &                          psst      ! Sea Surface Temperature 
+
+      !! * Local variables
+      INTEGER  ::             &
+         ji, jj, jt        ,  &  ! dummy loop indices
+         indaet            ,  &  !  = -1, 0, 1 for odd, normal and leap years resp.
+         iday              ,  &  ! integer part of day
+         indxb             ,  &  ! index for budyko coefficient
+         indxc                   ! index for cloud depth coefficient
+
+      REAL(wp)  ::            & 
+         zalat , zclat     ,  &  ! latitude in degrees 
+         zmt1, zmt2, zmt3  ,  &  ! tempory air temperatures variables
+         ztatm3, ztatm4    ,  &  ! power 3 and 4 of air temperature
+         z4tatm3           ,  &  ! 4 * ztatm3
+         zcmue             ,  &  ! cosine of local solar altitude
+         zcmue2            ,  &  ! root of zcmue1 
+         zscmue            ,  &  ! square-root of zcmue1 
+         zpcmue            ,  &  ! zcmue1**1.4
+         zdecl             ,  &  ! solar declination
+         zsdecl , zcdecl   ,  &  ! sine and cosine of solar declination 
+         zalbo             ,  &  ! albedo of sea-water
+         zalbi             ,  &  ! albedo of ice
+         ztamr             ,  &  ! air temperature minus triple point of water (rtt)
+         ztaevbk           ,  &  ! part of net longwave radiation
+         zevi , zevo       ,  &  ! vapour pressure of ice and ocean 
+         zind1,zind2,zind3 ,  &  ! switch for testing the values of air temperature
+         zinda             ,  &  ! switch for testing the values of sea ice cover
+         zpis2             ,  &  ! pi / 2
+         z2pi                    ! 2 * pi 
+
+      REAL(wp)  ::            & 
+         zxday             ,  &  ! day of year
+         ztsec             ,  &  ! time in seconds
+         zdist             ,  &  ! distance between the sun and the earth during the year
+         zdaycor           ,  &  ! corr. factor to take into account the variation of 
+         !                       ! zday when calc. the solar rad.    
+         zesi, zeso        ,  &  ! vapour pressure of ice and ocean at saturation
+         zesi2             ,  &  ! root of zesi 
+         zqsato            ,  &  ! humidity close to the ocean surface (at saturation)   
+         zqsati            ,  &  ! humidity close to the ice surface (at saturation) 
+         zqsati2           ,  &  ! root of  zqsati 
+         zdesidt           ,  &  ! derivative of zesi, function of ice temperature
+         zdteta            ,  &  ! diff. betw. sst and air temperature
+         zdeltaq           ,  &  ! diff. betw. spec. hum. and hum. close to the surface
+         ztvmoy, zobouks   ,  &  ! tempory scalars
+         zpsims, zpsihs, zpsils, zobouku, zxins, zpsimu ,  & 
+         zpsihu, zpsilu, zstab,zpsim, zpsih, zpsil      ,  & 
+         zvatmg, zcmn, zchn, zcln, zcmcmn, zdenum       ,  & 
+         zdtetar, ztvmoyr, zlxins, zcmn2, zchcm, zclcm , zcoef
+
+      REAL(wp)  ::            & 
+         zrhova            ,  &  ! air density per wind speed
+         zcsho , zcleo     ,  &  ! transfer coefficient over ocean
+         zcshi , zclei     ,  &  ! transfer coefficient over ice-free
+         zrhovacleo        ,  &  ! air density per wind speed per transfer coef.
+         zrhovacsho, zrhovaclei, zrhovacshi, & 
+         ztice3            ,  &  ! power 3 of ice temperature
+         zticemb, zticemb2 ,  &  ! tempory air temperatures variables
+         zdqlw_ice         ,  &  ! sensitivity of long-wave flux over ice
+         zdqsb_ice         ,  &  ! sensitivity of sensible heat flux over ice
+         zdqla_ice         ,  &  ! sensitivity of latent heat flux over ice
+         zdl, zdr                ! fractionnal part of latitude
+      REAL(wp), DIMENSION(jpi,jpj) :: & 
+         zpatm            ,  &   ! atmospheric pressure
+         zqatm            ,  &   ! specific humidity
+         zes              ,  &   ! vapour pressure at saturation
+         zev, zevsqr      ,  &   ! vapour pressure and his square-root
+         zrhoa            ,  &   ! air density
+         ztatm            ,  &   ! air temperature in Kelvins
+         zfrld            ,  &   ! fraction of sea ice cover 
+         zcatm1           ,  &   ! fraction of cloud
+         zcldeff                 ! correction factor to account cloud effect
+      REAL(wp), DIMENSION(jpi,jpj) ::   & 
+         zalbocsd         ,  &   ! albedo of ocean
+         zalboos          ,  &   ! albedo of ocean under overcast sky
+         zalbics          ,  &   ! albedo of ice under clear sky
+         zalbios          ,  &   ! albedo of ice under overcast sky
+         zalbomu          ,  &   ! albedo of ocean when zcmue is 0.4
+         zqsro            ,  &   ! solar radiation over ocean
+         zqsrics          ,  &   ! solar radiation over ice under clear sky
+         zqsrios          ,  &   ! solar radiation over ice under overcast sky
+         zcldcor          ,  &   ! cloud correction
+         zlsrise, zlsset  ,  &   ! sunrise and sunset
+         zlmunoon         ,  &   ! local noon solar altitude
+         zdlha            ,  &   ! length of the ninstr segments of the solar day
+         zps              ,  &   ! sine of latitude per sine of solar decli.
+         zpc                     ! cosine of latitude per cosine of solar decli. 
+
+      REAL(wp), DIMENSION(jpi,jpj) ::   & 
+         zqlw_oce         ,  &   ! long-wave heat flux over ocean
+         zqlw_ice         ,  &   ! long-wave heat flux over ice
+         zqla_oce         ,  &   ! latent heat flux over ocean
+         zqla_ice         ,  &   ! latent heat flux over ice
+         zqsb_oce         ,  &   ! sensible heat flux over ocean
+         zqsb_ice                ! sensible heat flux over ice
+ 
+      REAL(wp), DIMENSION(jpi,jpj,jpintsr) ::    &
+         zlha             ,  &   ! local hour angle
+         zalbocs          ,  &   ! tempory var. of ocean albedo under clear sky
+         zsqsro           ,  &   ! tempory var. of solar rad. over ocean 
+         zsqsrics         ,  &   ! temp. var. of solar rad. over ice under clear sky
+         zsqsrios                ! temp. var. of solar rad. over ice under overcast sky
+      !!---------------------------------------------------------------------
+
+      !---------------------
+      !   Initilization    !
+      !---------------------
+#if ! defined key_ice_lim
+      tn_ice(:,:) = psst(:,:)
+#endif
+
+      !  Determine cloud optical depths as a function of latitude (Chou et al., 1981).
+      !  and the correction factor for taking into account  the effect of clouds 
+      !------------------------------------------------------
+      IF( lbulk_init ) THEN
+         DO jj = 1, jpj  
+            DO ji = 1 , jpi
+            zalat          = ( 90.0 - ABS( gphit(ji,jj) ) ) / 5.0
+            zclat          = ( 95.0 -      gphit(ji,jj)   ) / 10.0
+            indxb          = 1 + INT( zalat ) 
+            !  correction factor to account for the effect of clouds 
+            sbudyko(ji,jj) = budyko(indxb)  
+            indxc          = 1 + INT( zclat )  
+            zdl            = zclat - INT( zclat ) 
+            zdr            = 1.0 - zdl
+            stauc(ji,jj)   = zdr * tauco( indxc ) + zdl * tauco( indxc + 1 ) 
+            END DO
+         END DO
+         IF( nleapy == 1 ) THEN
+            yearday = 366.0
+         ELSE IF( nleapy == 0 ) THEN
+            yearday = 365.0
+         ELSEIF( nleapy == 30) THEN
+            yearday = 360.0
+         ENDIF
+         lbulk_init = .FALSE.
+      ENDIF
+
+      zqlw_oce(:,:) = 0.e0
+      zqla_oce(:,:) = 0.e0
+      zqsb_oce(:,:) = 0.e0
+      zqlw_ice(:,:) = 0.e0
+      zqla_ice(:,:) = 0.e0
+      zqsb_ice(:,:) = 0.e0
+
+      zpis2       = rpi / 2.              ! pi / 2
+      z2pi        = 2. * rpi              ! 2 * pi 
+
+ !CDIR NOVERRCHK
+     DO jj = 1, jpj
+ !CDIR NOVERRCHK
+        DO ji = 1, jpi
+
+      ztatm (ji,jj) = 273.15 + tatm  (ji,jj)  !  air temperature in Kelvins 
+      zcatm1(ji,jj) = 1.0    - catm  (ji,jj)  !  fractional cloud cover
+      zfrld (ji,jj) = 1.0    - freeze(ji,jj)  !  fractional sea ice cover
+      zpatm(ji,jj)  = 101000.               !  pressure 
+      
+      !  Computation of air density, obtained from the equation of state for dry air. 
+      zrhoa(ji,jj) = zpatm(ji,jj) / ( 287.04 * ztatm(ji,jj) )
+      
+      !  zes : Saturation water vapour
+            ztamr = ztatm(ji,jj) - rtt
+            zmt1  = SIGN( 17.269, ztamr )
+            zmt2  = SIGN( 21.875, ztamr )
+            zmt3  = SIGN( 28.200, -ztamr )
+            zes(ji,jj) = 611.0 * EXP (  ABS( ztamr ) * MIN ( zmt1, zmt2 )   &
+               &                      / ( ztatm(ji,jj) - 35.86  + MAX( zzero, zmt3 ) ) )
+
+      !  zev : vapour pressure  (hatm is relative humidity)  
+      zev(ji,jj)   = hatm(ji,jj) * zes(ji,jj) 
+      !  square-root of vapour pressure
+!CDIR NOVERRCHK
+      zevsqr(ji,jj) = SQRT( zev(ji,jj) * 0.01 )
+      !  zqapb  : specific humidity 
+      zqatm(ji,jj) = 0.622 * zev(ji,jj) / ( zpatm(ji,jj) - 0.378 * zev(ji,jj) )
+
+
+      !----------------------------------------------------
+      !   Computation of snow precipitation (Ledley, 1985) |
+      !----------------------------------------------------
+
+            zmt1  =   253.0 - ztatm(ji,jj)
+            zmt2  = ( 272.0 - ztatm(ji,jj) ) / 38.0 
+            zmt3  = ( 281.0 - ztatm(ji,jj) ) / 18.0
+            zind1 = MAX( zzero, SIGN( zone, zmt1 ) )
+            zind2 = MAX( zzero, SIGN( zone, zmt2 ) )
+            zind3 = MAX( zzero, SIGN( zone, zmt3 ) )
+            ! total precipitation
+            tprecip(ji,jj) = watm(ji,jj)
+            ! solid  (snow) precipitation
+            sprecip(ji,jj) = tprecip(ji,jj) *       &
+               &             (           zind1      &
+               &               + ( 1.0 - zind1 ) * ( zind2 * ( 0.5 + zmt2 ) + ( 1.0 - zind2 ) *  zind3 * zmt3 ) ) 
+         END DO
+      END DO
+
+      !----------------------------------------------------------
+      !   Computation of albedo (need to calculates heat fluxes)|
+      !-----------------------------------------------------------
+      
+      CALL flx_blk_albedo( zalbios, zalboos, zalbics, zalbomu )
+
+      !-------------------------------------
+      !   Computation of solar irradiance. |
+      !----------------------------------------
+      indaet   = 1  
+      !  compution of the day of the year at which the fluxes have to be calculate 
+      !--The date corresponds to the middle of the time step.
+      ztsec = ( 2 * INT ( ( kt - 1 ) / nfbulk ) + 1 ) * rdtbs2
+      zxday = MOD( ztsec , raass ) / rday + 1.0  
+
+      iday   = INT( zxday )
+      IF( l_ctl .AND. lwp ) WRITE(numout,*) ' declin : iday ', iday, ' nfbulk= ', nfbulk
+      !   computation of the solar declination, his sine and his cosine
+      CALL flx_blk_declin( indaet, iday, zdecl )
+      
+      zdecl    = zdecl * rad
+      zsdecl   = SIN( zdecl )
+      zcdecl   = COS( zdecl )
+      
+      !  correction factor added for computation of shortwave flux to take into account the variation of
+      !  the distance between the sun and the earth during the year (Oberhuber 1988)
+      zdist    = zxday * z2pi / yearday
+      zdaycor  = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist )
+
+!CDIR NOVERRCHK
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi
+            !  product of sine of latitude and sine of solar declination
+            zps(ji,jj)     = SIN( gphit(ji,jj) * rad ) * zsdecl
+            !  product of cosine of latitude and cosine of solar declination
+            zpc(ji,jj)     = COS( gphit(ji,jj) * rad ) * zcdecl
+            !  computation of the both local time of sunrise and sunset
+            zlsrise(ji,jj) =  ACOS( - SIGN( zone, zps(ji,jj) ) * MIN( zone, SIGN( zone, zps(ji,jj) )  &
+               &                     * ( zps(ji,jj) / zpc(ji,jj) ) ) ) 
+            zlsset(ji,jj)  = - zlsrise(ji,jj)
+            !  dividing the solar day into jpintsr segments of length zdlha
+            zdlha(ji,jj)   =  ( zlsrise(ji,jj) - zlsset(ji,jj) ) / REAL( jpintsr )
+            !  computation of the local noon solar altitude
+            zlmunoon(ji,jj)=  ASIN ( ( zps(ji,jj) + zpc(ji,jj) ) ) / rad
+            
+            !  cloud correction taken from Reed (1977) (imposed lower than 1)
+            zcldcor(ji,jj) = MIN( zone, ( 1 - 0.62 * catm(ji,jj) + 0.0019 * zlmunoon(ji,jj) ) )
+         END DO
+      END DO
+
+         !  Computation of solar heat flux at each time of the day between sunrise and sunset. 
+         !  We do this to a better optimisation of the code 
+         !------------------------------------------------------       
+
+!CDIR NOVERRCHK   
+      DO jt = 1, jpintsr   
+         zcoef = FLOAT( jt ) - 0.5
+!CDIR NOVERRCHK     
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               !  local hour angle
+               zlha (ji,jj,jt)= COS ( zlsrise(ji,jj) - zcoef * zdlha(ji,jj) )
+
+               ! cosine of local solar altitude
+               zcmue              = MAX ( zzero ,   zps(ji,jj) + zpc(ji,jj) * zlha (ji,jj,jt)  )
+               zcmue2             = 1368.0 * zcmue * zcmue
+               zscmue             = SQRT ( zcmue )
+               zpcmue             = zcmue**1.4
+               ! computation of sea-water albedo (Payne, 1972)
+               zalbocs(ji,jj,jt)  = 0.05 / ( 1.1 * zpcmue + 0.15 )
+               zalbo              = zcatm1(ji,jj) * zalbocs(ji,jj,jt) + catm(ji,jj) * zalboos(ji,jj)
+               ! solar heat flux absorbed at ocean surfaces (Zillman, 1972)
+               zevo               = zev(ji,jj) * 1.0e-05
+               zsqsro(ji,jj,jt)   =  ( 1.0 - zalbo ) * zdlha(ji,jj) * zcmue2                &
+                                   / ( ( zcmue + 2.7 ) * zevo + 1.085 * zcmue +  0.10 )
+               !  solar heat flux absorbed at sea/ice surfaces 
+               !  Formulation of Shine and Crane, 1984 adapted for high albedo surfaces 
+
+               !  For clear sky        
+               zevi               = zevo
+               zalbi              = zalbics(ji,jj)
+               zsqsrics(ji,jj,jt) =  ( 1.0 - zalbi ) * zdlha(ji,jj) * zcmue2                &
+                  &                / ( ( 1.0 + zcmue ) * zevi + 1.2 * zcmue + 0.0455 )
+
+               ! For overcast sky
+               zalbi              = zalbios(ji,jj)
+               zsqsrios(ji,jj,jt) = zdlha(ji,jj) *                                                           &
+                  &                 ( ( 53.5 + 1274.5 * zcmue      ) *  zscmue * ( 1.0 - 0.996  * zalbi ) )  &
+                  &                 / (  1.0 + 0.139  * stauc(ji,jj) *           ( 1.0 - 0.9435 * zalbi ) )
+            END DO
+         END DO
+      END DO
+
+
+      !  Computation of daily (between sunrise and sunset) solar heat flux absorbed 
+      !  at the ocean and snow/ice surfaces.
+      !--------------------------------------------------------------------
+
+      zalbocsd(:,:) = 0.  
+      zqsro   (:,:) = 0.
+      zqsrics (:,:) = 0.
+      zqsrios (:,:) = 0.
+
+      DO jt = 1, jpintsr 
+#   if defined key_vectopt_loop && ! defined key_autotasking
+         DO ji = 1, jpij  
+            zalbocsd(ji,1)  = zalbocsd(ji,1) + zdlha(ji,1) * zalbocs(ji,1,jt)   &
+               &             / MAX( 2.0 * zlsrise(ji,1) , zeps0 )
+            zqsro   (ji,1)  =   zqsro(ji,1) + zsqsro  (ji,1,jt)
+            zqsrics (ji,1)  = zqsrics(ji,1) + zsqsrics(ji,1,jt)
+            zqsrios (ji,1)  = zqsrios(ji,1) + zsqsrios(ji,1,jt)
+         END DO
+#  else
+         DO jj = 1, jpj
+            DO ji = 1, jpi  
+               zalbocsd(ji,jj)  = zalbocsd(ji,jj) + zdlha(ji,jj) * zalbocs(ji,jj,jt)   &
+                  &             / MAX( 2.0 * zlsrise(ji,jj) , zeps0 )
+               zqsro  (ji,jj)   =   zqsro(ji,jj) + zsqsro  (ji,jj,jt)
+               zqsrics(ji,jj)   = zqsrics(ji,jj) + zsqsrics(ji,jj,jt)
+               zqsrios(ji,jj)   = zqsrios(ji,jj) + zsqsrios(ji,jj,jt)
+            END DO
+         END DO
+#  endif
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi 
+
+      !------------------------------------------- 
+      !  Computation of shortwave radiation.
+      !-------------------------------------------
+
+            ! the solar heat flux absorbed at ocean and snow/ice surfaces
+            !------------------------------------------------------------
+
+            ! For ocean
+            qsr_oce(ji,jj) = srgamma * zcldcor(ji,jj) * zqsro(ji,jj) / z2pi
+            zinda          = SIGN( zone , -( -0.5 - zfrld(ji,jj) ) )
+            zinda          = 1.0 - MAX( zzero , zinda )
+            qsr_oce(ji,jj) = ( 1.- zinda ) * qsr_oce(ji,jj)
+
+            ! For snow/ice 
+            qsr_ice(ji,jj) = ( zcatm1(ji,jj) * zqsrics(ji,jj) + catm(ji,jj) * zqsrios(ji,jj) ) / z2pi
+
+
+            ! Taking into account the ellipsity of the earth orbit
+            !-----------------------------------------------------
+
+            qsr_ice(ji,jj) = qsr_ice(ji,jj) * zdaycor
+            qsr_oce(ji,jj) = qsr_oce(ji,jj) * zdaycor
+
+            !  fraction of net shortwave radiation which is not absorbed in the 
+            !  thin surface layer and penetrates inside the ice cover 
+            !  ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 )
+            !------------------------------------------------------------------
+
+            fr1_i0(ji,jj) = 0.18  * zcatm1(ji,jj) + 0.35 * catm(ji,jj) 
+            fr2_i0(ji,jj) = 0.82  * zcatm1(ji,jj) + 0.65 * catm(ji,jj)
+
+      !---------------------------------------------------------------------------
+      !   Computation of long-wave radiation  ( Berliand 1952 ; all latitudes )
+      !---------------------------------------------------------------------------
+
+            ! tempory variables
+            ztatm3         = ztatm(ji,jj) * ztatm(ji,jj) * ztatm(ji,jj)
+            ztatm4         = ztatm3 * ztatm(ji,jj)
+            z4tatm3        = 4. * ztatm3
+            zcldeff(ji,jj) = 1.0 - sbudyko(ji,jj) * catm(ji,jj) * catm(ji,jj)    
+            ztaevbk        = ztatm4 * zcldeff(ji,jj) * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 
+
+            !  Long-Wave for Ice
+            !----------------------
+            zqlw_ice(ji,jj) = - emic * stefan * ( ztaevbk + z4tatm3 * ( tn_ice(ji,jj) - ztatm(ji,jj) ) ) 
+
+            !  Long-Wave for Ocean
+            !-----------------------
+            zqlw_oce(ji,jj) = - emic * stefan * ( ztaevbk + z4tatm3 * ( psst  (ji,jj) - ztatm(ji,jj) ) ) 
+
+         END DO
+      END DO
+
+      !----------------------------------------
+      !  Computation of turbulent heat fluxes  ( Latent and sensible ) 
+      !----------------------------------------        
+      !CDIR NOVERRCHK
+      DO jj = 2 , jpjm1
+!ib   DO jj = 1 , jpj
+         !CDIR NOVERRCHK
+         DO  ji = 1, jpi
+
+            !  Turbulent heat fluxes over water
+            !----------------------------------
+
+            ! zeso     : vapour pressure at saturation of ocean
+            ! zqsato   : humidity close to the ocean surface (at saturation)
+            zeso          =  611.0 * EXP ( 17.2693884 * ( psst(ji,jj) - rtt ) * tmask(ji,jj,1) / ( psst(ji,jj) - 35.86 ) )
+            zqsato        = ( 0.622 * zeso ) / ( zpatm(ji,jj) - 0.378 * zeso )
+
+            !  Drag coefficients from Large and Pond (1981,1982)
+            !---------------------------------------------------
+    
+            !  Stability parameters
+            zdteta         = psst(ji,jj) - ztatm(ji,jj)
+            zdeltaq        = zqatm(ji,jj) - zqsato
+            ztvmoy         = ztatm(ji,jj) * ( 1. + 2.2e-3 * ztatm(ji,jj) * zqatm(ji,jj) )
+            zdenum         = MAX( vatm(ji,jj) * vatm(ji,jj) * ztvmoy, zeps )
+!i
+!i          if( zdenum == 0.e0 ) then
+!i               write(numout,*) 'flxblk  zdenum=0 ', ji,jj
+!i               zdenum = zeps
+!i          endif
+!i
+            zdtetar        = zdteta / zdenum
+            ztvmoyr        = ztvmoy * ztvmoy * zdeltaq / zdenum
+            
+            ! For stable atmospheric conditions
+            zobouks        = -70.0 * 10. * ( zdtetar + 3.2e-3 * ztvmoyr )
+            zobouks        = MAX( zzero , zobouks )
+            zpsims         = -7.0 * zobouks
+            zpsihs         =  zpsims
+            zpsils         =  zpsims
+
+            !  For unstable atmospheric conditions
+            zobouku        = -100.0 * 10.0 * ( zdtetar + 2.2e-3 * ztvmoyr )
+            zobouku        = MIN( zzero , zobouku )
+            zxins          = ( 1. - 16. * zobouku )**0.25
+            zlxins         = LOG( ( 1. + zxins * zxins ) / 2. )
+            zpsimu         = 2. * LOG( ( 1 + zxins ) / 2. )  + zlxins - 2. * ATAN( zxins ) + zpis2
+            zpsihu         = 2. * zlxins
+            zpsilu         = zpsihu
+
+            ! computation of intermediate values
+            zstab          = MAX( zzero , SIGN( zone , zdteta ) )
+            zpsim          = zstab * zpsimu + (1.0 - zstab ) * zpsims
+            zpsih          = zstab * zpsihu + (1.0 - zstab ) * zpsihs
+            zpsil          = zpsih
+            
+            zvatmg         = MAX( 0.032 * 1.5e-3 * vatm(ji,jj) * vatm(ji,jj) / g, zeps )
+!i
+!!          if( zvatmg == 0.e0 ) then
+!!               write(numout,*) 'flxblk  zvatmg=0 ', ji,jj
+!!               zvatmg = zeps
+!!          endif
+!i
+
+            zcmn           = vkarmn / LOG ( 10. / zvatmg )
+            zcmn2          = zcmn * zcmn
+            zchn           = 0.0327 * zcmn
+            zcln           = 0.0346 * zcmn
+            zcmcmn         = 1 / ( 1 - zcmn * zpsim / vkarmn )
+            zchcm          = zcmcmn / ( 1 - zchn * zpsih / ( vkarmn * zcmn ) )
+            zclcm          = zchcm
+
+
+            !  Transfer cofficient zcsho and zcleo over ocean according to Large and Pond (1981,1982)
+            !-------------------------------------------------------------- 
+            zcsho          = zchn * zchcm
+            zcleo          = zcln * zclcm 
+
+
+            !   Computation of sensible and latent fluxes over Ocean 
+            !----------------------------------------------------------------
+
+            !  computation of intermediate values
+            zrhova         = zrhoa(ji,jj) * vatm(ji,jj)
+            zrhovacsho     = zrhova * zcsho
+            zrhovacleo     = zrhova * zcleo
+
+            ! sensible heat flux
+            zqsb_oce(ji,jj) = zrhovacsho * 1004.0  * ( psst(ji,jj) - ztatm(ji,jj) )  
+         
+            !  latent heat flux 
+            zqla_oce(ji,jj) = zrhovacleo * 2.5e+06 * ( zqsato      - zqatm(ji,jj) )
+               
+            !  Calculate evaporation over water. (kg/m2/s)
+            !-------------------------------------------------
+            evap(ji,jj)    = zqla_oce(ji,jj) / cevap
+               
+               
+            !  Turbulent heat fluxes over snow/ice.
+            !--------------------------------------------------
+            
+            !  zesi     : vapour pressure at saturation of ice
+            !  zqsati   : humidity close to the ice surface (at saturation)
+            zesi           =  611.0 * EXP ( 21.8745587 * tmask(ji,jj,1)   &   ! tmask needed to avoid overflow in the exponential
+               &                                       * ( tn_ice(ji,jj) - rtt ) / ( tn_ice(ji,jj) - 7.66 ) )
+            zqsati         = ( 0.622 * zesi ) / ( zpatm(ji,jj) - 0.378 * zesi )
+               
+            !  computation of intermediate values
+            zticemb        = ( tn_ice(ji,jj) - 7.66 )
+            zticemb2       = zticemb * zticemb  
+            ztice3         = tn_ice(ji,jj) * tn_ice(ji,jj) * tn_ice(ji,jj)
+            zqsati2        = zqsati * zqsati
+            zesi2          = zesi * zesi
+            zdesidt        = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 )  / zticemb2 )
+               
+            !  Transfer cofficient zcshi and zclei over ice. Assumed to be constant Parkinson 1979 ; Maykut 1982
+            !--------------------------------------------------------------------
+            zcshi          = 1.75e-03
+            zclei          = zcshi
+               
+            !  Computation of sensible and latent fluxes over ice
+            !----------------------------------------------------------------
+               
+            !  computation of intermediate values
+            zrhova          = zrhoa(ji,jj) * vatm(ji,jj)
+            zrhovacshi      = zrhova * zcshi * 2.834e+06
+            zrhovaclei      = zrhova * zclei * 1004.0
+            
+            !  sensible heat flux
+            zqsb_ice(ji,jj) = zrhovaclei * ( tn_ice(ji,jj) - ztatm(ji,jj) )
+            
+            !  latent heat flux 
+            zqla_ice(ji,jj) = zrhovacshi * ( zqsati        - zqatm(ji,jj) )
+             qla_ice(ji,jj) = zqla_ice(ji,jj)
+              
+            !  Computation of sensitivity of non solar fluxes (dQ/dT)
+            !---------------------------------------------------------------
+               
+            !  computation of long-wave, sensible and latent flux sensitivity
+            zdqlw_ice       = 4.0 * emic * stefan * ztice3
+            zdqsb_ice       = zrhovaclei
+            zdqla_ice       = zrhovacshi * ( zdesidt * ( zqsati2 / zesi2 ) * ( zpatm(ji,jj) / 0.622 ) )         
+            
+            !  total non solar sensitivity
+            dqns_ice(ji,jj) = -( zdqlw_ice + zdqsb_ice + zdqla_ice ) 
+            
+            ! latent flux sensitivity
+            dqla_ice(ji,jj) = zdqla_ice
+            
+         END DO
+      END DO
+
+      ! total non solar heat flux over ice
+      qnsr_ice(:,:) = zqlw_ice(:,:) - zqsb_ice(:,:) - zqla_ice(:,:)
+      ! total non solar heat flux over water 
+      qnsr_oce(:,:) = zqlw_oce(:,:) - zqsb_oce(:,:) - zqla_oce(:,:)
+
+      ! solid precipitations ( kg/m2/day -> kg/m2/s)
+      tprecip(:,:) = tprecip  (:,:) / rday 
+      ! snow  precipitations ( kg/m2/day -> kg/m2/s)
+      sprecip(:,:) = sprecip  (:,:) / rday  
+!i
+      CALL lbc_lnk( qsr_oce (:,:) , 'T', 1. )
+      CALL lbc_lnk( qnsr_oce(:,:) , 'T', 1. )
+      CALL lbc_lnk( qsr_ice (:,:) , 'T', 1. )
+      CALL lbc_lnk( qnsr_ice(:,:) , 'T', 1. )
+      CALL lbc_lnk( qla_ice (:,:) , 'T', 1. )
+      CALL lbc_lnk( dqns_ice(:,:) , 'T', 1. )
+      CALL lbc_lnk( dqla_ice(:,:) , 'T', 1. )
+      CALL lbc_lnk( fr1_i0  (:,:) , 'T', 1. )
+      CALL lbc_lnk( fr2_i0  (:,:) , 'T', 1. )
+      CALL lbc_lnk( tprecip (:,:) , 'T', 1. )
+      CALL lbc_lnk( sprecip (:,:) , 'T', 1. )
+      CALL lbc_lnk( evap    (:,:) , 'T', 1. )
+!i
+!i
+      qsr_oce (:,:) = qsr_oce (:,:)*tmask(:,:,1)
+      qnsr_oce(:,:) = qnsr_oce(:,:)*tmask(:,:,1)
+      qsr_ice (:,:) = qsr_ice (:,:)*tmask(:,:,1)
+      qnsr_ice(:,:) = qnsr_ice(:,:)*tmask(:,:,1)
+      qla_ice (:,:) = qla_ice (:,:)*tmask(:,:,1)
+      dqns_ice(:,:) = dqns_ice(:,:)*tmask(:,:,1)
+      dqla_ice(:,:) = dqla_ice(:,:)*tmask(:,:,1)
+      fr1_i0  (:,:) = fr1_i0  (:,:)*tmask(:,:,1)
+      fr2_i0  (:,:) = fr2_i0  (:,:)*tmask(:,:,1)
+      tprecip (:,:) = tprecip (:,:)*tmask(:,:,1)
+      sprecip (:,:) = sprecip (:,:)*tmask(:,:,1)
+      evap    (:,:) = evap    (:,:)*tmask(:,:,1)
+!i
+
+   END SUBROUTINE flx_blk
+
+
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim'                                         LIM ice model
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE flx_blk_albedo( palb , palcn , palbp , palcnp )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE flx_blk_albedo  ***
+      !!          
+      !! ** Purpose :   Computation of the albedo of the snow/ice system 
+      !!      as well as the ocean one
+      !!       
+      !! ** Method  : - Computation of the albedo of snow or ice (choose the 
+      !!      rignt one by a large number of tests
+      !!              - Computation of the albedo of the ocean
+      !!
+      !! References :
+      !!      Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250.
+      !!
+      !! History :
+      !!  8.0   !  01-04  (LIM 1.0)
+      !!  8.5   !  03-07  (C. Ethe, G. Madec)  Optimization (old name:shine)
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ice                   ! ???
+
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::  &
+         palb         ,     &    !  albedo of ice under overcast sky
+         palcn        ,     &    !  albedo of ocean under overcast sky
+         palbp        ,     &    !  albedo of ice under clear sky 
+         palcnp                  !  albedo of ocean under clear sky
+
+      !! * Local variables
+      INTEGER ::    &
+         ji, jj                   ! dummy loop indices
+      REAL(wp) ::   & 
+         zmue14         ,     &   !  zmue**1.4
+         zalbpsnm       ,     &   !  albedo of ice under clear sky when snow is melting
+         zalbpsnf       ,     &   !  albedo of ice under clear sky when snow is freezing
+         zalbpsn        ,     &   !  albedo of snow/ice system when ice is coverd by snow
+         zalbpic        ,     &   !  albedo of snow/ice system when ice is free of snow
+         zithsn         ,     &   !  = 1 for hsn >= 0 ( ice is cov. by snow ) ; = 0 otherwise (ice is free of snow)
+         zitmlsn        ,     &   !  = 1 freezinz snow (sist >=rt0_snow) ; = 0 melting snow (sist<rt0_snow)
+         zihsc1         ,     &   !  = 1 hsn <= c1 ; = 0 hsn > c1
+         zihsc2                   !  = 1 hsn >= c2 ; = 0 hsn < c2
+      REAL(wp), DIMENSION(jpi,jpj) ::  &
+         zalbfz         ,     &   !  ( = alphdi for freezing ice ; = albice for melting ice )
+         zficeth                  !  function of ice thickness
+      LOGICAL , DIMENSION(jpi,jpj) ::  &
+         llmask
+      !!---------------------------------------------------------------------
+      
+      !-------------------------                                                             
+      !  Computation of  zficeth
+      !-------------------------- 
+      
+      llmask = (hsnif == 0.0) .AND. ( sist >= rt0_ice )
+      WHERE ( llmask )   !  ice free of snow and melts
+         zalbfz = albice
+      ELSEWHERE                   
+         zalbfz = alphdi
+      END WHERE
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( hicif(ji,jj) > 1.5 ) THEN
+               zficeth(ji,jj) = zalbfz(ji,jj)
+            ELSEIF( hicif(ji,jj) > 1.0  .AND. hicif(ji,jj) <= 1.5 ) THEN
+               zficeth(ji,jj) = 0.472 + 2.0 * ( zalbfz(ji,jj) - 0.472 ) * ( hicif(ji,jj) - 1.0 )
+            ELSEIF( hicif(ji,jj) > 0.05 .AND. hicif(ji,jj) <= 1.0 ) THEN
+               zficeth(ji,jj) = 0.2467 + 0.7049 * hicif(ji,jj)                                &
+                  &                    - 0.8608 * hicif(ji,jj) * hicif(ji,jj)                 &
+                  &                    + 0.3812 * hicif(ji,jj) * hicif(ji,jj) * hicif (ji,jj)
+            ELSE
+               zficeth(ji,jj) = 0.1 + 3.6 * hicif(ji,jj) 
+            ENDIF
+         END DO
+      END DO
+      
+      !----------------------------------------------- 
+      !    Computation of the snow/ice albedo system 
+      !-------------------------- ---------------------
+      
+      !    Albedo of snow-ice for clear sky.
+      !-----------------------------------------------    
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !  Case of ice covered by snow.             
+            
+            !  melting snow        
+            zihsc1       = 1.0 - MAX ( zzero , SIGN ( zone , - ( hsnif(ji,jj) - c1 ) ) )
+            zalbpsnm     = ( 1.0 - zihsc1 ) * ( zficeth(ji,jj) + hsnif(ji,jj) * ( alphd - zficeth(ji,jj) ) / c1 ) &
+               &                 + zihsc1   * alphd  
+            !  freezing snow                
+            zihsc2       = MAX ( zzero , SIGN ( zone , hsnif(ji,jj) - c2 ) )
+            zalbpsnf     = ( 1.0 - zihsc2 ) * ( albice + hsnif(ji,jj) * ( alphc - albice ) / c2 )                 &
+               &                 + zihsc2   * alphc 
+            
+            zitmlsn      =  MAX ( zzero , SIGN ( zone , sist(ji,jj) - rt0_snow ) )   
+            zalbpsn      =  zitmlsn * zalbpsnf + ( 1.0 - zitmlsn ) * zalbpsnm 
+            
+            !  Case of ice free of snow.
+            zalbpic      = zficeth(ji,jj) 
+            
+            ! albedo of the system   
+            zithsn       = 1.0 - MAX ( zzero , SIGN ( zone , - hsnif(ji,jj) ) )
+            palbp(ji,jj) =  zithsn * zalbpsn + ( 1.0 - zithsn ) *  zalbpic
+         END DO
+      END DO
+      
+      !    Albedo of snow-ice for overcast sky.
+      !----------------------------------------------  
+      palb(:,:)   = palbp(:,:) + cgren                                           
+      
+      !--------------------------------------------
+      !    Computation of the albedo of the ocean 
+      !-------------------------- -----------------                                                          
+      
+      !  Parameterization of Briegled and Ramanathan, 1982 
+      zmue14      = zmue**1.4                                       
+      palcnp(:,:) = 0.05 / ( 1.1 * zmue14 + 0.15 )                
+      
+      !  Parameterization of Kondratyev, 1969 and Payne, 1972
+      palcn(:,:)  = 0.06                                                 
+      
+   END SUBROUTINE flx_blk_albedo
+
+# else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                   NO sea-ice model
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE flx_blk_albedo( palb , palcn , palbp , palcnp )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE flx_blk_albedo  ***
+      !! 
+      !! ** Purpose :   Computation of the albedo of the snow/ice system
+      !!      as well as the ocean one
+      !!
+      !! ** Method  :   Computation of the albedo of snow or ice (choose the
+      !!      wright one by a large number of tests Computation of the albedo
+      !!      of the ocean
+      !!
+      !! History :
+      !!  8.0   !  01-04  (LIM 1.0)
+      !!  8.5   !  03-07  (C. Ethe, G. Madec)  Optimization (old name:shine)
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::  &
+         palb         ,     &    !  albedo of ice under overcast sky
+         palcn        ,     &    !  albedo of ocean under overcast sky
+         palbp        ,     &    !  albedo of ice under clear sky
+         palcnp                  !  albedo of ocean under clear sky
+
+      REAL(wp) ::   &
+         zmue14                 !  zmue**1.4
+      !!----------------------------------------------------------------------
+
+      !--------------------------------------------
+      !    Computation of the albedo of the ocean
+      !-------------------------- -----------------
+
+      !  Parameterization of Briegled and Ramanathan, 1982
+      zmue14      = zmue**1.4
+      palcnp(:,:) = 0.05 / ( 1.1 * zmue14 + 0.15 )
+
+      !  Parameterization of Kondratyev, 1969 and Payne, 1972
+      palcn(:,:)  = 0.06
+
+      palb (:,:)  = palcn(:,:)
+      palbp(:,:)  = palcnp(:,:)
+
+   END SUBROUTINE flx_blk_albedo
+
+#endif
+
+   SUBROUTINE flx_blk_declin( ky, kday, pdecl )
+      !!---------------------------------------------------------------------------
+      !!               ***  ROUTINE flx_blk_declin  ***
+      !!          
+      !! ** Purpose :   Computation of the solar declination for the day
+      !!	        kday ( in decimal degrees ).
+      !!       
+      !! ** Method  :
+      !!
+      !! History :
+      !!         original    : 01-04 (LIM)
+      !!         addition    : 02-08 (C. Ethe, G. Madec)
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   &
+         ky  ,        &  ! = -1, 0, 1 for odd, normal and leap years resp.
+         kday            ! day of the year ( kday = 1 on january 1)
+      REAL(wp), INTENT(out) ::  &
+         pdecl            ! solar declination
+
+      !! * Local variables
+      REAL(wp) ::                & 
+         zday                ,   &  ! corresponding day of type year (cf. ky)
+         zp1, zp2, zp3, zp4         ! temporary scalars
+      !!---------------------------------------------------------------------
+      
+      zday = FLOAT( kday ) 
+      
+      IF( ky == 1 )  THEN 
+         zday = zday - 0.5
+      ELSEIF( ky == 3 )  THEN
+         zday = zday - 1.
+      ELSE 
+         zday = REAL( kday )
+      ENDIF
+      
+      zp1 = rpi * ( 2.0 * zday - 367.0 ) / yearday
+      zp2 = 2. * zp1
+      zp3 = 3. * zp1
+      zp4 = 4. * zp1
+      
+      pdecl  = a0                                                                      &
+         &   + a1 * COS( zp1 ) + a2 * COS( zp2 ) + a3 * COS( zp3 ) + a4 * COS( zp4 )   &
+         &   + b1 * SIN( zp1 ) + b2 * SIN( zp2 ) + b3 * SIN( zp3 ) + b4 * SIN( zp4 )
+      
+   END SUBROUTINE flx_blk_declin
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :           Empty module                     NO bulk
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE flx_blk            ! Empty routine
+   END SUBROUTINE flx_blk
+#endif
+
+   !!======================================================================
+END MODULE flxblk
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flxfwb.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flxfwb.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flxfwb.F90	(revision 4)
@@ -0,0 +1,326 @@
+MODULE flxfwb
+   !!======================================================================
+   !!                       ***  MODULE  flxfwb  ***
+   !! Ocean fluxes   : domain averaged freshwater budget
+   !!======================================================================
+#if defined key_dynspg_fsc
+   !!----------------------------------------------------------------------
+   !!   flx_fwb      : freshwater budget for global ocean configurations
+   !!                  in free surface and forced mode
+   !!   flx_fwb_init : freshwater budget for global ocean configurations
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE flxrnf          ! ocean runoffs
+   USE ocesbc          ! ocean surface boudaries conditions
+   USE blk_oce
+   USE flxblk          ! bulk formulea
+   USE daymod          ! calendar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC flx_fwb      ! routine called by step
+   PUBLIC flx_fwb_init ! routine called by opa
+
+   !! * Share module variables
+   LOGICAL, PUBLIC ::    &  !!! * namelist *
+      ln_fwb = .TRUE.        ! Flag to activate the fwb computation
+   REAL(wp), PUBLIC ::   &
+      a_fwb_b  ,  &  ! annual domain averaged freshwater budget
+      a_fwb          ! for 2 year before (_b) and before year.
+
+   !! * Module variables
+   REAL(wp) ::   &
+      a_emp   ,  & ! domain averaged evaporation minus precipitation
+      a_precip,  & ! domain averaged precipitation
+      a_rnf   ,  & ! domain averaged runoff
+      a_sshb  ,  & ! domain averaged sea surface heigh at nit000
+      a_sshend,  & ! domain averaged sea surface heigh at nitend
+      a_sal000,  & ! domain averaged ocean salinity at nit000 (before time step)
+      a_salend,  & ! domain averaged ocean salinity at nitend (now time step)
+      a_aminus,  & ! 
+      a_aplus
+      REAL(wp), DIMENSION(jpi,jpj) ::  &
+         e1e2_i    ! area of the interior domain (e1t*e2t*tmask_i)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flx_fwb( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE flx_fwb  ***
+      !!
+      !! ** Purpose :
+      !!
+      !! ** Method  :
+      !!	
+      !! History :
+      !!   8.2  !  01-02  (E. Durand)  Original code
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk        ! dummy loop indices
+      INTEGER  ::   inum = 11         ! temporary logical unit
+      INTEGER  ::   ikty              ! 
+      REAL(wp) ::   &
+         zarea, zvol, zwei,       &  ! temporary scalars
+         zsm0, zempnew                !    "         "
+      !!----------------------------------------------------------------------
+
+      ! Mean global salinity
+      zsm0 = 34.72654
+
+      ! To compute emp mean value mean emp
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'flx_fwb : FreshWater Budget correction'
+            WRITE(numout,*) '~~~~~~~'
+         ENDIF
+
+         a_emp    = 0.e0
+         a_precip = 0.e0
+         a_rnf    = 0.e0
+         a_sshb   = 0.e0   ! averaged sea surface heigh at nit000 
+         a_sal000 = 0.e0   ! averaged ocean salinity at nit000
+         a_aminus = 0.e0
+         a_aplus  = 0.e0
+         
+         e1e2_i(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)
+         a_sshb = SUM( e1e2_i(:,:) * sshn(:,:) )
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zwei  = e1e2_i(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk)
+                  a_sal000 = a_sal000 + ( sb(ji,jj,jk) - zsm0 ) * zwei
+               END DO
+            END DO
+         END DO
+#if defined key_mpp
+      ! Mpp: sum over all the global domain
+      CALL  mpp_sum( a_sshb   )        
+      CALL  mpp_sum( a_sal000 )        
+#endif
+
+      ENDIF
+      
+      ! cumulate surface freshwater budget at each time-step
+      ! --------------------------------------====----------
+      a_emp    = SUM( e1e2_i(:,:) * emp   (:,:) )
+#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+      a_precip = SUM( e1e2_i(:,:) * watm  (:,:) )
+#endif
+      a_rnf    = SUM( e1e2_i(:,:) * runoff(:,:) )
+
+      IF( aminus /= 0.0 ) a_aminus = a_aminus + ( MIN( aplus, aminus ) / aminus )
+      IF( aplus  /= 0.0 ) a_aplus  = a_aplus  + ( MIN( aplus, aminus ) / aplus  )
+
+#if defined key_mpp
+      ! Mpp: sum over all the global domain
+      CALL  mpp_sum( a_emp    )   
+#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+      CALL  mpp_sum( a_precip )   
+#endif
+      CALL  mpp_sum( a_rnf    )   
+#endif
+
+
+      ! Update empold if new year start
+      ikty = 365 * 86400 /rdttra(1)
+      IF( MOD( kt, ikty ) == 0 ) THEN
+            zarea    = SUM( e1e2_i(:,:)             )
+            a_fwb_b = a_fwb
+            a_fwb   = SUM( e1e2_i(:,:) * sshn(:,:) )
+#if defined key_mpp
+      ! Mpp: sum over all the global domain
+      CALL  mpp_sum( zarea    )        
+      CALL  mpp_sum( a_fwb    )        
+#endif
+            a_fwb   = a_fwb * 1.e+3 / ( zarea * 86400. * 365. )    ! convert in Kg/m3/s = mm/s
+
+            empold = 2. * a_fwb - a_fwb_b   ! current year freshwater budget correction
+            !                               ! estimate from the 2 previous years budget
+
+      ENDIF
+
+
+      IF( kt == nitend ) THEN
+         zvol  = 0.e0
+         zempnew = 0.e0
+         ! Mean sea level at nitend
+         a_sshend = SUM( e1e2_i(:,:) * sshn(:,:) )
+         zarea    = SUM( e1e2_i(:,:)             )
+         
+         a_salend = 0.e0
+         DO jk = 1, jpkm1   
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zwei  = e1e2_i(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk)
+                  a_salend = a_salend + ( sn(ji,jj,jk) - zsm0 ) * zwei
+                  zvol  = zvol  + zwei
+               END DO
+            END DO
+         END DO
+#if defined key_mpp
+      ! Mpp: sum over all the global domain
+      CALL  mpp_sum( zarea    )        
+      CALL  mpp_sum( a_sshend )        
+      CALL  mpp_sum( a_salend )        
+#endif
+
+         a_aminus = a_aminus / ( nitend - nit000 + 1 )
+         a_aplus  = a_aplus  / ( nitend - nit000 + 1 )
+
+         ! Conversion in m3
+         a_emp    = a_emp    * rdttra(1) * 1.e-3 
+         a_precip = a_precip * rdttra(1) * 1.e-3 / rday
+         a_rnf    = a_rnf    * rdttra(1) * 1.e-3
+         
+      ENDIF
+
+
+      ! Ecriture des diagnostiques 
+      ! --------------------------
+
+      IF( kt == nitend ) THEN
+
+         OPEN( inum, FILE='EMPave.dat' )
+         WRITE(inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb
+         WRITE(inum,*)
+         WRITE(inum,*)    'Net freshwater budget '
+         WRITE(inum,9010) '  emp    = ', a_emp   , ' m3 =', a_emp   /((nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'
+         WRITE(inum,9010) '  precip = ', a_precip, ' m3 =', a_precip/((nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'
+         WRITE(inum,9010) '  a_rnf  = ', a_rnf   , ' m3 =', a_rnf   /((nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'
+         WRITE(inum,*)
+         WRITE(inum,9010) '  zarea =',zarea
+         WRITE(inum,9010) '  zvol  =',zvol
+         WRITE(inum,*)
+         WRITE(inum,*)    'Mean sea level : '
+         WRITE(inum,9010) '  at nit000 = ',a_sshb           ,' m3 '
+         WRITE(inum,9010) '  at nitend = ',a_sshend         ,' m3 '
+         WRITE(inum,9010) '  diff      = ',(a_sshend-a_sshb),' m3 =', (a_sshend-a_sshb)/((nitend-nit000+1)*rdt) * 1.e-6,' Sv'
+         WRITE(inum,9020) '  mean sea level elevation    =', a_sshend/zarea,' m'
+         WRITE(inum,*)
+         WRITE(inum,*)    'Anomaly of salinity content : '
+         WRITE(inum,9010) '  at nit000 = ', a_sal000           ,' psu.m3 '
+         WRITE(inum,9010) '  at nitend = ', a_salend           ,' psu.m3 '
+         WRITE(inum,9010) '  diff      = ', a_salend - a_sal000,' psu.m3'
+         WRITE(inum,*)
+         WRITE(inum,*)    'Mean salinity : '
+         WRITE(inum,9020) '  at nit000 = ',  a_sal000/zvol+zsm0     ,' psu '
+         WRITE(inum,9020) '  at nitend = ',  a_salend/zvol+zsm0     ,' psu '
+         WRITE(inum,9020) '  diff      = ', (a_salend-a_sal000)/zvol,' psu'
+         WRITE(inum,9020) '  S-SLevitus= ',  a_salend          /zvol,' psu'
+         WRITE(inum,*)
+         WRITE(inum,*)    'Coeff : '
+         WRITE(inum,9030) '  Alpha+   =  ', a_aplus
+         WRITE(inum,9030) '  Alpha-   =  ', a_aminus
+         WRITE(inum,*)
+      ENDIF
+
+ 9006 FORMAT(1X,A,ES24.16)
+ 9010 FORMAT(1X,A,ES12.5,A,F10.5,A)
+ 9020 FORMAT(1X,A,F10.5,A)
+ 9030 FORMAT(1X,A,F8.2,A)
+
+   END SUBROUTINE flx_fwb
+
+
+   SUBROUTINE flx_fwb_init
+      !!---------------------------------------------------------------------
+      !!                ***  ROUTINE flx_fwb_init  ***
+      !!
+      !! ** Purpose :
+      !!
+      !! ** Method  :
+      !!  
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      LOGICAL ::   llbon
+      CHARACTER (len=32) ::   &
+         clname = 'EMPave_old.dat'
+      INTEGER ::   inum = 11         ! temporary logical unit
+      INTEGER ::   iyear
+
+      NAMELIST/namfwb/ ln_fwb 
+      !!----------------------------------------------------------------------
+         
+      ! Read Namelist namfwb : freshWater Budget correction
+      ! --------------------
+      REWIND( numnam )
+      READ  ( numnam, namfwb )            
+      
+      ! Parameter control and print
+      ! ---------------------------
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'flx_fwb_init : FreshWater Budget correction'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '               Namelist namfwb : set fwb parameters'
+         WRITE(numout,*) '                  use or not fwb correction      ln_fwb   = ', ln_fwb
+      ENDIF
+      ! Option consistency
+#if ! defined key_dynspg_fsc
+      IF(lwp) WRITE '               Rigid-lid option, fwb correction is useless, but valid'
+#endif
+#if defined key_coupled
+      IF(lwp) WRITE '               Coupled option, fwb correction is a flux correction ! '
+      IF(lwp) WRITE '               ln_fwb = .FALSE. is recommanded'
+#endif
+
+      !                                       ! ==============================
+      IF( ln_fwb ) THEN                        !  Freshwater budget correction 
+         !                                    ! ==============================
+         ! Read the corrective factor on precipitations (empold)
+         INQUIRE( FILE=clname, EXIST=llbon )
+         IF( llbon ) THEN
+            OPEN ( inum, FILE=clname)
+            READ ( inum, "(24X,I8,2ES24.16)" ) iyear, a_fwb_b, a_fwb
+            CLOSE( inum )
+            empold = 2. * a_fwb - a_fwb_b   ! current year freshwater budget correction
+            !                               ! estimate from the 2 previous years budget
+            IF(lwp)WRITE(numout,*)
+            IF(lwp)WRITE(numout,*)'flx_fwb_init : year = ',iyear  , ' freshwater budget correction = ', empold
+            IF(lwp)WRITE(numout,*)'               year = ',iyear-1, ' freshwater budget read       = ', a_fwb
+            IF(lwp)WRITE(numout,*)'               year = ',iyear-2, ' freshwater budget read       = ', a_fwb_b
+         ELSE
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*)'flx_fwb_init : unable to read the file', clname
+            nstop = nstop + 1
+         ENDIF
+         !                                    ! ==============================
+      ELSE                                    !      NO  budget correction 
+         !                                    ! ==============================
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*)'flx_fwb_init : NO freshwater budget correction'
+         empold = 0.e0
+      ENDIF
+
+   END SUBROUTINE flx_fwb_init
+
+#else
+CONTAINS
+   SUBROUTINE flx_fwb
+   END SUBROUTINE flx_fwb
+   SUBROUTINE flx_fwb_init
+   END SUBROUTINE flx_fwb_init
+#endif
+   !!======================================================================
+END MODULE flxfwb
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flxmod.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flxmod.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flxmod.F90	(revision 4)
@@ -0,0 +1,133 @@
+MODULE flxmod
+   !!======================================================================
+   !!                       ***  MODULE  flxmod  ***
+   !! Ocean forcing:  thermohaline forcing of the ocean
+   !!=====================================================================
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE daymod          ! calendar
+   USE ocfzpt          ! ocean freezing point
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC flx       ! routine called by step.F90
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+#if defined key_flx_bulk_monthly
+# if defined key_fdir
+   !!----------------------------------------------------------------------
+   !!   'key_flx_bulk_monthly'   and                           MONTHLY bulk
+   !!   'key_fdir'                                       direct access file
+   !!----------------------------------------------------------------------
+#  include "flx_bulk_monthly_fdir.h90"
+
+# else
+   !!----------------------------------------------------------------------
+   !!   'key_flx_bulk_monthly'   and                           MONTHLY bulk
+   !!   Default option                                         Net CDF file
+   !!----------------------------------------------------------------------
+#  include "flx_bulk_monthly.h90"
+
+# endif
+#elif defined key_flx_bulk_daily
+   !!----------------------------------------------------------------------
+   !!   'key_flx_bulk_daily'                                     DAILY bulk
+   !!                                                          Net CDF file
+   !!----------------------------------------------------------------------
+#  include "flx_bulk_daily.h90"
+
+#elif defined key_flx_forced_daily
+   !!----------------------------------------------------------------------
+   !!   'key_flx_forced_daily'                                 DAILY fluxes
+   !!                                                          Net CDF file
+   !!----------------------------------------------------------------------
+#  include "flx_forced_daily.h90"
+
+#elif defined key_coupled
+# if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_coupled'  and                          Coupled Ocan/Atmosphere
+   !!   'key_ice_lim'                               with  LIM sea-ice model
+   !!----------------------------------------------------------------------
+#  include "flx_coupled_ice.h90"
+
+# else
+   !!----------------------------------------------------------------------
+   !!   'key_flx_coupled'  and                      Coupled Ocan/Atmosphere
+   !!   Default option                              without   sea-ice model
+   !!----------------------------------------------------------------------
+#  include "flx_coupled_noice.h90"
+
+# endif
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                   Analytical forcing
+   !!----------------------------------------------------------------------
+   !!   flx          : define the thermohaline fluxes for the ocean
+   !!----------------------------------------------------------------------
+   !! * Module used
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flx ( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE flx  ***
+      !!              
+      !! ** Purpose :   provide the thermohaline fluxes (heat and freshwater)
+      !!      to the ocean at each time step.
+      !!
+      !! ** Method  :   Constant surface fluxes (read in namelist (namflx))
+      !!
+      !! ** Action  : - q, qt, qsr, emp, emps, qrp, erp
+      !!
+      !! History :
+      !!        !  91-03  ()  Original code
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE flxrnf                       ! ocean runoffs
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * local declarations
+      REAL(wp) ::                   & !!! surface fluxes namelist (namflx)
+         q0   = 0.e0,               &  ! net heat flux
+         qsr0 = 0.e0,               &  ! solar heat flux
+         emp0 = 0.e0                   ! net freshwater flux
+
+      NAMELIST/namflx/ q0, qsr0, emp0
+      !!---------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+
+         ! Read Namelist namflx : surface thermohaline fluxes
+         ! --------------------
+         REWIND ( numnam )
+         READ   ( numnam, namflx )
+
+         IF(lwp) WRITE(numout,*)' '
+         IF(lwp) WRITE(numout,*)' flx     : Constant surface fluxes read in namelist'
+         IF(lwp) WRITE(numout,*)' ~~~~~~~ '
+         IF(lwp) WRITE(numout,*)'      : See the routine ocesbc'     
+
+     ENDIF
+
+   END SUBROUTINE flx
+
+#endif
+   !!======================================================================
+END MODULE flxmod
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flxrnf.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flxrnf.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flxrnf.F90	(revision 4)
@@ -0,0 +1,359 @@
+MODULE flxrnf
+   !!======================================================================
+   !!                       ***  MODULE  flxrnf  ***
+   !! Ocean forcing:  runoff
+   !!=====================================================================
+#if defined key_orca_r05
+   !!----------------------------------------------------------------------
+   !!   'key_orca_r05'                               ORCA R05 configuration
+   !!----------------------------------------------------------------------
+#  include "flxrnf_ORCA_R05.h90"
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                     Standard runoffs
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   flx_rnf      : monthly runoff read in a NetCDF file
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+   USE ioipsl          ! NetCDF IPSL library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Shared module variables
+   PUBLIC flx_rnf         ! routine call by step.F90
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &
+      runoff,          &  ! monthly runoff (kg/m2/s)
+      upsadv,          &  ! mixed adv scheme in straits vicinity (hori.)
+      upsrnfh             ! mixed adv scheme in runoffs vicinity (hori.)
+   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &
+      upsrnfz             ! mixed adv scheme in runoffs vicinity (vert.)
+   INTEGER, PUBLIC ::   &
+      numrof  = 48 ,    &  ! logical unit for runoff data
+      nrunoff =  0 ,    &  ! runoff option (namelist)
+      nrnf1, nrnf2         ! first and second record used
+
+   !! * Module variable
+   REAL(wp), DIMENSION(jpi,jpj,2) ::   &
+      rnfdta              ! monthly runoff data array (kg/m2/s)
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flx_rnf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE flx_rnf  ***
+      !!       
+      !! ** Purpose :   Introduce a climatological run off forcing
+      !!
+      !! ** Method :
+      !!      Initialze each mouth of river with a monthly climatology 
+      !!      provided from different data.
+      !!     C a u t i o n : upward water flux, runoff is negative
+      !!                     set at the last loop of the routine
+      !!
+      !! ** Action :
+      !!
+      !! References : 
+      !!       J. D. Milliman and R. H. Meade, 1983 : world-wide delivery
+      !!          of river sediment to the oceans, journal of geology vol 91
+      !!          pp 1-21.
+      !!       G. L. Russell and J. R. Miller, 1990 : global river runoff
+      !!          calculated from a global atmospheric general circulation
+      !!          model, journal of hydrology, 117(1990), pp 241-254.
+      !!       F. Van Der Leeden, Troise F. L., Todd D. K. : the water
+      !!          encyclopedia, second edition, lewis publishers.
+      !!       J. W. Weatherly, J. E. Walsh : The effects of precipitation
+      !!          and river runoff in a coupled ice-ocean model of Arctic
+      !!          Climate dynamics 1996 12:785,798
+      !!       Jacobs et al. 1992. J. Glaciol. 38 (130) 375-387.
+      !!
+      !! History :
+      !!        !  94-10  (G.Madec, M. Pontaud, M. Imbard)  Original code
+      !!        !  97-03  (G.Madec)  time dependent version
+      !!        !  98-06  (J.M. Molines)  exact computation of zxy 
+      !!                         for months that are not 30 days
+      !!        !  98-07  (M. Imbard)  ORCA and mpp option
+      !!        !  99-08  (J.P. Boulanger H.L.Ayina)  New rivers and 
+      !!                         values given in m3/s 
+      !!        !  00-04  (G. Madec, K. Roberts) add antarctica ice discharge.
+      !!        !  00-11  (R. Hordoir, E. Durand)  NetCDF FORMAT
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt       ! ocean time step
+
+      !! * Local declarations
+# if ! defined key_coupled
+      INTEGER ::   &
+         i15 , imois , iman,            &  ! temporary integers
+         idbd, idmeom                      !    "          "
+      REAL(wp) ::   zxy
+# endif
+      CHARACTER (len=32) ::   &
+         clname = 'runoff_1m_nomask'       ! monthly runoff filename
+      INTEGER, PARAMETER :: jpmois = 12
+      INTEGER  ::   ji, jj                 ! dummy loop indices
+      INTEGER  ::   ipi, ipj, ipk          ! temporary integers
+      INTEGER, DIMENSION(jpmois) ::     &
+         istep                             ! temporary workspace
+      REAL(wp) ::   zdate0                 ! temporary scalars
+      REAL(wp), DIMENSION(jpk) ::       &
+         zlev                              ! temporary workspace
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zlon, zlat,                    &  ! temporary workspace
+         zcoefr                            ! coeff of advection link to runoff
+      !!----------------------------------------------------------------------
+      
+      IF( kt == nit000 ) THEN
+
+         SELECT CASE ( nrunoff )
+
+         CASE ( 0 )
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'flx_rnf : No runoff in this simulation (nrunoff=0)'
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+            
+         CASE ( 1 )
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'flx_rnf : monthly runoff (nrunoff=0)'
+            IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+         CASE ( 2 )
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'flx_rnf : monthly runoff with upsteam advection'
+            IF(lwp) WRITE(numout,*) '~~~~~~~   in the vicinity of river mouths (nrunoff=2)'
+
+         CASE DEFAULT
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*)' Error nrunoff = ', nrunoff, ' /= 0, 1 or 2'
+            nstop = nstop + 1
+
+         END SELECT
+
+         ! Set runoffs and upstream coeff to zero
+         runoff (:,:) = 0.e0
+         upsrnfh(:,:) = 0.e0
+         upsrnfz(:)   = 0.e0 
+         upsadv (:,:) = 0.e0
+
+      ENDIF
+
+
+      ! 1. Initialization
+      ! -----------------
+
+      IF( nrunoff == 1 .OR. nrunoff == 2 ) THEN
+# if ! defined key_coupled
+
+         ! year, month, day
+
+         iman  = jpmois
+         i15   = nday / 16
+         imois = nmonth + i15 - 1
+         IF( imois == 0 )   imois = iman
+         ! Number of days in the month
+         IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
+            idbd = nbiss(imois)
+         ELSEIF( nleapy > 1 ) THEN
+            idbd = nleapy
+         ELSE
+            idbd = nobis(imois)
+         ENDIF
+         ! Number of days between imois, 15 and the end of month
+         idmeom = idbd - 15
+# endif
+         ipi = jpiglo
+         ipj = jpjglo
+         ipk = jpk
+         
+         ! Open file
+
+         IF( kt == nit000 ) THEN
+            CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj,    &
+                           .false., ipi, ipj, ipk, zlon,        &
+                           zlat, zlev, jpmois, istep, zdate0,   &
+                           rdt, numrof )
+            !   Title, dimensions and tests
+# if ! defined key_coupled
+            IF( iman /= jpmois ) THEN
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) 'problem with time coordinates'
+               IF(lwp) WRITE(numout,*) ' iman ', iman, ' jpmois ', jpmois
+               nstop = nstop + 1
+            ENDIF
+            IF(lwp) WRITE(numout,*) iman, istep, zdate0, rdt, numrof
+            IF(lwp) WRITE(numout,*) 'numrof=', numrof
+            IF(lwp) WRITE(numout,*) 'jpmois=', jpmois
+            IF(lwp) WRITE(numout,*) 'rdt=', rdt
+# endif
+            IF(ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1) THEN
+               IF(lwp)WRITE(numout,*) ' '
+               IF(lwp)WRITE(numout,*) 'problem with dimensions'
+               IF(lwp)WRITE(numout,*) ' ipi ', ipi, ' jpidta ', jpidta
+               IF(lwp)WRITE(numout,*) ' ipj ', ipj, ' jpjdta ', jpjdta
+               IF(lwp)WRITE(numout,*) ' ipk ', ipk, ' =? 1'
+               nstop = nstop + 1
+            ENDIF
+            IF(lwp)WRITE(numout,*) 'ipi=', ipi, ' ipj=', ipj, ' ipk=', ipk
+         ENDIF
+         
+# if ! defined key_coupled
+
+         ! 2. Read monthly file of runoff
+         ! ------------------------------
+
+         IF( kt == nit000 .OR. imois /= nrnf1 ) THEN
+
+            ! Calendar computation for interpolation
+            !     nrnf1 number of the first array record used in the simulation
+            !     nrnf2 number of the last  array record
+
+            nrnf1 = imois
+            nrnf2 = nrnf1 + 1
+            nrnf1 = MOD( nrnf1, iman )
+            IF( nrnf1 == 0 ) nrnf1 = iman
+            nrnf2 = MOD( nrnf2, iman )
+            IF( nrnf2 == 0 ) nrnf2 = iman
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' runoff monthly field'
+               WRITE(numout,*) ' --------------------'
+               WRITE(numout,*) ' NetCDF format'
+               WRITE(numout,*)
+               WRITE(numout,*) 'first array record used nrnf1 ',nrnf1
+               WRITE(numout,*) 'last  array record used nrnf2 ',nrnf2
+               WRITE(numout,*)
+            ENDIF
+            
+            ! Read monthly runoff data in kg/m2/s
+
+            CALL flinget(numrof,'sorunoff',jpidta,jpjdta,1,jpmois   &
+                  ,nrnf1,nrnf1,mig(1),nlci,mjg(1),nlcj,rnfdta(1:nlci,1:nlcj,1))
+            CALL flinget(numrof,'sorunoff',jpidta,jpjdta,1,jpmois   &
+                  ,nrnf2,nrnf2,mig(1),nlci,mjg(1),nlcj,rnfdta(1:nlci,1:nlcj,2))
+
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' read runoff field ok'
+            IF(lwp) WRITE(numout,*)
+
+         ENDIF
+
+         ! Linear interpolation and conversion in upward water flux
+         ! C a u t i o n : runoff is negative and in kg/m2/s 
+
+         zxy = FLOAT( nday + idmeom - idbd * i15 ) / idbd
+
+         runoff(:,:) = -( (1.-zxy)*rnfdta(:,:,1) + zxy*rnfdta(:,:,2) )
+
+         ! Runoff reduction
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 ) THEN
+                  runoff(ji,jj) = 0.85 * runoff(ji,jj)
+               ENDIF
+            END DO
+         END DO
+         
+# endif
+
+      ENDIF
+
+
+      ! 3. Mixed advection scheme 
+      ! -------------------------
+
+      IF( nrunoff == 2 .AND. kt == nit000 ) THEN
+
+         ! Upstream and centered scheme in the vicinity of river mouths
+
+         !  Creates the array coef that contains the coefficient to affect to
+         !  the upstream scheme. advection scheme will be:
+         !  coefr * upstream + (1- coefr) centered
+         !  coefr must be between 0 and 1.
+
+         CALL flinget(numrof,'socoefr',jpidta,jpjdta,1,jpmois,nrnf1   &
+                     ,nrnf1,mig(1),nlci,mjg(1),nlcj,zcoefr(1:nlci,1:nlcj))
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' read coefr for advection ok'
+         IF(lwp) WRITE(numout,*)
+         
+         upsrnfh(:,:) = zcoefr(:,:)
+         upsrnfz(:)   = 0.e0
+         upsrnfz(1)   = 1.0
+         upsrnfz(2)   = 1.0
+         upsrnfz(3)   = 0.5
+         upsrnfz(4)   = 0.25
+         upsrnfz(5)   = 0.125
+         
+         IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN
+            ! ORCA_R2 configuration :
+            ! upstream scheme in the Sound Strait
+            upsrnfh( mi0(144):mi1(144) , mj0(116):mj1(116) ) = 0.25
+            upsrnfh( mi0(145):mi1(147) , mj0(116):mj1(116) ) = 0.50
+            upsrnfh( mi0(148):mi1(148) , mj0(116):mj1(116) ) = 0.25
+         ENDIF
+
+      ENDIF
+
+      ! Upstream and centered scheme in the vicinity of some straits
+
+      IF( kt == nit000 ) THEN 
+
+         IF( cp_cfg == "orca" ) THEN
+
+            SELECT CASE ( jp_cfg )
+            !                                        ! =======================
+            CASE ( 4 )                               !  ORCA_R4 configuration 
+               !                                     ! =======================
+
+               !                                                       ! Gibraltar Strait
+               upsadv( mi0(70):mi1(71) , mj0(52):mj1(53) ) = 0.50
+         
+               !                                     ! =======================
+            CASE ( 2 )                               !  ORCA_R2 configuration 
+               !                                     ! =======================
+
+               !                                          ! Gibraltar Strait
+               upsadv( mi0(138):mi1(138) , mj0(102):mj1(102) ) = 0.20
+               upsadv( mi0(139):mi1(139) , mj0(102):mj1(102) ) = 0.40
+               upsadv( mi0(140):mi1(140) , mj0(102):mj1(102) ) = 0.50
+               upsadv( mi0(141):mi1(141) , mj0(101):mj1(102) ) = 0.50
+
+               !                                          ! Bab el Mandeb Strait
+               upsadv( mi0(164):mi1(164) , mj0( 87):mj1( 88) ) = 0.10
+               upsadv( mi0(163):mi1(163) , mj0( 88):mj1( 88) ) = 0.25
+               upsadv( mi0(162):mi1(162) , mj0( 88):mj1( 88) ) = 0.40
+               upsadv( mi0(160):mi1(161) , mj0( 88):mj1( 88) ) = 0.50
+               upsadv( mi0(158):mi1(160) , mj0( 89):mj1( 89) ) = 0.25
+               upsadv( mi0(160):mi1(160) , mj0( 90):mj1( 90) ) = 0.25
+
+               !                                          ! Sound Strait
+               upsadv( mi0(145):mi1(147) , mj0(116):mj1(116) ) = 0.50
+         
+            END SELECT 
+
+         ENDIF
+
+      ENDIF
+     
+      ! 4. Closing all files
+      ! --------------------
+
+      IF( kt == nitend .AND. nrunoff >= 1 )   CALL flinclo( numrof )
+
+   END SUBROUTINE flx_rnf
+
+#endif
+   !!======================================================================
+END MODULE flxrnf
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flxrnf_ORCA_R05.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flxrnf_ORCA_R05.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flxrnf_ORCA_R05.h90	(revision 4)
@@ -0,0 +1,1206 @@
+   !!----------------------------------------------------------------------
+   !!                  *** flxrnf_ORCA_R05.h90  ***
+   !!----------------------------------------------------------------------
+   !!   flx_rnf      : update ocean runoffs for ORCA_R05 configuration
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Shared module variables
+   PUBLIC flx_rnf         ! routine call by step.F90
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &
+      runoff,          &  ! monthly runoff (kg/m2/s)
+      upsadv,          &  ! mixed adv scheme in straits vicinity (hori.)
+      upsrnfh             ! mixed adv scheme in runoffs vicinity (hori.)
+   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &
+      upsrnfz             ! mixed adv scheme in runoffs vicinity (vert.)
+   INTEGER, PUBLIC ::   &
+      numrof  = 48 ,    &  ! logical unit for runoff data
+      nrunoff =  0 ,    &  ! runoff option (namelist)
+      nrnf1, nrnf2         ! first and second record used
+
+   !! * Module variable
+   REAL(wp), DIMENSION(jpi,jpj,2) ::   &
+      rnfdta              ! monthly runoff data array (kg/m2/s)
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE flx_rnf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE flx_rnf  ***
+      !!       
+      !! ** Purpose :   Introduce a climatological run off forcing
+      !!
+      !! ** Method  :   ORCA R05 configuration
+      !!      Initialze each mouth of river with a monthly climatology 
+      !!      provided from different data.
+      !!     C a u t i o n : upward water flux, runoff is negative
+      !!                     set at the last loop of the routine
+      !!
+      !! ** Action :
+      !!
+      !! References : 
+      !!       J. D. Milliman and R. H. Meade, 1983 : world-wide delivery
+      !!          of river sediment to the oceans, journal of geology vol 91
+      !!          pp 1-21.
+      !!       G. L. Russell and J. R. Miller, 1990 : global river runoff
+      !!          calculated from a global atmospheric general circulation
+      !!          model, journal of hydrology, 117(1990), pp 241-254.
+      !!       F. Van Der Leeden, Troise F. L., Todd D. K. : the water
+      !!          encyclopedia, second edition, lewis publishers.
+      !!       J. W. Weatherly, J. E. Walsh : The effects of precipitation
+      !!          and river runoff in a coupled ice-ocean model of Arctic
+      !!          Climate dynamics 1996 12:785,798
+      !!       Jacobs et al. 1992. J. Glaciol. 38 (130) 375-387.
+      !!
+      !! History :
+      !!        !  94-10  (G.Madec, M. Pontaud, M. Imbard)  Original code
+      !!        !  97-03  (G.Madec)  time dependent version
+      !!        !  98-06  (J.M. Molines)  exact computation of zxy 
+      !!                         for months that are not 30 days
+      !!        !  98-07  (M. Imbard)  ORCA and mpp option
+      !!        !  99-08  (J.P. Boulanger H.L.Ayina)  New rivers and 
+      !!                         values given in m3/s 
+      !!        !  00-04  (G. Madec, K. Roberts) add antarctica ice discharge.
+      !!        !  00-11  (R. Hordoir, E. Durand)  NetCDF FORMAT
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt ! ocean time step
+
+#if defined key_coupled
+      runoff(:,:) = 0.0e0
+#else
+      !!----------------------------------------------------------------------
+      !!  ORCA_R05
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER  :: jpmois
+      INTEGER  ::   &
+         jpriv,    & ! jpriv : maximum river number
+         jpcoef      ! jpcoef: maximum point number
+      INTEGER, PARAMETER ::   jpmois=12, jpriv=120, jpcoef=20
+
+      INTEGER  ::   ji, jj, jl, jm, jn, jr, jc
+      INTEGER  ::   i15, imois, iman
+      INTEGER  ::   inbp, idbd, idmeom
+      INTEGER  ::   iipt0, iipt1, ijpt0, ijpt1, ii, ij
+      INTEGER  ::   iirnf(jpcoef,jpriv),ijrnf(jpcoef,jpriv)
+      INTEGER  ::   inb(jpriv)
+
+      REAL(wp) ::   zconv, zxy
+      REAL(wp) ::   zrup1,zrup2,zrup3
+      REAL(wp) ::   zrnfm(jpmois, jpriv)
+      REAL(wp) ::   zcoefr(jpi, jpj, 5)
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+      ! ====
+      ! DATA
+      ! ====
+
+      ! I NORTH AMERICA
+      ! ---------------
+
+      ! 1-Saint Lawrence (Canada) 49N30 67W00               R2
+      ! Old=447 km3/year=14165m3/s; CLIPPER=12430m3/s; ratio=1.14
+      ! --> 13975.249m3/s
+      DATA inb(1)/3/
+      DATA (iirnf(jc,1),jc=1,jpcoef)/ 444, 444, 444, 17*0 /
+      DATA (ijrnf(jc,1),jc=1,jpcoef)/ 367, 368, 369, 17*0 /
+      DATA (zrnfm(jm,1),jm=1,jpmois)/   &
+          11718.,  11971.,  12466.,  14980.,  19257.,  16913.,   &
+          14211.,  13119.,  13367.,  13644.,  13463.,  12594./
+      ! 2-Hudson River (USA) 41N00 77W00                    R1
+      ! Old=12 km3/year=380m3/s; UNESCO(64-83,p255)=408m3/s
+      ! --> 407.416687m3/s
+      DATA inb(2)/1/
+      DATA (iirnf(jc,2),jc=1,jpcoef)/ 426, 19*0 /
+      DATA (ijrnf(jc,2),jc=1,jpcoef)/ 336, 19*0 /
+      DATA (zrnfm(jm,2),jm=1,jpmois)/   &
+          364.,    404.,    648.,    873.,    593.,    301.,   &
+          205.,    171.,    205.,    290.,    379.,    456./
+      ! 3-Missisipi and Atchafalaya (USA) 29N 90W           R1 
+      ! Old=580 km3/year=18380m3/s; CLIPPER=17599m3/s
+      ! --> 17599.334m3/s
+      DATA inb(3)/2/
+      DATA (iirnf(jc,3),jc=1,jpcoef)/ 397, 398, 18*0 /
+      DATA (ijrnf(jc,3),jc=1,jpcoef)/ 312, 313, 18*0 /
+      DATA (zrnfm(jm,3),jm=1,jpmois)/   &
+          19260.,  20813.,  23026.,  28160.,  26510.,  19650.,   &
+          14181.,  10676.,   9578.,  10167.,  11699.,  17472./
+      ! 4-Brazos (USA) 29N58 95W53                          R1
+      ! Old=7 km3/year=222m3/s; UNESCO(65-84, p298)=200m3/s
+      ! --> 199.666656m3/s
+      DATA inb(4)/1/
+      DATA (iirnf(jc,4),jc=1,jpcoef)/ 386, 19*0 /
+      DATA (ijrnf(jc,4),jc=1,jpcoef)/ 311, 19*0 /
+      DATA (zrnfm(jm,4),jm=1,jpmois)/   &
+          165.,    224.,    200.,    266.,    457.,    327.,   &
+          143.,     69.,    102.,    132.,    160.,    151./
+      ! 5-Colorado (Mexico) 31N54 114W57                    R5
+      ! Old=20 km3/year=634m3/s
+      ! --> 634.m3/s
+      DATA inb(5)/2/
+      DATA (iirnf(jc,5),jc=1,jpcoef)/ 347, 348, 18*0 /
+      DATA (ijrnf(jc,5),jc=1,jpcoef)/ 316, 316, 18*0 /
+      DATA (zrnfm(jm,5),jm=1,jpmois)/12*634./ 
+      ! 6-Columbia (USA) 45N60 121W17                       R1
+      ! Old=251 km3/year=7954m3/s; UNESCO(65-84, p312)=5368m3/s
+      ! --> 5368.41602m3/s
+      DATA inb(6)/2/
+      DATA (iirnf(jc,6),jc=1,jpcoef)/ 326, 326, 18*0 /
+      DATA (ijrnf(jc,6),jc=1,jpcoef)/ 360, 361, 18*0 /
+      DATA (zrnfm(jm,6),jm=1,jpmois)/   &
+          4752.,    5077.,    5633.,    6075.,    8422.,    9822.,   &
+          6350.,    4112.,    3273.,    3251.,    3548.,    4106./ 
+      ! 7-Fraser (USA)                                      R5
+      ! Old=112 km3/year=3550m3/s;not found in UNESCO
+      ! --> 3549.99976m3/s
+      DATA inb(7)/2/
+      DATA (iirnf(jc,7),jc=1,jpcoef)/ 317, 317, 18*0 /
+      DATA (ijrnf(jc,7),jc=1,jpcoef)/ 378, 379, 18*0 /
+      DATA (zrnfm(jm,7),jm=1,jpmois)/12*3550./ 
+      ! 8-Yukon (USA) 63N00 165W00                          R3
+      ! Old=195 km3/year=6179m3/s; UNESCO(65-77+80-84, p321)=4245; ratio=1.46
+      ! --> 6017.24951m3/s
+      DATA inb(8)/2/
+      DATA (iirnf(jc,8),jc=1,jpcoef)/ 244, 244, 18*0 /
+      DATA (ijrnf(jc,8),jc=1,jpcoef)/ 413, 414, 18*0 /
+      DATA (zrnfm(jm,8),jm=1,jpmois)/   &
+           1459.,    1213.,    1065.,    1100.,    9067.,   17675.,   &
+          10680.,   11271.,    8658.,    5453.,    2649.,    1917./ 
+      ! 9-Copper (USA) 61N47 144W45                         R2
+      ! Old=39 km3/year=1236m3/s; UNESCO(65-84, p317)=1052m3/s; ratio=1.18
+      ! --> 1236.25m3/s
+      DATA inb(9)/1/
+      DATA (iirnf(jc,9),jc=1,jpcoef)/ 274, 19*0 /
+      DATA (ijrnf(jc,9),jc=1,jpcoef)/ 409, 19*0 /
+      DATA (zrnfm(jm,9),jm=1,jpmois)/   &
+           219.,    195.,    181.,    214.,    904.,   2532.,   &
+          4026.,   3627.,   1632.,    697.,    354.,    254./ 
+      ! 10-Susitna (USA)                                    R5
+      ! Old=40 km3/year=1268m3/s
+      ! --> 1268.m3/s
+      DATA inb(10)/2/
+      DATA (iirnf(jc,10),jc=1,jpcoef)/ 263, 264, 18*0 /
+      DATA (ijrnf(jc,10),jc=1,jpcoef)/ 405, 405, 18*0 /
+      DATA (zrnfm(jm,10),jm=1,jpmois)/12*1268./ 
+      ! 11-McKenzie (Canada) 70N00 135W00                   R3
+      ! Old=306 km3/year=9697m3/s; UNESCO(67+72+7479+82-84, p168)=8343m3/s;
+      ! ratio=1.16
+      ! --> 9606.66797m3/s
+      DATA inb(11)/3/
+      DATA (iirnf(jc,11),jc=1,jpcoef)/ 272, 272, 272, 17*0 /
+      DATA (ijrnf(jc,11),jc=1,jpcoef)/ 451, 452, 453, 17*0 /
+      DATA (zrnfm(jm,11),jm=1,jpmois)/   &
+           3644.,    3400.,    3258.,    3546.,   14188.,   21544.,   &
+          18954.,   15487.,   11284.,   10169.,    5901.,    3905./
+      ! 12-Kuksokwim (USA) 60N00 ~162W30                    R4
+      ! UNESCO(65-84, p318)=1112m3/s (61N87 158E10, Crooked Creek, inland)
+      ! --> 1111.99988m3/s
+      DATA inb(12)/2/
+      DATA (iirnf(jc,12),jc=1,jpcoef)/ 244, 245, 18*0 /
+      DATA (ijrnf(jc,12),jc=1,jpcoef)/ 413, 414, 18*0 /
+      DATA (zrnfm(jm,12),jm=1,jpmois)/   &
+          335.,     308.,     295.,     407.,    2415.,    2027.,   &
+          1917.,   2049.,    1585.,    1072.,     545.,     389./     
+
+      DATA inb(13)/0/
+      DATA inb(14)/0/
+      DATA inb(15)/0/
+
+      ! Total run-offs(I)=60974.2539m3/s
+
+      ! II SOUTH AMERICA
+      ! -----------------
+      ! 16-Chira (Peru) 4s54 81w08                          R2
+      ! Old=5 km3/year=158m3/s; UNESCO (65-68, p357)=80.9; ratio=1.95
+      ! --> 158.000015m3/s
+      DATA inb(16)/1/
+      DATA (iirnf(jc,16),jc=1,jpcoef)/ 414, 19*0 /
+      DATA (ijrnf(jc,16),jc=1,jpcoef)/ 244, 19*0 /
+      DATA (zrnfm(jm,16),jm=1,jpmois)/   &
+          70.,     105.,     564.,     582.,     230.,      94.,   &
+          87.,      47.,      35.,      32.,      29.,      21./
+      ! 17-Magdalena (Colombia) 11N06 74W51                 R2
+      ! Old=237 km3/year=7510m3/s; UNESCO(71-73+76-79, p348)=6973m3/s;
+      ! ratio=1.08
+      ! --> 7451.58301m3/s
+      DATA inb(17)/2/
+      DATA (iirnf(jc,17),jc=1,jpcoef)/ 424, 424, 18*0 /
+      DATA (ijrnf(jc,17),jc=1,jpcoef)/ 270, 271, 18*0 /
+      DATA (zrnfm(jm,17),jm=1,jpmois)/   &
+          6598.,    4441.,    4087.,    5445.,    7380.,    8067.,   &
+          8509.,    7428.,    7631.,    9296.,   10588.,    9949./
+      ! 18-Orinoco (Venezuela) 8N37 62W15!                  R1
+      ! Old=1100 km3/year=34857m3/s; UNESCO(73-75, p364)=28736m3/s;
+      ! HLA=26371m3/s
+      ! Data from HLA: 8.1N - 63.3W   1925/89
+      ! --> 26371.416
+      DATA inb(18)/5/
+      DATA (iirnf(jc,18),jc=1,jpcoef)/ 451, 451, 452, 452, 452, 15*0 /
+      DATA (ijrnf(jc,18),jc=1,jpcoef)/ 271, 272, 271, 272, 272, 15*0 /
+      DATA (zrnfm(jm,18),jm=1,jpmois)/   &
+          10670.,    7513.,    6344.,    6887.,   13086.,   26699.,   &
+          43938.,   59957.,   57435.,   39951.,   27410.,   16567./ 
+      ! 19-Amazon (Brazil) 0S05 50W00                       R1
+      ! Old=6300 km3/year=199634m3/s; CLIPPER=166192m3/s~UNESCO;
+      ! HLA=184806m3/s
+      ! UNESCO data are at Obidos which is far inland and therefore does not
+      ! fully represent the actual discharge
+      ! Data from HLA: 1.5N - 55.3W   1970/96
+      ! --> 184845.484m3/s
+      DATA inb(19)/14/
+      DATA (iirnf(jc,19),jc=1,jpcoef)/ 475, 476, 476, 476, 476,  &
+                                       477, 477, 477, 477, 477,  &
+                                       478, 478, 478, 478, 6*0 /
+      DATA (ijrnf(jc,19),jc=1,jpcoef)/ 254, 251, 252, 253, 254,  &
+                                       250, 251, 252, 253, 254,  &
+                                       250, 251, 252, 253, 6*0 /
+      DATA (zrnfm(jm,19),jm=1,jpmois)/   &
+          152233., 176415., 199941., 225565., 244016., 244861.,   &
+          230711., 203128., 164531., 128486., 118214., 130045. /
+      ! 20-Sao Francisco (Brazil) 10S30 36W24               R1
+      ! Old=97 km3/year=3074m3/s; UNESCO(77-79, p338)=2645m3/s
+      ! --> 2645.3335m3/s
+      DATA inb(20)/1/
+      DATA (iirnf(jc,20),jc=1,jpcoef)/ 498, 19*0 /
+      DATA (ijrnf(jc,20),jc=1,jpcoef)/ 223, 19*0 /
+      DATA (zrnfm(jm,20),jm=1,jpmois)/   &
+          3244.,   4116.,   5139.,   4330.,   2323.,   1800.,     &
+          1587.,   1511.,   1593.,   1740.,   2190.,   2171. /
+      ! 21-Parana+Uruguay(Arg./Uru.) 34S12 58W18            R1 
+      ! Old=470 km3/year=14893m3/s; UNESCO(p323/324)=22263m3/s
+      ! --> 22203.168m3/s 
+      DATA inb(21)/5/
+      DATA (iirnf(jc,21),jc=1,jpcoef)/ 462, 462, 462, 462, 463, 15*0 /
+      DATA (ijrnf(jc,21),jc=1,jpcoef)/ 172, 173, 174, 175, 175, 15*0 /
+      DATA (zrnfm(jm,21),jm=1,jpmois)/   &
+          24803.,   26836.,   24585.,   21358.,   20041.,   21689.,   &
+          22647.,   20403.,   19627.,   21400.,   21126.,   21923./
+      ! 22-Negro (Argentina)  41S02  62W47                  R2
+      ! Old=30 km3/year=951m3/s; UNESCO(65-79,p330)=765m3/s; ratio=1.24
+      ! --> 907.666687m3/s
+      DATA inb(22)/2/
+      DATA (iirnf(jc,22),jc=1,jpcoef)/ 446, 447, 18*0 /
+      DATA (ijrnf(jc,22),jc=1,jpcoef)/ 160, 160, 18*0 /
+      DATA (zrnfm(jm,22),jm=1,jpmois)/   &
+          882.,     587.,     519.,     482.,     623.,     984.,   &
+          1120.,   1294.,    1092.,    1166.,    1105.,    1038./
+      ! 23- Tocantins :  ~48W00 ~0.5S                       R4
+      ! UNESCO(76-77+80-81, p335)=12167m3/s (station far inland!)
+      ! --> 12173.082m3/s
+      DATA inb(23)/4/
+      DATA (iirnf(jc,23),jc=1,jpcoef)/ 479, 480, 481, 482, 16*0 /
+      DATA (ijrnf(jc,23),jc=1,jpcoef)/ 249, 249, 249, 249, 16*0 /
+      DATA (zrnfm(jm,23),jm=1,jpmois)/   &
+          15507.,  24855.,  27854.,  24257.,  15860.,   7861.,   &
+          4440.,   3082.,   2728.,   3417.,   5511.,  10705. /
+
+      DATA inb(24)/0/
+      DATA inb(25)/0/
+
+      ! Total run-offs(II)=256755.75
+      ! Total run-offs(I+II)=317730
+
+      ! III EUROPE
+      ! ----------
+      ! 26-Rhone (France) 43N20 4E50                        R1 
+      ! Old=49 km3/year=1553m3/s; UNESCO(65-83, p512)=1229
+      ! --> 1217.16663m3/s
+      DATA inb(26)/1/
+      DATA (iirnf(jc,26),jc=1,jpcoef)/ 584, 19*0 /
+      DATA (ijrnf(jc,26),jc=1,jpcoef)/ 347, 19*0 /
+      DATA (zrnfm(jm,26),jm=1,jpmois)/   &
+          1385.,    1848.,    1568.,    1311.,    1420.,    1191.,   &
+           937.,     796.,     794.,     962.,    1161.,    1233./
+      ! 27-Po (Italy) 11N10 1W09                            R1 
+      ! Old=46 km3/year=1458m3/s; UNESCO(65-84, p527)=1550m3/s
+      ! --> 1550.08337m3/s
+      DATA inb(27)/1/
+      DATA (iirnf(jc,27),jc=1,jpcoef)/ 599, 19*0 /
+      DATA (ijrnf(jc,27),jc=1,jpcoef)/ 355, 19*0 /
+      DATA (zrnfm(jm,27),jm=1,jpmois)/   &
+          1304.,    1605.,    1856.,    1549.,    1958.,    1760.,   &
+          1040.,    1007.,    1615.,    1907.,    1772.,    1228./
+      ! 28-Danube (Roumania) 45N20 29E40                    R1 
+      ! Old=206 km3/year=6527m3/s; UNESCO(65-84, p544)=7011m3/s
+      ! --> 7011.8335m3/s
+      DATA inb(28)/2/
+      DATA (iirnf(jc,28),jc=1,jpcoef)/ 632, 632, 18*0 /
+      DATA (ijrnf(jc,28),jc=1,jpcoef)/ 356, 357, 18*0 /
+      DATA (zrnfm(jm,28),jm=1,jpmois)/   &
+          6625.,    7352.,    7986.,    9279.,    9482.,    8618.,   &
+          7586.,    6001.,    5210.,    4989.,    4921.,    6093./
+
+      DATA inb(29)/0/
+      DATA inb(30)/0/
+
+      ! Total run-offs(III)=9779.08301m3/s
+      ! Total run-offs(I+II+III)=327509.094m3/s
+      
+      ! IV EURASIAN ARCTIC
+      ! ------------------
+      ! 31-Iana (Russia)                                    R1
+      ! Old=29 km3/year=919m3/s; UNESCO(65-72+74+76-84, p463)=936m3/s
+      ! --> 0m3/s
+      DATA inb(31)/0/
+      DATA (iirnf(jc,31),jc=1,jpcoef)/ 20*0 /
+      DATA (ijrnf(jc,31),jc=1,jpcoef)/ 20*0 /
+      DATA (zrnfm(jm,31),jm=1,jpmois)/   &
+             2.,       1.,       0.,       0.,     917.,    3514.,   &
+          2968.,    2329.,    1322.,     178.,      36.,       8./ 
+      ! 32-Ob (Russia) 66N45 69E30                          R1 
+      ! Old=385 km3/year=12200m3/s; UNESCO(65-84, p478)=12862m3/s
+      ! --> 12861.5m3/s
+      DATA inb(32)/8/
+      DATA (iirnf(jc,32),jc=1,jpcoef)/ 635, 635, 636, 636, 636,637, 637,637,12*0 /
+      DATA (ijrnf(jc,32),jc=1,jpcoef)/ 508, 509, 509, 508, 507,509, 508,507,12*0 /
+      DATA (zrnfm(jm,32),jm=1,jpmois)/   &
+           4977.,    4150.,    3611.,    3590.,   14723.,   33366.,   &
+          30773.,   22785.,   14701.,    9705.,    6078.,    5879./
+      ! 33-Yenesei (Russia) 71N50 82E40                     R1 
+      ! Old=560 km3/year=17745m3/s; UNESCO(65-84, p472)=17462m3/s
+      ! --> 17461.666m3/s
+      DATA inb(33)/9/
+      DATA (iirnf(jc,33),jc=1,jpcoef)/ 114,115,115,116, 117,117,117,118,118,11*0 /
+      DATA (ijrnf(jc,33),jc=1,jpcoef)/ 504,504,503,503, 501,502,503,502,501,11*0 /
+      DATA (zrnfm(jm,33),jm=1,jpmois)/   &
+           6659.,    7007.,    6895.,    7089.,   24183.,   74965.,   &
+          25325.,   15940.,   16050.,   12678.,    6741.,    6008./
+      ! 34-Severnaya Dvina(Russia)64N32 40E30               R5 
+      ! Old=106 km3/year=3359m3/s; not in UNESCO data base
+      ! --> 3359.00024m3/s
+      DATA inb(34)/2/
+      DATA (iirnf(jc,34),jc=1,jpcoef)/ 620, 620, 18*0 /
+      DATA (ijrnf(jc,34),jc=1,jpcoef)/ 448, 449, 18*0 /
+      DATA (zrnfm(jm,34),jm=1,jpmois)/12*3359./
+      ! 35-Lena (Russia) 72N25 126E40                       R1 
+      ! --> 16192.333m3/s
+      DATA inb(35)/9/
+      DATA (iirnf(jc,35),jc=1,jpcoef)/ 142,143,148,148,149,149,150,150,150,11*0 /
+      DATA (ijrnf(jc,35),jc=1,jpcoef)/ 458,458,456,448,449,448,451,450,449,11*0 /
+      DATA (zrnfm(jm,35),jm=1,jpmois)/   &
+           2663.,    2095.,    1629.,    1324.,    7203.,   64230.,   &
+          40810.,   28310.,   25995.,   13299.,    3673.,    3077./
+      ! 36-Kolyma (Russia) 69N30 161E00                     R1
+      ! Old=71 km3/year=2250m3/s; UNESCO(65-84)=2138m3/s
+      ! --> 2138.66675m3/s
+      DATA inb(36)/2/
+      DATA (iirnf(jc,36),jc=1,jpcoef)/ 184, 185, 18*0 /
+      DATA (ijrnf(jc,36),jc=1,jpcoef)/ 429, 429, 18*0 /
+      DATA (zrnfm(jm,36),jm=1,jpmois)/   &
+           131.,      92.,      76.,      65.,    2576.,    9143.,   &
+          4670.,    3727.,    3226.,    1119.,     630.,     209./
+      ! 37-Indigirka (russia) 70N48 148E54                  R1 
+      ! Old=55 km3/year=1743m3/s; UNESCO(65-68+70+72-84)=1622.
+      ! --> 1622.00012m3/s
+      DATA inb(37)/1/
+      DATA (iirnf(jc,37),jc=1,jpcoef)/ 172, 19*0 /
+      DATA (ijrnf(jc,37),jc=1,jpcoef)/ 438, 19*0 /
+      DATA (zrnfm(jm,37),jm=1,jpmois)/   &
+            32.,      17.,      11.,       7.,     354.,    5629.,   &
+          5210.,    4617.,    2823.,     559.,     142.,      63./
+
+      DATA inb(38)/0/
+      DATA inb(39)/0/
+      DATA inb(40)/0/
+
+      ! Total run-offs(IV)=40773.6641m3/s
+      ! Total run-offs(I+II+III+IV)=368282.75m3/s
+
+      ! V ASIA
+      ! ------
+      ! 41-Amur (Russia) 52N56 141E10                       R2
+      ! Old=325 km3/year=10299m3/s; UNESCO(65-84, p451)=8792m3/s; ratio=1.17
+      ! --> 10299.332m3/s
+      DATA inb(41)/2/
+      DATA (iirnf(jc,41),jc=1,jpcoef)/ 141, 141, 18*0 /
+      DATA (ijrnf(jc,41),jc=1,jpcoef)/ 381, 382, 18*0 /
+      DATA (zrnfm(jm,41),jm=1,jpmois)/   &
+           2108.,    1543.,    1252.,    4088.,   15464.,   17336.,   &
+          16100.,   20801.,   21548.,   15658.,    5188.,    2506./
+      ! 42-Liaohe (China) 40N40 122E09                      R5
+      ! Old=6 km3/year=190m3/s; not found in UNESCO data base
+      ! --> 189.999985m3/s
+      DATA inb(42)/1/
+      DATA (iirnf(jc,42),jc=1,jpcoef)/ 100, 19*0 /
+      DATA (ijrnf(jc,42),jc=1,jpcoef)/ 342, 19*0 /
+      DATA (zrnfm(jm,42),jm=1,jpmois)/12*190./
+      ! 43-Daling (China) 40N56 121E43                      R5
+      ! Old=1 km3/year=32m3/s; not found in UNESCO data base
+      ! --> 31.9999962m3/s
+      DATA inb(43)/2/
+      DATA (iirnf(jc,43),jc=1,jpcoef)/  99, 100, 18*0 /
+      DATA (ijrnf(jc,43),jc=1,jpcoef)/ 342, 342, 18*0 /
+      DATA (zrnfm(jm,43),jm=1,jpmois)/12*32./
+      ! 44-Haiho (China) 6N17   1E23
+      ! Old=2 km3/year=64m3/s; not found in UNESCO data base
+      ! --> 63.9999924m3/s
+      DATA inb(44)/1/
+      DATA (iirnf(jc,44),jc=1,jpcoef)/ 121, 19*0 /
+      DATA (ijrnf(jc,44),jc=1,jpcoef)/ 348, 19*0 /
+      DATA (zrnfm(jm,44),jm=1,jpmois)/12*64./
+      ! 45-Yellow/Huangho (China) 37N32 118E19              R2 
+      ! Old=49 km3/year=1553m3/s; UNESCO(p371)=1210m3/s; ratio=1.28
+      ! --> 1552.5m3/s
+      DATA inb(45)/3/
+      DATA (iirnf(jc,45),jc=1,jpcoef)/  92,  92,  92, 17*0 /
+      DATA (ijrnf(jc,45),jc=1,jpcoef)/ 336, 337, 338, 17*0 /
+      DATA (zrnfm(jm,45),jm=1,jpmois)/   &
+           697.,     674.,    1282.,    1206.,    1109.,     778.,   &
+          1964.,    3270.,    3668.,    2133.,     978.,     871./
+      ! 46-Yangtze (China) 31N48 121E10=Changjiang          R2
+      ! Old=900 km3/year=28520m3/s; UNESCO(p372)=25032m3/s; ratio=1.14
+      ! --> 28519.584m3/s
+      DATA inb(46)/2/
+      DATA (iirnf(jc,46),jc=1,jpcoef)/ 100, 100, 18*0 /
+      DATA (ijrnf(jc,46),jc=1,jpcoef)/ 316, 317, 18*0 /
+      DATA (zrnfm(jm,46),jm=1,jpmois)/   &
+          10994.,   10548.,   13254.,   24097.,   36972.,   47197.,   &
+          53891.,   42070.,   37627.,   30762.,   22046.,   12777./
+      ! 47-Pearl/Zhujiang (China) 23N36 106E34=Xijiang      R2 
+      ! Old=302 km3/year=9570m3/s; UNESCO(76,82, p373)=6987m3/s; ratio=1.37
+      ! --> 9570.75m3/s
+      DATA inb(47)/2/
+      DATA (iirnf(jc,47),jc=1,jpcoef)/  72,  73, 18*0 /
+      DATA (ijrnf(jc,47),jc=1,jpcoef)/ 294, 294, 18*0 /
+      DATA (zrnfm(jm,47),jm=1,jpmois)/   &
+           2357.,    2415.,    2634.,    6446.,   14246.,   18395.,   &
+          19213.,   17558.,   12312.,    7255.,    5864.,    6154./
+      ! 48-Red/Hungho (Vietnam) 20N17 106E34                R5 
+      ! Old=123 km3/year=3897m3/s; not in UNESCO data base
+      ! --> 3897.m3/s
+      DATA inb(48)/3/
+      DATA (iirnf(jc,48),jc=1,jpcoef)/  68,  68,  68, 17*0 /
+      DATA (ijrnf(jc,48),jc=1,jpcoef)/ 288, 289, 290, 17*0 /
+      DATA (zrnfm(jm,48),jm=1,jpmois)/12*3897./
+      ! 49-Mekong (Vietnam) 10N33 105E24                    R5
+      ! Old=470 km3/year=14893m3/s; not in UNESCO data base
+      ! --> 14893.0029m3/s
+      DATA inb(49)/3/
+      DATA (iirnf(jc,49),jc=1,jpcoef)/  69,  69,  70, 17*0 /
+      DATA (ijrnf(jc,49),jc=1,jpcoef)/ 269, 270, 270, 17*0 /
+      DATA (zrnfm(jm,49),jm=1,jpmois)/12*14893./
+      ! 50-Irrawady (Burma) 15N50  95E06                    R5
+      ! Old=428 km3/year=13563m3/s; not in UNESCO data base
+      ! --> 13563.m3/s
+      DATA inb(50)/2/
+      DATA (iirnf(jc,50),jc=1,jpcoef)/  44,  45, 18*0 /
+      DATA (ijrnf(jc,50),jc=1,jpcoef)/ 283, 282, 18*0 /
+      DATA (zrnfm(jm,50),jm=1,jpmois)/12*13563./
+      ! 51-Ganges+Brahmaputra (Beng.) 22N00  91E00          R1
+      ! Old=971 km3/year=30769m3/s; UNESCO(69-70+73-75, p367)=31760m3/s
+      ! --> 32147.498m3/s
+      DATA inb(51)/4/
+      DATA (iirnf(jc,51),jc=1,jpcoef)/  36,  37,  38,  39, 16*0 /
+      DATA (ijrnf(jc,51),jc=1,jpcoef)/ 295, 295, 295, 295, 16*0 /
+      DATA (zrnfm(jm,51),jm=1,jpmois)/   &
+           6623.,    6315.,    6432.,    9410.,   17263.,   38302.,   &
+          64688.,   80338.,   84802.,   43387.,   17888.,   10322./
+      ! 52-Mehandi (India)                                  R5
+      ! Old=67 km3/year=2123m3/s; not in UNESCO data base
+      ! --> 0m3/s
+      DATA inb(52)/0/
+      DATA (iirnf(jc,52),jc=1,jpcoef)/ 20*0 /
+      DATA (ijrnf(jc,52),jc=1,jpcoef)/ 20*0 /
+      DATA (zrnfm(jm,52),jm=1,jpmois)/12*2123./
+      ! 53-Damodar (India)                                  R2
+      ! Old=10 km3/year=320m3/s; UNESCO(p386)=173m3/s; ratio=1.85
+      ! --> 432.916656m3/s
+      DATA inb(53)/1/
+      DATA (iirnf(jc,53),jc=1,jpcoef)/  30, 19*0 /
+      DATA (ijrnf(jc,53),jc=1,jpcoef)/ 294, 19*0 /
+      DATA (zrnfm(jm,53),jm=1,jpmois)/   &
+           51.,      37.,      42.,      49.,      85.,     296.,   &
+          896.,    1390.,    1591.,     542.,     172.,      44./   
+      ! 54-Godavari (India) 17N00  81E45                    R2
+      ! Old=84 km3/year=2662m3/s; UNESCO(p379)=1916m3/s; ratio=1.39
+      ! --> 3670.5m3/s
+      DATA inb(54)/1/
+      DATA (iirnf(jc,54),jc=1,jpcoef)/  19, 19*0 /
+      DATA (ijrnf(jc,54),jc=1,jpcoef)/ 283, 19*0 /
+      DATA (zrnfm(jm,54),jm=1,jpmois)/   &
+           988.,     737.,     280.,     219.,     196.,    1691.,   &
+          8063.,   14571.,   11428.,    3953.,    1221.,     699./   
+      ! 55-Indus (Pakistan) 24N20  67E47             R2
+      ! Old=238 km3/year=7542m3/s; UNESCO (76-79, p428)=2396m3/s; ratio=3.15
+      ! --> 7562.m3/s
+      DATA inb(55)/4/
+      DATA (iirnf(jc,55),jc=1,jpcoef)/ 711, 711, 712, 713, 16*0 /
+      DATA (ijrnf(jc,55),jc=1,jpcoef)/ 297, 298, 297, 297, 16*0 /
+      DATA (zrnfm(jm,55),jm=1,jpmois)/   &
+            988.,     737.,    1904.,    1968.,    3625.,    6143.,   &
+          15969.,    36656.,  17173.,    3215.,    1251.,    1115./   
+      ! 56-Tigris and Euphrates (Iraq) 31N00  47E25         R1
+      ! Old=46 km3/year=1458m3/s; UNESCO(76-79, p428)=2396m3/s
+      ! --> 2248.8335m3/s
+      DATA inb(56)/3/
+      DATA (iirnf(jc,56),jc=1,jpcoef)/ 673, 673, 674, 17*0 /
+      DATA (ijrnf(jc,56),jc=1,jpcoef)/ 312, 313, 313, 17*0 /
+      DATA (zrnfm(jm,56),jm=1,jpmois)/   &
+          1872.,    2127.,    2962.,    4944.,    5036.,    3078.,   &
+          1362.,     900.,     786.,     993.,    1184.,    1742./   
+
+      DATA inb(57)/0/
+      DATA inb(58)/0/
+      DATA inb(59)/0/
+      DATA inb(60)/0/
+
+      ! Total run-offs (V)=128642.922m3/s
+      ! Total run-offs (I+II+III+IV+V)=496925.688m3/s
+
+      ! VI AFRICA
+      ! ----------
+      ! 61-Nile (Egypt) 30N10  31E06                        R1
+      ! Old=30 km3/year=951m3/s; UNESCO(73-84)=1251m3/s
+      ! --> 1251.33337m3/s
+      DATA inb(61)/3/
+      DATA (iirnf(jc,61),jc=1,jpcoef)/ 636, 636, 637, 17*0 /
+      DATA (ijrnf(jc,61),jc=1,jpcoef)/ 317, 318, 318, 17*0 /
+      DATA (zrnfm(jm,61),jm=1,jpmois)/   &
+          1239.,    1035.,    1126.,    1110.,    1170.,    1542.,   &
+          1742.,    1559.,    1191.,    1103.,    1075.,    1124./   
+      ! 62-Niger (Nigeria) 5N33   6E33                      R1
+      ! Old=192 km3/year=6084m3/s; HLA=5545m3/s;
+      ! Data from HLA: 4.5N -  6  E   1950/87
+      ! --> 5545.08301m3/s
+      DATA inb(62)/3/
+      DATA (iirnf(jc,62),jc=1,jpcoef)/ 591, 592, 593, 17*0 /
+      DATA (ijrnf(jc,62),jc=1,jpcoef)/ 258, 258, 258, 17*0 /
+      DATA (zrnfm(jm,62),jm=1,jpmois)/   &
+          2029.,    1804.,    1573.,    1418.,    1494.,    2561.,   &
+          5272.,    9629.,   14951.,   16227.,    6842.,    2741./   
+      ! 63-Zaire/Congo (Congo) 6S04  12E24                  R1      
+      ! Old=1250 km3/year=39610m3/s; UNESCO(65-83, p149)=41941m3/s; HLA
+      ! =39720m3/s
+      ! Data from HLA: 6S - 12  E   1902/96
+      ! --> 39719.5m3/s
+      DATA inb(63)/4/
+      DATA (iirnf(jc,63),jc=1,jpcoef)/ 599, 599, 600, 600, 16*0 /
+      DATA (ijrnf(jc,63),jc=1,jpcoef)/ 237, 238, 236, 237, 16*0 /
+      DATA (zrnfm(jm,63),jm=1,jpmois)/   &
+          47200.,   37692.,   34374.,   36603.,   37862.,   35588.,   &
+          30966.,   30774.,   35981.,   42825.,   51455.,   55314./  
+      ! 64-Orange (Sth Africa) 28S41 16E28                  R5
+      ! Old=11 km3/year=349m3/s
+      ! --> 349.000031m3/s
+      DATA inb(64)/2/
+      DATA (iirnf(jc,64),jc=1,jpcoef)/ 609, 609, 18*0 /
+      DATA (ijrnf(jc,64),jc=1,jpcoef)/ 188, 189, 18*0 /
+      DATA (zrnfm(jm,64),jm=1,jpmois)/12*349./
+      ! 65-Zambesi (Mozambique) 18S55 36E04                 R5
+      ! Old=223 km3/year=7066m3/s
+      ! --> 7066.00049m3/s
+      DATA inb(65)/3/
+      DATA (iirnf(jc,65),jc=1,jpcoef)/ 646, 646, 646, 17*0 /
+      DATA (ijrnf(jc,65),jc=1,jpcoef)/ 207, 208, 209, 17*0 /
+      DATA (zrnfm(jm,65),jm=1,jpmois)/12*7066./
+      ! 66-Limpopo (mozambique) 25S15 33E30                 R5
+      ! Old=5 km3/year=158m3/s
+      ! --> 158.m3/s
+      DATA inb(66)/2/
+      DATA (iirnf(jc,66),jc=1,jpcoef)/ 642, 642, 18*0 /
+      DATA (ijrnf(jc,66),jc=1,jpcoef)/ 196, 197, 18*0 /
+      DATA (zrnfm(jm,66),jm=1,jpmois)/12*158./
+      ! 67-Rufiji (tanzania) 8S00 39E20                     R5
+      ! Old=9 km3/year=285m3/s
+      ! --> 285.m3/s
+      DATA inb(67)/1/
+      DATA (iirnf(jc,67),jc=1,jpcoef)/ 655, 19*0 /
+      DATA (ijrnf(jc,67),jc=1,jpcoef)/ 235, 19*0 /
+      DATA (zrnfm(jm,67),jm=1,jpmois)/12*285./
+      ! Other rivers from the Gulf of Guinea
+      ! 68-Kouilou (Congo)  4.5S-11.5E (UNESCO=p51)         R1
+      ! Data from HLA:  4S - 11  E   1953/86 = 919m3/s
+      ! --> 924.25m3/s
+      DATA inb(68)/1/
+      DATA (iirnf(jc,68),jc=1,jpcoef)/ 599, 19*0 /
+      DATA (ijrnf(jc,68),jc=1,jpcoef)/ 241, 19*0 /
+      DATA (zrnfm(jm,68),jm=1,jpmois)/   &
+          1115.,    1166.,    1285.,    1462.,    1454.,     725.,   &
+           480.,     378.,     327.,     400.,    1018.,    1281./
+      ! 69-Nyanga (Gabon)  3S-10E (UNESCO=p66)              R1
+      ! Data from HLA: 2.8N - 10  E   1952/82 = 264m3/s
+      ! --> 264.166687m3/s
+      DATA inb(69)/1/
+      DATA (iirnf(jc,69),jc=1,jpcoef)/ 595, 19*0 /
+      DATA (ijrnf(jc,69),jc=1,jpcoef)/ 244, 19*0 /
+      DATA (zrnfm(jm,69),jm=1,jpmois)/   &
+          126.,      99.,     143.,     253.,     316.,     300.,   &
+          156.,      93.,     231.,     557.,     592.,     304./
+      ! 70-Ogoue (Gabon) 1S-9E (UNESCO, p69)                R1
+      ! Data from HLA: .75S -  9  E   1930/90 = 4512m3/s
+      ! --> 4511.83301m3/s
+      DATA inb(70)/2/
+      DATA (iirnf(jc,70),jc=1,jpcoef)/ 593, 593, 18*0 /
+      DATA (ijrnf(jc,70),jc=1,jpcoef)/ 247, 248, 18*0 /
+      DATA (zrnfm(jm,70),jm=1,jpmois)/   &
+          4514.,    3988.,    4622.,    5403.,    5790.,    4145.,   &
+          2616.,    1961.,    2119.,    4304.,    7870.,    6810./
+      ! 71-Sanaga (Cameroun) 3.5N-9.5E (UNESCO, p31)        R1
+      ! Data from HLA: 3.9N -  9.6E   1944/80 = 1983m3/s
+      ! --> 1982.58337m3/s
+      DATA inb(71)/2/
+      DATA (iirnf(jc,71),jc=1,jpcoef)/ 595, 595, 18*0 /
+      DATA (ijrnf(jc,71),jc=1,jpcoef)/ 255, 256, 18*0 /
+      DATA (zrnfm(jm,71),jm=1,jpmois)/   &
+           813.,     578.,     517.,     633.,     909.,    1278.,   &
+          1928.,    2653.,    4361.,    5470.,    3307.,    1344./
+      ! 72-Nyong (Cameroun) 3.1N-9.5E (UNESCO, p36)         R1
+      ! Data from HLA: 3.5N -  9.8E   1951/84 = 432m3/s
+      ! --> 431.166656m3/s      
+      DATA inb(72)/1/
+      DATA (iirnf(jc,72),jc=1,jpcoef)/ 594, 19*0 /
+      DATA (ijrnf(jc,72),jc=1,jpcoef)/ 257, 19*0 /
+      DATA (zrnfm(jm,72),jm=1,jpmois)/   &
+          232.,     128.,     150.,     266.,     402.,     459.,   &
+          353.,     306.,     604.,     930.,     878.,     466./
+      ! 73-Ntem (Cameroun) 2.5N-9.5E (UNESCO, p36)          R1
+      ! Data from HLA: 3N -  9.8E   1951/87 = 330m3/s      
+      ! --> 329.75m3/s
+      DATA inb(73)/1/
+      DATA (iirnf(jc,73),jc=1,jpcoef)/ 594, 19*0 /
+      DATA (ijrnf(jc,73),jc=1,jpcoef)/ 254, 19*0 /
+      DATA (zrnfm(jm,73),jm=1,jpmois)/   &
+          452.,     455.,     492.,     466.,     482.,     251.,   &
+          151.,     108.,      87.,     133.,     395.,     485./
+      ! 74-Wouri (Cameroun) 4N-9.5E (UNESCO, p34)           R1
+      ! Data from HLA: 4N -  9.5E   1951/84  = 307m3/s
+      ! --> 306.583374m3/s
+      DATA inb(74)/1/
+      DATA (iirnf(jc,74),jc=1,jpcoef)/ 594, 19*0 /
+      DATA (ijrnf(jc,74),jc=1,jpcoef)/ 258, 19*0 /
+      DATA (zrnfm(jm,74),jm=1,jpmois)/   &
+           88.,      63.,      68.,      95.,     139.,     222.,   &
+          395.,     633.,     825.,     675.,     328.,     148./
+      ! 75-Oueme (Benin) 6.5N-2.5E (UNESCO, p27)            R1
+      ! Data from HLA:  6.2N -  2.5E   1951/84 =113m3/s
+      ! --> 112.666664m3/s
+      DATA inb(75)/1/
+      DATA (iirnf(jc,75),jc=1,jpcoef)/ 583, 19*0 /
+      DATA (ijrnf(jc,75),jc=1,jpcoef)/ 262, 19*0 /
+      DATA (zrnfm(jm,75),jm=1,jpmois)/   &
+           0.,       0.,       0.,       0.,       1.,      18.,   &
+          96.,     324.,     531.,     319.,      58.,       5./
+      ! 76-Mono(Tepetou,Benin/Togo) 6.25N-1.8E (U, p27)     R1
+      ! Data from HLA: 6.2N -  1  E   1951/85  = 96m3/s       
+      ! --> 96.4999924m3/s
+      DATA inb(76)/2/
+      DATA (iirnf(jc,76),jc=1,jpcoef)/ 578, 579, 18*0 /
+      DATA (ijrnf(jc,76),jc=1,jpcoef)/ 262, 262, 18*0 /
+      DATA (zrnfm(jm,76),jm=1,jpmois)/   &
+            2.,       1.,       1.,       4.,       8.,      44.,   &
+          168.,     274.,     386.,     215.,      47.,       8./
+      ! 77-Comoe (Ivory Coast) 5N-4W (UNESCO, p56)          R1
+      ! Data from HLA: 5.1N -  4  W   1955/86 = 194m3/s       
+      ! --> 194.25m3/s
+      DATA inb(77)/1/
+      DATA (iirnf(jc,77),jc=1,jpcoef)/ 569, 19*0 /
+      DATA (ijrnf(jc,77),jc=1,jpcoef)/ 260, 19*0 /
+      DATA (zrnfm(jm,77),jm=1,jpmois)/   &
+           14.,       7.,       9.,      17.,      29.,      90.,   &
+          145.,     349.,     740.,     688.,     198.,      45./
+      ! 78-Sassandra (Ivory Coast) 5N-6W (UNESCO, p58)      R1
+      ! Data from HLA: 5N -  6  W   1953/86 = 449m3/s
+      ! --> 449.333344m3/s
+      DATA inb(78)/1/
+      DATA (iirnf(jc,78),jc=1,jpcoef)/ 564, 19*0 /
+      DATA (ijrnf(jc,78),jc=1,jpcoef)/ 260, 19*0 /
+      DATA (zrnfm(jm,78),jm=1,jpmois)/   &
+          144.,     116.,     119.,     143.,     156.,     334.,   &
+          419.,     692.,    1277.,    1190.,     553.,     249./
+      
+      DATA inb(79)/0/
+      DATA inb(80)/0/
+      DATA inb(82)/0/
+      DATA inb(83)/0/
+      DATA inb(84)/0/
+      DATA inb(85)/0/
+      DATA inb(86)/0/
+      DATA inb(87)/0/
+      DATA inb(88)/0/
+      DATA inb(89)/0/
+      DATA inb(90)/0/
+
+      ! Total run-offs (VI)=63977.m3/s
+      ! Total run-offs (I+II+III+IV+V+VI)=560902.688m3/s
+
+      ! VII OCEANIA
+      ! ------------
+      ! 91-Murray (Austrlia) 35S34 138E54                   R5
+      ! Old=22 km3/year=697m3/s
+      ! --> 696.999939m3/s
+      DATA inb(91)/3/
+      DATA (iirnf(jc,91),jc=1,jpcoef)/ 129, 130, 130, 17*0 /
+      DATA (ijrnf(jc,91),jc=1,jpcoef)/ 177, 176, 177, 17*0 /
+      DATA (zrnfm(jm,91),jm=1,jpmois)/12*697./
+      ! 92-Haast (N. Zeland) 43S50 169E02                   R5
+      ! Old=6 km3/year=190m3/s
+      ! --> 189.999985m3/s
+      DATA inb(92)/1/
+      DATA (iirnf(jc,92),jc=1,jpcoef)/ 194, 19*0 /
+      DATA (ijrnf(jc,92),jc=1,jpcoef)/ 153, 19*0 /
+      DATA (zrnfm(jm,92),jm=1,jpmois)/12*190./
+      ! 93-Fly (N. Guinea) 8S30 143E05                      R5
+      ! Old=77 km3/year=2440m3/s
+      ! --> 2440.m3/s
+      DATA inb(93)/1/
+      DATA (iirnf(jc,93),jc=1,jpcoef)/ 143, 19*0 /
+      DATA (ijrnf(jc,93),jc=1,jpcoef)/ 233, 19*0 /
+      DATA (zrnfm(jm,93),jm=1,jpmois)/12*2440./
+      ! 94-Purari (N. Guinea) 7S25 145E05                   R4
+      ! Old=77 km3/year=2440m3/s; UNESCO(77+83,p595)=2727m3/s
+      ! --> 2727.33325m3/s
+      DATA inb(94)/1/
+      DATA (iirnf(jc,94),jc=1,jpcoef)/ 146, 19*0 /
+      DATA (ijrnf(jc,94),jc=1,jpcoef)/ 234, 19*0 /
+      DATA (zrnfm(jm,94),jm=1,jpmois)/   &
+          1972.,    3067.,    2332.,    2981.,    2693.,    2876.,   &
+          2867.,    3477.,    2195.,    2967.,    2674.,    2627./
+      ! 95-Choshui ch''i (taiwan) 24N03 120E23              R2
+      ! Old=6 km3/year=190m3/s; UNESCO(65-68, p374)=120m3/s; ratio=1.58 
+      ! --> 0.m3/s
+      DATA inb(95)/0/
+      DATA (iirnf(jc,95),jc=1,jpcoef)/  20*0 /
+      DATA (ijrnf(jc,95),jc=1,jpcoef)/  20*0 /
+      DATA (zrnfm(jm,95),jm=1,jpmois)/   &
+           65.,      63.,      83.,     100.,     177.,     535.,   &
+          332.,     313.,     236.,     193.,     101.,      84./
+      ! 96-Kaoping (Taiwan)                                 R5  
+      ! Old=9 km3/year=285m3/s
+      ! --> 0.m3/s
+      DATA inb(96)/0/
+      DATA (iirnf(jc,96),jc=1,jpcoef)/ 20*0 /
+      DATA (ijrnf(jc,96),jc=1,jpcoef)/ 20*0 /
+      DATA (zrnfm(jm,96),jm=1,jpmois)/12*285./
+      ! 97-Tsengwen (Taiwan)                                R5
+      ! Old=2 km3/year=63m3/s
+      ! --> 0.m3/s
+      DATA inb(97)/0/
+      DATA (iirnf(jc,97),jc=1,jpcoef)/ 20*0 /
+      DATA (ijrnf(jc,97),jc=1,jpcoef)/ 20*0 /
+      DATA (zrnfm(jm,97),jm=1,jpmois)/12*63./
+      ! 98-Hualien (Taiwan)                                 R5
+      ! Old=4 km3/year=127m3/s
+      ! --> 0.m3/s
+      DATA inb(98)/0/
+      DATA (iirnf(jc,98),jc=1,jpcoef)/ 20*0 /
+      DATA (ijrnf(jc,98),jc=1,jpcoef)/ 20*0 /
+      DATA (zrnfm(jm,98),jm=1,jpmois)/12*127./
+      ! 99-Peinan (Taiwan) 22N46 121E10                     R5
+      ! Old=4 km3/year=127m3/s
+      ! --> 127.000008m3/s
+      DATA inb(99)/1/
+      DATA (iirnf(jc,99),jc=1,jpcoef)/  98, 19*0 /
+      DATA (ijrnf(jc,99),jc=1,jpcoef)/ 287, 19*0 /
+      DATA (zrnfm(jm,99),jm=1,jpmois)/12*127./
+      ! 100-Hsiukuluan (Taiwan)                             R5
+      ! Old=4 km3/year=127m3/s
+      ! --> 0.m3/s
+      DATA inb(100)/0/
+      DATA (iirnf(jc,100),jc=1,jpcoef)/ 20*0 /
+      DATA (ijrnf(jc,100),jc=1,jpcoef)/ 20*0 /
+      DATA (zrnfm(jm,100),jm=1,jpmois)/12*127./
+
+      DATA inb(101)/0/
+      DATA inb(102)/0/
+
+      !  Total run-offs(VII)=6181.33301m3/s
+      !  Total run-offs(I+II+III+IV+V+VI+VII)= 567084. m3/s
+      !                                      = 1.588668056E-6 kg/m2/s
+      !                                      = 17883.5586 km3/Year
+      !                                      = 0.567083955 Sverdrup
+
+      DATA (inb(jr),jr=103,jpriv)/18*0/
+      
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'flxrnf : runoff + orca05'
+         IF(lwp) WRITE(numout,*) '~~~~~~'
+         IF(lwp) WRITE(numout,*) '   nrunoff = ', nrunoff
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      ! 0. initialization and  indexes  modification for zoom version
+      ! --------------------------------------------------------------
+      
+      
+      ! conversion factor m3/s --> kg/m2/s *e1t*e2t
+
+      zconv = rauw
+
+      IF( kt == nit000 ) THEN 
+         ! Set runoffs and upstream coeff to zero
+         runoff (:,:) = 0.e0                                                                                  
+         upsrnfh(:,:) = 0.e0
+         upsrnfz(:)   = 0.e0
+         upsadv (:,:) = 0.e0
+         zcoefr(:,:,:) = 0.e0
+
+         IF( nrunoff == 0 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' NO RUNOFF in this simulation '
+            IF(lwp) WRITE(numout,*)
+         ENDIF
+      ENDIF
+
+      ! 1. initialization of the runoff array
+      ! -------------------------------------
+
+      IF( nrunoff == 1 .OR. nrunoff == 2) THEN
+
+         iman  = jpmois
+         
+         i15 = nday / 16
+         
+         imois = nmonth + i15 - 1
+         IF( imois == 0) imois = iman
+         IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
+            ! Number of Day Between Data
+            idbd = nbiss(imois)
+         ELSEIF( nleapy > 1 ) THEN
+            idbd = nleapy
+         ELSE
+            idbd = nobis(imois)
+         END IF
+         ! Number of days between imois, 15 and the end of month
+         idmeom = idbd - 15
+         
+         ! 1.1 Calendar computation
+         
+         ! nrnf1 number of the first array record used in the simulation
+         ! nrnf2 number of the last  array record
+         
+         nrnf1 = imois
+         nrnf2 = nrnf1 + 1
+         nrnf1 = MOD( nrnf1, iman )
+         IF( nrnf1 == 0 ) nrnf1 = iman
+         nrnf2 = MOD( nrnf2, iman )
+         IF( nrnf2 == 0 ) nrnf2 = iman
+         
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'flxrnf routine'
+            IF(lwp) WRITE(numout,*) 'first array record used nrnf1 ',nrnf1
+            IF(lwp) WRITE(numout,*) 'last  array record used nrnf2 ',nrnf2
+         ENDIF
+
+         zxy = FLOAT( nday + idmeom - idbd * i15 ) / idbd
+
+         DO jr = 1, jpriv-1
+            inbp = inb(jr)
+            IF( inbp /= 0 ) THEN
+               DO jl = 1, inbp
+                  DO jj = mj0(ijrnf(jl,jr)), mj1(ijrnf(jl,jr))
+                     DO ji = mi0(iirnf(jl,jr)), mi1(iirnf(jl,jr))
+                        runoff(ji,jj) = runoff(ji,jj)   & 
+                           &          + ( (1.-zxy) * zrnfm(nrnf1,jr)   &
+                           &          +       zxy  * zrnfm(nrnf2,jr)  ) / FLOAT(inbp)
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+         END DO
+
+
+         ! 2. conversion in mm/day
+         ! -----------------------
+         !     C a u t i o n : upward water flux, runoff is negative
+
+         runoff(:,:) = -zconv * runoff(:,:) / ( e1t(:,:) * e2t(:,:) )
+         
+
+         ! 3. advectve coefficient
+         ! -----------------------
+
+         !  Creates the array coef that contains the coefficient to affect to
+         !  the upstream scheme. advection scheme will be:
+         !  coefr * upstream + (1- coefr) centered
+         !  coefr must be between 0 and 1.
+         !  3 values are used: maximum = zrup1, between zrup2, small zrup3.
+         ! 
+         IF( nrunoff == 2 .AND. kt == nit000 ) THEN
+
+            zrup1 = 0.5
+            zrup2 = 0.25
+            zrup3 = 0.125
+            DO jr = 1, jpriv-1
+               inbp = inb(jr)
+               IF( inbp /= 0) THEN
+                  DO jl = 1, inbp
+                     ! ji,jj
+                     DO jj = mj0(ijrnf(jl,jr)), mj1(ijrnf(jl,jr))
+                        DO ji = mi0(iirnf(jl,jr)), mi1(iirnf(jl,jr))
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = zrup1
+                           END DO
+                           zcoefr(ji,jj,4) = zrup2
+                           zcoefr(ji,jj,5) = zrup3
+                        END DO
+                     END DO
+                     ! --> zrup2 (originally = 0.5)
+                     ! ji,jj+1
+                     DO jj = mj0(ijrnf(jl,jr) + 1), mj1(ijrnf(jl,jr) + 1)
+                        DO ji = mi0(iirnf(jl,jr)), mi1(iirnf(jl,jr))
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji,jj-1
+                     DO jj = mj0(ijrnf(jl,jr) - 1), mj1(ijrnf(jl,jr) - 1)
+                        DO ji = mi0(iirnf(jl,jr)), mi1(iirnf(jl,jr))
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj-1
+                     DO jj = mj0(ijrnf(jl,jr) - 1), mj1(ijrnf(jl,jr) - 1)
+                        DO ji = mi0(iirnf(jl,jr) + 1), mi1(iirnf(jl,jr) + 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj
+                     DO jj = mj0(ijrnf(jl,jr)), mj1(ijrnf(jl,jr))
+                        DO ji = mi0(iirnf(jl,jr) + 1), mi1(iirnf(jl,jr) + 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj+1
+                     DO jj = mj0(ijrnf(jl,jr) + 1), mj1(ijrnf(jl,jr) + 1)
+                        DO ji = mi0(iirnf(jl,jr) + 1), mi1(iirnf(jl,jr) + 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj+1
+                     DO jj = mj0(ijrnf(jl,jr) + 1), mj1(ijrnf(jl,jr) + 1)
+                        DO ji = mi0(iirnf(jl,jr) - 1), mi1(iirnf(jl,jr) - 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj
+                     DO jj = mj0(ijrnf(jl,jr)), mj1(ijrnf(jl,jr))
+                        DO ji = mi0(iirnf(jl,jr) - 1), mi1(iirnf(jl,jr) - 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj-1
+                     DO jj = mj0(ijrnf(jl,jr) - 1), mj1(ijrnf(jl,jr) - 1)
+                        DO ji = mi0(iirnf(jl,jr) - 1), mi1(iirnf(jl,jr) - 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! --> zrup3 (originally = 0.25)
+                     ! ji-1,jj+2
+                     DO jj = mj0(ijrnf(jl,jr) + 2), mj1(ijrnf(jl,jr) + 2)
+                        DO ji = mi0(iirnf(jl,jr) - 1), mi1(iirnf(jl,jr) - 1)
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-1,jj-2
+                     ijpt0 = MAX( 1, MIN( ij-2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji,jj-2
+                     iipt0 = MAX( 1, MIN( ii,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+1,jj-2
+                     iipt0 = MAX( 1, MIN( ii+1,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+1,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+1,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj-2
+                     iipt0 = MAX( 1, MIN( ii+2,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+2,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3  
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj
+                     ijpt0 = MAX( 1, MIN( ij,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj
+                     iipt0 = MAX( 1, MIN( ii-2,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii-2,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3        
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj-2
+                     ijpt0 = MAX( 1, MIN( ij-2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                  END DO
+               ENDIF
+            END DO
+            upsrnfh(:,:) = zcoefr(:,:,1)
+            upsrnfz(:)   = 0.e0
+            upsrnfz(1)   = zrup1
+            upsrnfz(2)   = zrup1
+            upsrnfz(3)   = zrup1
+            upsrnfz(4)   = zrup2
+            upsrnfz(5)   = zrup3
+         ENDIF
+      ENDIF
+    
+#endif
+
+   END SUBROUTINE flx_rnf
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flxrnf_ORCA_R2.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flxrnf_ORCA_R2.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flxrnf_ORCA_R2.h90	(revision 4)
@@ -0,0 +1,1317 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  flxrnf_ORCA_R2.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!                  OLD ORCA R2 runoff specification
+   !!                      kept here for memory
+   !!                         ( 20/04/2000 )
+   !!----------------------------------------------------------------------
+
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER :: kt
+      INTEGER, PARAMETER ::   &
+         jpmois =  12,        &  ! number of months
+         jpriv  = 120,        &  ! maximum number of river
+         jpcoef = 300            ! maximum of river mouth grid-points
+      INTEGER ::   &
+         ji, jj, jl, jm,      &  ! dummy loop indices
+         jn, jr, jc              !    "         "
+      INTEGER ::   &
+         i15, imois, iman,    &  ! temporary integers
+         inbp, idbd, idmeom,  &  !    "          "
+         iipt0, iipt1, ijpt0, &  !    "          "
+         ijpt1, ii, ij           !    "          "
+      INTEGER, DIMENSION(jpriv) ::   &
+         inb                     ! ???
+      INTEGER, DIMENSION(jpcoef,jpriv) ::   &
+         iirnf, ijrnf            ! ???
+
+      REAL(wp) ::   &
+         zconv, zxy,          &  ! temporary scalars
+         zrup1, zrup2, zrup3     !    "         "
+      REAL(wp), DIMENSION(jpmois,jpriv) ::   &
+         zrnfm                   ! ???
+      REAL(wp), DIMENSION(jpi, jpj, 5) ::   &
+         zcoefr                  ! ???
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+      ! ====
+      ! DATA
+      ! ====
+
+      ! I NORTH AMERICA
+      ! ---------------
+
+      ! 1-Saint Lawrence (Canada) 49N30 67W00               R2
+      ! Old=447 km3/year=14165m3/s; CLIPPER=12430m3/s; ratio=1.14
+      ! --> 13975.249m3/s
+      DATA inb(1)/2/
+      DATA (iirnf(jc,1),jc=1,jpcoef)/ 110, 110, 298*0 /
+      DATA (ijrnf(jc,1),jc=1,jpcoef)/ 110, 111, 298*0 /
+      DATA (zrnfm(jm,1),jm=1,jpmois)/   &
+          11718.,  11971.,  12466.,  14980.,  19257.,  16913.,   &
+          14211.,  13119.,  13367.,  13644.,  13463.,  12594./
+      ! 2-Hudson River (USA) 41N00 77W00                    R1
+      ! Old=12 km3/year=380m3/s; UNESCO(64-83,p255)=408m3/s
+      ! --> 407.416687m3/s
+      DATA inb(2)/1/
+      DATA (iirnf(jc,2),jc=1,jpcoef)/ 106, 299*0 /
+      DATA (ijrnf(jc,2),jc=1,jpcoef)/ 104, 299*0 /
+      DATA (zrnfm(jm,2),jm=1,jpmois)/   &
+          364.,    404.,    648.,    873.,    593.,    301.,   &
+          205.,    171.,    205.,    290.,    379.,    456./
+      ! 3-Missisipi and Atchafalaya (USA) 29N 90W           R1 
+      ! Old=580 km3/year=18380m3/s; CLIPPER=17599m3/s
+      ! --> 17599.334m3/s
+      DATA inb(3)/2/
+      DATA (iirnf(jc,3),jc=1,jpcoef)/  97, 98, 298*0 /
+      DATA (ijrnf(jc,3),jc=1,jpcoef)/  97, 97, 298*0 /
+      DATA (zrnfm(jm,3),jm=1,jpmois)/   &
+          19260.,  20813.,  23026.,  28160.,  26510.,  19650.,   &
+          14181.,  10676.,   9578.,  10167.,  11699.,  17472./
+      ! 4-Brazos (USA) 29N58 95W53                          R1
+      ! Old=7 km3/year=222m3/s; UNESCO(65-84, p298)=200m3/s
+      ! --> 199.666656m3/s
+      DATA inb(4)/1/
+      DATA (iirnf(jc,4),jc=1,jpcoef)/  95, 299*0 /
+      DATA (ijrnf(jc,4),jc=1,jpcoef)/  97, 299*0 /
+      DATA (zrnfm(jm,4),jm=1,jpmois)/   &
+          165.,    224.,    200.,    266.,    457.,    327.,   &
+          143.,     69.,    102.,    132.,    160.,    151./
+      ! 5-Colorado (Mexico) 31N54 114W57                    R5
+      ! Old=20 km3/year=634m3/s
+      ! --> 634.m3/s
+      DATA inb(5)/1/
+      DATA (iirnf(jc,5),jc=1,jpcoef)/  88, 299*0 /
+      DATA (ijrnf(jc,5),jc=1,jpcoef)/  94, 299*0 /
+      DATA (zrnfm(jm,5),jm=1,jpmois)/12*634./ 
+      ! 6-Columbia (USA) 45N60 121W17                       R1
+      ! Old=251 km3/year=7954m3/s; UNESCO(65-84, p312)=5368m3/s
+      ! --> 5368.41602m3/s
+      DATA inb(6)/1/
+      DATA (iirnf(jc,6),jc=1,jpcoef)/  79, 299*0 /
+      DATA (ijrnf(jc,6),jc=1,jpcoef)/ 110, 299*0 /
+      DATA (zrnfm(jm,6),jm=1,jpmois)/   &
+          4752.,    5077.,    5633.,    6075.,    8422.,    9822.,   &
+          6350.,    4112.,    3273.,    3251.,    3548.,    4106./ 
+      ! 7-Fraser (USA)                                      R5
+      ! Old=112 km3/year=3550m3/s;not found in UNESCO
+      ! --> 3549.99976m3/s
+      DATA inb(7)/1/
+      DATA (iirnf(jc,7),jc=1,jpcoef)/  77, 299*0 /
+      DATA (ijrnf(jc,7),jc=1,jpcoef)/ 112, 299*0 /
+      DATA (zrnfm(jm,7),jm=1,jpmois)/12*3550./ 
+      ! 8-Yukon (USA) 63N00 165W00                          R3
+      ! Old=195 km3/year=6179m3/s; UNESCO(65-77+80-84, p321)=4245; ratio=1.46
+      ! --> 6017.24951m3/s
+      DATA inb(8)/1/
+      DATA (iirnf(jc,8),jc=1,jpcoef)/  58, 299*0 /
+      DATA (ijrnf(jc,8),jc=1,jpcoef)/ 122, 299*0 /
+      DATA (zrnfm(jm,8),jm=1,jpmois)/   &
+           1459.,    1213.,    1065.,    1100.,    9067.,   17675.,   &
+          10680.,   11271.,    8658.,    5453.,    2649.,    1917./ 
+     ! 9-Copper (USA) 61N47 144W45                          R2
+     ! Old=39 km3/year=1236m3/s; UNESCO(65-84, p317)=1052m3/s; ratio=1.18
+     ! --> 1236.25m3/s
+      DATA inb(9)/1/
+      DATA (iirnf(jc,9),jc=1,jpcoef)/  67, 299*0 /
+      DATA (ijrnf(jc,9),jc=1,jpcoef)/ 119, 299*0 /
+      DATA (zrnfm(jm,9),jm=1,jpmois)/   &
+           219.,    195.,    181.,    214.,    904.,   2532.,   &
+          4026.,   3627.,   1632.,    697.,    354.,    254./ 
+      ! 10-Susitna (USA)                                    R5
+      ! Old=40 km3/year=1268m3/s
+      ! --> 1268.m3/s
+      DATA inb(10)/1/
+      DATA (iirnf(jc,10),jc=1,jpcoef)/  65, 299*0 /
+      DATA (ijrnf(jc,10),jc=1,jpcoef)/ 118, 299*0 /
+      DATA (zrnfm(jm,10),jm=1,jpmois)/12*1268./ 
+      ! 11-McKenzie (Canada) 70N00 135W00                   R3
+      ! Old=306 km3/year=9697m3/s; UNESCO(67+72+7479+82-84, p168)=8343m3/s;
+      ! ratio=1.16
+      ! --> 9606.66797m3/s
+      DATA inb(11)/1/
+      DATA (iirnf(jc,11),jc=1,jpcoef)/  69, 299*0 /
+      DATA (ijrnf(jc,11),jc=1,jpcoef)/ 131, 299*0 /
+      DATA (zrnfm(jm,11),jm=1,jpmois)/   &
+           3644.,    3400.,    3258.,    3546.,   14188.,   21544.,   &
+          18954.,   15487.,   11284.,   10169.,    5901.,    3905./
+      ! 12-Kuksokwim (USA) 60N00 ~162W30                    R4
+      ! UNESCO(65-84, p318)=1112m3/s (61N87 158E10, Crooked Creek, inland)
+      ! --> 1111.99988m3/s
+      DATA inb(12)/1/
+      DATA (iirnf(jc,12),jc=1,jpcoef)/  60, 299*0 /
+      DATA (ijrnf(jc,12),jc=1,jpcoef)/ 118, 299*0 /
+      DATA (zrnfm(jm,12),jm=1,jpmois)/   &
+          335.,     308.,     295.,     407.,    2415.,    2027.,   &
+          1917.,   2049.,    1585.,    1072.,     545.,     389./     
+
+      DATA inb(13)/0/
+      DATA inb(14)/0/
+      DATA inb(15)/0/
+
+      ! Total run-offs(I)=60974.2539m3/s
+
+      ! II SOUTH AMERICA
+      ! -----------------
+      ! 16-Chira (Peru) 4s54 81w08                          R2
+      ! Old=5 km3/year=158m3/s; UNESCO (65-68, p357)=80.9; ratio=1.95
+      ! --> 158.000015m3/s
+      DATA inb(16)/1/
+      DATA (iirnf(jc,16),jc=1,jpcoef)/ 101, 299*0 /
+      DATA (ijrnf(jc,16),jc=1,jpcoef)/  66, 299*0 /
+      DATA (zrnfm(jm,16),jm=1,jpmois)/   &
+          70.,     105.,     564.,     582.,     230.,      94.,   &
+          87.,      47.,      35.,      32.,      29.,      21./
+      ! 17-Magdalena (Colombia) 11N06 74W51                 R2
+      ! Old=237 km3/year=7510m3/s; UNESCO(71-73+76-79, p348)=6973m3/s;
+      ! ratio=1.08
+      ! --> 7451.58301m3/s
+      DATA inb(17)/1/
+      DATA (iirnf(jc,17),jc=1,jpcoef)/ 104, 299*0 /
+      DATA (ijrnf(jc,17),jc=1,jpcoef)/  86, 299*0 /
+      DATA (zrnfm(jm,17),jm=1,jpmois)/   &
+          6598.,    4441.,    4087.,    5445.,    7380.,    8067.,   &
+          8509.,    7428.,    7631.,    9296.,   10588.,    9949./
+      ! 18-Orinoco (Venezuela) 8N37 62W15!                  R1
+      ! Old=1100 km3/year=34857m3/s; UNESCO(73-75, p364)=28736m3/s;
+      ! HLA=26371m3/s
+      ! Data from HLA: 8.1N - 63.3W   1925/89
+      ! --> 26371.416
+      DATA inb(18)/1/
+      DATA (iirnf(jc,18),jc=1,jpcoef)/ 112, 299*0 /
+      DATA (ijrnf(jc,18),jc=1,jpcoef)/  86, 299*0 /
+      DATA (zrnfm(jm,18),jm=1,jpmois)/   &
+          10670.,    7513.,    6344.,    6887.,   13086.,   26699.,   &
+          43938.,   59957.,   57435.,   39951.,   27410.,   16567./ 
+      ! 19-Amazon (Brazil) 0S05 50W00                       R1
+      ! Old=6300 km3/year=199634m3/s; CLIPPER=166192m3/s~UNESCO;
+      ! HLA=184806m3/s
+      ! UNESCO data are at Obidos which is far inland and therefore does not
+      ! fully represent the actual discharge
+      ! Data from HLA: 1.5N - 55.3W   1970/96
+      ! --> 184845.484m3/s
+      DATA inb(19)/2/
+      DATA (iirnf(jc,19),jc=1,jpcoef)/ 117, 117, 298*0 /
+      DATA (ijrnf(jc,19),jc=1,jpcoef)/  75,  76, 298*0 /
+      DATA (zrnfm(jm,19),jm=1,jpmois)/   &
+          152233., 176415., 199941., 225565., 244016., 244861.,   &
+          230711., 203128., 164531., 128486., 118214., 130045. /
+      ! 20-Sao Francisco (Brazil) 10S30 36W24               R1
+      ! Old=97 km3/year=3074m3/s; UNESCO(77-79, p338)=2645m3/s
+      ! --> 2645.3335m3/s
+      DATA inb(20)/1/
+      DATA (iirnf(jc,20),jc=1,jpcoef)/ 123, 299*0 /
+      DATA (ijrnf(jc,20),jc=1,jpcoef)/  59, 299*0 /
+      DATA (zrnfm(jm,20),jm=1,jpmois)/   &
+          3244.,   4116.,   5139.,   4330.,   2323.,   1800.,   &
+          1587.,   1511.,   1593.,   1740.,   2190.,   2171. /
+      ! 21-Parana+Uruguay(Arg./Uru.) 34S12 58W18            R1 
+      ! Old=470 km3/year=14893m3/s; UNESCO(p323/324)=22263m3/s
+      ! --> 22203.168m3/s 
+      DATA inb(21)/2/
+      DATA (iirnf(jc,21),jc=1,jpcoef)/ 114, 114, 298*0 /
+      DATA (ijrnf(jc,21),jc=1,jpcoef)/  46,  47, 298*0 /
+      DATA (zrnfm(jm,21),jm=1,jpmois)/   &
+          24803.,   26836.,   24585.,   21358.,   20041.,   21689.,   &
+          22647.,   20403.,   19627.,   21400.,   21126.,   21923./
+      ! 22-Negro (Argentina)  41S02  62W47                  R2
+      ! Old=30 km3/year=951m3/s; UNESCO(65-79,p330)=765m3/s; ratio=1.24
+      ! --> 907.666687m3/s
+      DATA inb(22)/1/
+      DATA (iirnf(jc,22),jc=1,jpcoef)/ 110, 299*0 /
+      DATA (ijrnf(jc,22),jc=1,jpcoef)/  43, 299*0 /
+      DATA (zrnfm(jm,22),jm=1,jpmois)/   &
+          882.,     587.,     519.,     482.,     623.,     984.,   &
+          1120.,   1294.,    1092.,    1166.,    1105.,    1038./
+     ! 23- Tocantins :  ~48W00 ~0.5S                        R4
+     ! UNESCO(76-77+80-81, p335)=12167m3/s (station far inland!)
+     ! --> 12173.082m3/s
+      DATA inb(23)/1/
+      DATA (iirnf(jc,23),jc=1,jpcoef)/118, 299*0 /
+      DATA (ijrnf(jc,23),jc=1,jpcoef)/ 73, 299*0 /
+      DATA (zrnfm(jm,23),jm=1,jpmois)/   &
+          15507.,  24855.,  27854.,  24257.,  15860.,   7861.,   &
+          4440.,   3082.,   2728.,   3417.,   5511.,  10705. /
+
+      DATA inb(24)/0/
+      DATA inb(25)/0/
+
+      ! Total run-offs(II)=256755.75
+      ! Total run-offs(I+II)=317730
+
+      ! III EUROPE
+      ! ----------
+      ! 26-Rhone (France) 43N20 4E50                        R1 
+      ! Old=49 km3/year=1553m3/s; UNESCO(65-83, p512)=1229
+      ! --> 1217.16663m3/s
+      DATA inb(26)/1/
+      DATA (iirnf(jc,26),jc=1,jpcoef)/ 150, 299*0 /
+      DATA (ijrnf(jc,26),jc=1,jpcoef)/ 108, 299*0 /
+      DATA (zrnfm(jm,26),jm=1,jpmois)/   &
+          1385.,    1848.,    1568.,    1311.,    1420.,    1191.,   &
+           937.,     796.,     794.,     962.,    1161.,    1233./
+      ! 27-Po (Italy) 11N10 1W09                            R1 
+      ! Old=46 km3/year=1458m3/s; UNESCO(65-84, p527)=1550m3/s
+      ! --> 1550.08337m3/s
+      DATA inb(27)/1/
+      DATA (iirnf(jc,27),jc=1,jpcoef)/ 159, 299*0 /
+      DATA (ijrnf(jc,27),jc=1,jpcoef)/ 110, 299*0 /
+      DATA (zrnfm(jm,27),jm=1,jpmois)/   &
+          1304.,    1605.,    1856.,    1549.,    1958.,    1760.,   &
+          1040.,    1007.,    1615.,    1907.,    1772.,    1228./
+      ! 28-Danube (Roumania) 45N20 29E40                    R1 
+      ! Old=206 km3/year=6527m3/s; UNESCO(65-84, p544)=7011m3/s
+      ! --> 7011.8335m3/s
+      DATA inb(28)/1/
+      DATA (iirnf(jc,28),jc=1,jpcoef)/ 171, 299*0 /
+      DATA (ijrnf(jc,28),jc=1,jpcoef)/ 106, 299*0 /
+      DATA (zrnfm(jm,28),jm=1,jpmois)/   &
+          6625.,    7352.,    7986.,    9279.,    9482.,    8618.,   &
+          7586.,    6001.,    5210.,    4989.,    4921.,    6093./
+
+      DATA inb(29)/0/
+      DATA inb(30)/0/
+
+      ! Total run-offs(III)=9779.08301m3/s
+      ! Total run-offs(I+II+III)=327509.094m3/s
+
+      ! IV EURASIAN ARCTIC
+      ! ------------------
+      ! 31-Iana (Russia)                                    R1
+      ! Old=29 km3/year=919m3/s; UNESCO(65-72+74+76-84, p463)=936m3/s
+      ! --> 0m3/s
+      DATA inb(31)/0/
+      DATA (iirnf(jc,31),jc=1,jpcoef)/ 300*0 /
+      DATA (ijrnf(jc,31),jc=1,jpcoef)/ 300*0 /
+      DATA (zrnfm(jm,31),jm=1,jpmois)/   &
+             2.,       1.,       0.,       0.,     917.,    3514.,   &
+          2968.,    2329.,    1322.,     178.,      36.,       8./ 
+      ! 32-Ob (Russia) 66N45 69E30                          R1 
+      ! Old=385 km3/year=12200m3/s; UNESCO(65-84, p478)=12862m3/s
+      ! --> 12861.5m3/s
+      DATA inb(32)/2/
+      DATA (iirnf(jc,32),jc=1,jpcoef)/ 153, 153, 298*0 /
+      DATA (ijrnf(jc,32),jc=1,jpcoef)/ 146, 147, 298*0 /
+      DATA (zrnfm(jm,32),jm=1,jpmois)/   &
+           4977.,    4150.,    3611.,    3590.,   14723.,   33366.,   &
+          30773.,   22785.,   14701.,    9705.,    6078.,    5879./
+      ! 33-Yenesei (Russia) 71N50 82E40                     R1 
+      ! Old=560 km3/year=17745m3/s; UNESCO(65-84, p472)=17462m3/s
+      ! --> 17461.666m3/s
+      DATA inb(33)/1/
+      DATA (iirnf(jc,33),jc=1,jpcoef)/  32, 299*0 /
+      DATA (ijrnf(jc,33),jc=1,jpcoef)/ 147, 299*0 /
+      DATA (zrnfm(jm,33),jm=1,jpmois)/   &
+           6659.,    7007.,    6895.,    7089.,   24183.,   74965.,   &
+          25325.,   15940.,   16050.,   12678.,    6741.,    6008./
+     ! 34-Severnaya Dvina(Russia)64N32 40E30                R5 
+     ! Old=106 km3/year=3359m3/s; not in UNESCO data base
+     ! --> 3359.00024m3/s
+      DATA inb(34)/1/
+      DATA (iirnf(jc,34),jc=1,jpcoef)/ 153, 299*0 /
+      DATA (ijrnf(jc,34),jc=1,jpcoef)/ 133, 299*0 /
+      DATA (zrnfm(jm,34),jm=1,jpmois)/12*3359./
+      ! 35-Lena (Russia) 72N25 126E40                       R1 
+      ! --> 16192.333m3/s
+      DATA inb(35)/1/
+      DATA (iirnf(jc,35),jc=1,jpcoef)/  36, 299*0 /
+      DATA (ijrnf(jc,35),jc=1,jpcoef)/ 137, 299*0 /
+      DATA (zrnfm(jm,35),jm=1,jpmois)/   &
+           2663.,    2095.,    1629.,    1324.,    7203.,   64230.,   &
+          40810.,   28310.,   25995.,   13299.,    3673.,    3077./
+      ! 36-Kolyma (Russia) 69N30 161E00                     R1
+      ! Old=71 km3/year=2250m3/s; UNESCO(65-84)=2138m3/s
+      ! --> 2138.66675m3/s
+      DATA inb(36)/1/
+      DATA (iirnf(jc,36),jc=1,jpcoef)/  46, 299*0 /
+      DATA (ijrnf(jc,36),jc=1,jpcoef)/ 128, 299*0 /
+      DATA (zrnfm(jm,36),jm=1,jpmois)/   &
+           131.,      92.,      76.,      65.,    2576.,    9143.,   &
+          4670.,    3727.,    3226.,    1119.,     630.,     209./
+     ! 37-Indigirka (russia) 70N48 148E54                   R1 
+     ! Old=55 km3/year=1743m3/s; UNESCO(65-68+70+72-84)=1622.
+     ! --> 1622.00012m3/s
+      DATA inb(37)/1/
+      DATA (iirnf(jc,37),jc=1,jpcoef)/  42, 299*0 /
+      DATA (ijrnf(jc,37),jc=1,jpcoef)/ 131, 299*0 /
+      DATA (zrnfm(jm,37),jm=1,jpmois)/   &
+            32.,      17.,      11.,       7.,     354.,    5629.,   &
+          5210.,    4617.,    2823.,     559.,     142.,      63./
+
+      DATA inb(38)/0/
+      DATA inb(39)/0/
+      DATA inb(40)/0/
+
+      ! Total run-offs(IV)=40773.6641m3/s
+      ! Total run-offs(I+II+III+IV)=368282.75m3/s
+
+      ! V ASIA
+      ! ------
+      ! 41-Amur (Russia) 52N56 141E10                       R2
+      ! Old=325 km3/year=10299m3/s; UNESCO(65-84, p451)=8792m3/s; ratio=1.17
+      ! --> 10299.332m3/s
+      DATA inb(41)/1/
+      DATA (iirnf(jc,41),jc=1,jpcoef)/  33, 299*0 /
+      DATA (ijrnf(jc,41),jc=1,jpcoef)/ 116, 299*0 /
+      DATA (zrnfm(jm,41),jm=1,jpmois)/   &
+           2108.,    1543.,    1252.,    4088.,   15464.,   17336.,   &
+          16100.,   20801.,   21548.,   15658.,    5188.,    2506./
+      ! 42-Liaohe (China) 40N40 122E09                      R5
+      ! Old=6 km3/year=190m3/s; not found in UNESCO data base
+      ! --> 189.999985m3/s
+      DATA inb(42)/1/
+      DATA (iirnf(jc,42),jc=1,jpcoef)/  22, 299*0 /
+      DATA (ijrnf(jc,42),jc=1,jpcoef)/ 104, 299*0 /
+      DATA (zrnfm(jm,42),jm=1,jpmois)/12*190./
+      ! 43-Daling (China) 40N56 121E43                      R5
+      ! Old=1 km3/year=32m3/s; not found in UNESCO data base
+      ! --> 31.9999962m3/s
+      DATA inb(43)/1/
+      DATA (iirnf(jc,43),jc=1,jpcoef)/  24, 299*0 /
+      DATA (ijrnf(jc,43),jc=1,jpcoef)/ 104, 299*0 /
+      DATA (zrnfm(jm,43),jm=1,jpmois)/12*32./
+      ! 44-Haiho (China) 6N17   1E23
+      ! Old=2 km3/year=64m3/s; not found in UNESCO data base
+      ! --> 63.9999924m3/s
+      DATA inb(44)/1/
+      DATA (iirnf(jc,44),jc=1,jpcoef)/  28, 299*0 /
+      DATA (ijrnf(jc,44),jc=1,jpcoef)/ 106, 299*0 /
+      DATA (zrnfm(jm,44),jm=1,jpmois)/12*64./
+      ! 45-Yellow/Huangho (China) 37N32 118E19              R2 
+      ! Old=49 km3/year=1553m3/s; UNESCO(p371)=1210m3/s; ratio=1.28
+      ! --> 1552.5m3/s
+      DATA inb(45)/1/
+      DATA (iirnf(jc,45),jc=1,jpcoef)/  22, 299*0 /
+      DATA (ijrnf(jc,45),jc=1,jpcoef)/ 103, 299*0 /
+      DATA (zrnfm(jm,45),jm=1,jpmois)/   &
+           697.,     674.,    1282.,    1206.,    1109.,     778.,   &
+          1964.,    3270.,    3668.,    2133.,     978.,     871./
+      ! 46-Yangtze (China) 31N48 121E10=Changjiang          R2
+      ! Old=900 km3/year=28520m3/s; UNESCO(p372)=25032m3/s; ratio=1.14
+      ! --> 28519.584m3/s
+      DATA inb(46)/1/
+      DATA (iirnf(jc,46),jc=1,jpcoef)/  23, 299*0 /
+      DATA (ijrnf(jc,46),jc=1,jpcoef)/  98, 299*0 /
+      DATA (zrnfm(jm,46),jm=1,jpmois)/   &
+          10994.,   10548.,   13254.,   24097.,   36972.,   47197.,   &
+          53891.,   42070.,   37627.,   30762.,   22046.,   12777./
+      ! 47-Pearl/Zhujiang (China) 23N36 106E34=Xijiang      R2 
+      ! Old=302 km3/year=9570m3/s; UNESCO(76,82, p373)=6987m3/s; ratio=1.37
+      ! --> 9570.75m3/s
+      DATA inb(47)/1/
+      DATA (iirnf(jc,47),jc=1,jpcoef)/  22, 299*0 /
+      DATA (ijrnf(jc,47),jc=1,jpcoef)/  95, 299*0 /
+      DATA (zrnfm(jm,47),jm=1,jpmois)/   &
+           2357.,    2415.,    2634.,    6446.,   14246.,   18395.,   &
+          19213.,   17558.,   12312.,    7255.,    5864.,    6154./
+      ! 48-Red/Hungho (Vietnam) 20N17 106E34                R5 
+      ! Old=123 km3/year=3897m3/s; not in UNESCO data base
+      ! --> 3897.m3/s
+      DATA inb(48)/1/
+      DATA (iirnf(jc,48),jc=1,jpcoef)/  16, 299*0 /
+      DATA (ijrnf(jc,48),jc=1,jpcoef)/  91, 299*0 /
+      DATA (zrnfm(jm,48),jm=1,jpmois)/12*3897./
+      ! 49-Mekong (Vietnam) 10N33 105E24                    R5
+      ! Old=470 km3/year=14893m3/s; not in UNESCO data base
+      ! --> 14893.0029m3/s
+      DATA inb(49)/2/
+      DATA (iirnf(jc,49),jc=1,jpcoef)/  16,  16, 298*0 /
+      DATA (ijrnf(jc,49),jc=1,jpcoef)/  86,  87, 298*0 /
+      DATA (zrnfm(jm,49),jm=1,jpmois)/12*14893./
+      ! 50-Irrawady (Burma) 15N50  95E06                    R5
+      ! Old=428 km3/year=13563m3/s; not in UNESCO data base
+      ! --> 13563.m3/s
+      DATA inb(50)/1/
+      DATA (iirnf(jc,50),jc=1,jpcoef)/  10, 299*0 /
+      DATA (ijrnf(jc,50),jc=1,jpcoef)/  90, 299*0 /
+      DATA (zrnfm(jm,50),jm=1,jpmois)/12*13563./
+      ! 51-Ganges+Brahmaputra (Beng.) 22N00  91E00          R1
+      ! Old=971 km3/year=30769m3/s; UNESCO(69-70+73-75, p367)=31760m3/s
+      ! --> 32147.498m3/s
+      DATA inb(51)/2/
+      DATA (iirnf(jc,51),jc=1,jpcoef)/   7,  8, 298*0 /
+      DATA (ijrnf(jc,51),jc=1,jpcoef)/  93, 93, 298*0 /
+      DATA (zrnfm(jm,51),jm=1,jpmois)/   &
+           6623.,    6315.,    6432.,    9410.,   17263.,   38302.,   &
+          64688.,   80338.,   84802.,   43387.,   17888.,   10322./
+      ! 52-Mehandi (India)                                  R5
+      ! Old=67 km3/year=2123m3/s; not in UNESCO data base
+      ! --> 0m3/s
+      DATA inb(52)/0/
+      DATA (iirnf(jc,52),jc=1,jpcoef)/ 300*0 /
+      DATA (ijrnf(jc,52),jc=1,jpcoef)/ 300*0 /
+      DATA (zrnfm(jm,52),jm=1,jpmois)/12*2123./
+      ! 53-Damodar (India)                                  R2
+      ! Old=10 km3/year=320m3/s; UNESCO(p386)=173m3/s; ratio=1.85
+      ! --> 432.916656m3/s
+      DATA inb(53)/1/
+      DATA (iirnf(jc,53),jc=1,jpcoef)/   6, 299*0 /
+      DATA (ijrnf(jc,53),jc=1,jpcoef)/  93, 299*0 /
+      DATA (zrnfm(jm,53),jm=1,jpmois)/   &
+           51.,      37.,      42.,      49.,      85.,     296.,   &
+          896.,    1390.,    1591.,     542.,     172.,      44./   
+      ! 54-Godavari (India) 17N00  81E45                    R2
+      ! Old=84 km3/year=2662m3/s; UNESCO(p379)=1916m3/s; ratio=1.39
+      ! --> 3670.5m3/s
+      DATA inb(54)/1/
+      DATA (iirnf(jc,54),jc=1,jpcoef)/   3, 299*0 /
+      DATA (ijrnf(jc,54),jc=1,jpcoef)/  90, 299*0 /
+      DATA (zrnfm(jm,54),jm=1,jpmois)/   &
+           988.,     737.,     280.,     219.,     196.,    1691.,   &
+          8063.,   14571.,   11428.,    3953.,    1221.,     699./   
+     ! 55-Indus (Pakistan) 24N20  67E47                     R2
+     ! Old=238 km3/year=7542m3/s; UNESCO (76-79, p428)=2396m3/s; ratio=3.15
+     ! --> 7562.m3/s
+      DATA inb(55)/2/
+      DATA (iirnf(jc,55),jc=1,jpcoef)/ 176, 176, 298*0 /
+      DATA (ijrnf(jc,55),jc=1,jpcoef)/  93,  94, 298*0 /
+      DATA (zrnfm(jm,55),jm=1,jpmois)/   &
+            988.,     737.,    1904.,    1968.,    3625.,    6143.,   &
+          15969.,    36656.,  17173.,    3215.,    1251.,    1115./   
+      ! 56-Tigris and Euphrates (Iraq) 31N00  47E25         R1
+      ! Old=46 km3/year=1458m3/s; UNESCO(76-79, p428)=2396m3/s
+      ! --> 2248.8335m3/s
+      DATA inb(56)/1/
+      DATA (iirnf(jc,56),jc=1,jpcoef)/ 172, 299*0 /
+      DATA (ijrnf(jc,56),jc=1,jpcoef)/  94, 299*0 /
+      DATA (zrnfm(jm,56),jm=1,jpmois)/   &
+          1872.,    2127.,    2962.,    4944.,    5036.,    3078.,   &
+          1362.,     900.,     786.,     993.,    1184.,    1742./   
+
+      DATA inb(57)/0/
+      DATA inb(58)/0/
+      DATA inb(59)/0/
+      DATA inb(60)/0/
+
+      ! Total run-offs (V)=128642.922m3/s
+      ! Total run-offs (I+II+III+IV+V)=496925.688m3/s
+      
+      ! VI AFRICA
+      ! ----------
+      ! 61-Nile (Egypt) 30N10  31E06                        R1
+      ! Old=30 km3/year=951m3/s; UNESCO(73-84)=1251m3/s
+      ! --> 1251.33337m3/s
+      DATA inb(61)/1/
+      DATA (iirnf(jc,61),jc=1,jpcoef)/ 176, 299*0 /
+      DATA (ijrnf(jc,61),jc=1,jpcoef)/  97, 299*0 /
+      DATA (zrnfm(jm,61),jm=1,jpmois)/   &
+          1239.,    1035.,    1126.,    1110.,    1170.,    1542.,   &
+          1742.,    1559.,    1191.,    1103.,    1075.,    1124./   
+      ! 62-Niger (Nigeria) 5N33   6E33                      R1
+      ! Old=192 km3/year=6084m3/s; HLA=5545m3/s;
+      ! Data from HLA: 4.5N -  6  E   1950/87
+      ! --> 5545.08301m3/s
+      DATA inb(62)/1/
+      DATA (iirnf(jc,62),jc=1,jpcoef)/ 146, 299*0 /
+      DATA (ijrnf(jc,62),jc=1,jpcoef)/  81, 299*0 /
+      DATA (zrnfm(jm,62),jm=1,jpmois)/   &
+          2029.,    1804.,    1573.,    1418.,    1494.,    2561.,   &
+          5272.,    9629.,   14951.,   16227.,    6842.,    2741./   
+      ! 63-Zaire/Congo (Congo) 6S04  12E24                  R1      
+      ! Old=1250 km3/year=39610m3/s; UNESCO(65-83, p149)=41941m3/s; HLA
+      ! =39720m3/s
+      ! Data from HLA: 6S - 12  E   1902/96
+      ! --> 39719.5m3/s
+      DATA inb(63)/2/
+      DATA (iirnf(jc,63),jc=1,jpcoef)/ 148, 148, 298*0 /
+      DATA (ijrnf(jc,63),jc=1,jpcoef)/  63,  64, 298*0 /
+      DATA (zrnfm(jm,63),jm=1,jpmois)/   &
+          47200.,   37692.,   34374.,   36603.,   37862.,   35588.,   &
+          30966.,   30774.,   35981.,   42825.,   51455.,   55314./  
+      ! 64-Orange (Sth Africa) 28S41 16E28                  R5
+      ! Old=11 km3/year=349m3/s
+      ! --> 349.000031m3/s
+      DATA inb(64)/1/
+      DATA (iirnf(jc,64),jc=1,jpcoef)/ 150, 299*0 /
+      DATA (ijrnf(jc,64),jc=1,jpcoef)/  51, 299*0 /
+      DATA (zrnfm(jm,64),jm=1,jpmois)/12*349./
+      ! 65-Zambesi (Mozambique) 18S55 36E04                 R5
+      ! Old=223 km3/year=7066m3/s
+      ! --> 7066.00049m3/s
+      DATA inb(65)/1/
+      DATA (iirnf(jc,65),jc=1,jpcoef)/ 160, 299*0 /
+      DATA (ijrnf(jc,65),jc=1,jpcoef)/  56, 299*0 /
+      DATA (zrnfm(jm,65),jm=1,jpmois)/12*7066./
+      ! 66-Limpopo (mozambique) 25S15 33E30                 R5
+      ! Old=5 km3/year=158m3/s
+      ! --> 158.m3/s
+      DATA inb(66)/1/
+      DATA (iirnf(jc,66),jc=1,jpcoef)/ 159, 299*0 /
+      DATA (ijrnf(jc,66),jc=1,jpcoef)/  52, 299*0 /
+      DATA (zrnfm(jm,66),jm=1,jpmois)/12*158./
+      ! 67-Rufiji (tanzania) 8S00 39E20                     R5
+      ! Old=9 km3/year=285m3/s
+      ! --> 285.m3/s
+      DATA inb(67)/1/
+      DATA (iirnf(jc,67),jc=1,jpcoef)/ 162, 299*0 /
+      DATA (ijrnf(jc,67),jc=1,jpcoef)/  62, 299*0 /
+      DATA (zrnfm(jm,67),jm=1,jpmois)/12*285./
+      ! Other rivers from the Gulf of Guinea
+      ! 68-Kouilou (Congo)  4.5S-11.5E (UNESCO=p51)         R1
+      ! Data from HLA:  4S - 11  E   1953/86 = 919m3/s
+      ! --> 924.25m3/s
+      DATA inb(68)/1/
+      DATA (iirnf(jc,68),jc=1,jpcoef)/ 147, 299*0 /
+      DATA (ijrnf(jc,68),jc=1,jpcoef)/  67, 299*0 /
+      DATA (zrnfm(jm,68),jm=1,jpmois)/   &
+          1115.,    1166.,    1285.,    1462.,    1454.,     725.,   &
+           480.,     378.,     327.,     400.,    1018.,    1281./
+      ! 69-Nyanga (Gabon)  3S-10E (UNESCO=p66)              R1
+      ! Data from HLA: 2.8N - 10  E   1952/82 = 264m3/s
+      ! --> 264.166687m3/s
+      DATA inb(69)/1/
+      DATA (iirnf(jc,69),jc=1,jpcoef)/ 147, 299*0 /
+      DATA (ijrnf(jc,69),jc=1,jpcoef)/  68, 299*0 /
+      DATA (zrnfm(jm,69),jm=1,jpmois)/   &
+          126.,      99.,     143.,     253.,     316.,     300.,   &
+          156.,      93.,     231.,     557.,     592.,     304./
+      ! 70-Ogoue (Gabon) 1S-9E (UNESCO, p69)                R1
+      ! Data from HLA: .75S -  9  E   1930/90 = 4512m3/s
+      ! --> 4511.83301m3/s
+      DATA inb(70)/1/
+      DATA (iirnf(jc,70),jc=1,jpcoef)/ 146, 299*0 /
+      DATA (ijrnf(jc,70),jc=1,jpcoef)/  72, 299*0 /
+      DATA (zrnfm(jm,70),jm=1,jpmois)/   &
+          4514.,    3988.,    4622.,    5403.,    5790.,    4145.,   &
+          2616.,    1961.,    2119.,    4304.,    7870.,    6810./
+      ! 71-Sanaga (Cameroun) 3.5N-9.5E (UNESCO, p31)        R1
+      ! Data from HLA: 3.9N -  9.6E   1944/80 = 1983m3/s
+      ! --> 1982.58337m3/s
+      DATA inb(71)/1/
+      DATA (iirnf(jc,71),jc=1,jpcoef)/ 146, 299*0 /
+      DATA (ijrnf(jc,71),jc=1,jpcoef)/  81, 299*0 /
+      DATA (zrnfm(jm,71),jm=1,jpmois)/   &
+           813.,     578.,     517.,     633.,     909.,    1278.,   &
+          1928.,    2653.,    4361.,    5470.,    3307.,    1344./
+      ! 72-Nyong (Cameroun) 3.1N-9.5E (UNESCO, p36)         R1
+      ! Data from HLA: 3.5N -  9.8E   1951/84 = 432m3/s
+      ! --> 431.166656m3/s      
+      DATA inb(72)/1/
+      DATA (iirnf(jc,72),jc=1,jpcoef)/ 146, 299*0 /
+      DATA (ijrnf(jc,72),jc=1,jpcoef)/  80, 299*0 /
+      DATA (zrnfm(jm,72),jm=1,jpmois)/   &
+          232.,     128.,     150.,     266.,     402.,     459.,   &
+          353.,     306.,     604.,     930.,     878.,     466./
+      ! 73-Ntem (Cameroun) 2.5N-9.5E (UNESCO, p36)          R1
+      ! Data from HLA: 3N -  9.8E   1951/87 = 330m3/s      
+      ! --> 329.75m3/s
+      DATA inb(73)/1/
+      DATA (iirnf(jc,73),jc=1,jpcoef)/ 146, 299*0 /
+      DATA (ijrnf(jc,73),jc=1,jpcoef)/  79, 299*0 /
+      DATA (zrnfm(jm,73),jm=1,jpmois)/   &
+          452.,     455.,     492.,     466.,     482.,     251.,   &
+          151.,     108.,      87.,     133.,     395.,     485./
+      ! 74-Wouri (Cameroun) 4N-9.5E (UNESCO, p34)           R1
+      ! Data from HLA: 4N -  9.5E   1951/84  = 307m3/s
+      ! --> 306.583374m3/s
+      DATA inb(74)/1/
+      DATA (iirnf(jc,74),jc=1,jpcoef)/ 145, 299*0 /
+      DATA (ijrnf(jc,74),jc=1,jpcoef)/  81, 299*0 /
+      DATA (zrnfm(jm,74),jm=1,jpmois)/   &
+           88.,      63.,      68.,      95.,     139.,     222.,   &
+          395.,     633.,     825.,     675.,     328.,     148./
+      ! 75-Oueme (Benin) 6.5N-2.5E (UNESCO, p27)            R1
+      ! Data from HLA:  6.2N -  2.5E   1951/84 =113m3/s
+      ! --> 112.666664m3/s
+      DATA inb(75)/1/
+      DATA (iirnf(jc,75),jc=1,jpcoef)/ 144, 299*0 /
+      DATA (ijrnf(jc,75),jc=1,jpcoef)/  83, 299*0 /
+      DATA (zrnfm(jm,75),jm=1,jpmois)/   &
+           0.,       0.,       0.,       0.,       1.,      18.,   &
+          96.,     324.,     531.,     319.,      58.,       5./
+      ! 76-Mono(Tepetou,Benin/Togo) 6.25N-1.8E (U, p27)     R1
+      ! Data from HLA: 6.2N -  1  E   1951/85  = 96m3/s       
+      ! --> 96.4999924m3/s
+      DATA inb(76)/1/
+      DATA (iirnf(jc,76),jc=1,jpcoef)/ 143, 299*0 /
+      DATA (ijrnf(jc,76),jc=1,jpcoef)/  83, 299*0 /
+      DATA (zrnfm(jm,76),jm=1,jpmois)/   &
+            2.,       1.,       1.,       4.,       8.,      44.,   &
+          168.,     274.,     386.,     215.,      47.,       8./
+      ! 77-Comoe (Ivory Coast) 5N-4W (UNESCO, p56)          R1
+      ! Data from HLA: 5.1N -  4  W   1955/86 = 194m3/s       
+      ! --> 194.25m3/s
+      DATA inb(77)/1/
+      DATA (iirnf(jc,77),jc=1,jpcoef)/ 140, 299*0 /
+      DATA (ijrnf(jc,77),jc=1,jpcoef)/  82, 299*0 /
+      DATA (zrnfm(jm,77),jm=1,jpmois)/   &
+           14.,       7.,       9.,      17.,      29.,      90.,   &
+          145.,     349.,     740.,     688.,     198.,      45./
+      ! 78-Sassandra (Ivory Coast) 5N-6W (UNESCO, p58)      R1
+      ! Data from HLA: 5N -  6  W   1953/86 = 449m3/s
+      ! --> 449.333344m3/s
+      DATA inb(78)/1/
+      DATA (iirnf(jc,78),jc=1,jpcoef)/ 139, 299*0 /
+      DATA (ijrnf(jc,78),jc=1,jpcoef)/  82, 299*0 /
+      DATA (zrnfm(jm,78),jm=1,jpmois)/   &
+          144.,     116.,     119.,     143.,     156.,     334.,   &
+          419.,     692.,    1277.,    1190.,     553.,     249./
+
+      DATA inb(79)/0/
+      DATA inb(80)/0/
+      DATA inb(82)/0/
+      DATA inb(83)/0/
+      DATA inb(84)/0/
+      DATA inb(85)/0/
+      DATA inb(86)/0/
+      DATA inb(87)/0/
+      DATA inb(88)/0/
+      DATA inb(89)/0/
+      DATA inb(90)/0/
+
+      ! Total run-offs (VI)=63977.m3/s
+      ! Total run-offs (I+II+III+IV+V+VI)=560902.688m3/s
+      
+      ! VII OCEANIA
+      ! ------------
+      ! 91-Murray (Austrlia) 35S34 138E54                   R5
+      ! Old=22 km3/year=697m3/s
+      ! --> 696.999939m3/s
+      DATA inb(91)/1/
+      DATA (iirnf(jc,91),jc=1,jpcoef)/  30, 299*0 /
+      DATA (ijrnf(jc,91),jc=1,jpcoef)/  47, 299*0 /
+      DATA (zrnfm(jm,91),jm=1,jpmois)/12*697./
+      ! 92-Haast (N. Zeland) 43S50 169E02                   R5
+      ! Old=6 km3/year=190m3/s
+      ! --> 189.999985m3/s
+      DATA inb(92)/1/
+      DATA (iirnf(jc,92),jc=1,jpcoef)/  48, 299*0 /
+      DATA (ijrnf(jc,92),jc=1,jpcoef)/  41, 299*0 /
+      DATA (zrnfm(jm,92),jm=1,jpmois)/12*190./
+      ! 93-Fly (N. Guinea) 8S30 143E05                      R5
+      ! Old=77 km3/year=2440m3/s
+      ! --> 2440.m3/s
+      DATA inb(93)/1/
+      DATA (iirnf(jc,93),jc=1,jpcoef)/  34, 299*0 /
+      DATA (ijrnf(jc,93),jc=1,jpcoef)/  62, 299*0 /
+      DATA (zrnfm(jm,93),jm=1,jpmois)/12*2440./
+      ! 94-Purari (N. Guinea) 7S25 145E05                   R4
+      ! Old=77 km3/year=2440m3/s; UNESCO(77+83,p595)=2727m3/s
+      ! --> 2727.33325m3/s
+      DATA inb(94)/1/
+      DATA (iirnf(jc,94),jc=1,jpcoef)/  36, 299*0 /
+      DATA (ijrnf(jc,94),jc=1,jpcoef)/  64, 299*0 /
+      DATA (zrnfm(jm,94),jm=1,jpmois)/   &
+          1972.,    3067.,    2332.,    2981.,    2693.,    2876.,   &
+          2867.,    3477.,    2195.,    2967.,    2674.,    2627./
+      ! 95-Choshui ch''i (taiwan) 24N03 120E23              R2
+      ! Old=6 km3/year=190m3/s; UNESCO(65-68, p374)=120m3/s; ratio=1.58 
+      ! --> 0.m3/s
+      DATA inb(95)/0/
+      DATA (iirnf(jc,95),jc=1,jpcoef)/  22, 299*0 /
+      DATA (ijrnf(jc,95),jc=1,jpcoef)/  94, 299*0 /
+      DATA (zrnfm(jm,95),jm=1,jpmois)/   &
+           65.,      63.,      83.,     100.,     177.,     535.,   &
+          332.,     313.,     236.,     193.,     101.,      84./
+      ! 96-Kaoping (Taiwan)                                 R5  
+      ! Old=9 km3/year=285m3/s
+      ! --> 0.m3/s
+      DATA inb(96)/0/
+      DATA (iirnf(jc,96),jc=1,jpcoef)/ 300*0 /
+      DATA (ijrnf(jc,96),jc=1,jpcoef)/ 300*0 /
+      DATA (zrnfm(jm,96),jm=1,jpmois)/12*285./
+      ! 97-Tsengwen (Taiwan)                                R5
+      ! Old=2 km3/year=63m3/s
+      ! --> 0.m3/s
+      DATA inb(97)/0/
+      DATA (iirnf(jc,97),jc=1,jpcoef)/ 300*0 /
+      DATA (ijrnf(jc,97),jc=1,jpcoef)/ 300*0 /
+      DATA (zrnfm(jm,97),jm=1,jpmois)/12*63./
+      ! 98-Hualien (Taiwan)                                 R5
+      ! Old=4 km3/year=127m3/s
+      ! --> 0.m3/s
+      DATA inb(98)/0/
+      DATA (iirnf(jc,98),jc=1,jpcoef)/ 300*0 /
+      DATA (ijrnf(jc,98),jc=1,jpcoef)/ 300*0 /
+      DATA (zrnfm(jm,98),jm=1,jpmois)/12*127./
+      ! 99-Peinan (Taiwan) 22N46 121E10                     R5
+      ! Old=4 km3/year=127m3/s
+      ! --> 127.000008m3/s
+      DATA inb(99)/1/
+      DATA (iirnf(jc,99),jc=1,jpcoef)/  23, 299*0 /
+      DATA (ijrnf(jc,99),jc=1,jpcoef)/  94, 299*0 /
+      DATA (zrnfm(jm,99),jm=1,jpmois)/12*127./
+      ! 100-Hsiukuluan (Taiwan)                             R5
+      ! Old=4 km3/year=127m3/s
+      ! --> 0.m3/s
+      DATA inb(100)/0/
+      DATA (iirnf(jc,100),jc=1,jpcoef)/ 300*0 /
+      DATA (ijrnf(jc,100),jc=1,jpcoef)/ 300*0 /
+      DATA (zrnfm(jm,100),jm=1,jpmois)/12*127./
+
+      DATA inb(101)/0/
+      DATA inb(102)/0/
+
+      !  Total run-offs(VII)=6181.33301m3/s
+      !  Total run-offs(I+II+III+IV+V+VI+VII)= 567084. m3/s
+      !                                      = 1.588668056E-6 kg/m2/s
+      !                                      = 17883.5586 km3/Year
+      !                                      = 0.567083955 Sverdrup
+
+      ! VIII ANTARCTICA
+      ! ---------------
+      ! 103 -Antarcti! ice discharge (2 613 Gt/year) (jacobs et al 1992)
+      ! Data from Jacobs et al 92: =2613 km3/year=82857.686454 m3/s
+      ! --> 82858 m3/s
+      DATA inb(103)/295/
+      DATA (iirnf(jc,103),jc=1,jpcoef)/   &
+            1,    2,    3,    3,    4,    4,    5,    6,    7,    8,   &
+            9,    9,   10,   11,   12,   13,   14,   14,   15,   16,   &
+           17,   18,   19,   20,   21,   22,   23,   24,   25,   26,   &
+           27,   28,   29,   30,   31,   32,   32,   33,   34,   35,   &
+           35,   36,   36,   37,   38,   39,   40,   40,   41,   42,   &
+           42,   43,   43,   44,   44,   44,   44,   44,   44,   44,   &
+           45,   45,   45,   45,   46,   46,   46,   46,   46,   47,   &
+           47,   47,   47,   47,   48,   48,   48,   48,   48,   49,   &
+           50,   51,   51,   52,   53,   54,   55,   56,   57,   58,   &
+           59,   60,   61,   62,   62,   63,   63,   64,   65,   66,   &
+           66,   67,   67,   68,   69,   69,   70,   71,   71,   72,   &
+           73,   73,   74,   75,   76,   76,   77,   78,   78,   79,   &
+           80,   81,   82,   83,   83,   84,   85,   86,   87,   88,   &
+           88,   89,   89,   90,   91,   92,   93,   94,   95,   96,   &
+           97,   98,   99,  100,  101,  102,  102,  103,  104,  104,   &
+          104,  104,  104,  105,  105,  106,  106,  107,  107,  107,   &
+          108,  108,  109,  109,  110,  110,  111,  111,  112,  112,   &
+          112,  112,  112,  112,  112,  112,  112,  112,  112,  112,   &
+          112,  112,  112,  112,  112,  113,  113,  113,  113,  113,   &
+          114,  114,  114,  114,  115,  115,  115,  115,  115,  116,   &
+          116,  117,  117,  118,  118,  119,  119,  120,  121,  122,   &
+          123,  124,  124,  125,  125,  126,  126,  127,  128,  128,   &
+          129,  130,  130,  131,  132,  132,  133,  133,  133,  133,   &
+          133,  134,  135,  135,  136,  136,  136,  137,  137,  138,   &
+          139,  140,  141,  142,  142,  143,  144,  145,  146,  147,   &
+          148,  149,  150,  151,  152,  153,  154,  155,  156,  156,   &
+          157,  158,  159,  160,  161,  161,  162,  163,  163,  164,   &
+          165,  165,  166,  166,  167,  168,  169,  170,  171,  171,   &
+          172,  173,  173,  174,  175,  176,  177,  177,  178,  178,   &
+          179,  180,  180,  181,  181,    0,    0,    0,    0,    0    &
+                                      /
+      DATA (ijrnf(jc,103),jc=1,jpcoef)/   &
+           19,   20,   20,   21,   21,   22,   22,   22,   22,   22,   &
+           22,   23,   23,   23,   23,   23,   22,   23,   22,   22,   &
+           22,   22,   22,   22,   22,   22,   22,   22,   22,   22,   &
+           22,   22,   22,   22,   22,   21,   22,   21,   21,   20,   &
+           21,   19,   20,   19,   19,   19,   18,   19,   18,   17,   &
+           18,   16,   17,    3,    4,    5,    6,    7,    8,   16,   &
+            3,    8,    9,   16,    3,    9,   10,   15,   16,    3,   &
+           10,   11,   14,   15,    3,   11,   12,   13,   14,    3,   &
+            3,    2,    3,    2,    2,    2,    2,    2,    2,    2,   &
+            2,    2,    2,    2,    3,    3,    4,    4,    4,    4,   &
+            5,    5,    6,    6,    6,    7,    7,    7,    8,    8,   &
+            8,    9,    9,    9,    9,   10,   10,   10,   11,   11,   &
+           11,   11,   11,   10,   11,   10,   10,   10,   10,   10,   &
+           11,   11,   12,   12,   12,   12,   12,   12,   12,   12,   &
+           12,   12,   12,   12,   12,   12,   13,   13,   13,   14,   &
+           15,   16,   17,   17,   18,   18,   19,   19,   20,   21,   &
+           21,   22,   22,   23,   23,   24,   24,   25,    8,    9,   &
+           10,   11,   12,   13,   14,   15,   16,   17,   18,   19,   &
+           20,   21,   22,   25,   26,    7,    8,   22,   23,   26,   &
+            7,   23,   24,   26,    6,    7,   24,   25,   26,    5,   &
+            6,    4,    5,    3,    4,    2,    3,    2,    2,    2,   &
+            2,    2,    3,    3,    4,    4,    5,    5,    5,    6,   &
+            6,    6,    7,    7,    7,    8,    8,    9,   10,   11,   &
+           12,   12,   12,   13,   13,   14,   15,   15,   16,   16,   &
+           16,   16,   16,   16,   17,   17,   17,   17,   17,   17,   &
+           17,   17,   17,   17,   17,   17,   17,   17,   17,   18,   &
+           18,   18,   18,   18,   18,   19,   19,   19,   20,   20,   &
+           20,   21,   21,   22,   22,   22,   22,   22,   21,   22,   &
+           21,   20,   21,   20,   20,   20,   19,   20,   18,   19,   &
+           18,   18,   19,   19,   20,    0,    0,    0,    0,    0    &
+                                      /
+      DATA (zrnfm(jm,103),jm=1,jpmois)/12*82858./
+
+      !  Total run-offs(VIII)=82858 m3/s
+      !  Total run-offs(I+II+III+IV+V+VI+VII+VIII)= 649941. m3/s
+      !                                           = 0.649940955 Sverdrup
+
+
+      DATA (inb(jr),jr=104,jpriv)/17*0/
+
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'flxrnf : runoff + orca2'
+         IF(lwp) WRITE(numout,*) '~~~~~~'
+         IF(lwp) WRITE(numout,*) '   nrunoff = ', nrunoff
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      ! 0. initialization and  indexes  modification for zoom version
+      ! --------------------------------------------------------------
+      
+      
+      ! conversion factor m3/s --> kg/m2/s *e1t*e2t
+
+      zconv = rauw
+
+      IF( kt == nit000 ) THEN 
+         ! Set runoffs and upstream coeff to zero
+         runoff (:,:) = 0.e0                                                                                  
+         upsrnfh(:,:) = 0.e0
+         upsrnfz(:)   = 0.e0
+         upsadv (:,:) = 0.e0
+         zcoefr(:,:,:) = 0.e0
+
+         IF( nrunoff == 0 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' NO RUNOFF in this simulation '
+            IF(lwp) WRITE(numout,*)
+         ENDIF
+      ENDIF
+
+      ! 1. initialization of the runoff array
+      ! -------------------------------------
+
+      IF( nrunoff == 1 .OR. nrunoff == 2) THEN
+
+         iman  = jpmois
+         
+         i15 = nday / 16
+         
+         imois = nmonth + i15 - 1
+         IF( imois == 0) imois = iman
+         IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
+            ! Number of Day Between Data
+            idbd = nbiss(imois)
+         ELSEIF( nleapy > 1 ) THEN
+            idbd = nleapy
+         ELSE
+            idbd = nobis(imois)
+         ENDIF
+         ! Number of days between imois, 15 and the end of month
+         idmeom = idbd - 15
+         
+         ! 1.1 Calendar computation
+         
+         ! nrnf1 number of the first array record used in the simulation
+         ! nrnf2 number of the last  array record
+         
+         nrnf1 = imois
+         nrnf2 = nrnf1 + 1
+         nrnf1 = MOD( nrnf1, iman )
+         IF( nrnf1 == 0 ) nrnf1 = iman
+         nrnf2 = MOD( nrnf2, iman )
+         IF( nrnf2 == 0 ) nrnf2 = iman
+         
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'flxrnf routine'
+            IF(lwp) WRITE(numout,*) 'first array record used nrnf1 ',nrnf1
+            IF(lwp) WRITE(numout,*) 'last  array record used nrnf2 ',nrnf2
+         ENDIF
+
+         zxy = FLOAT( nday + idmeom - idbd * i15 ) / idbd
+
+         DO jr = 1, jpriv-1
+            inbp = inb(jr)
+            IF( inbp /= 0 ) THEN
+               DO jl = 1, inbp
+                  ii = iirnf(jl,jr) - nimpp + 1 - jpizoom + 1
+                  ij = ijrnf(jl,jr) - njmpp + 1 - jpjzoom + 1
+                  iipt0 = MAX( 1, MIN( ii, jpi   ) )
+                  iipt1 = MAX( 0, MIN( ii, jpi-1 ) )
+                  ijpt0 = MAX( 1, MIN( ij, jpj   ) )
+                  ijpt1 = MAX( 0, MIN( ij, jpj-1 ) )
+                  DO jj = ijpt0, ijpt1
+                     DO ji = iipt0, iipt1
+                        runoff(ji,jj) = runoff(ji,jj)   & 
+                                      + ( (1.-zxy) * zrnfm(nrnf1,jr)   &
+                                      +       zxy  * zrnfm(nrnf2,jr)  ) / FLOAT(inbp)
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+         END DO
+
+
+         ! 2. conversion in mm/day
+         ! -----------------------
+         !     C a u t i o n : upward water flux, runoff is negative
+
+         runoff(:,:) = -zconv * runoff(:,:) / ( e1t(:,:) * e2t(:,:) )
+         
+
+         ! 3. advectve coefficient
+         ! -----------------------
+
+         !  Creates the array coef that contains the coefficient to affect to
+         !  the upstream scheme. advection scheme will be:
+         !  coefr * upstream + (1- coefr) centered
+         !  coefr must be between 0 and 1.
+         !  3 values are used: maximum = zrup1, between zrup2, small zrup3.
+         ! 
+         IF( nrunoff == 2 .AND. kt == nit000 ) THEN
+
+            zrup1 = 0.5
+            zrup2 = 0.25
+            zrup3 = 0.125
+            DO jr = 1, jpriv-1
+               inbp = inb(jr)
+               IF( inbp /= 0) THEN
+                  DO jl = 1, inbp
+                     ! --> zrup1 (originally, = 1 = all upstream).
+                     ! ji,jj
+                     ii = iirnf(jl,jr) - nimpp + 1 - jpizoom - 1
+                     ij = ijrnf(jl,jr) - njmpp + 1 - jpjzoom - 1
+                     iipt0 = MAX( 1, MIN( ii,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii,jpi-1) )
+                     ijpt0 = MAX( 1, MIN( ij,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = zrup1
+                           END DO
+                           zcoefr(ji,jj,4) = zrup2
+                           zcoefr(ji,jj,5) = zrup3
+                        END DO
+                     END DO
+                     ! --> zrup2 (originally = 0.5)
+                     ! ji,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1, jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1, jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1, jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1, jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj-1
+                     iipt0 = MAX( 1, MIN( ii+1, jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+1, jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj
+                     ijpt0 = MAX( 1, MIN( ij, jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij, jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj+1
+                     iipt0 = MAX( 1, MIN( ii-1,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii-1,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj
+                     ijpt0 = MAX( 1, MIN( ij,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! --> zrup3 (originally = 0.25)
+                     ! ji-1,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-1,jj-2
+                     ijpt0 = MAX( 1, MIN( ij-2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji,jj-2
+                     iipt0 = MAX( 1, MIN( ii,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+1,jj-2
+                     iipt0 = MAX( 1, MIN( ii+1,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+1,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+1,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj-2
+                     iipt0 = MAX( 1, MIN( ii+2,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+2,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3  
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj
+                     ijpt0 = MAX( 1, MIN( ij,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj
+                     iipt0 = MAX( 1, MIN( ii-2,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii-2,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3        
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj-2
+                     ijpt0 = MAX( 1, MIN( ij-2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                  END DO
+               ENDIF
+            END DO
+            upsrnfh(:,:) = zcoefr(:,:,1)
+            upsrnfz(:)   = 0.e0
+            upsrnfz(1)   = 1.0
+            upsrnfz(2)   = 1.0
+            upsrnfz(3)   = zrup1
+            upsrnfz(4)   = zrup2
+            upsrnfz(5)   = zrup3
+
+            ! Reduces the sea surface restoring term to Levitus98
+            ! in the Sound Strait
+            DO jj = mj0(116), mj1(116)
+               DO ji = mi0(144), mi1(144)
+                  upsrnfh(ji,jj) = 0.25
+               END DO
+               DO ji = mi0(145), mi1(147)
+                  upsrnfh(ji,jj) = 0.5
+               END DO
+               DO ji = mi0(148), mi1(148)
+                  upsrnfh(ji,jj) = 0.25
+               END DO
+            END DO
+         ENDIF
+      ENDIF
+      
+      ! Upstream and centered scheme in the vicinity of some straits
+
+      IF( kt == nit000 ) THEN
+
+         ! ORCA_R2 configuration :
+         ! Gibraltar Strait
+         DO jj = mj0(102), mj1(102)
+            DO ji = mi0(138), mi1(138)
+               upsadv(ji,jj) = 0.2
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)
+            DO ji = mi0(139), mi1(139)
+               upsadv(ji,jj) = 0.4
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)
+            DO ji = mi0(140), mi1(140)
+               upsadv(ji,jj) = 0.5
+            END DO
+         END DO
+         DO jj = mj0(101), mj1(102)
+            DO ji = mi0(141), mi1(141)
+               upsadv(ji,jj) = 0.5
+            END DO
+         END DO
+         ! Bab el Mandeb Strait
+         DO jj = mj0(87), mj1(88)
+            DO ji = mi0(164), mi1(164)
+               upsadv(ji,jj) = 0.1
+            END DO
+         END DO
+         DO jj = mj0(88), mj1(88)
+            DO ji = mi0(163), mi1(163)
+               upsadv(ji,jj) = 0.25
+            END DO
+         END DO
+         DO jj = mj0(88), mj1(88)
+            DO ji = mi0(162), mi1(162)
+               upsadv(ji,jj) = 0.4
+            END DO
+         END DO
+         DO jj = mj0(88), mj1(88)
+            DO ji = mi0(160), mi1(161)
+               upsadv(ji,jj) = 0.5
+            END DO
+         END DO
+         DO jj = mj0(89), mj1(89)
+            DO ji = mi0(158), mi1(160)
+               upsadv(ji,jj) = 0.25
+            END DO
+         END DO
+         DO jj = mj0(90), mj1(90)
+            DO ji = mi0(160), mi1(160)
+               upsadv(ji,jj) = 0.25
+            END DO
+         END DO
+         ! Sound Strait
+         DO jj = mj0(116), mj1(116)
+            DO ji = mi0(145), mi1(147)
+               upsadv(ji,jj) = 0.5
+            END DO
+         END DO
+
+      ENDIF
Index: /branches/nemo/NEMO/OPA_SRC/SBC/flxrnf_ORCA_R4.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/flxrnf_ORCA_R4.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/flxrnf_ORCA_R4.h90	(revision 4)
@@ -0,0 +1,1338 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  flxrnf_ORCA_R4.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!                  OLD ORCA R4 runoff specification
+   !!                      kept here for memory
+   !!                         ( 20/04/2000 )
+   !!----------------------------------------------------------------------
+
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER  :: kt
+      INTEGER  :: jpmois
+      INTEGER  ::   &
+         jpriv,    & ! jpriv : maximum river number
+         jpcoef      ! jpcoef: maximum point number
+      INTEGER, PARAMETER ::   jpmois=12, jpriv=120, jpcoef=150
+
+      INTEGER  ::   ji, jj, jl, jm, jn, jr, jc
+      INTEGER  ::   i15, imois, iman
+      INTEGER  ::   inbp, idbd, idmeom
+      INTEGER  ::   iipt0, iipt1, ijpt0, ijpt1, ii, ij
+      INTEGER  ::   iirnf(jpcoef,jpriv),ijrnf(jpcoef,jpriv)
+      INTEGER  ::   inb(jpriv)
+
+      REAL(wp) ::   zconv, zxy
+      REAL(wp) ::   zrup1,zrup2,zrup3
+      REAL(wp) ::   zrnfm(jpmois, jpriv)
+      REAL(wp) ::   zcoefr(jpi, jpj, 5)
+      CHARACTER (len=20) ::   criver(jpriv)
+
+      REAL(wp) ::   zbilan , zero
+
+      COMMON/zzzrnf/ zrnfm, iirnf, ijrnf, inb
+
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+      ! ====
+      ! DATA
+      ! ====
+
+      zero = 0.0e0
+      IF( kt == nit000 ) THEN 
+          criver = "                    "
+          inb = 0
+          iirnf = 0
+          ijrnf = 0
+          zrnfm  = zero
+          runoff = zero
+         
+          ! I NORTH AMERICA
+          ! ---------------
+          
+          ! 1-Saint Lawrence (Canada) 49N30 67W00           R2
+          ! Old=447 km3/year=14165m3/s; CLIPPER=12430m3/s; ratio=1.14
+          ! --> 13975.249m3/s
+          criver(1) = "Saint Lawrence      "
+          inb(1) = 1
+          iirnf(1:1,1) = 57
+          ijrnf(1:1,1) = 55
+          zrnfm(1:jpmois,1) = (/   &
+              11718.,  11971.,  12466.,  14980.,  19257.,  16913.,   &
+              14211.,  13119.,  13367.,  13644.,  13463.,  12594./)
+          ! 2-Hudson River (USA) 41N00 77W00                R1
+          ! Old=12 km3/year=380m3/s; UNESCO(64-83,p255)=408m3/s
+          ! --> 407.416687m3/s
+          criver(2) = "Hudson River        "
+          inb(2) = 1
+          iirnf(1:1,2) = 54
+          ijrnf(1:1,2) = 53
+          zrnfm(1:jpmois,2) = (/   &
+              364.,    404.,    648.,    873.,    593.,    301.,   &
+              205.,    171.,    205.,    290.,    379.,    456./)
+          ! 3-Missisipi and Atchafalaya (USA) 29N 90W       R1 
+          ! Old=580 km3/year=18380m3/s; CLIPPER=17599m3/s
+          ! --> 17599.334m3/s
+          criver(3) = "Missisipi           "
+          inb(3) = 1
+          iirnf(1:1,3) = 50
+          ijrnf(1:1,3) = 49
+          zrnfm(1:jpmois,3) = (/   &
+              19260.,  20813.,  23026.,  28160.,  26510.,  19650.,   &
+              14181.,  10676.,   9578.,  10167.,  11699.,  17472./)
+          ! 4-Brazos (USA) 29N58 95W53                      R1
+          ! Old=7 km3/year=222m3/s; UNESCO(65-84, p298)=200m3/s
+          ! --> 199.666656m3/s
+          criver(4) = "Brazos              "
+          inb(4) = 1
+          iirnf(1:1,4) = 48
+          ijrnf(1:1,4) = 49
+          zrnfm(1:jpmois,4) = (/   &
+              165.,    224.,    200.,    266.,    457.,    327.,   &
+              143.,     69.,    102.,    132.,    160.,    151. /)
+          ! 5-Colorado (Mexico) 31N54 114W57                R5
+          ! Old=20 km3/year=634m3/s
+          ! --> 634.m3/s
+          criver(5) = "Colorado            "
+          inb(5) = 1
+          iirnf(1:1,5) = 43
+          ijrnf(1:1,5) = 50
+          zrnfm(1:jpmois,5) = 634. 
+          ! 6-Columbia (USA) 45N60 121W17                   R1
+          ! Old=251 km3/year=7954m3/s; UNESCO(65-84, p312)=5368m3/s
+          ! --> 5368.41602m3/s
+          criver(6) = "Columbia            "
+          inb(6) = 1
+          iirnf(1:1,6) = 40
+          ijrnf(1:1,6) = 56
+          zrnfm(1:jpmois,6) = (/   &
+              4752.,    5077.,    5633.,    6075.,    8422.,    9822.,   &
+              6350.,    4112.,    3273.,    3251.,    3548.,    4106. /)
+          ! 7-Fraser (USA) 47N 124W                         R5
+          ! Old=112 km3/year=3550m3/s;not found in UNESCO
+          ! --> 3549.99976m3/s
+          criver(7) = "Fraser              "
+          inb(7) = 1
+          iirnf(1:1,7) = 40
+          ijrnf(1:1,7) = 57
+          zrnfm(1:jpmois,7) = 3550. 
+          ! 8-Yukon (USA) 63N00 165W00                      R3
+          ! Old=195 km3/year=6179m3/s; UNESCO(65-77+80-84, p321)=4245; ratio=1.46
+          ! --> 6017.24951m3/s
+          criver(8) = "Yukon               "
+          inb(8) = 1
+          iirnf(1:1,8) = 30
+          ijrnf(1:1,8) = 62
+          zrnfm(1:jpmois,8) = (/   &
+              1459.,    1213.,    1065.,    1100.,    9067.,   17675.,   &
+              10680.,   11271.,    8658.,    5453.,    2649.,    1917./)
+          ! 9-Copper (USA) 61N47 144W45                     R2
+          ! Old=39 km3/year=1236m3/s; UNESCO(65-84, p317)=1052m3/s; ratio=1.18
+          ! --> 1236.25m3/s
+          criver(9) = "Copper              "
+          inb(9) = 1
+          iirnf(1:1,9) = 35
+          ijrnf(1:1,9) = 60
+          zrnfm(1:jpmois,9) = (/   &
+              219.,    195.,    181.,    214.,    904.,   2532.,   &
+              4026.,   3627.,   1632.,    697.,    354.,    254. /) 
+          ! 10-Susitna (USA)   62N 150E                     R5
+          ! Old=40 km3/year=1268m3/s
+          ! --> 1268.m3/s
+          criver(10) = "Susitna             "
+          inb(10) = 1
+          iirnf(1:1,10) = 34
+          ijrnf(1:1,10) = 60
+          zrnfm(1:jpmois,10) = 1268. 
+          ! 11-McKenzie (Canada) 70N00 135W00               R3
+          ! Old=306 km3/year=9697m3/s; UNESCO(67+72+7479+82-84, p168)=8343m3/s;
+          ! ratio=1.16
+          ! --> 9606.66797m3/s
+          criver(11) = "McKenzie            "
+          inb(11) = 1
+          iirnf(1:1,11) = 35
+          ijrnf(1:1,11) = 66
+          zrnfm(1:jpmois,11) = (/   &
+              3644.,    3400.,    3258.,    3546.,   14188.,   21544.,   &
+              18954.,   15487.,   11284.,   10169.,    5901.,    3905./)
+          ! 12-Kuksokwim (USA) 60N00 ~162W30                R4
+          ! UNESCO(65-84, p318)=1112m3/s (61N87 158E10, Crooked Creek, inland)
+          ! --> 1111.99988m3/s
+          criver(12) = "Kuksokwim           "
+          inb(12) = 1
+          iirnf(1:1,12) = 30
+          ijrnf(1:1,12) = 60
+          zrnfm(1:jpmois,12) = (/   &
+              335.,     308.,     295.,     407.,    2415.,    2027.,   &
+              1917.,   2049.,    1585.,    1072.,     545.,     389./)
+          ! 13-Nelson
+          criver(13) = "Nelson              "
+          inb(13) = 1
+          iirnf(1:1,13) = 51
+          ijrnf(1:1,13) = 65
+          zrnfm(1:jpmois,13) = 0.
+
+          ! Total run-offs(I)=60974.2539m3/s
+
+          ! II SOUTH AMERICA
+          ! -----------------
+          ! 16-Chira (Peru) 4s54 81w08                      R2
+          ! Old=5 km3/year=158m3/s; UNESCO (65-68, p357)=80.9; ratio=1.95
+          ! --> 158.000015m3/s
+          criver(16) = "Chira               "
+          inb(16) = 1
+          iirnf(1:1,16) = 51
+          ijrnf(1:1,16) = 34
+          zrnfm(1:jpmois,16) = (/   &
+              70.,     105.,     564.,     582.,     230.,      94.,   &
+              87.,      47.,      35.,      32.,      29.,      21./)
+          ! 17-Magdalena (Colombia) 11N06 74W51             R2
+          ! Old=237 km3/year=7510m3/s; UNESCO(71-73+76-79, p348)=6973m3/s;
+          ! ratio=1.08
+          ! --> 7451.58301m3/s
+          criver(17) = "Magdelena           "
+          inb(17) = 1
+          iirnf(1:1,17) = 53
+          ijrnf(1:1,17) = 45
+          zrnfm(1:jpmois,17) = (/   &
+              6598.,    4441.,    4087.,    5445.,    7380.,    8067.,   &
+              8509.,    7428.,    7631.,    9296.,   10588.,    9949./)
+          ! 18-Orinoco (Venezuela) 8N37 62W15!              R1
+          ! Old=1100 km3/year=34857m3/s; UNESCO(73-75, p364)=28736m3/s;
+          ! HLA=26371m3/s
+          ! Data from HLA: 8.1N - 63.3W   1925/89
+          ! --> 26371.416
+          criver(18) = "Orinico             "
+          inb(18) = 1
+          iirnf(1:1,18) = 57
+          ijrnf(1:1,18) = 44
+          zrnfm(1:jpmois,18) = (/   &
+              10670.,    7513.,    6344.,    6887.,   13086.,   26699.,   &
+              43938.,   59957.,   57435.,   39951.,   27410.,   16567./)
+          ! 19-Amazon (Brazil) 0S05 50W00                   R1
+          ! Old=6300 km3/year=199634m3/s; CLIPPER=166192m3/s~UNESCO;
+          ! HLA=184806m3/s
+          ! UNESCO data are at Obidos which is far inland and therefore does not
+          ! fully represent the actual discharge
+          ! Data from HLA: 1.5N - 55.3W   1970/96
+          ! --> 184845.484m3/s
+          criver(19) = "Amazon              "
+          inb(19) = 3
+          iirnf(1:3,19) = (/ 60, 60, 60 /)
+          ijrnf(1:3,19) = (/ 39, 40, 41 /)
+          zrnfm(1:jpmois,19) = (/   &
+              152233., 176415., 199941., 225565., 244016., 244861.,   &
+              230711., 203128., 164531., 128486., 118214., 130045. /)
+          ! 20-Sao Francisco (Brazil) 10S30 36W24           R1
+          ! Old=97 km3/year=3074m3/s; UNESCO(77-79, p338)=2645m3/s
+          ! --> 2645.3335m3/s
+          criver(20) = "San Fransisco       "
+          inb(20) = 1
+          iirnf(1:1,20) = 63
+          ijrnf(1:1,20) = 31
+          zrnfm(1:jpmois,20) = (/   &
+              3244.,   4116.,   5139.,   4330.,   2323.,   1800.,     &
+              1587.,   1511.,   1593.,   1740.,   2190.,   2171. /)
+          ! 21-Parana+Uruguay(Arg./Uru.) 34S12 58W18        R1 
+          ! Old=470 km3/year=14893m3/s; UNESCO(p323/324)=22263m3/s
+          ! --> 22203.168m3/s 
+          criver(21) = "Parana              "
+          inb(21) = 1
+          iirnf(1:1,21) = 58
+          ijrnf(1:1,21) = 24
+          zrnfm(1:jpmois,21) = (/   &
+              24803.,   26836.,   24585.,   21358.,   20041.,   21689.,   &
+              22647.,   20403.,   19627.,   21400.,   21126.,   21923./)
+          ! 22-Negro (Argentina)  41S02  62W47              R2
+          ! Old=30 km3/year=951m3/s; UNESCO(65-79,p330)=765m3/s; ratio=1.24
+          ! --> 907.666687m3/s
+          criver(22) = "Rio Negro           "
+          inb(22) = 1
+          iirnf(1:1,22) = 56
+          ijrnf(1:1,22) = 22
+          zrnfm(1:jpmois,22) = (/   &
+              882.,     587.,     519.,     482.,     623.,     984.,   &
+              1120.,   1294.,    1092.,    1166.,    1105.,    1038./)
+          ! 23- Tocantins :  ~48W00 ~0.5S                   R4
+          ! UNESCO(76-77+80-81, p335)=12167m3/s (station far inland!)
+          ! --> 12173.082m3/s
+          criver(23) = "Tocantins           "
+          inb(23) = 1
+          iirnf(1:1,23) = 60
+          ijrnf(1:1,23) = 38
+          zrnfm(1:jpmois,23) = (/   &
+              15507.,  24855.,  27854.,  24257.,  15860.,   7861.,   &
+              4440.,   3082.,   2728.,   3417.,   5511.,  10705. /)
+
+          ! Total run-offs(II)=256755.75
+          ! Total run-offs(I+II)=317730
+
+          ! III EUROPE
+          ! ----------
+          ! 26-Rhone (France) 43N20 4E50                    R1 
+          ! Old=49 km3/year=1553m3/s; UNESCO(65-83, p512)=1229
+          ! --> 1217.16663m3/s
+          criver(26) = "Rhone               "
+          inb(26) = 1
+          iirnf(1:1,26) = 76
+          ijrnf(1:1,26) = 55
+          zrnfm(1:jpmois,26) = (/   &
+              1385.,    1848.,    1568.,    1311.,    1420.,    1191.,   &
+              937.,     796.,     794.,     962.,    1161.,    1233./)
+          ! 27-Po (Italy) 41N10 11E09                       R1 
+          ! Old=46 km3/year=1458m3/s; UNESCO(65-84, p527)=1550m3/s
+          ! --> 1550.08337m3/s
+          criver(27) = "Po                  "
+          inb(27) = 1
+          iirnf(1:1,27) = 79
+          ijrnf(1:1,27) = 54
+          zrnfm(1:jpmois,27) = (/   &
+              1304.,    1605.,    1856.,    1549.,    1958.,    1760.,   &
+              1040.,    1007.,    1615.,    1907.,    1772.,    1228./)
+          ! 28-Danube (Roumania) 45N20 29E40                R1 
+          ! Old=206 km3/year=6527m3/s; UNESCO(65-84, p544)=7011m3/s
+          ! --> 7011.8335m3/s
+          criver(28) = "Danube              "
+          inb(28) = 1
+          iirnf(1:1,28) = 87
+          ijrnf(1:1,28) = 53
+          zrnfm(1:jpmois,28) = (/   &
+              6625.,    7352.,    7986.,    9279.,    9482.,    8618.,   &
+              7586.,    6001.,    5210.,    4989.,    4921.,    6093./)
+
+          ! 29-Volga
+          criver(29) = "Volga               "
+          inb(29) = 1
+          iirnf(1:1,29) = 4
+          ijrnf(1:1,29) = 56
+          zrnfm(1:jpmois,29) = 0.
+          ! 30-Dniepr
+          criver(30) = "Dniepr+Don          "
+          inb(30)= 2
+          iirnf(1:2,30) = (/ 89, 90 /)
+          ijrnf(1:2,30) = (/ 56, 56 /)
+
+          ! Total run-offs(III)=9779.08301m3/s
+          ! Total run-offs(I+II+III)=327509.094m3/s
+
+          ! IV EURASIAN ARCTIC
+          ! ------------------
+          ! 31-Iana (Russia)      126E40 72N25              R1
+          ! Old=29 km3/year=919m3/s; UNESCO(65-72+74+76-84, p463)=936m3/s
+          ! --> 0m3/s
+          criver(31) = "Iana                "
+          inb(31) = 1
+          iirnf(1:1,31) = 20
+          ijrnf(1:1,31) = 68
+          zrnfm(1:jpmois,31) = (/   &
+              2.,       1.,       0.,       0.,     917.,    3514.,   &
+              2968.,    2329.,    1322.,   178.,      36.,       8./)
+          ! 32-Ob (Russia) 66N45 69E30                      R1 
+          ! Old=385 km3/year=12200m3/s; UNESCO(65-84, p478)=12862m3/s
+          ! --> 12861.5m3/s
+          criver(32) = "Ob                  "
+          inb(32) = 1
+          iirnf(1:1,32) = 78
+          ijrnf(1:1,32) = 72
+          zrnfm(1:jpmois,32) = (/   &
+              4977.,    4150.,    3611.,    3590.,   14723.,   33366.,   &
+              30773.,   22785.,   14701.,    9705.,    6078.,    5879./)
+          ! 33-Yenesei (Russia) 71N50 82E40                 R1 
+          ! Old=560 km3/year=17745m3/s; UNESCO(65-84, p472)=17462m3/s
+          ! --> 17461.666m3/s
+          criver(33) = "Yenesei             "
+          inb(33) = 1
+          iirnf(1:1,33) = 77
+          ijrnf(1:1,33) = 75
+          zrnfm(1:jpmois,33) = (/   &
+              6659.,    7007.,    6895.,    7089.,   24183.,   74965.,   &
+              25325.,   15940.,   16050.,   12678.,    6741.,    6008./)
+          ! 34-Severnaya Dvina(Russia)64N32 40E30           R5 
+          ! Old=106 km3/year=3359m3/s; not in UNESCO data base
+          ! --> 3359.00024m3/s
+          criver(34) = "Severnaya Dvina     "
+          inb(34) = 1
+          iirnf(1:1,34) = 78
+          ijrnf(1:1,34) = 68
+          zrnfm(1:jpmois,34) = 3359.
+          ! 35-Lena (Russia) 72N25 126E40                   R1 
+          ! --> 16192.333m3/s
+          criver(35) = "Lena                "
+          inb(35) = 1
+          iirnf(1:1,35) = 20
+          ijrnf(1:1,35) = 68
+          zrnfm(1:jpmois,35) = (/   &
+              2663.,    2095.,    1629.,    1324.,    7203.,   64230.,   &
+              40810.,   28310.,   25995.,   13299.,    3673.,    3077./)
+          ! 36-Kolyma (Russia) 69N30 161E00                 R1
+          ! Old=71 km3/year=2250m3/s; UNESCO(65-84)=2138m3/s
+          ! --> 2138.66675m3/s
+          criver(36) = "Kolyma              "
+          inb(36) = 1
+          iirnf(1:1,36) = 24
+          ijrnf(1:1,36) = 65
+          zrnfm(1:jpmois,36) = (/   &
+              131.,      92.,      76.,      65.,    2576.,    9143.,   &
+              4670.,    3727.,    3226.,    1119.,     630.,     209./)
+          ! 37-Indigirka (russia) 70N48 148E54              R1 
+          ! Old=55 km3/year=1743m3/s; UNESCO(65-68+70+72-84)=1622.
+          ! --> 1622.00012m3/s
+          criver(37) = "Indigirka           "
+          inb(37) = 1
+          iirnf(1:1,37) = 23
+          ijrnf(1:1,37) = 66
+          zrnfm(1:jpmois,37) = (/   &
+              32.,      17.,      11.,       7.,     354.,    5629.,   &
+              5210.,    4617.,    2823.,     559.,     142.,      63./)
+          ! 38-Khatanga
+          criver(38) = "Khatanga             "
+          inb(38) = 1
+          iirnf(1:1,38) = 20
+          ijrnf(1:1,38) = 72
+          zrnfm(1:jpmois,38) = 0.
+
+          ! Total run-offs(IV)=40773.6641m3/s
+          ! Total run-offs(I+II+III+IV)=368282.75m3/s
+
+          ! V ASIA
+          ! ------
+          ! 41-Amur (Russia) 52N56 141E10                   R2
+          ! Old=325 km3/year=10299m3/s; UNESCO(65-84, p451)=8792m3/s; ratio=1.17
+          ! --> 10299.332m3/s
+          criver(41) = "Amur                "
+          inb(41) = 1
+          iirnf(1:1,41) = 18
+          ijrnf(1:1,41) = 59
+          zrnfm(1:jpmois,41) = (/   &
+              2108.,    1543.,    1252.,    4088.,   15464.,   17336.,   &
+              16100.,   20801.,   21548.,   15658.,    5188.,    2506./)
+          ! 42-Liaohe (China) 40N40 122E09                  R5
+          ! Old=6 km3/year=190m3/s; not found in UNESCO data base
+          ! --> 189.999985m3/s
+          criver(42) = "Liaohe              "
+          inb(42) = 1
+          iirnf(1:1,42) = 15
+          ijrnf(1:1,42) = 54
+          zrnfm(1:jpmois,42) = 190.
+          ! 43-Daling (China) 40N56 121E43                  R5
+          ! Old=1 km3/year=32m3/s; not found in UNESCO data base
+          ! --> 31.9999962m3/s
+          criver(43) = "Daling              "
+          inb(43) = 1
+          iirnf(1:1,43) = 15
+          ijrnf(1:1,43) = 54
+          zrnfm(1:jpmois,43) = 32.
+          ! 44-Haiho (China) 6N17   1E23
+          ! Old=2 km3/year=64m3/s; not found in UNESCO data base
+          ! --> 63.9999924m3/s
+          criver(44) = "Haiho               "
+          inb(44) = 0
+          iirnf(1:1,44) = 0
+          ijrnf(1:1,44) = 0
+          zrnfm(1:jpmois,44) = 64.
+          ! 45-Yellow/Huangho (China) 37N32 118E19          R2 
+          ! Old=49 km3/year=1553m3/s; UNESCO(p371)=1210m3/s; ratio=1.28
+          ! --> 1552.5m3/s
+          criver(45) = "Yellow/Huangho      "
+          inb(45) = 1
+          iirnf(1:1,45) = 13
+          ijrnf(1:1,45) = 51
+          zrnfm(1:jpmois,45) = (/   &
+              697.,     674.,    1282.,    1206.,    1109.,     778.,   &
+              1964.,    3270.,    3668.,    2133.,     978.,     871./)
+          ! 46-Yangtze (China) 31N48 121E10=Changjiang      R2
+          ! Old=900 km3/year=28520m3/s; UNESCO(p372)=25032m3/s; ratio=1.14
+          ! --> 28519.584m3/s
+          criver(46) = "Yangtze             "
+          inb(46) = 1
+          iirnf(1:1,46) = 13
+          ijrnf(1:1,46) = 50
+          zrnfm(1:jpmois,46) = (/   &
+              10994.,   10548.,   13254.,   24097.,   36972.,   47197.,   &
+              53891.,   42070.,   37627.,   30762.,   22046.,   12777./)
+          ! 47-Pearl/Zhujiang (China) 23N36 106E34=Xijiang  R2 
+          ! Old=302 km3/year=9570m3/s; UNESCO(76,82, p373)=6987m3/s; ratio=1.37
+          ! --> 9570.75m3/s
+          criver(47) = "Pearl Zhujiang       "
+          inb(47) = 1
+          iirnf(1:1,47) = 12
+          ijrnf(1:1,47) = 48
+          zrnfm(1:jpmois,47) = (/   &
+              2357.,    2415.,    2634.,    6446.,   14246.,   18395.,   &
+              19213.,   17558.,   12312.,    7255.,    5864.,    6154./)
+          ! 48-Red/Hungho (Vietnam) 20N17 106E34            R5 
+          ! Old=123 km3/year=3897m3/s; not in UNESCO data base
+          ! --> 3897.m3/s
+          criver(48) = "Red Hungho          "
+          inb(48) = 1
+          iirnf(1:1,48) = 10
+          ijrnf(1:1,48) = 47
+          zrnfm(1:jpmois,48) = 3897.
+          ! 49-Mekong (Vietnam) 10N33 105E24                R5
+          ! Old=470 km3/year=14893m3/s; not in UNESCO data base
+          ! --> 14893.0029m3/s
+          criver(49) = "Mekong              "
+          inb(49) = 1
+          iirnf(1:1,49) =  8
+          ijrnf(1:1,49) = 44
+          zrnfm(1:jpmois,49) = 14893.
+          ! 50-Irrawady (Burma) 15N50  95E06                R5
+          ! Old=428 km3/year=13563m3/s; not in UNESCO data base
+          ! --> 13563.m3/s
+          criver(50) = "Irrawady            "
+          inb(50) = 1
+          iirnf(1:1,50) =  6
+          ijrnf(1:1,50) = 46
+          zrnfm(1:jpmois,50) = 13563.
+          ! 51-Ganges+Brahmaputra (Beng.) 22N00  91E00      R1
+          ! Old=971 km3/year=30769m3/s; UNESCO(69-70+73-75, p367)=31760m3/s
+          ! --> 32147.498m3/s
+          criver(51) = "Ganges              "
+          inb(51) = 2
+          iirnf(1:2,51) = (/  4,  5 /)
+          ijrnf(1:2,51) = (/ 47, 47 /)
+          zrnfm(1:jpmois,51) = (/   &
+              6623.,    6315.,    6432.,    9410.,   17263.,   38302.,   &
+              64688.,   80338.,   84802.,   43387.,   17888.,   10322./)
+          ! 52-Mehandi (India)                              R5
+          ! Old=67 km3/year=2123m3/s; not in UNESCO data base
+          ! --> 0m3/s
+          criver(52) = "Mehandi             "
+          inb(52) = 0
+          iirnf(1:1,52) = 0
+          ijrnf(1:1,52) = 0
+          zrnfm(1:jpmois,52) = 2123.
+          ! 53-Damodar (India)                              R2
+          ! Old=10 km3/year=320m3/s; UNESCO(p386)=173m3/s; ratio=1.85
+          ! --> 432.916656m3/s
+          criver(53) = "Damodar             "
+          inb(53) = 0
+          iirnf(1:1,53) = 0
+          ijrnf(1:1,53) = 0
+          zrnfm(1:jpmois,53) = (/   &
+              51.,      37.,      42.,      49.,      85.,     296.,   &
+              896.,    1390.,    1591.,     542.,     172.,      44./)  
+          ! 54-Godavari (India) 17N00  81E45                R2
+          ! Old=84 km3/year=2662m3/s; UNESCO(p379)=1916m3/s; ratio=1.39
+          ! --> 3670.5m3/s
+          criver(54) = "Godaravi            "
+          inb(54) = 1
+          iirnf(1:1,54) =  3
+          ijrnf(1:1,54) = 46
+          zrnfm(1:jpmois,54) = (/   &
+              988.,     737.,     280.,     219.,     196.,    1691.,   &
+              8063.,   14571.,   11428.,    3953.,    1221.,     699./)
+          ! 55-Indus (Pakistan) 24N20  67E47                R2
+          ! Old=238 km3/year=7542m3/s; UNESCO (76-79, p428)=2396m3/s; ratio=3.15
+          ! --> 7562.m3/s
+          criver(55) = "Indus               "
+          inb(55) = 1
+          iirnf(1:1,55) = 89
+          ijrnf(1:1,55) = 47
+          zrnfm(1:jpmois,55) = (/   &
+              988.,     737.,    1904.,    1968.,    3625.,    6143.,   &
+              15969.,    36656.,  17173.,    3215.,    1251.,    1115./)
+          ! 56-Tigris and Euphrates (Iraq) 31N00  47E25     R1
+          ! Old=46 km3/year=1458m3/s; UNESCO(76-79, p428)=2396m3/s
+          ! --> 2248.8335m3/s
+          criver(56) = "Tigris              "
+          inb(56) = 1
+          iirnf(1:1,56) = 88
+          ijrnf(1:1,56) = 47
+          zrnfm(1:jpmois,56) = (/   &
+              1872.,    2127.,    2962.,    4944.,    5036.,    3078.,   &
+              1362.,     900.,     786.,     993.,    1184.,    1742./)
+
+          ! Total run-offs (V)=128642.922m3/s
+          ! Total run-offs (I+II+III+IV+V)=496925.688m3/s
+
+          ! VI AFRICA
+          ! ----------
+          ! 61-Nile (Egypt) 30N10  31E06                    R1
+          ! Old=30 km3/year=951m3/s; UNESCO(73-84)=1251m3/s
+          ! --> 1251.33337m3/s
+          criver(61) = "Nile                "
+          inb(61) = 1
+          iirnf(1:1,61) = 90
+          ijrnf(1:1,61) = 50
+          zrnfm(1:jpmois,61) = (/   &
+              1239.,    1035.,    1126.,    1110.,    1170.,    1542.,   &
+              1742.,    1559.,    1191.,    1103.,    1075.,    1124./)
+          ! 62-Niger (Nigeria) 5N33   6E33                  R1
+          ! Old=192 km3/year=6084m3/s; HLA=5545m3/s;
+          ! Data from HLA: 4.5N -  6  E   1950/87
+          ! --> 5545.08301m3/s
+          criver(62) = "Niger               "
+          inb(62) = 1
+          iirnf(1:1,62) = 74
+          ijrnf(1:1,62) = 41
+          zrnfm(1:jpmois,62) = (/   &
+              2029.,    1804.,    1573.,    1418.,    1494.,    2561.,   &
+              5272.,    9629.,   14951.,   16227.,    6842.,    2741./)
+          ! 63-Zaire/Congo (Congo) 6S04  12E24              R1      
+          ! Old=1250 km3/year=39610m3/s; UNESCO(65-83, p149)=41941m3/s; HLA
+          ! =39720m3/s
+          ! Data from HLA: 6S - 12  E   1902/96
+          ! --> 39719.5m3/s
+          criver(63) = "Zaire Congo         "
+          inb(63) = 1
+          iirnf(1:1,63) = 75
+          ijrnf(1:1,63) = 33
+          zrnfm(1:jpmois,63) = (/   &
+              47200.,   37692.,   34374.,   36603.,   37862.,   35588.,   &
+              30966.,   30774.,   35981.,   42825.,   51455.,   55314./)
+          ! 64-Orange (Sth Africa) 28S41 16E28              R5
+          ! Old=11 km3/year=349m3/s
+          ! --> 349.000031m3/s
+          criver(64) = "Orange              "
+          inb(64) = 1
+          iirnf(1:1,64) = 76
+          ijrnf(1:1,64) = 26
+          zrnfm(1:jpmois,64) = 349.
+          ! 65-Zambesi (Mozambique) 18S55 36E04             R5
+          ! Old=223 km3/year=7066m3/s
+          ! --> 7066.00049m3/s
+          criver(65) = "Zambesi             "
+          inb(65) = 1
+          iirnf(1:1,65) = 81
+          ijrnf(1:1,65) = 29
+          zrnfm(1:jpmois,65) = 7066.
+          ! 66-Limpopo (mozambique) 25S15 33E30             R5
+          ! Old=5 km3/year=158m3/s
+          ! --> 158.m3/s
+          criver(66) = "Limpopo             "
+          inb(66) = 1
+          iirnf(1:1,66) = 81
+          ijrnf(1:1,66) = 28
+          zrnfm(1:jpmois,66) = 158.
+          ! 67-Rufiji (tanzania) 8S00 39E20                 R5
+          ! Old=9 km3/year=285m3/s
+          ! --> 285.m3/s
+          criver(67) = "Rufiji             "
+          inb(67) = 1
+          iirnf(1:1,67) = 82
+          ijrnf(1:1,67) = 33
+          zrnfm(1:jpmois,67) = 285.
+          ! Other rivers from the Gulf of Guinea
+          ! 68-Kouilou (Congo)  4.5S-11.5E (UNESCO=p51)     R1
+          ! Data from HLA:  4S - 11  E   1953/86 = 919m3/s
+          ! --> 924.25m3/s
+          criver(68) = "Kouilou            "
+          inb(68) = 1
+          iirnf(1:1,68) = 75
+          ijrnf(1:1,68) = 33
+          zrnfm(1:jpmois,68) = (/   &
+              1115.,    1166.,    1285.,    1462.,    1454.,     725.,   &
+              480.,     378.,     327.,     400.,    1018.,    1281./)
+          ! 69-Nyanga (Gabon)  3S-10E (UNESCO=p66)          R1
+          ! Data from HLA: 2.8N - 10  E   1952/82 = 264m3/s
+          ! --> 264.166687m3/s
+          criver(69) = "Nyanga              "
+          inb(69) = 1
+          iirnf(1:1,69) = 74
+          ijrnf(1:1,69) = 36
+          zrnfm(1:jpmois,69) = (/   &
+              126.,      99.,     143.,     253.,     316.,     300.,   &
+              156.,      93.,     231.,     557.,     592.,     304./)
+          ! 70-Ogoue (Gabon) 1S-9E (UNESCO, p69)            R1
+          ! Data from HLA: .75S -  9  E   1930/90 = 4512m3/s
+          ! --> 4511.83301m3/s
+          criver(70) = "Ogoue               "
+          inb(70) = 1
+          iirnf(1:1,70) = 74
+          ijrnf(1:1,70) = 37
+          zrnfm(1:jpmois,70) = (/   &
+              4514.,    3988.,    4622.,    5403.,    5790.,    4145.,   &
+              2616.,    1961.,    2119.,    4304.,    7870.,    6810./)
+          ! 71-Sanaga (Cameroun) 3.5N-9.5E (UNESCO, p31)    R1
+          ! Data from HLA: 3.9N -  9.6E   1944/80 = 1983m3/s
+          ! --> 1982.58337m3/s
+          criver(71) = "Sanaga              "
+          inb(71) = 1
+          iirnf(1:1,71) = 74
+          ijrnf(1:1,71) = 41
+          zrnfm(1:jpmois,71) = (/   &
+              813.,     578.,     517.,     633.,     909.,    1278.,   &
+              1928.,    2653.,    4361.,    5470.,    3307.,    1344./)
+          ! 72-Nyong (Cameroun) 3.1N-9.5E (UNESCO, p36)     R1
+          ! Data from HLA: 3.5N -  9.8E   1951/84 = 432m3/s
+          ! --> 431.166656m3/s      
+          criver(72) = "Nyong               "
+          inb(72) = 1
+          iirnf(1:1,72) = 74
+          ijrnf(1:1,72) = 41
+          zrnfm(1:jpmois,72) = (/   &
+              232.,     128.,     150.,     266.,     402.,     459.,   &
+              353.,     306.,     604.,     930.,     878.,     466./)
+          ! 73-Ntem (Cameroun) 2.5N-9.5E (UNESCO, p36)      R1
+          ! Data from HLA: 3N -  9.8E   1951/87 = 330m3/s      
+          ! --> 329.75m3/s
+          criver(73) = "Ntem                "
+          inb(73) = 1
+          iirnf(1:1,73) = 74
+          ijrnf(1:1,73) = 41
+          zrnfm(1:jpmois,73) = (/   &
+              452.,     455.,     492.,     466.,     482.,     251.,   &
+              151.,     108.,      87.,     133.,     395.,     485./)
+          ! 74-Wouri (Cameroun) 4N-9.5E (UNESCO, p34)       R1
+          ! Data from HLA: 4N -  9.5E   1951/84  = 307m3/s
+          ! --> 306.583374m3/s
+          criver(74) = "Wouri               "
+          inb(74) = 1
+          iirnf(1:1,74) = 74
+          ijrnf(1:1,74) = 41
+          zrnfm(1:jpmois,74) = (/   &
+              88.,      63.,      68.,      95.,     139.,     222.,   &
+              395.,     633.,     825.,     675.,     328.,     148./)
+          ! 75-Oueme (Benin) 6.5N-2.5E (UNESCO, p27)        R1
+          ! Data from HLA:  6.2N -  2.5E   1951/84 =113m3/s
+          ! --> 112.666664m3/s
+          criver(75) = "Oueme               "
+          inb(75) = 1
+          iirnf(1:1,75) = 73
+          ijrnf(1:1,75) = 42
+          zrnfm(1:jpmois,75) = (/   &
+              0.,       0.,       0.,       0.,       1.,      18.,   &
+              96.,     324.,     531.,     319.,      58.,       5./)
+          ! 76-Mono(Tepetou,Benin/Togo) 6.25N-1.8E (U, p27) R1
+          ! Data from HLA: 6.2N -  1  E   1951/85  = 96m3/s       
+          ! --> 96.4999924m3/s
+          criver(76) = "Mono                "
+          inb(76) = 1
+          iirnf(1:1,76) = 72
+          ijrnf(1:1,76) = 42
+          zrnfm(1:jpmois,76) = (/   &
+              2.,       1.,       1.,       4.,       8.,      44.,   &
+              168.,     274.,     386.,     215.,      47.,       8./)
+          ! 77-Comoe (Ivory Coast) 5N-4W (UNESCO, p56)      R1
+          ! Data from HLA: 5.1N -  4  W   1955/86 = 194m3/s       
+          ! --> 194.25m3/s
+          criver(77) = "Comoe               "
+          inb(77) = 1
+          iirnf(1:1,77) = 71
+          ijrnf(1:1,77) = 41
+          zrnfm(1:jpmois,77) = (/   &
+              14.,       7.,       9.,      17.,      29.,      90.,   &
+              145.,     349.,     740.,     688.,     198.,      45./)
+          ! 78-Sassandra (Ivory Coast) 5N-6W (UNESCO, p58)  R1
+          ! Data from HLA: 5N -  6  W   1953/86 = 449m3/s
+          ! --> 449.333344m3/s
+          criver(78) = "Sassandra           "
+          inb(78) = 1
+          iirnf(1:1,78) = 71
+          ijrnf(1:1,78) = 41
+          zrnfm(1:jpmois,78) = (/   &
+              144.,     116.,     119.,     143.,     156.,     334.,   &
+              419.,     692.,    1277.,    1190.,     553.,     249./)
+          ! 79-Jubba (Somali Coast)
+          criver(79) = "Jubba               "
+          inb(79) = 1
+          iirnf(1:1,79) = 84
+          ijrnf(1:1,79) = 39
+          zrnfm(1:jpmois,79) = 0.
+          ! 80-Senaga
+          criver(80) = "Senegal             "
+          inb(79) = 1
+          iirnf(1:1,80) = 66
+          ijrnf(1:1,80) = 47
+          zrnfm(1:jpmois,79) = 0.
+      
+          ! Total run-offs (VI)=63977.m3/s
+          ! Total run-offs (I+II+III+IV+V+VI)=560902.688m3/s
+          
+          ! VII OCEANIA
+          ! ------------
+          ! 91-Murray (Australia) 35S34 138E54              R5
+          ! Old=22 km3/year=697m3/s
+          ! --> 696.999939m3/s
+          criver(91) = "Murray              "
+          inb(91) = 1
+          iirnf(1:1,91) = 16
+          ijrnf(1:1,91) = 24
+          zrnfm(1:jpmois,91) = 697.
+          ! 92-Haast (N. Zeland) 43S50 169E02               R5
+          ! Old=6 km3/year=190m3/s
+          ! --> 189.999985m3/s
+          criver(92) = "Haast               "
+          inb(92) = 1
+          iirnf(1:1,92) = 24
+          ijrnf(1:1,92) = 22
+          zrnfm(1:jpmois,92) = 190.
+          ! 93-Fly (N. Guinea) 8S30 143E05                  R5
+          ! Old=77 km3/year=2440m3/s
+          ! --> 2440.m3/s
+          criver(93) = "Fly                 "
+          inb(93) = 1
+          iirnf(1:1,93) = 19
+          ijrnf(1:1,93) = 31
+          zrnfm(1:jpmois,93) = 2440.
+          ! 94-Purari (N. Guinea) 7S25 145E05               R4
+          ! Old=77 km3/year=2440m3/s; UNESCO(77+83,p595)=2727m3/s
+          ! --> 2727.33325m3/s
+          criver(94) = "Purari              "
+          inb(94) = 1
+          iirnf(1:1,94) = 19
+          ijrnf(1:1,94) = 33
+          zrnfm(1:jpmois,94) = (/   &
+              1972.,    3067.,    2332.,    2981.,    2693.,    2876.,   &
+              2867.,    3477.,    2195.,    2967.,    2674.,    2627./)
+          ! 95-Choshui ch''i (taiwan) 24N03 120E23          R2
+          ! Old=6 km3/year=190m3/s; UNESCO(65-68, p374)=120m3/s; ratio=1.58 
+          ! --> 0.m3/s
+          criver(95) = "Choshui             "
+          inb(95) = 1
+          iirnf(1:1,95) = 12
+          ijrnf(1:1,95) = 48
+          zrnfm(1:jpmois,95) = (/   &
+              65.,      63.,      83.,     100.,     177.,     535.,   &
+              332.,     313.,     236.,     193.,     101.,      84./)
+          ! 96-Kaoping (Taiwan)                             R5  
+          ! Old=9 km3/year=285m3/s
+          ! --> 0.m3/s
+          criver(96) = "Kaoping             "
+          inb(96) = 0
+          iirnf(1:1,96) = 0
+          ijrnf(1:1,96) = 0
+          zrnfm(1:jpmois,96) = 285.
+          ! 97-Tsengwen (Taiwan)                            R5
+          ! Old=2 km3/year=63m3/s
+          ! --> 0.m3/s
+          criver(97) = "Tsengwen            "
+          inb(97) = 0
+          iirnf(1:1,97) = 0
+          ijrnf(1:1,97) = 0
+          zrnfm(1:jpmois,97) = 63.
+          ! 98-Hualien (Taiwan)                             R5
+          ! Old=4 km3/year=127m3/s
+          ! --> 0.m3/s
+          criver(98) = "Hualien             "
+          inb(98) = 0
+          iirnf(1:1,98) = 0
+          ijrnf(1:1,98) = 0
+          zrnfm(1:jpmois,98) = 127.
+          ! 99-Peinan (Taiwan) 22N46 121E10                 R5
+          ! Old=4 km3/year=127m3/s
+          ! --> 127.000008m3/s
+          criver(99) = "Peinan              "
+          inb(99) = 1
+          iirnf(1:1,99) = 12
+          ijrnf(1:1,99) = 48
+          zrnfm(1:jpmois,99) = 127.
+          ! 100-Hsiukuluan (Taiwan)                         R5
+          ! Old=4 km3/year=127m3/s
+          ! --> 0.m3/s
+          criver(100) = "Hsiukuluan          "
+          inb(100) = 0
+          iirnf(1:1,100) = 0
+          ijrnf(1:1,100) = 0
+          zrnfm(1:jpmois,100) = 127.
+
+          !  Total run-offs(VII)=6181.33301m3/s
+          
+
+          ! VIII ANTARCTICA
+          ! ---------------
+          ! 103 -Antarctic ice discharge (2 613 Gt/year) (jacobs et al 1992)
+          ! Data from Jacobs et al 92: =2613 km3/year=82857.686454 m3/s
+          ! --> 82858 m3/s
+          criver(103) = "Antarctica         "
+          inb(103) = 108
+          iirnf(1:108,103) = (/   &
+               2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,16,17,18,19,20,   &
+              21,22,23,24,25,25,24,24,24,25,26,27,28,29,30,31,32,33,34,   &
+              35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,51,53,   &
+              53,53,53,54,54,54,56,57,57,57,57,57,57,57,57,57,57,58,59,   &
+              60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,   &
+              79,80,81,82,83,84,85,86,87,88,89,90,91 /)
+          ijrnf(1:108,103) = (/   &
+              12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,11,11,   &
+              10,10, 9, 9, 8, 7, 6, 5, 3, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3,   &
+               3, 4, 5, 6, 6, 6, 7, 7, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7,   &
+               8, 9,10,10,11,12,13,12,11,10, 9, 8, 7, 6, 5, 4, 3, 2, 2,   &
+               2, 2, 2, 2, 3, 4, 4, 5, 7, 8, 9, 9, 9, 9, 9, 9,10,10,10,   &
+              10,10,10,10,11,12,12,12,12,11,11,10,10 /)
+          zrnfm(1:jpmois,100) = 82858.0
+                   
+
+          !  Total run-offs(I+II+III+IV+V+VI+VII)= 567084. m3/s
+          !                                      = 1.588668056E-6 kg/m2/s
+          !                                      = 17883.5586 km3/Year
+          !                                      = 0.567083955 Sverdrup
+      ENDIF
+
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'flxrnf : runoff + orca4'
+         IF(lwp) WRITE(numout,*) '~~~~~~'
+         IF(lwp) WRITE(numout,*) '   nrunoff = ', nrunoff
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      ! 0. initialization and  indexes  modification for zoom version
+      ! --------------------------------------------------------------
+      
+      
+      ! conversion factor m3/s --> kg/m2/s *e1t*e2t
+
+      zconv = rauw
+
+      IF( kt == nit000 ) THEN 
+         ! Set runoffs and upstream coeff to zero
+         runoff (:,:) = 0.e0                                                                                  
+         upsrnfh(:,:) = 0.e0
+         upsrnfz(:)   = 0.e0
+         upsadv (:,:) = 0.e0
+         zcoefr(:,:,:) = 0.e0
+
+         IF( nrunoff == 0 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' NO RUNOFF in this simulation '
+            IF(lwp) WRITE(numout,*)
+         ENDIF
+      ENDIF
+
+      IF( kt == nit000 ) THEN
+         IF( nrunoff >= 1 ) THEN 
+            zbilan = 0.0 
+!OCL SCALAR
+            DO jr = 1, jpriv-1
+               inbp = inb(jr)
+               IF( inbp /= 0 ) THEN
+                  ii = mj0(iirnf(1,jr))
+                  ij = mi0(ijrnf(1,jr))
+                  ii = MAX( 2, MIN( ii, jpi-1 ) )
+                  ij = MAX( 2, MIN( ij, jpj-1 ) )
+!OCL SCALAR
+                  IF( tmask(ii,ij,1) <= 0.5 ) THEN 
+                     IF(lwp) WRITE(numout,*) 'Erreur riviere masquee   ', ii, ij, jr, criver(jr)
+                  ENDIF
+                  IF( tmask(ii-1,ij,1)*tmask(ii+1,ij,1)   &
+                     *tmask(ii,ij-1,1)*tmask(ii,ij+1,1) /= 0. )THEN 
+                     IF(lwp) WRITE(numout,*) 'Erreur riviere non cotiere ',ii, ij, jr, criver(jr)
+                  ENDIF
+                  DO nrnf1 = 1, jpmois
+                     zbilan = zbilan + zrnfm(nrnf1,jr) * tmask(ii,ij,1)
+                  END DO
+               ENDIF
+            END DO
+            IF(lwp) WRITE(numout,*) 'zrnfm (runoff) ', zero, zconv, rauw, SUM(zrnfm)
+            IF(lwp) THEN 
+               WRITE(numout,'("Total runoff : ",1E30.15)' ) zbilan
+               WRITE(numout,*) 'Run-off : POSITION and value '
+               WRITE(numout,*) 'ji jj glamt gphit annual mask 12-month '
+!OCL SCALAR
+               DO jr = 1, jpriv-1
+                  inbp = inb(jr)
+                  IF(inbp /= 0) THEN
+!OCL SCALAR
+                     DO jl = 1, inbp
+                        ii = mj0(iirnf(jl,jr))
+                        ij = mi0(ijrnf(jl,jr))
+                        WRITE(numout,'(2I3,1X,1A20,2X,2I4,2F7.1,1I3,1PE10.1,1I2,12E9.1)')   &
+                           jr, jl, criver(jr),   &
+                           ii, ij, glamt(ii,ij), gphit(ii,ij), inbp,   &
+                           SUM(zrnfm(1:jpmois,jr))/float(inbp),   &
+                           NINT(tmask(ii,ij,1)),   &
+                           zrnfm(1:jpmois,jr)/float(inbp)
+                     END DO
+                  ENDIF
+               END DO
+            ENDIF
+            IF(lwp) WRITE(numout,*) ' zrnfm (runoff) ', zero, zconv, rauw, SUM(zrnfm)
+         ENDIF
+      ENDIF
+
+      ! 1. initialization of the runoff array
+      ! -------------------------------------
+
+      IF( nrunoff == 1 .OR. nrunoff == 2) THEN
+
+         iman  = jpmois
+         
+         i15 = nday/16
+         
+         imois = nmonth + i15 - 1
+         IF( imois == 0) imois = iman
+         IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
+            ! Number of Day Between Data
+            idbd = nbiss(imois)
+         ELSEIF( nleapy > 1 ) THEN
+            idbd = nleapy
+         ELSE
+            idbd = nobis(imois)
+         ENDIF
+         ! Number of days between imois, 15 and the end of month
+         idmeom = idbd - 15
+         
+         ! 1.1 Calendar computation
+         
+         ! nrnf1 number of the first array record used in the simulation
+         ! nrnf2 number of the last  array record
+         
+         nrnf1 = imois
+         nrnf2 = nrnf1 + 1
+         nrnf1 = MOD( nrnf1, iman )
+         IF( nrnf1 == 0 ) nrnf1 = iman
+         nrnf2 = MOD( nrnf2, iman )
+         IF( nrnf2 == 0 ) nrnf2 = iman
+         
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'flxrnf routine'
+            IF(lwp) WRITE(numout,*) 'first array record used nrnf1 ',nrnf1
+            IF(lwp) WRITE(numout,*) 'last  array record used nrnf2 ',nrnf2
+            IF(lwp) WRITE(numout,*) 'total zrnfm ', SUM(zrnfm)
+            IF(lwp) WRITE(numout,*) 'total surface ', SUM(e1t*e2t*tmask(:,:,1))
+         ENDIF
+
+         zxy = FLOAT( nday + idmeom - idbd * i15 ) / idbd
+
+!OCL SCALAR
+         DO jr = 1, jpriv-1
+            inbp = inb(jr)
+!OCL SCALAR
+            IF( inbp /= 0 ) THEN
+               DO jl = 1, inbp
+                  ii = iirnf(jl,jr) - nimpp + 1 - jpizoom + 1
+                  ij = ijrnf(jl,jr) - njmpp + 1 - jpjzoom + 1
+                  iipt0 = MAX( 1, MIN( ii, jpi   ) )
+                  iipt1 = MAX( 0, MIN( ii, jpi-1 ) )
+                  ijpt0 = MAX( 1, MIN( ij, jpj   ) )
+                  ijpt1 = MAX( 0, MIN( ij, jpj-1 ) )
+                  DO jj = ijpt0, ijpt1
+                     DO ji = iipt0, iipt1
+                        runoff(ji,jj) = runoff(ji,jj)   & 
+                                      + ( (1.-zxy) * zrnfm(nrnf1,jr)   &
+                                      +       zxy  * zrnfm(nrnf2,jr)  ) / FLOAT(inbp)      
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+         END DO
+
+
+         ! 2. conversion in mm/day
+         ! -----------------------
+         !     C a u t i o n : upward water flux, runoff is negative
+
+         runoff(:,:) = -zconv * runoff(:,:) / ( e1t(:,:) * e2t(:,:) )
+         
+
+         ! 3. advectve coefficient
+         ! -----------------------
+
+         !  Creates the array coef that contains the coefficient to affect to
+         !  the upstream scheme. advection scheme will be:
+         !  coefr * upstream + (1- coefr) centered
+         !  coefr must be between 0 and 1.
+         !  3 values are used: maximum = zrup1, between zrup2, small zrup3.
+         ! 
+         IF( nrunoff == 2 .AND. kt == nit000 ) THEN
+
+            zrup1 = 0.5
+            zrup2 = 0.25
+            zrup3 = 0.125
+            DO jr = 1, jpriv-1
+               inbp = inb(jr)
+               IF( inbp /= 0) THEN
+                  DO jl = 1, inbp
+                     ! --> zrup1 (originally, = 1 = all upstream).
+                     ! ji,jj
+                     ii = iirnf(jl,jr) - nimpp + 1 - jpizoom - 1
+                     ij = ijrnf(jl,jr) - njmpp + 1 - jpjzoom - 1
+                     iipt0 = MAX( 1, MIN( ii,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii,jpi-1) )
+                     ijpt0 = MAX( 1, MIN( ij,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = zrup1
+                           END DO
+                           zcoefr(ji,jj,4) = zrup2
+                           zcoefr(ji,jj,5) = zrup3
+                        END DO
+                     END DO
+                     ! --> zrup2 (originally = 0.5)
+                     ! ji,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1, jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1, jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1, jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1, jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj-1
+                     iipt0 = MAX( 1, MIN( ii+1, jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+1, jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj
+                     ijpt0 = MAX( 1, MIN( ij, jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij, jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji+1,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj+1
+                     iipt0 = MAX( 1, MIN( ii-1,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii-1,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj
+                     ijpt0 = MAX( 1, MIN( ij,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! ji-1,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup2, zcoefr(ji,jj,jn) )
+                           END DO
+                           zcoefr(ji,jj,4) = MAX( zrup3, zcoefr(ji,jj,4) )
+                        END DO
+                     END DO
+                     ! --> zrup3 (originally = 0.25)
+                     ! ji-1,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-1,jj-2
+                     ijpt0 = MAX( 1, MIN( ij-2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji,jj-2
+                     iipt0 = MAX( 1, MIN( ii,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+1,jj-2
+                     iipt0 = MAX( 1, MIN( ii+1,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+1,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+1,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj-2
+                     iipt0 = MAX( 1, MIN( ii+2,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii+2,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3  
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji+2,jj
+                     ijpt0 = MAX( 1, MIN( ij,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj
+                     iipt0 = MAX( 1, MIN( ii-2,jpi  ) )
+                     iipt1 = MAX( 0, MIN( ii-2,jpi-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3        
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj-2
+                     ijpt0 = MAX( 1, MIN( ij-2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj+2
+                     ijpt0 = MAX( 1, MIN( ij+2,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+2,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj-1
+                     ijpt0 = MAX( 1, MIN( ij-1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij-1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                     ! ji-2,jj+1
+                     ijpt0 = MAX( 1, MIN( ij+1,jpj  ) )
+                     ijpt1 = MAX( 0, MIN( ij+1,jpj-1) )
+                     DO jj = ijpt0, ijpt1
+                        DO ji = iipt0, iipt1
+                           DO jn = 1, 3 
+                              zcoefr(ji,jj,jn) = MAX( zrup3, zcoefr(ji,jj,jn) )
+                           END DO
+                        END DO
+                     END DO
+                  END DO
+               ENDIF
+            END DO
+            upsrnfh(:,:) = zcoefr(:,:,1)
+            upsrnfz(:)   = 0.e0
+            upsrnfz(1)   = 1.0
+            upsrnfz(2)   = 1.0
+            upsrnfz(3)   = zrup1
+            upsrnfz(4)   = zrup2
+            upsrnfz(5)   = zrup3
+         ENDIF
+      ENDIF
+      
+      ! Upstream and centered scheme in the vicinity of some straits
+      
+      IF( kt == nit000 ) THEN
+
+         ! ORCA_R4 configuration :
+         ! Gibraltar Strait
+         DO jj = mj0(52), mj1(53)
+            DO ji = mi0(70), mi1(71)
+               upsadv(ji,jj) = 0.5
+            END DO
+         END DO
+
+      ENDIF
Index: /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc.F90	(revision 4)
@@ -0,0 +1,737 @@
+MODULE ocesbc
+   !!======================================================================
+   !!                     ***  MODULE  ocesbc  ***
+   !!                     Ocean surface boundary conditions
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!    oce_sbc : initialization and namelist read
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce            ! dynamics and tracers variables
+   USE dom_oce        ! ocean space domain variables
+   USE cpl_oce        ! coupled ocean-atmosphere variables
+   USE ice_oce
+   USE blk_oce
+   USE phycst         ! Define parameters for the routines
+   USE taumod
+   USE flxmod
+   USE flxrnf
+   USE tradmp         ! damping salinity trend
+   USE dtatem
+   USE dtasal
+   USE ocfzpt
+   USE lbclnk
+   USE in_out_manager ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC oce_sbc    ! routine called by step
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::   &
+      aplus, aminus,     &
+      empold = 0.e0  ! current year freshwater budget correction
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &
+      qt  ,         &  ! total surface heat flux (w/m2)
+      q   ,         &  ! surface heat flux (w/m2)
+      qsr ,         &  ! solar radiation (w/m2)
+      emp ,         &  ! evaporation minus precipitation (kg/m2/s = mm/s)
+      emps,         &  ! evaporation - precipitation (free surface)
+      qrp ,         &  ! heat flux damping (w/m2)
+      erp              ! evaporation damping (kg/m2/s = mm/s)
+#if defined key_dynspg_fsc
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &
+      dmp              ! internal dampind term
+#endif
+
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   LIM 2.0 , UCL-LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim' :                                   LIM sea-ice model
+   !!----------------------------------------------------------------------
+# if defined key_coupled
+      !!----------------------------------------------------------------------
+      !!   'key_coupled' :                            Coupled Ocean/Atmosphere
+      !!----------------------------------------------------------------------
+
+   SUBROUTINE oce_sbc( kt )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE oce_sbc  ***
+      !!                    
+      !! ** Purpose :   Ocean surface boundaries conditions with 
+      !!        Louvain la Neuve Sea Ice Model in coupled mode
+      !!
+      !! History :
+      !!   1.0  !  00-10  (O. Marti)  Original code
+      !!   2.0  !  02-12  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj                   ! dummy loop indices
+      REAL(wp) ::   ztx, ztaux, zty, ztauy, ztrp, zsrp
+      REAL(wp) ::   ztdta, ztgel, zqrp
+      !!----------------------------------------------------------------------
+ 
+      ! 1. initialization to zero at kt = nit000
+      ! ---------------------------------------
+      
+      IF( kt == nit000 ) THEN     
+         qsr   (:,:) = 0.e0
+         freeze(:,:) = 0.e0
+         qt    (:,:) = 0.e0
+         q     (:,:) = 0.e0
+         qrp   (:,:) = 0.e0
+         emp   (:,:) = 0.e0
+         emps  (:,:) = 0.e0
+         erp   (:,:) = 0.e0
+#if defined key_dynspg_fsc 
+         dmp   (:,:) = 0.e0
+#endif
+      ENDIF
+
+      IF( MOD( kt-1, nfice ) == 0 ) THEN 
+
+         CALL oce_sbc_dmp   ! Computation of internal and evaporation damping terms       
+
+         ! Surface heat flux (W/m2)
+         ! -----------------------
+
+         ! restoring heat flux
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztgel = fzptn(ji,jj)
+#if defined key_dtasst
+               ztdta = MAX( sst(ji,jj),    ztgel )
+#else
+               ztdta = MAX( t_dta(ji,jj,1), ztgel )
+#endif
+               zqrp = ztrp * ( tb(ji,jj,1) - ztdta )
+
+               qrp(ji,jj) = (1.0-freeze(ji,jj) ) * zqrp
+            END DO
+         END DO
+
+         ! non solar heat flux + solar flux + restoring
+         q  (:,:) = fnsolar(:,:) + fsolar(:,:) + qrp(:,:)
+         qt (:,:) = q(:,:)
+
+         ! solar flux
+         qsr(:,:) = fsolar(:,:)
+
+#if defined key_dynspg_fsc  
+         ! total concentration/dilution effect (use on SSS)
+         emps(:,:) = fmass(:,:) + fsalt(:,:) + runoff(:,:) + erp(:,:)
+
+         ! total volume flux (use on sea-surface height)
+         emp (:,:) = fmass(:,:)  -  dmp(:,:) + runoff(:,:) + erp(:,:)
+#else
+         ! Rigid-lid (emp=emps=E-P-R+Erp) 
+         ! freshwater flux
+         emps(:,:) = fmass(:,:) + fsalt(:,:) + runoff(:,:) + erp(:,:)
+         emp (:,:) = emps(:,:)
+#endif
+
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vertor opt.
+               ztx   = 0.5 * ( freeze(ji+1,jj) + freeze(ji+1,jj+1) )
+               ztaux = 0.5 * ( ftaux (ji+1,jj) + ftaux (ji+1,jj+1) )
+               taux(ji,jj) = (1.0-ztx) * taux(ji,jj) + ztx * ztaux
+
+               zty   = 0.5 * ( freeze(ji,jj+1) + freeze(ji+1,jj+1) )
+               ztauy = 0.5 * ( ftauy (ji,jj+1) + ftauy (ji+1,jj+1) )
+               tauy(ji,jj) = (1.0-zty) * tauy(ji,jj) + zty * ztauy
+            END DO
+         END DO
+         CALL lbc_lnk( taux, 'U', -1. )
+         CALL lbc_lnk( tauy, 'V', -1. )    
+
+         ! Re-initialization of fluxes
+         sst_io(:,:) = 0.0
+         sss_io(:,:) = 0.0
+         u_io  (:,:) = 0.0
+         v_io  (:,:) = 0.0
+         gtaux (:,:) = 0.
+         gtauy (:,:) = 0.
+
+      ENDIF
+
+   END SUBROUTINE oce_sbc
+
+# elif defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+      !!----------------------------------------------------------------------
+      !!   'key_ice_lim'                              with  LIM sea-ice model
+      !!----------------------------------------------------------------------
+
+   SUBROUTINE oce_sbc( kt )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE oce_sbc  ***
+      !!                    
+      !! ** Purpose : - Ocean surface boundary conditions with LIM sea-ice
+      !!        model in forced mode using bulk formulea
+      !!
+      !! History :
+      !!   1.0  !  99-11  (M. Imbard)  Original code
+      !!        !  01-03  (D. Ludicone, E. Durand, G. Madec) free surf.
+      !!   2.0  !  02-09  (G. Madec, C. Ethe)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * Local declarations
+      INTEGER ::   ji, jj                   ! dummy loop indices
+      REAL ztx, ztaux, zty, ztauy
+      !!----------------------------------------------------------------------
+
+      ! 1. initialization to zero at kt = nit000
+      ! ---------------------------------------
+      
+      IF( kt == nit000 ) THEN     
+         qsr    (:,:) = 0.e0
+         qt     (:,:) = 0.e0
+         q      (:,:) = 0.e0
+         qrp    (:,:) = 0.e0
+         emp    (:,:) = 0.e0
+         emps   (:,:) = 0.e0
+         erp    (:,:) = 0.e0
+#if defined key_dynspg_fsc 
+         dmp    (:,:) = 0.e0
+#endif
+      ENDIF
+
+      IF( MOD( kt-1, nfice ) == 0 ) THEN
+
+         CALL oce_sbc_dmp       ! Computation of internal and evaporation damping terms       
+
+         ! Surface Ocean fluxes
+         ! ====================
+
+         ! Surface heat flux (W/m2)
+         ! -----------------
+
+         q   (:,:) = fnsolar(:,:) + fsolar(:,:)     ! non solar heat flux + solar flux
+         qt  (:,:) = q(:,:)
+         qsr (:,:) = fsolar(:,:)                     ! solar flux
+
+#if defined key_dynspg_fsc     
+         ! total concentration/dilution effect (use on SSS)
+         emps(:,:) = fmass(:,:) + fsalt(:,:) + runoff(:,:) + erp(:,:) + empold
+
+         ! total volume flux (use on sea-surface height)
+         emp (:,:) = fmass(:,:) -   dmp(:,:) + runoff(:,:) + erp(:,:) + empold      
+#else
+         ! Rigid-lid (emp=emps=E-P-R+Erp)
+         emps(:,:) = fmass(:,:) + fsalt(:,:) + runoff(:,:) + erp(:,:)     ! freshwater flux
+         emp (:,:) = emps(:,:)
+
+#endif
+
+         ! Surface stress
+         ! --------------
+
+         ! update the stress beloww sea-ice area
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vertor opt.
+               ztx         = MAX( freezn(ji,jj), freezn(ji,jj+1) )   ! ice/ocean indicator at U- and V-points
+               zty         = MAX( freezn(ji,jj), freezn(ji+1,jj) )
+               ztaux       = 0.5 *( ftaux(ji+1,jj) + ftaux(ji+1,jj+1) ) ! ice-ocean stress at U- and V-points
+               ztauy       = 0.5 *( ftauy(ji,jj+1) + ftauy(ji+1,jj+1) )
+               taux(ji,jj) = (1.-ztx) * taux(ji,jj) + ztx * ztaux    ! stress at the ocean surface
+               tauy(ji,jj) = (1.-zty) * tauy(ji,jj) + zty * ztauy
+            END DO
+         END DO
+
+         ! boundary condition on the stress (taux,tauy)
+         CALL lbc_lnk( taux, 'U', -1. )
+         CALL lbc_lnk( tauy, 'V', -1. )
+
+         ! Re-initialization of fluxes
+         sst_io(:,:) = 0.0
+         sss_io(:,:) = 0.0
+         u_io  (:,:) = 0.0
+         v_io  (:,:) = 0.0
+
+      ENDIF
+
+   END SUBROUTINE oce_sbc
+
+# else
+      !!----------------------------------------------------------------------
+      !!   Error option               LIM sea-ice model requires bulk formulea
+      !!----------------------------------------------------------------------
+      This line forced a compilation error
+# endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                 NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+# if defined key_coupled
+      !!----------------------------------------------------------------------
+      !!   'key_coupled' :                            Coupled Ocean/Atmosphere
+      !!----------------------------------------------------------------------
+
+   SUBROUTINE oce_sbc( kt )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE oce_sbc  ***
+      !!                    
+      !! ** Purpose :   Ocean surface boundaries conditions in 
+      !!                coupled ocean/atmosphere case without sea-ice
+      !!
+      !! History :
+      !!   1.0  !  00-10  (O. Marti)  Original code
+      !!   2.0  !  02-12  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE cpl_oce 
+
+      !! * Arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step index
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jf         ! dummy loop indices
+      REAL(wp) ::   ztrp, ztgel,    &  ! temporary scalars
+         zice, zhemis, zqrp, zqri,  &  !    "         "
+         zq, zqi, zerp, ze, zei, zro   !    "         "
+      !!----------------------------------------------------------------------
+
+      ! Compute fluxes
+      ! --------------
+
+      ! constant initialization
+      ztrp = -40.   ! restoring term for temperature (w/m2/k)
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+
+            ztgel = fzptn(ji,jj)   ! local freezing temperature
+
+            ! opa model ice freeze()
+
+            zice = tmask(ji,jj,1)
+            IF( tn(ji,jj,1) >=  ztgel ) zice = 0.
+            freeze(ji,jj) = zice
+
+            ! hemisphere indicator (=1 north, =-1 south)
+            
+            zhemis = float(isign(1, mjg(jj)-(jpjglo/2+1)))
+            
+            ! a) net downward radiative flux qsr()
+            ! - AGCM qsrc if no ice
+            ! - zero under ice (zice=1)
+
+            qsr(ji,jj) = (1.-zice)*qsrc(ji,jj)*tmask(ji,jj,1)
+
+            ! b) heat flux damping term qrp()
+            ! - no damping if no  ice      (zice=0) 
+            ! - gamma*min(0,t-tgel) if ice (zice=1)
+
+            zqrp = 0.
+            zqri = ztrp*MIN( 0., tb(ji,jj,1)-ztgel )
+            qrp(ji,jj) = ( ( 1. - zice ) * zqrp + zice * zqri ) * tmask(ji,jj,1)
+
+
+            ! c) net downward heat flux q() = q0 + qrp()
+            ! for q0
+            ! - AGCM qc if no  ice (zice=0)
+            ! - -2 watt/m2 (arctic) or -4 watt/m2 (antarctic) if ice (zice=1)
+            zq  = qc(ji,jj)
+            zqi = -3. + zhemis
+            qt(ji,jj) = ( (1.-zice) * zq + zice * zqi ) * tmask(ji,jj,1) + qrp(ji,jj)
+            q (ji,jj) = qt(ji,jj)
+            
+            ! d) water flux damping term erp()
+            ! - no damping
+            zerp = 0.
+            erp(ji,jj) = zerp
+            
+            ! e) net upward water flux e() = eo + runoff() + erp()
+            ! for e0
+            ! - AGCM if no ice (zice=0)
+            ! - 1.mm/day if climatological and opa ice (zice=1)
+            ze  = ec(ji,jj)
+            zei = 1./rday
+            zro = runoff(ji,jj)
+            emp(ji,jj) = ( ( 1. - zice ) *  ze + zice * zei + zro ) * tmask(ji,jj,1) + erp(ji,jj)
+            
+         END DO
+      END DO
+
+   END SUBROUTINE oce_sbc
+
+# elif defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_forced_daily
+      !!-------------------------------------------------------------------------
+      !!   'key_flx_bulk_monthly' or 'key_flx_bulk_daily' or        bulk formulea
+      !!   'key_flx_forced_daily'                                or no bulk case 
+      !!-------------------------------------------------------------------------
+
+   SUBROUTINE oce_sbc( kt )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE oce_sbc  ***
+      !!                    
+      !! ** Purpose :   Ocean surface boundary conditions in forced mode
+      !!      using either flux or bulk formulation.
+      !!
+      !! History :
+      !!   1.0  !  99-11  (M. Imbard)  Original code
+      !!        !  01-03  (D. Ludicone, E. Durand, G. Madec) free surf.
+      !!   2.0  !  02-09  (G. Madec, C. Ethe)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE daymod
+#if ! defined key_dtasst
+      USE dtasst, ONLY : rclice
+#endif
+#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+      USE blk_oce
+#endif
+#if defined key_flx_forced_daily
+      USE flx_oce
+#endif
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * local declarations
+      INTEGER ::   ji, jj        ! dummy loop arguments
+      INTEGER ::   i15, ifreq             !      
+      REAL(wp) ::  zxy
+      REAL(wp) ::  zsice, zqri, zqrp, ztdta, zqrj
+      REAL(wp) ::  zq, zqi, zhemis, ztrp
+      REAL(wp), DIMENSION(jpi,jpj) :: zeri, zerps, ziclim
+      REAL(wp), DIMENSION(jpi,jpj) :: zqt, zqsr, zemp  
+      !!----------------------------------------------------------------------
+ 
+      ! 1. initialization to zero at kt = nit000
+      ! ---------------------------------------
+      
+      IF( kt == nit000 ) THEN     
+         qsr    (:,:) = 0.e0
+         freeze (:,:) = 0.e0
+         qt     (:,:) = 0.e0
+         q      (:,:) = 0.e0
+         qrp    (:,:) = 0.e0
+         emp    (:,:) = 0.e0
+         emps   (:,:) = 0.e0
+         erp    (:,:) = 0.e0
+#if defined key_dynspg_fsc 
+         dmp    (:,:) = 0.e0
+#endif
+      ENDIF
+
+#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+      ifreq      = nfbulk
+      zqt (:,:)  = qsr_oce(:,:) + qnsr_oce(:,:)
+      zqsr(:,:)  = qsr_oce(:,:)
+      zemp(:,:)  = evap(:,:) - tprecip(:,:)
+#endif 
+
+#if defined key_flx_forced_daily
+      ifreq      = 1
+      zqt (:,:)  = p_qt (:,:)
+      zqsr(:,:)  = p_qsr(:,:)
+      zemp(:,:)  = p_emp(:,:)
+#endif 
+
+      IF( MOD( kt-1, ifreq) == 0 ) THEN
+         ! Computation of internal and evaporation damping terms       
+         CALL oce_sbc_dmp
+
+         ztrp = -40.             ! restoring terme for temperature (w/m2/k)   
+         zsice = - 0.04 / 0.8    ! ratio of isohaline compressibility over isotherme compressibility 
+                                 ! ( d rho / dt ) / ( d rho / ds )      ( s = 34, t = -1.8 )
+         ! Flux computation
+         DO jj = 1, jpj
+            DO ji = 1, jpi      
+               ! climatological ice 
+#if defined key_dtasst 
+               ziclim(ji,jj) = FLOAT( NINT( rclice(ji,jj,1) ) )
+#else
+               ! tested only with key key_dtasst (A. Lazar 07/2001)
+               ! this loop in CASE of interpolation of monthly rclice
+               i15           = INT( 2.* FLOAT(nday) / (FLOAT( nobis(nmonth) ) + 0.5) )
+               zxy           = FLOAT(nday) / FLOAT(nobis(nmonth)) + 0.5 - i15
+               ziclim(ji,jj) = FLOAT( NINT( (1-zxy) * rclice(ji,jj,1) + zxy  * rclice(ji,jj,2) ) )
+#endif
+
+               ! avoid surfreezing point            
+               tn(ji,jj,1) = MAX( tn(ji,jj,1), fzptn(ji,jj) )
+
+               ! hemisphere indicator (=1 north, =-1 south)           
+               zhemis = FLOAT( isign(1, mjg(jj) - (jpjdta/2+1) ) )
+
+               ! restoring temperature (ztdta >= to local freezing temperature)            
+#if defined key_dtasst
+               ztdta = MAX( sst(ji,jj),    fzptn(ji,jj) )
+#else
+               ztdta = MAX( t_dta(ji,jj,1), fzptn(ji,jj) )
+#endif
+
+               ! a) net downward radiative flux qsr()           
+               qsr(ji,jj) = zqsr(ji,jj) * tmask(ji,jj,1)
+
+               ! b) heat flux damping term qrp()
+               ! - gamma*(t-tlevitus) if no  climatological ice (ziclim=0)
+               ! - gamma*(t-(tgel-1.))  if climatological ice and no opa ice   (ziclim=1 zicopa=0)
+               ! - gamma*min(0,t-tgel) if climatological and opa ice (ziclim=1 zicopa=1)
+
+               zqrp = ztrp * ( tb(ji,jj,1) - ztdta )
+               zqri = ztrp * ( tb(ji,jj,1) - ( fzptn(ji,jj) - 1.) )
+               zqrj = ztrp * MIN( 0., tb(ji,jj,1) - fzptn(ji,jj) )
+               qrp(ji,jj) = ( (1. - ziclim(ji,jj)) * zqrp   &
+                  + ziclim(ji,jj)  * ( ( 1 - freeze(ji,jj)) * zqri   &
+                  + freeze(ji,jj)  * zqrj ) ) * tmask(ji,jj,1)
+
+               ! c) net downward heat flux q() = q0 + qrp()
+               ! for q0
+               ! - ECMWF fluxes if no climatological ice      (ziclim=0)
+               ! - qrp if climatological ice and no opa ice   (ziclim=1 zicopa=0)
+               ! - -2 watt/m2 (arctic) or -4 watt/m2 (antarctic) if climatological and opa ice 
+               !                                              (ziclim=1 zicopa=1)
+               zq  = zqt(ji,jj)
+               zqi = -3. + zhemis
+               qt (ji,jj) = ( (1.-ziclim(ji,jj)) * zq   &
+                  +ziclim(ji,jj)  * freeze(ji,jj) * zqi )   &
+                  * tmask(ji,jj,1)   &
+                  + qrp(ji,jj)
+               q  (ji,jj) = qt (ji,jj)
+
+            END DO
+         END DO
+
+#if defined key_dynspg_fsc 
+         ! Free-surface
+
+         ! Water flux for zero buoyancy flux if no opa ice and ice clim
+         zeri(:,:) = -zsice * qrp(:,:) * ro0cpr * rauw / 34.0
+         zerps(:,:) = ziclim(:,:) * ( (1-freeze(:,:)) * zeri(:,:) )
+
+         ! Contribution to sea level:
+         ! net upward water flux emp() = e-p + runoff() + erp() + dmp + empold
+         emp (:,:) = zemp(:,:)     &   ! e-p data
+            &      + runoff(:,:)   &   ! runoff data
+            &      + erp(:,:)      &   ! restoring term to SSS data
+            &      + dmp(:,:)      &   ! freshwater flux associated with internal damping
+            &      + empold            ! domain averaged annual mean correction
+
+         ! Contribution to salinity:
+         ! net upward water flux emps() = e-p + runoff() + erp() + zerps + empold
+         emps(:,:) = zemp(:,:)     &
+            &      + runoff(:,:)   &
+            &      + erp(:,:)      &
+            &      + zerps(:,:)    &
+            &      + empold 
+#else
+         ! Rigid-lid (emp=emps=E-P-R+Erp)
+         ! freshwater flux
+         zeri(:,:)  = -zsice * qrp(:,:) * ro0cpr * rauw / 34.0
+         zerps(:,:) = ziclim(:,:) * ( (1-freeze(:,:)) * zeri(:,:) )
+         emps (:,:) = zemp(:,:)     &
+            &       + runoff(:,:)   &
+            &       + erp(:,:)      &
+            &       + zerps(:,:)
+         emp (:,:) = emps(:,:)
+#endif  
+
+         ! Boundary condition on emp for free surface option
+         ! -------------------------------------------------
+         CALL lbc_lnk( emp, 'T', 1. )
+      
+      ENDIF
+
+   END SUBROUTINE oce_sbc
+
+# else
+      !!----------------------------------------------------------------------
+      !!   Default option :                                 Analytical forcing
+      !!----------------------------------------------------------------------
+
+   SUBROUTINE oce_sbc( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE oce_sbc  ***
+      !!              
+      !! ** Purpose :   provide the thermohaline fluxes (heat and freshwater)
+      !!      to the ocean at each time step.
+      !!
+      !! ** Method  :   Constant surface fluxes (read in namelist (namflx))
+      !!
+      !! ** Action  : - q, qt, qsr, emp, emps, qrp, erp
+      !!
+      !! History :
+      !!        !  91-03  ()  Original code
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE flxrnf                       ! ocean runoffs
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * local declarations
+      REAL(wp) ::                   & !!! surface fluxes namelist (namflx)
+         q0   = 0.e0,               &  ! net heat flux
+         qsr0 = 0.e0,               &  ! solar heat flux
+         emp0 = 0.e0                   ! net freshwater flux
+
+      NAMELIST/namflx/ q0, qsr0, emp0
+      !!---------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+
+         ! Read Namelist namflx : surface thermohaline fluxes
+         ! --------------------
+         REWIND ( numnam )
+         READ   ( numnam, namflx )
+
+         IF(lwp) WRITE(numout,*)' '
+         IF(lwp) WRITE(numout,*)' ocesbc  : Constant surface fluxes read in namelist'
+         IF(lwp) WRITE(numout,*)' ~~~~~~~ '
+         IF(lwp) WRITE(numout,*)'           Namelist namflx: set the constant flux values'
+         IF(lwp) WRITE(numout,*)'              net heat flux          q0   = ', q0  , ' W/m2'
+         IF(lwp) WRITE(numout,*)'              solar heat flux        qsr0 = ', qsr0, ' W/m2'
+         IF(lwp) WRITE(numout,*)'              net heat flux          emp0 = ', emp0, ' W/m2'
+
+         qt    (:,:) = q0
+         qsr   (:,:) = qsr0
+         q     (:,:) = q0
+         emp   (:,:) = emp0
+         emps  (:,:) = emp0
+         qrp   (:,:) = 0.e0
+         erp   (:,:) = 0.e0
+
+         runoff(:,:) = 0.e0
+     ENDIF
+
+  END SUBROUTINE oce_sbc
+
+# endif
+#endif
+
+   SUBROUTINE oce_sbc_dmp
+      !!---------------------------------------------------------------------
+      !!                   ***    ROUTINE oce_sbc_dmp ***
+      !!                    
+      !! ** Purpose : Computation of internal and evaporation damping terms 
+      !!        for ocean surface boundary conditions 
+      !!
+      !! History :
+      !!   1.0  !  99-11  (M. Imbard)  Original code
+      !!        !  01-03  (D. Ludicone, E. Durand, G. Madec) free surf.
+      !!   2.0  !  02-09  (G. Madec, C. Ethe)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj                   ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj)  :: zsss, zfreeze
+#if defined key_dynspg_fsc
+      REAL zwei, zerp, ztrp, zsrp
+      REAL zerpplus(jpi,jpj), zerpminus(jpi,jpj)
+      REAL zplus, zminus, zadefi
+# if defined key_tradmp
+      INTEGER jk
+      REAL(wp), DIMENSION(jpi,jpj) ::   zstrdmp
+# endif
+#endif
+      !!----------------------------------------------------------------------
+
+#if defined key_ice_lim
+      ! sea ice indicator (1 or 0)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            freezn(ji,jj) = MAX(0., SIGN(1., freeze(ji,jj)-rsmall))
+         END DO
+      END DO
+      zsss   (:,:) = sss_io(:,:)
+      zfreeze(:,:) = freezn(:,:)
+#else
+      zsss   (:,:) = sn    (:,:,1)
+      zfreeze(:,:) = freeze(:,:)
+#endif
+
+      ! Initialisation
+      ! --------------
+      ! Restoring coefficients on SST and SSS   
+      IF( lk_cpl ) THEN
+         ztrp = 0.e0
+         zsrp = 0.e0
+      ELSE
+         ztrp  = -40.                   ! (W/m2/K)    
+         zsrp  = ztrp * ro0cpr * rauw   ! (Kg/m2/s2) 
+      ENDIF
+
+#if defined key_dynspg_fsc 
+      ! Free-surface
+         
+      ! Internal damping
+# if defined key_tradmp
+      ! Vertical mean of dampind trend (computed in tradmp module)
+      zstrdmp(:,:) = 0.e0
+      DO jk = 1, jpk
+         zstrdmp(:,:) = zstrdmp(:,:) + strdmp(:,:,jk) * fse3t(:,:,jk)
+      END DO
+      ! volume flux associated to internal damping to climatology
+      dmp(:,:) = zstrdmp(:,:) * rauw / ( zsss(:,:) + rsmall )
+# else
+      dmp(:,:) = 0.e0            ! No internal damping
+# endif
+      
+      !   evaporation damping term ( Surface restoring )
+      zerpplus (:,:) = 0.e0
+      zerpminus(:,:) = 0.e0
+      zplus  =  15. / rday
+      zminus = -15. / rday
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zerp = ( 1. - 2.*upsrnfh(ji,jj) ) * zsrp   &
+               & * ( zsss(ji,jj) - s_dta(ji,jj,1) )     &
+               & / ( zsss(ji,jj) + rsmall        )
+            
+            zerp = MIN( zerp, zplus  )
+            zerp = MAX( zerp, zminus )
+            erp(ji,jj) = zerp
+            zerpplus (ji,jj) = MAX( erp(ji,jj), 0.e0 )
+            zerpminus(ji,jj) = MIN( erp(ji,jj), 0.e0 )
+         END DO
+      END DO
+
+      aplus  = 0.e0
+      aminus = 0.e0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zwei   = e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
+            aplus  = aplus  + zerpplus (ji,jj) * zwei
+            aminus = aminus - zerpminus(ji,jj) * zwei
+         END DO
+      END DO
+# if defined key_mpp
+      CALL mpp_sum( aplus  )   ! mpp: sum over all the global domain
+      CALL mpp_sum( aminus )
+# endif
+      IF( l_ctl .AND. lwp ) WRITE(numout,*) ' oce_sbc_dmp : a+ = ', aplus, ' a- = ', aminus
+
+      zadefi = MIN( aplus, aminus )
+      IF( zadefi == 0.0 ) THEN 
+         erp(:,:) = 0.e0
+      ELSE
+         erp(:,:) = zadefi * ( zerpplus(:,:) / aplus + zerpminus(:,:) / aminus )
+      ENDIF
+#else
+      ! Rigid-lid (emp=emps=E-P-R+Erp)
+      
+      erp(:,:) = ( 1. - zfreeze(:,:) ) * zsrp    &   ! surface restoring term
+         &     * ( zsss(:,:) - s_dta(:,:,1) )     &
+         &     / ( zsss(:,:) + rsmall      )
+#endif
+
+   END SUBROUTINE oce_sbc_dmp
+
+   !!======================================================================
+END MODULE ocesbc
Index: /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc_cpl_ice.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc_cpl_ice.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc_cpl_ice.h90	(revision 4)
@@ -0,0 +1,111 @@
+   !!----------------------------------------------------------------------
+   !!                       ***  ocesbc_cpl_ice.h90  ***
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE oce_sbc(kt)
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE oce_sbc  ***
+      !!                    
+      !! ** Purpose :   Ocean surface boundaries conditions with 
+      !!        Louvain la Neuve Sea Ice Model in coupled mode
+      !!
+      !! History :
+      !!   1.0  !  00-10  (O. Marti)  Original code
+      !!   2.0  !  02-12  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj                   ! dummy loop indices
+      REAL(wp) ::   ztx, ztaux, zty, ztauy, ztrp, zsrp
+      REAL(wp) ::   ztdta, ztgel, zqrp
+
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+ 
+      !!----------------------------------------------------------------------        
+      ! 1. initialization to zero at kt = nit000
+      ! ---------------------------------------
+      
+      IF( kt == nit000 ) THEN     
+         qsr   (:,:) = 0.e0
+         freeze(:,:) = 0.e0
+         qt    (:,:) = 0.e0
+         q     (:,:) = 0.e0
+         qrp   (:,:) = 0.e0
+         emp   (:,:) = 0.e0
+         emps  (:,:) = 0.e0
+         erp   (:,:) = 0.e0
+#if defined key_dynspg_fsc 
+         dmp   (:,:) = 0.e0
+#endif
+      ENDIF
+
+      IF( MOD( kt-1, nfice ) == 0 ) THEN 
+
+         CALL oce_sbc_dmp   ! Computation of internal and evaporation damping terms       
+
+         ! Surface heat flux (W/m2)
+         ! -----------------------
+
+         ! restoring heat flux
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztgel = fzptn(ji,jj)
+#if defined key_dtasst
+               ztdta = MAX( sst(ji,jj),    ztgel )
+#else
+               ztdta = MAX( t_dta(ji,jj,1), ztgel )
+#endif
+               zqrp = ztrp * ( tb(ji,jj,1) - ztdta )
+
+               qrp(ji,jj) = (1.0-freeze(ji,jj) ) * zqrp
+            END DO
+         END DO
+
+         ! non solar heat flux + solar flux + restoring
+         q  (:,:) = fnsolar(:,:) + fsolar(:,:) + qrp(:,:)
+         qt (:,:) = q(:,:)
+
+         ! solar flux
+         qsr(:,:) = fsolar(:,:)
+
+#if defined key_dynspg_fsc  
+         ! total concentration/dilution effect (use on SSS)
+         emps(:,:) = fmass(:,:) + fsalt(:,:) + runoff(:,:) + erp(:,:)
+
+         ! total volume flux (use on sea-surface height)
+         emp (:,:) = fmass(:,:)  -  dmp(:,:) + runoff(:,:) + erp(:,:)
+
+#else
+         ! Rigid-lid (emp=emps=E-P-R+Erp) 
+         ! freshwater flux
+         emps(:,:) = fmass(:,:) + fsalt(:,:) + runoff(:,:) + erp(:,:)
+         emp (:,:) = emps(:,:)
+
+#endif
+
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vertor opt.
+               ztx   = 0.5 * ( freeze(ji+1,jj) + freeze(ji+1,jj+1) )
+               ztaux = 0.5 * ( ftaux (ji+1,jj) + ftaux (ji+1,jj+1) )
+               taux(ji,jj) = (1.0-ztx) * taux(ji,jj) + ztx * ztaux
+
+               zty   = 0.5 * ( freeze(ji,jj+1) + freeze(ji+1,jj+1) )
+               ztauy = 0.5 * ( ftauy (ji,jj+1) + ftauy (ji+1,jj+1) )
+               tauy(ji,jj) = (1.0-zty) * tauy(ji,jj) + zty * ztauy
+            END DO
+         END DO
+         CALL lbc_lnk( taux, 'U', -1. )
+         CALL lbc_lnk( tauy, 'V', -1. )    
+
+         ! Re-initialization of fluxes
+         sst_io(:,:) = 0.0
+         sss_io(:,:) = 0.0
+         u_io  (:,:) = 0.0
+         v_io  (:,:) = 0.0
+         gtaux (:,:) = 0.
+         gtauy (:,:) = 0.
+
+      ENDIF
+
+   END SUBROUTINE oce_sbc
Index: /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc_cpl_noice.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc_cpl_noice.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc_cpl_noice.h90	(revision 4)
@@ -0,0 +1,90 @@
+   !!----------------------------------------------------------------------
+   !!                       ***  ocesbc_cpl_noice.h90  ***
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE oce_sbc(kt)
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE oce_sbc  ***
+      !!                    
+      !! ** Purpose :   Ocean surface boundaries conditions in 
+      !!                coupled ocean/atmosphere case without sea-ice
+      !!
+      !! History :
+      !!   1.0  !  00-10  (O. Marti)  Original code
+      !!   2.0  !  02-12  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE cpl_oce 
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt ! ocean time step
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jf
+
+      REAL(wp) ::   ztrp
+      REAL(wp) ::   ztgel,zice,zhemis,zqrp,zqri,zq,zqi,zerp,ze,zei,zro
+
+      ! Compute fluxes
+      ! --------------
+
+      ! constant initialization
+      ztrp = -40.   ! restoring term for temperature (w/m2/k)
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+
+            ztgel = fzptn(ji,jj)   ! local freezing temperature
+
+            ! opa model ice freeze()
+
+            zice = tmask(ji,jj,1)
+            IF( tn(ji,jj,1) >=  ztgel ) zice = 0.
+            freeze(ji,jj) = zice
+
+            ! hemisphere indicator (=1 north, =-1 south)
+            
+            zhemis = float(isign(1, mjg(jj)-(jpjglo/2+1)))
+            
+            ! a) net downward radiative flux qsr()
+            ! - AGCM qsrc if no ice
+            ! - zero under ice (zice=1)
+
+            qsr(ji,jj) = (1.-zice)*qsrc(ji,jj)*tmask(ji,jj,1)
+
+            ! b) heat flux damping term qrp()
+            ! - no damping if no  ice      (zice=0) 
+            ! - gamma*min(0,t-tgel) if ice (zice=1)
+
+            zqrp = 0.
+            zqri = ztrp*MIN( 0., tb(ji,jj,1)-ztgel )
+            qrp(ji,jj) = ( ( 1. - zice ) * zqrp + zice * zqri ) * tmask(ji,jj,1)
+
+
+            ! c) net downward heat flux q() = q0 + qrp()
+            ! for q0
+            ! - AGCM qc if no  ice (zice=0)
+            ! - -2 watt/m2 (arctic) or -4 watt/m2 (antarctic) if ice (zice=1)
+            zq  = qc(ji,jj)
+            zqi = -3. + zhemis
+            qt(ji,jj) = ( (1.-zice) * zq + zice * zqi ) * tmask(ji,jj,1) + qrp(ji,jj)
+            q (ji,jj) = qt(ji,jj)
+            
+            ! d) water flux damping term erp()
+            ! - no damping
+            zerp = 0.
+            erp(ji,jj) = zerp
+            
+            ! e) net upward water flux e() = eo + runoff() + erp()
+            ! for e0
+            ! - AGCM if no ice (zice=0)
+            ! - 1.mm/day if climatological and opa ice (zice=1)
+            ze  = ec(ji,jj)
+            zei = 1./rday
+            zro = runoff(ji,jj)
+            emp(ji,jj) = ( ( 1. - zice ) *  ze + zice * zei + zro ) * tmask(ji,jj,1) + erp(ji,jj)
+            
+         END DO
+      END DO
+
+   END SUBROUTINE oce_sbc
Index: /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc_forced_ice.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc_forced_ice.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc_forced_ice.h90	(revision 4)
@@ -0,0 +1,101 @@
+   !!----------------------------------------------------------------------
+   !!                     ***  ocesbc_forced_ice.h90  ***
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE oce_sbc (kt)
+      !!---------------------------------------------------------------------
+      !!                   ***    ROUTINE oce_sbc ***
+      !!                    
+      !! ** Purpose : Ocean surface boundary conditions with 
+      !!        Louvain la Neuve Sea Ice Model in forced mode
+      !!        using 'clio' bulk formulea
+      !!
+      !! History :
+      !!   1.0  !  99-11  (M. Imbard)  Original code
+      !!        !  01-03  (D. Ludicone, E. Durand, G. Madec) free surf.
+      !!   2.0  !  02-09  (G. Madec, C. Ethe)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * Local declarations
+      INTEGER ::   ji, jj                   ! dummy loop indices
+      REAL ztx, ztaux, zty, ztauy
+
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+ 
+
+      ! 1. initialization to zero at kt = nit000
+      ! ---------------------------------------
+      
+      IF( kt == nit000 ) THEN     
+         qsr    (:,:) = 0.e0
+         qt     (:,:) = 0.e0
+         q      (:,:) = 0.e0
+         qrp    (:,:) = 0.e0
+         emp    (:,:) = 0.e0
+         emps   (:,:) = 0.e0
+         erp    (:,:) = 0.e0
+#if defined key_dynspg_fsc 
+         dmp    (:,:) = 0.e0
+#endif
+      ENDIF
+
+      IF( MOD(kt-1,nfice) == 0 ) THEN
+
+         ! Computation of internal and evaporation damping terms       
+         CALL oce_sbc_dmp
+
+         ! Surface Ocean fluxes
+         ! ====================
+
+         ! Surface heat flux (W/m2)
+         ! -----------------
+
+         q   (:,:) = fnsolar(:,:) + fsolar(:,:)     ! non solar heat flux + solar flux
+         qt  (:,:) = q(:,:)
+         qsr (:,:) = fsolar(:,:)                     ! solar flux
+
+#if defined key_dynspg_fsc     
+         ! total concentration/dilution effect (use on SSS)
+         emps(:,:) = fmass(:,:) + fsalt(:,:) + runoff(:,:) + erp(:,:) + empold
+
+         ! total volume flux (use on sea-surface height)
+         emp (:,:) = fmass(:,:) -   dmp(:,:) + runoff(:,:) + erp(:,:) + empold      
+#else
+         ! Rigid-lid (emp=emps=E-P-R+Erp)
+         emps(:,:) = fmass(:,:) + fsalt(:,:) + runoff(:,:) + erp(:,:)     ! freshwater flux
+         emp (:,:) = emps(:,:)
+
+#endif
+
+         ! Surface stress
+         ! --------------
+
+         ! update the stress beloww sea-ice area
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vertor opt.
+               ztx         = MAX( freezn(ji,jj), freezn(ji,jj+1) )   ! ice/ocean indicator at U- and V-points
+               zty         = MAX( freezn(ji,jj), freezn(ji+1,jj) )
+               ztaux       = 0.5 *( ftaux(ji+1,jj) + ftaux(ji+1,jj+1) ) ! ice-ocean stress at U- and V-points
+               ztauy       = 0.5 *( ftauy(ji,jj+1) + ftauy(ji+1,jj+1) )
+               taux(ji,jj) = (1.-ztx) * taux(ji,jj) + ztx * ztaux    ! stress at the ocean surface
+               tauy(ji,jj) = (1.-zty) * tauy(ji,jj) + zty * ztauy
+            END DO
+         END DO
+
+         ! boundary condition on the stress (taux,tauy)
+         CALL lbc_lnk( taux, 'U', -1. )
+         CALL lbc_lnk( tauy, 'V', -1. )
+
+         ! Re-initialization of fluxes
+         sst_io(:,:) = 0.0
+         sss_io(:,:) = 0.0
+         u_io  (:,:) = 0.0
+         v_io  (:,:) = 0.0
+
+      ENDIF
+
+   END SUBROUTINE oce_sbc
Index: /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc_forced_noice.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc_forced_noice.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/ocesbc_forced_noice.h90	(revision 4)
@@ -0,0 +1,185 @@
+   !!----------------------------------------------------------------------
+   !!                     ***  ocesbc_forced_noice.h90  ***
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE oce_sbc(kt)
+      !!---------------------------------------------------------------------
+      !!                   ***    ROUTINE oce_sbc ***
+      !!                    
+      !! ** Purpose : Ocean surface boundary conditions 
+      !!        in forced mode using flux formulation or bulk formulation
+      !!       
+      !!
+      !! History :
+      !!   1.0  !  99-11  (M. Imbard)  Original code
+      !!        !  01-03  (D. Ludicone, E. Durand, G. Madec) free surf.
+      !!   2.0  !  02-09  (G. Madec, C. Ethe)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE daymod
+#if ! defined key_dtasst
+      USE dtasst, ONLY : rclice
+#endif
+
+#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+      USE blk_oce
+#endif
+
+#if defined key_flx_forced_daily
+      USE flx_oce
+#endif
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * local declarations
+      INTEGER ::   ji, jj        ! dummy loop arguments
+      INTEGER ::   i15, ifreq             !      
+      REAL(wp) ::  zxy
+      REAL(wp) ::  zsice, zqri, zqrp, ztdta, zqrj
+      REAL(wp) ::  zq, zqi, zhemis, ztrp
+      REAL(wp), DIMENSION(jpi,jpj) :: zeri, zerps, ziclim
+      REAL(wp), DIMENSION(jpi,jpj) :: zqt, zqsr, zemp  
+
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+ 
+      ! 1. initialization to zero at kt = nit000
+      ! ---------------------------------------
+      
+      IF( kt == nit000 ) THEN     
+         qsr    (:,:) = 0.e0
+         freeze (:,:) = 0.e0
+         qt     (:,:) = 0.e0
+         q      (:,:) = 0.e0
+         qrp    (:,:) = 0.e0
+         emp    (:,:) = 0.e0
+         emps   (:,:) = 0.e0
+         erp    (:,:) = 0.e0
+#if defined key_dynspg_fsc 
+         dmp    (:,:) = 0.e0
+#endif
+      ENDIF
+
+#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+      ifreq      = nfbulk
+      zqt (:,:)  = qsr_oce(:,:) + qnsr_oce(:,:)
+      zqsr(:,:)  = qsr_oce(:,:)
+      zemp(:,:)  = evap(:,:) - tprecip(:,:)
+#endif 
+
+#if defined key_flx_forced_daily
+      ifreq      = 1
+      zqt (:,:)  = p_qt (:,:)
+      zqsr(:,:)  = p_qsr(:,:)
+      zemp(:,:)  = p_emp(:,:)
+#endif 
+
+      IF( MOD( kt-1, ifreq) == 0 ) THEN
+         ! Computation of internal and evaporation damping terms       
+         CALL oce_sbc_dmp
+
+         ztrp = -40.             ! restoring terme for temperature (w/m2/k)   
+         zsice = - 0.04 / 0.8    ! ratio of isohaline compressibility over isotherme compressibility 
+                                 ! ( d rho / dt ) / ( d rho / ds )      ( s = 34, t = -1.8 )
+         ! Flux computation
+         DO jj = 1, jpj
+            DO ji = 1, jpi      
+               ! climatological ice 
+#if defined key_dtasst 
+               ziclim(ji,jj) = FLOAT( NINT( rclice(ji,jj,1) ) )
+#else
+               ! tested only with key key_dtasst (A. Lazar 07/2001)
+               ! this loop in CASE of interpolation of monthly rclice
+               i15           = INT( 2.* FLOAT(nday) / (FLOAT( nobis(nmonth) ) + 0.5) )
+               zxy           = FLOAT(nday) / FLOAT(nobis(nmonth)) + 0.5 - i15
+               ziclim(ji,jj) = FLOAT( NINT( (1-zxy) * rclice(ji,jj,1) + zxy  * rclice(ji,jj,2) ) )
+#endif
+
+               ! avoid surfreezing point            
+               tn(ji,jj,1) = MAX( tn(ji,jj,1), fzptn(ji,jj) )
+
+               ! hemisphere indicator (=1 north, =-1 south)           
+               zhemis = FLOAT( isign(1, mjg(jj) - (jpjdta/2+1) ) )
+
+               ! restoring temperature (ztdta >= to local freezing temperature)            
+#if defined key_dtasst
+               ztdta = MAX( sst(ji,jj),    fzptn(ji,jj) )
+#else
+               ztdta = MAX( t_dta(ji,jj,1), fzptn(ji,jj) )
+#endif
+
+               ! a) net downward radiative flux qsr()           
+               qsr(ji,jj) = zqsr(ji,jj) * tmask(ji,jj,1)
+
+               ! b) heat flux damping term qrp()
+               ! - gamma*(t-tlevitus) if no  climatological ice (ziclim=0)
+               ! - gamma*(t-(tgel-1.))  if climatological ice and no opa ice   (ziclim=1 zicopa=0)
+               ! - gamma*min(0,t-tgel) if climatological and opa ice (ziclim=1 zicopa=1)
+
+               zqrp = ztrp * ( tb(ji,jj,1) - ztdta )
+               zqri = ztrp * ( tb(ji,jj,1) - ( fzptn(ji,jj) - 1.) )
+               zqrj = ztrp * MIN( 0., tb(ji,jj,1) - fzptn(ji,jj) )
+               qrp(ji,jj) = ( (1. - ziclim(ji,jj)) * zqrp   &
+                  + ziclim(ji,jj)  * ( ( 1 - freeze(ji,jj)) * zqri   &
+                  + freeze(ji,jj)  * zqrj ) ) * tmask(ji,jj,1)
+
+               ! c) net downward heat flux q() = q0 + qrp()
+               ! for q0
+               ! - ECMWF fluxes if no climatological ice      (ziclim=0)
+               ! - qrp if climatological ice and no opa ice   (ziclim=1 zicopa=0)
+               ! - -2 watt/m2 (arctic) or -4 watt/m2 (antarctic) if climatological and opa ice 
+               !                                              (ziclim=1 zicopa=1)
+               zq  = zqt(ji,jj)
+               zqi = -3. + zhemis
+               qt (ji,jj) = ( (1.-ziclim(ji,jj)) * zq   &
+                  +ziclim(ji,jj)  * freeze(ji,jj) * zqi )   &
+                  * tmask(ji,jj,1)   &
+                  + qrp(ji,jj)
+               q  (ji,jj) = qt (ji,jj)
+
+            END DO
+         END DO
+
+#if defined key_dynspg_fsc 
+         ! Free-surface
+
+         ! Water flux for zero buoyancy flux if no opa ice and ice clim
+         zeri(:,:) = -zsice * qrp(:,:) * ro0cpr * rauw / 34.0
+         zerps(:,:) = ziclim(:,:) * ( (1-freeze(:,:)) * zeri(:,:) )
+
+         ! Contribution to sea level:
+         ! net upward water flux emp() = e-p + runoff() + erp() + dmp + empold
+         emp (:,:) = zemp(:,:)     &   ! e-p data
+                   + runoff(:,:)   &   ! runoff data
+                   + erp(:,:)      &   ! restoring term to SSS data
+                   + dmp(:,:)      &   ! freshwater flux associated with internal damping
+                   + empold            ! domain averaged annual mean correction
+
+         ! Contribution to salinity:
+         ! net upward water flux emps() = e-p + runoff() + erp() + zerps + empold
+         emps(:,:) = zemp(:,:)     &
+                   + runoff(:,:)   &
+                   + erp(:,:)      &
+                   + zerps(:,:)    &
+                   + empold 
+#else
+         ! Rigid-lid (emp=emps=E-P-R+Erp)
+         ! freshwater flux
+         zeri(:,:)  = -zsice * qrp(:,:) * ro0cpr * rauw / 34.0
+         zerps(:,:) = ziclim(:,:) * ( (1-freeze(:,:)) * zeri(:,:) )
+         emps (:,:) = zemp(:,:)     &
+                    + runoff(:,:)   &
+                    + erp(:,:)      &
+                    + zerps(:,:)
+         emp (:,:) = emps(:,:)
+#endif  
+
+
+         ! Boundary condition on emp for free surface option
+         ! -------------------------------------------------
+         CALL lbc_lnk( emp, 'T', 1. )
+      
+      ENDIF
+
+   END SUBROUTINE oce_sbc
Index: /branches/nemo/NEMO/OPA_SRC/SBC/tau_coupled.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/tau_coupled.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/tau_coupled.h90	(revision 4)
@@ -0,0 +1,153 @@
+   !!----------------------------------------------------------------------
+   !!                     ***  tau_coupled.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tau     :   update the surface stress - coupled ocean-atmosphere
+   !!               case, without sea-ice
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE ioipsl       ! NetCDF library
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tau( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE tau  ***
+      !!   
+      !! ** Purpose :   provide to the ocean the stress at each time step
+      !!
+      !! ** Method  :   Read wind stress from a coupled Atmospheric model
+      !!      - horizontal interpolation is done
+      !!        They are given in the geographic referential 
+      !!      (zonal and meridional components at both U- and V-points)
+      !!     CAUTION: never mask the surface stress field !
+      !!
+      !! ** Action  :   update at each time-step the two components of the 
+      !!      surface stress in both (i,j) and geographical referencial
+      !!
+      !! References : The OASIS User Guide, Version 2.0, CERFACS/TR 95/46
+      !!
+      !! History :
+      !!   7.0  !  94-03  (L. Terray)  Original code
+      !!        !  96-07  (Laurent TERRAY)  OASIS 2 Version
+      !!        !  96-11  (Eric Guilyardi) horizontal interpolation
+      !!        !  98-04  (M.A Foujols, S. Valcke, M. Imbard) OASIS2.2
+      !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * Local declarations
+      INTEGER :: ji,jj,jf
+      INTEGER :: itm1,isize,iflag,icpliter,info,inuread,index
+      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
+         ztaux , ztauxv,    &  ! ???
+         ztauy , ztauyu        !
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         ztauxg, ztauyg        ! ???
+
+! Addition for SIPC CASE
+      CHARACTER (len=3) ::   clmodinf       ! Header or not
+      CHARACTER (len=3) ::   cljobnam_r    ! Experiment name in the field brick, if any 
+      INTEGER ,DIMENSION(3) :: infos       ! infos in the field brick, if any
+      !!---------------------------------------------------------------------
+
+! 0. Initialization
+! -----------------
+
+      isize = jpiglo * jpjglo
+      itm1 = ( kt - nit000 + 1 ) - 1
+
+! 1. Reading wind stress from coupler
+! -----------------------------------
+
+      IF( MOD(kt,nexco) == 1 )THEN
+
+! Test what kind of message passing we are using
+
+          IF (cchan == 'PIPE') THEN 
+
+! UNIT number for fields
+
+              inuread = 99
+
+! exchanges from to atmosphere=CPL to ocean
+
+              DO jf = 1, ntauc2o
+!                CALL PIPE_Model_Recv(cpl_readtau(jf), icpliter, numout)
+                OPEN (inuread, FILE=cpl_f_readtau(jf), FORM='UNFORMATTED')
+                IF( jf == 1 ) CALL locread( cpl_readtau(jf), ztaux , isize, inuread, iflag, numout )
+                IF( jf == 2 ) CALL locread( cpl_readtau(jf), ztauxv, isize, inuread, iflag, numout )
+                IF( jf == 3 ) CALL locread( cpl_readtau(jf), ztauy , isize, inuread, iflag, numout )
+                IF( jf == 4 ) CALL locread( cpl_readtau(jf), ztauyu, isize, inuread, iflag, numout )
+                CLOSE (inuread)
+              END DO 
+
+          ELSE IF( cchan == 'SIPC' ) THEN 
+
+!         Define IF a header must be encapsulated within the field brick :
+              clmodinf = 'NOT'   ! as $MODINFO in namcouple  
+! 
+!         reading of input field zonal wind stress SOZOTAUX
+
+              index = 1
+!              CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, ztaux)
+
+!         reading of input field meridional wind stress SOZOTAU2 (at v point)
+
+              index = 2
+!              CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, ztaux2)
+
+!         reading of input field zonal wind stress SOMETAUY
+
+              index = 3
+!              CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, ztauy)
+
+!         reading of input field meridional wind stress SOMETAU2 (at u point)
+
+              index = 4
+!              CALL SIPC_Read_Model(index, isize, clmodinf, cljobnam_r, infos, ztauy2)
+! 
+
+          ELSE IF( cchan == 'CLIM' ) THEN 
+! 
+
+! exchanges from atmosphere=CPL to ocean
+
+              DO jf = 1, ntauc2o
+                IF (jf == 1) CALL CLIM_Import ( cpl_readtau(jf), itm1, ztaux , info )
+                IF (jf == 2) CALL CLIM_Import ( cpl_readtau(jf), itm1, ztauxv, info )
+                IF (jf == 3) CALL CLIM_Import ( cpl_readtau(jf), itm1, ztauy , info )
+                IF (jf == 4) CALL CLIM_Import ( cpl_readtau(jf), itm1, ztauyu, info )
+                IF ( info /= CLIM_Ok) THEN
+                    WRITE(numout,*)'Pb in reading ', cpl_readtau(jf), jf
+                    WRITE(numout,*)'Couplage itm1 is = ',itm1
+                    WRITE(numout,*)'CLIM error code is = ', info
+                    WRITE(numout,*)'STOP in Fromcpl'
+                    STOP 'tau.coupled.h'
+                ENDIF
+              END DO 
+
+          ENDIF
+
+! 2. CHANGING DATA GRID COORDINATES --> GLOBAL GRID COORDINATES
+! -------------------------------------------------------------
+
+          DO jj = 1, jpj
+            DO ji = 1, jpi
+              tauxg (ji,jj) = ztaux ( mig(ji), mjg(jj) )
+              tauyg (ji,jj) = ztauy ( mig(ji), mjg(jj) )
+              ztauxg(ji,jj) = ztauxv( mig(ji), mjg(jj) )
+              ztauyg(ji,jj) = ztauyu( mig(ji), mjg(jj) )
+            END DO
+          END DO
+
+          CALL repcmo( tauxg, ztauyg, ztauxg, tauyg, taux, tauy, kt )
+
+      ENDIF
+
+   END SUBROUTINE flx
Index: /branches/nemo/NEMO/OPA_SRC/SBC/tau_coupled_ice.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/tau_coupled_ice.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/tau_coupled_ice.h90	(revision 4)
@@ -0,0 +1,257 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  tau_coupled_ice.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tau     :   update the surface stress - coupled case with LIM
+   !!               sea-ice model
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE ioipsl       ! NetCDF library
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tau( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE tau  ***
+      !!  
+      !! ** Purpose :   provide to the ocean the stress at each time step
+      !!
+      !! ** Method  :   Coupled case with LIM sea-ice model
+      !!      Read wind stress from a coupled Atmospheric model
+      !!      - horizontal interpolation is done in OASIS
+      !!        They are given in the 3D referential 
+      !!      (3 components at both U- and V-points)
+      !!
+      !!    CAUTION: never mask the surface stress field !
+      !!
+      !! ** Action  :   update at each time-step the two components of the 
+      !!                surface stress in both (i,j) and geographical ref.
+      !!
+      !! References : The OASIS User Guide, Version 2.0, CERFACS/TR 95/46
+      !!
+      !! History :
+      !!   7.0  !  94-03  (L. Terray)  Original code
+      !!        !  96-07  (Laurent TERRAY)  OASIS 2 Version
+      !!        !  96-11  (Eric Guilyardi) horizontal interpolation
+      !!        !  98-04  (M.A Foujols, S. Valcke, M. Imbard) OASIS2.2
+      !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * Local declarations
+      INTEGER :: ji,jj,jf
+      INTEGER :: itm1,isize,iflag,icpliter,info,inuread,index
+      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
+         ztauxxu, ztauyyu, ztauzzu,   &  ! 3 components of the wind stress
+         ztauxxv, ztauyyv, ztauzzv       ! at U- and V-points
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         ztauxx, ztauyy, ztauzz,      &  ! ???
+         ztauxg, ztauyg, ztauver         !
+
+! netcdf outputs
+
+      CHARACTER (len=80) ::   clcpltnam
+      INTEGER :: nhoridct, nidct
+      INTEGER ,DIMENSION(jpi*jpj) :: ndexct
+      SAVE nhoridct,nidct,ndexct
+      LOGICAL, SAVE :: lfirstt=.true.
+      REAL(wp) ::   zjulian
+
+! Addition for SIPC CASE
+      CHARACTER (len=3) ::   clmodinf      ! Header or not
+      CHARACTER (len=3) ::   cljobnam_r    ! Experiment name in the field brick, if any 
+      INTEGER ,DIMENSION(3) ::  infos          ! infos in the field brick, if any
+!!---------------------------------------------------------------------
+
+! 0. Initialization
+!------------------
+
+      isize = jpiglo * jpjglo
+      itm1 = ( kt - nit000 + 1 ) - 1
+
+! initialisation for output
+
+      IF( lfirstt ) THEN 
+          lfirstt = .FALSE.
+          ndexct(:) = 0
+          clcpltnam = "cpl_oce_tau"
+
+! Compute julian date from starting date of the run
+          CALL ymds2ju( nyear    , nmonth, nday , 0.e0  , zjulian )
+          CALL histbeg( clcpltnam, jpiglo, glamt, jpjglo, gphit,   &
+             1, jpiglo, 1, jpjglo, 0, zjulian, rdt, nhoridct, nidct)
+! no vertical axis
+          CALL histdef( nidct, 'taux'  , 'taux'  , "-", jpi, jpj, nhoridct,   &
+             1, 1, 1, -99, 32, "inst", rdt, rdt )
+          CALL histdef( nidct, 'tauy'  , 'tauy'  , "-", jpi, jpj, nhoridct,   &
+             1, 1, 1, -99, 32, "inst", rdt, rdt )
+          CALL histdef( nidct, 'tauxeu', 'tauxeu', "-", jpi, jpj, nhoridct,   &
+             1, 1, 1, -99, 32, "inst", rdt, rdt )
+          CALL histdef( nidct, 'tauynu', 'tauynu', "-", jpi, jpj, nhoridct,   &
+             1, 1, 1, -99, 32, "inst", rdt, rdt )
+          CALL histdef( nidct, 'tauzzu', 'tauzzu', "-", jpi, jpj, nhoridct,   &
+             1, 1, 1, -99, 32, "inst", rdt, rdt )
+          CALL histdef( nidct, 'tauxev', 'tauxev', "-", jpi, jpj, nhoridct,   &
+             1, 1, 1, -99, 32, "inst", rdt, rdt )
+          CALL histdef( nidct, 'tauynv', 'tauynv', "-", jpi, jpj, nhoridct,   &
+             1, 1, 1, -99, 32, "inst", rdt, rdt )
+          CALL histdef( nidct, 'tauzzv', 'tauzzv', "-", jpi, jpj, nhoridct,   &
+             1, 1, 1, -99, 32, "inst", rdt, rdt )
+
+          DO jf = 1, ntauc2o
+            CALL histdef( nidct, cpl_readtau(jf), cpl_readtau(jf),   &
+               "-", jpi, jpj, nhoridct,   &
+               1, 1, 1, -99, 32, "inst", rdt, rdt )
+          END DO 
+
+          CALL histend(nidct)
+
+      ENDIF 
+
+! 1. Reading wind stress from coupler
+! -----------------------------------
+
+      IF( MOD(kt,nexco) == 1 ) THEN
+
+! Test what kind of message passing we are using
+
+          IF( cchan == 'PIPE' ) THEN 
+
+! UNIT number for fields
+
+              inuread = 99
+
+! exchanges from to atmosphere=CPL to ocean
+
+              DO jf = 1, ntauc2o
+!                CALL PIPE_Model_Recv(cpl_readtau(jf), icpliter, numout)
+                OPEN (inuread, FILE=cpl_f_readtau(jf), FORM='UNFORMATTED')
+                IF( jf == 1 ) CALL locread(cpl_readtau(jf), ztauxxu,isize,inuread,iflag,numout)
+                IF( jf == 2 ) CALL locread(cpl_readtau(jf), ztauyyu,isize,inuread,iflag,numout)
+                IF( jf == 3 ) CALL locread(cpl_readtau(jf), ztauzzu,isize,inuread,iflag,numout)
+                IF( jf == 4 ) CALL locread(cpl_readtau(jf), ztauxxv,isize,inuread,iflag,numout)
+                IF( jf == 5 ) CALL locread(cpl_readtau(jf), ztauyyv,isize,inuread,iflag,numout)
+                IF( jf == 6 ) CALL locread(cpl_readtau(jf), ztauyyv,isize,inuread,iflag,numout)
+                CLOSE ( inuread )
+              END DO 
+
+          ELSE IF( cchan == 'SIPC' ) THEN 
+
+!         Define IF a header must be encapsulated within the field brick :
+              clmodinf = 'NOT'   ! as $MODINFO in namcouple  
+! 
+!         reading of input field zonal wind stress SOZOTAUX
+
+              index = 1
+!              CALL SIPC_Read_Model(index, isize, clmodinf,cljobnam_r, infos, ztaux)
+
+!         reading of input field meridional wind stress SOZOTAU2 (at v point)
+
+              index = 2
+!              CALL SIPC_Read_Model(index, isize, clmodinf,cljobnam_r, infos, ztaux2)
+
+!         reading of input field zonal wind stress SOMETAUY
+
+              index = 3
+!              CALL SIPC_Read_Model(index, isize, clmodinf,cljobnam_r, infos, ztauy)
+
+!         reading of input field meridional wind stress SOMETAU2 (at u point)
+
+              index = 4
+!              CALL SIPC_Read_Model(index, isize, clmodinf,cljobnam_r, infos, ztauy2)
+! 
+
+          ELSE IF ( cchan == 'CLIM' ) THEN 
+
+              WRITE (numout,*) 'Reading wind stress from coupler ', kt
+
+! exchanges from atmosphere=CPL to ocean
+
+              DO jf = 1, ntauc2o
+                IF( jf == 1 ) CALL CLIM_Import (cpl_readtau(jf), itm1,ztauxxu,info)
+                IF( jf == 2 ) CALL CLIM_Import (cpl_readtau(jf), itm1,ztauyyu,info)
+                IF( jf == 3 ) CALL CLIM_Import (cpl_readtau(jf), itm1,ztauzzu,info)
+                IF( jf == 4 ) CALL CLIM_Import (cpl_readtau(jf), itm1,ztauxxv,info)
+                IF( jf == 5 ) CALL CLIM_Import (cpl_readtau(jf), itm1,ztauyyv,info)
+                IF( jf == 6 ) CALL CLIM_Import (cpl_readtau(jf), itm1,ztauzzv,info)
+                IF( info /= CLIM_Ok) THEN
+                    WRITE(numout,*)'Pb in reading ', cpl_readtau(jf), jf
+                    WRITE(numout,*)'Couplage itm1 is = ',itm1
+                    WRITE(numout,*)'CLIM error code is = ', info
+                    WRITE(numout,*)'STOP in Fromcpl'
+                    STOP 'tau.coupled.h90'
+                ENDIF
+              END DO 
+          ENDIF
+
+          DO jf = 1, ntauc2o
+            IF( jf == 1 ) CALL histwrite(nidct,cpl_readtau(jf), kt,ztauxxu,jpi*jpj,ndexct)
+            IF( jf == 2 ) CALL histwrite(nidct,cpl_readtau(jf), kt,ztauyyu,jpi*jpj,ndexct)
+            IF( jf == 3 ) CALL histwrite(nidct,cpl_readtau(jf), kt,ztauzzu,jpi*jpj,ndexct)
+            IF( jf == 4 ) CALL histwrite(nidct,cpl_readtau(jf), kt,ztauxxv,jpi*jpj,ndexct)
+            IF( jf == 5 ) CALL histwrite(nidct,cpl_readtau(jf), kt,ztauyyv,jpi*jpj,ndexct)
+            IF( jf == 6 ) CALL histwrite(nidct,cpl_readtau(jf), kt,ztauzzv,jpi*jpj,ndexct)
+          END DO 
+
+          CALL histsync(nidct)
+
+! 2. CHANGING DATA GRID COORDINATES --> GLOBAL GRID COORDINATES
+! -------------------------------------------------------------
+! On u grid
+          DO jj = 1, jpj
+            DO ji = 1, jpi
+              ztauxx(ji,jj) = ztauxxu( mig(ji), mjg(jj) )
+              ztauyy(ji,jj) = ztauyyu( mig(ji), mjg(jj) )
+              ztauzz(ji,jj) = ztauzzu( mig(ji), mjg(jj) )
+            END DO
+          END DO
+
+          CALL geo2oce( ztauxx, ztauyy, ztauzz, 'u', glamu, gphiu, tauxg, ztauyg, ztauver )
+
+          CALL histwrite( nidct, 'tauxeu', kt , tauxg  , jpi*jpj, ndexct )
+          CALL histwrite( nidct, 'tauynu', kt , ztauyg , jpi*jpj, ndexct )
+          CALL histwrite( nidct, 'tauzzu', kt , ztauver, jpi*jpj, ndexct ) 
+
+! On v grid
+          DO jj = 1, jpj
+            DO ji = 1, jpi
+              ztauxx(ji,jj) = ztauxxv( mig(ji), mjg(jj) )
+              ztauyy(ji,jj) = ztauyyv( mig(ji), mjg(jj) )
+              ztauzz(ji,jj) = ztauzzv( mig(ji), mjg(jj) )
+            END DO
+          END DO
+
+          CALL geo2oce( ztauxx, ztauyy, ztauzz, 'v', glamv, gphiv, ztauxg, tauyg, ztauver )
+
+          CALL histwrite( nidct, 'tauxev', kt , ztauxg , jpi*jpj, ndexct )
+          CALL histwrite( nidct, 'tauynv', kt , tauyg  , jpi*jpj, ndexct )
+          CALL histwrite( nidct, 'tauzzv', kt , ztauver, jpi*jpj, ndexct ) 
+
+
+          CALL repcmo( tauxg, ztauyg, ztauxg, tauyg, taux, tauy, kt )
+
+! sortie des composantes de vents : tauxn tauye
+
+          CALL histwrite( nidct, 'taux', kt , taux, jpi*jpj, ndexct )
+          CALL histwrite( nidct, 'tauy', kt , tauy, jpi*jpj, ndexct )
+          CALL histsync( nidct )
+          IF( nitend-kt < nexco ) CALL histclo( nidct )
+
+! Pour l'instant pas de différentiation de tension de vent mer libre / glace
+!  9: la tension de vent sur l'ocean suivant i              
+          sciobc (:,:, 9) = taux
+! 10: la tension de vent sur la glace suivant i              
+          sciobc (:,:,10) = taux
+! 11: la tension de vent sur l'ocean suivant j               
+          sciobc (:,:,11) = tauy
+! 12: la tension de vent sur la glace suivant j               
+          sciobc (:,:,12) = tauy
+
+      ENDIF
+
+   END SUBROUTINE flx
Index: /branches/nemo/NEMO/OPA_SRC/SBC/tau_forced_daily.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/tau_forced_daily.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/tau_forced_daily.h90	(revision 4)
@@ -0,0 +1,179 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  tau_forced_daily.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tau     :   update the surface stress - daily fields in NetCDF file
+   !!----------------------------------------------------------------------
+   !! * local modules variables
+   INTEGER ::   &
+      numtau,         &  ! logical unit for the i-component of the wind data
+      numtav,         &  ! logical unit for the j-component of the wind data
+      ntau1, ntau2 ,  &  ! index of the first and second record used
+      ndaytau            ! new day for ers/ncep tau forcing
+
+   CHARACTER (len=34) ::   &      !!! * monthly climatology/interanual fields
+      cl_taux = 'taux.nc',  & ! generic name of the i-component monthly NetCDF file
+      cl_tauy = 'tauy.nc'     ! generic name of the j-component monthly NetCDF file
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tau( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE tau  ***
+      !!     
+      !! ** Purpose :   provide to the ocean the stress at each time step
+      !!
+      !! ** Method  :   Read the daily surface stress components in NetCDF 
+      !!      file. They are given in the (i,j) referential 
+      !!        The i-component is given at U-point (INTERP package)
+      !!        The j-component is given at V-point (INTERP package)
+      !!
+      !!    CAUTION: never mask the surface stress field !
+      !!
+      !! ** Action  :   update at each time-step the two components of the 
+      !!      surface stress in both (i,j) and geographical referencial
+      !!
+      !! History :
+      !!   4.0  !  91-03  (G. Madec)  Original code
+      !!   6.0  !  92-07  (M. Imbard)
+      !!   8.1  !  00-08  (D. Ludicone) adapted to ERS-NCEP
+      !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
+      !!        !  03-07  (C. Ethe, G. Madec)  daily generic forcing
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl       ! NetCDF library
+
+      !! * Arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * Local declarations
+      INTEGER, PARAMETER ::   jpday = 365
+      INTEGER ::   &
+         itime,   &
+         iday, idy,   &
+         ipi, ipj, ipk
+      INTEGER  , DIMENSION(jpday)  ::   istep
+      REAL(wp) , DIMENSION(jpi,jpj)::  &
+         zlon  , & 
+         zlat
+      REAL(wp) , DIMENSION(jpk)::  &
+         zlev
+      REAL(wp) ::   zsecond, zdate0
+      !!---------------------------------------------------------------------
+
+      ! -------------- !
+      ! Initialization !
+      ! -------------- !
+
+      itime = jpday
+      ipi   = jpiglo
+      ipj   = jpjglo
+      ipk   = jpk
+      idy   = 365
+      IF ( nleapy == 1 ) idy = 366 
+
+
+      ! -------------------- !
+      ! First call kt=nit000 !
+      ! -------------------- !
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) ' '
+            WRITE(numout,*) ' tau    : DAILY wind stress in NetCDF files'
+            WRITE(numout,*) ' ~~~~~~~'
+         ENDIF
+         ! title, dimensions and tests
+         
+         CALL flinopen( cl_taux, mig(1), nlci, mjg(1), nlcj,   &   ! taux on U-grid
+                        .FALSE., ipi   , ipj, ipk   ,        &
+                        zlon , zlat  , zlev   , itime,       &
+                        istep, zdate0, zsecond, numtau )
+         
+         IF( itime /= jpday .AND. itime /= jpday+1 ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '   problem with time coordinates in file ', cl_taux
+            IF(lwp) WRITE(numout,*) '   itime = ', itime,' jpday = ',jpday
+            nstop = nstop + 1
+         ENDIF
+         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '   problem with size read in file ', cl_taux
+            IF(lwp) WRITE(numout,*) '   ipi = ',ipi,' jpidta = ',jpidta
+            IF(lwp) WRITE(numout,*) '   ipj = ',ipj,' jpjdta = ',jpjdta
+            IF(lwp) WRITE(numout,*) '   ipk = ',ipk,' must be 1'
+            nstop = nstop + 1
+         ENDIF
+
+         CALL flinopen( cl_tauy, mig(1), nlci, mjg(1), nlcj,   &   ! tauy on V-grid
+                        .FALSE., ipi   , ipj, ipk   ,        &
+                        zlon , zlat  , zlev   , itime,       &
+                        istep, zdate0, zsecond, numtav )
+         
+         IF( itime /= jpday .AND. itime /= jpday+1 ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '   problem with time coordinates in file ', cl_tauy
+            IF(lwp) WRITE(numout,*) '   itime = ', itime,' jpday = ',jpday
+            nstop = nstop + 1
+         ENDIF
+         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '   problem with size read in file ', cl_tauy
+            IF(lwp) WRITE(numout,*) '   ipi = ',ipi,' jpidta = ',jpidta
+            IF(lwp) WRITE(numout,*) '   ipj = ',ipj,' jpjdta = ',jpjdta
+            IF(lwp) WRITE(numout,*) '   ipk = ',ipk,' must be 1'
+            nstop = nstop + 1
+         ENDIF
+      ENDIF
+
+      ! ----------------- !
+      ! Read daily file   !
+      ! ----------------- !
+
+      IF ( ndaytau /= nday ) THEN
+            
+         ndaytau = nday
+         iday  = nday_year
+            
+         ! Read daily wind stress data
+         CALL flinget( numtau,'taux',                 &   ! taux: i-component at U-pt
+                       jpidta,jpjdta,1,jpday,iday,    &
+                       iday,mig(1),nlci,mjg(1),nlcj,taux(1:nlci,1:nlcj) )
+         CALL flinget( numtav,'tauy',                 &   ! tauy: j-component at V-pt
+                       jpidta,jpjdta,1,jpday,iday,    &
+                       iday,mig(1),nlci,mjg(1),nlcj,tauy(1:nlci,1:nlcj) )
+            
+         IF (lwp .AND. nitend-nit000 <= 100 ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' read daily wind stress ok'
+            WRITE(numout,*)
+            WRITE(numout,*) ' day: ', ndastp , '  taux: 1 multiply by ', 1.
+            CALL prihre( taux, jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
+            WRITE(numout,*)
+            WRITE(numout,*) ' day: ', ndastp , '  tauy: 1 multiply by ', 1.
+            CALL prihre( tauy, jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
+            WRITE(numout,*) ' ' 
+         ENDIF
+            
+         CALL FLUSH(numout)
+      ENDIF
+         
+      ! Save components in geographical ref on U grid
+      tauxg(:,:) = taux(:,:)
+      tauyg(:,:) = tauy(:,:)
+         
+      ! ------------------- !
+      ! Last call kt=nitend !
+      ! ------------------- !
+
+      ! Closing of the 2 files
+      IF( kt == nitend ) THEN
+          CALL flinclo( numtau )
+          CALL flinclo( numtav )
+      ENDIF
+         
+   END SUBROUTINE tau
Index: /branches/nemo/NEMO/OPA_SRC/SBC/tau_forced_monthly.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/tau_forced_monthly.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/tau_forced_monthly.h90	(revision 4)
@@ -0,0 +1,220 @@
+   !!----------------------------------------------------------------------
+   !!                ***  tau_forced_monthly.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tau     : update the surface wind stress - monthly fields in NetCDF
+   !!             file.
+   !!----------------------------------------------------------------------
+   !! * local modules variables
+   INTEGER ::   &
+      numtau,   &  ! logical unit for the i-component of the wind data
+      numtav,   &  ! logical unit for the j-component of the wind data
+      ntau1, ntau2  ! index of the first and second record used
+
+   CHARACTER (len=34) ::   &      !!! * monthly climatology/interanual fields
+      cl_taux = 'taux_1m.nc',  & ! generic name of the i-component monthly NetCDF file
+      cl_tauy = 'tauy_1m.nc'     ! generic name of the j-component monthly NetCDF file
+
+   REAL(wp), DIMENSION(jpi,jpj,2) ::   &
+      taux_dta,    &  ! i- and j-components of the surface stress (Pascal)
+      tauy_dta        ! at 2 consecutive months in the (i,j) referential
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tau( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE tau  ***
+      !!              
+      !! ** Purpose :   provide to the ocean the stress at each time step
+      !!
+      !! ** Method  : - Read the 2 monthly surface stress components in NetCDF 
+      !!      file at 2 consecutive time-steps
+      !!        They are given in the (i,j) referential 
+      !!        The i-component is given at U-point (INTERP package)
+      !!        The j-component is given at V-point (INTERP package)
+      !!              - a linear time-interpolation is performed to provide the
+      !!      stress at the kt time-step.
+      !!
+      !!    CAUTION: never mask the surface stress field !
+      !!
+      !! ** Action :
+      !!        update at each time-step the two components of the surface
+      !!      stress in both (i,j) and geographical referencial
+      !!
+      !! History :
+      !!   4.0  !  91-03  (G. Madec)  Original code
+      !!   6.0  !  92-07  (M. Imbard)
+      !!   8.1  !  00-08  (D. Ludicone) adapted to ERS-NCEP
+      !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
+      !!        !                     daily/monthly, forced/coupled form
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl       ! NetCDF library
+      !! * Arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * Local declarations
+      INTEGER, PARAMETER ::   jpmonth = 12
+      INTEGER ::   &
+         imois, iman, itime,   &
+         i15,   &
+         ipi, ipj, ipk
+      INTEGER, DIMENSION(jpmonth) ::   istep
+      REAL(wp) , DIMENSION(jpi,jpj)::  &
+         zlon  , &
+         zlat
+      REAL(wp) , DIMENSION(jpk)::  &
+         zlev
+      REAL(wp) ::   &
+         zsecond,   & ! ???
+         zdate0,    & ! ???
+         zxy          ! coefficient of the linear time interpolation
+      !!---------------------------------------------------------------------
+
+      ! -------------- !
+      ! Initialization !
+      ! -------------- !
+      
+      ! iman=number of dates in data file (12 for a year of monthly values)
+      iman  = INT( raamo )
+      ipi=jpiglo
+      ipj=jpjglo
+
+      i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) )
+
+      imois = nmonth + i15 - 1
+      IF( imois == 0 ) imois = iman
+
+
+      ! -------------------- !
+      ! First call kt=nit000 !
+      ! -------------------- !
+
+      IF( kt == nit000 ) THEN
+         ntau1 = 0
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' tau    : MONTHLY climatological wind stress (NetCDF files)'
+         IF(lwp) WRITE(numout,*) ' ~~~    '
+         
+         ! title, dimensions and tests
+         
+         CALL flinopen( cl_taux, mig(1), nlci, mjg(1), nlcj,   &   ! taux on U-grid
+                        .FALSE., ipi   , ipj, ipk   ,        &
+                        zlon , zlat  , zlev   , itime,       &
+                        istep, zdate0, zsecond, numtau )
+         
+         IF( itime /= jpmonth ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '   problem with time coordinates in file ', cl_taux
+            IF(lwp) WRITE(numout,*) '   itime = ', itime,' jpmonth = ',jpmonth
+            nstop = nstop + 1
+         ENDIF
+         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '   problem with size read in file ', cl_taux
+            IF(lwp) WRITE(numout,*) '   ipi = ',ipi,' jpidta = ',jpidta
+            IF(lwp) WRITE(numout,*) '   ipj = ',ipj,' jpjdta = ',jpjdta
+            IF(lwp) WRITE(numout,*) '   ipk = ',ipk,' must be 1'
+            nstop = nstop + 1
+         ENDIF
+
+         CALL flinopen( cl_tauy, mig(1), nlci, mjg(1), nlcj,   &   ! tauy on V-grid
+                        .FALSE., ipi   , ipj, ipk   ,        &
+                        zlon , zlat  , zlev   , itime,       &
+                        istep, zdate0, zsecond, numtav )
+
+         IF( itime /= jpmonth ) THEN          
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '   problem with time coordinates in file ', cl_tauy
+            IF(lwp) WRITE(numout,*) '   itime = ', itime,' jpmonth = ',jpmonth
+            nstop = nstop + 1
+         ENDIF
+         IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '   problem with size read in file ', cl_tauy
+            IF(lwp) WRITE(numout,*) '   ipi = ',ipi,' jpidta = ',jpidta
+            IF(lwp) WRITE(numout,*) '   ipj = ',ipj,' jpjdta = ',jpjdta
+            IF(lwp) WRITE(numout,*) '   ipk = ',ipk,' must be 1'
+            nstop = nstop + 1
+         ENDIF
+      ENDIF
+      
+      ! ----------------- !
+      ! Read monthly file !
+      ! ----------------- !
+
+      IF( kt == nit000 .OR. imois /= ntau1 ) THEN
+
+         ! Calendar computation
+         ntau1 = imois          ! index of the first record
+         ntau2 = ntau1 + 1      ! index of the last  record
+         ntau1 = MOD( ntau1, iman )
+         IF( ntau1 == 0 ) ntau1 = iman
+         ntau2 = MOD( ntau2, iman )
+         IF( ntau2 == 0 ) ntau2 = iman
+         IF(lwp) WRITE(numout,*) 'first month used ntau1 = ', ntau1
+         IF(lwp) WRITE(numout,*) 'last  month used ntau2 = ', ntau2
+
+         ! Read the corresponding 2 monthly stress data
+         ! ntau1
+         CALL flinget( numtau,'sozotaux',    &               ! i-component at U-pt
+            jpidta,jpjdta,1,jpmonth,ntau1,   &
+            ntau1,mig(1),nlci,mjg(1),nlcj,taux_dta(1:nlci,1:nlcj,1) )
+         CALL flinget( numtav,'sometauy',    &               ! j-component at V-pt
+            jpidta,jpjdta,1,jpmonth,ntau1,   &
+            ntau1,mig(1),nlci,mjg(1),nlcj,tauy_dta(1:nlci,1:nlcj,1) )
+         ! ntau2
+         CALL flinget( numtau,'sozotaux',    &               ! i-component at U-pt
+            jpidta,jpjdta,1,jpmonth,ntau2,   &
+            ntau2,mig(1),nlci,mjg(1),nlcj,taux_dta(1:nlci,1:nlcj,2) )
+         CALL flinget( numtav,'sometauy',    &               ! j-component at V-pt
+            jpidta,jpjdta,1,jpmonth,ntau2,   &
+            ntau2,mig(1),nlci,mjg(1),nlcj,tauy_dta(1:nlci,1:nlcj,2) )
+         
+         IF(lwp .AND. nitend-nit000 <= 100 ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' monthly stress read'
+            WRITE(numout,*)
+            WRITE(numout,*) ' month: ', ntau1, '  taux: 1 multiply by ', 1.
+            CALL prihre( taux_dta(1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
+            WRITE(numout,*)
+            WRITE(numout,*) ' month: ', ntau2, '  tauy: 2 multiply by ', 1.
+            CALL prihre( tauy_dta(1,1,2), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
+         ENDIF
+
+         CALL FLUSH(numout)
+      ENDIF
+
+      ! ------------------------------- !
+      ! linear time interpolation at kt !
+      ! ------------------------------- !
+
+      ! zxy : coefficient for linear interpolation in time
+
+      zxy = FLOAT( nday ) / FLOAT( nobis(ntau1) ) + 0.5 - i15
+
+      taux(:,:) = (1.-zxy) * taux_dta(:,:,1) + zxy * taux_dta(:,:,2)
+      tauy(:,:) = (1.-zxy) * tauy_dta(:,:,1) + zxy * tauy_dta(:,:,2)
+
+      ! Save components 
+
+      tauxg(:,:) = taux(:,:)
+      tauyg(:,:) = tauy(:,:)
+
+      CALL FLUSH(numout)
+
+      ! ------------------- !
+      ! Last call kt=nitend !
+      ! ------------------- !
+
+      ! Closing of the 2 files (required in mpp)
+      IF( kt == nitend ) THEN
+          CALL flinclo(numtau)
+          CALL flinclo(numtav)
+      ENDIF
+
+   END SUBROUTINE tau
Index: /branches/nemo/NEMO/OPA_SRC/SBC/tau_forced_monthly_fdir.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/tau_forced_monthly_fdir.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/tau_forced_monthly_fdir.h90	(revision 4)
@@ -0,0 +1,199 @@
+   !!----------------------------------------------------------------------
+   !!                ***  tau_forced_monthly_fdir.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tau     : update surface stress from monthly mean fields read in 
+   !!             a direct access file
+   !!----------------------------------------------------------------------
+   !! * local modules variables
+   INTEGER ::           &
+      numtau = 64,      &  ! logical unit for the i-component of the wind data
+      ntau1, ntau2         ! index of the first and second record used
+   CHARACTER (len=32) ::   &
+      cl_tau = 'tauxy_1m'  &
+      !                    ! name of the monthly direct acces file
+      !                    ! which containt the 2 surface stress components
+   REAL(wp), DIMENSION(jpi,jpj,2,4) ::   &
+      taudta               ! the 2 components of the surface stress (Pascal)
+      !                    ! at 2 consecutive time-steps in the (i,j) referential
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tau( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE tau  ***
+      !!              
+      !! ** Purpose :   provide to the ocean the stress at each time step
+      !!
+      !! ** Method  : - Read the 2 monthly surface stress components in a 
+      !!      direct access file at 2 consecutive time-steps
+      !!        They are given in the (i,j) referential 
+      !!        The i-component is given at U-point (INTERP package)
+      !!        The j-component is given at V-point (INTERP package)
+      !!              - a linear time-interpolation is performed to provide 
+      !!      the stress at the kt time-step.
+      !!
+      !!    CAUTION: never mask the surface stress field !
+      !!
+      !! ** Action :
+      !!        update at each time-step the two components of the surface
+      !!      stress in both (i,j) and geographical referencial
+      !!
+      !! History :
+      !!   4.0  !  91-03  (G. Madec)  Original code
+      !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * Local declarations
+      INTEGER :: ji, jj, ios
+      INTEGER :: iimlu, ijmlu, ikmlu, ilmlu, immlu
+      INTEGER :: imois, iman
+      INTEGER :: i15
+      INTEGER :: ildta,ibloc,ilseq
+
+      CHARACTER (len=30) ::   cltit
+      CHARACTER (len=21) ::   clunf, clold, cldir
+
+      REAL(wp) ::   zxy, zfacto
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztauxg, ztauyg
+!!---------------------------------------------------------------------
+
+
+! 0. Initialization
+! -----------------
+! Open specifier
+
+      clold = 'OLD'
+      clunf = 'UNFORMATTED'
+      cldir = 'DIRECT'
+
+      ilseq = 1
+
+! computation of the record length for direct access file
+! this length depend of 4096 (device specification)
+
+      ibloc = 4096
+      ildta = ibloc*((jpidta*jpjdta*jpbytda-1 )/ibloc+1)
+
+! iman=number of dates in data file (12 for a year of monthly values)
+      iman  = int(raamo)
+
+      i15 = INT( 2 * FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) )
+
+      imois = nmonth + i15 - 1
+      IF ( imois == 0 ) imois = iman
+
+
+! 1. first call kt=nit000
+! -----------------------
+
+      IF( kt == nit000 ) THEN
+          ntau1 = 0
+          IF(lwp) WRITE(numout,*) ' '
+          IF(lwp) WRITE(numout,*) ' tau    : monthly stress direct access file'
+          IF(lwp) WRITE(numout,*) ' ~~~~~~'
+          IF(lwp) WRITE(numout,*)
+          IF(lwp) WRITE(numout,*) 'file numtau = ', numtau
+
+! title, dimensions and tests
+
+          CALL ctlopn(numtau, cl_tau, clold, clunf, cldir, ildta, numout, lwp, 1 )
+          READ ( numtau, REC=1, IOSTAT=ios ) cltit, iimlu, ijmlu, ikmlu, ilmlu, immlu
+
+          IF(lwp) WRITE(numout,*)' number of points in the 5 directions '
+          IF(lwp) WRITE(numout,*) iimlu, ijmlu, ikmlu, ilmlu, immlu
+      ENDIF
+
+
+! 2. Read monthly file
+! -------------------
+
+      IF ( kt == nit000 .OR. imois /= ntau1 ) THEN
+
+! 2.1 calendar computation
+
+! ntau1 number of the first file record used in the simulation
+! ntau2 number of the last  file record
+
+          ntau1 = imois
+          ntau2 = ntau1+1
+          ntau1 = mod( ntau1, iman )
+          IF ( ntau1 == 0 ) ntau1 = iman
+          ntau2 = MOD( ntau2, iman )
+          IF ( ntau2 == 0 ) ntau2 = iman
+          IF(lwp) WRITE(numout,*) 'first record file used ntau1 ', ntau1
+          IF(lwp) WRITE(numout,*) 'last  record file used ntau2 ', ntau2
+
+! 2.3 Read monthly stress data Hellerman
+
+! ntau1
+! ...Txu
+          CALL read2D(numtau,taudta(1,1,1,1),1,6*(ntau1-1)+3)
+! ...Txv
+          CALL read2D(numtau,taudta(1,1,1,2),1,6*(ntau1-1)+4)
+! ...Tyu
+          CALL read2D(numtau,taudta(1,1,1,3),1,6*(ntau1-1)+6)
+! ...Tyv
+          CALL read2D(numtau,taudta(1,1,1,4),1,6*(ntau1-1)+7)
+! ntau2
+! ...Txu
+          CALL read2D(numtau,taudta(1,1,2,1),1,6*(ntau2-1)+3)
+! ...Txv
+          CALL read2D(numtau,taudta(1,1,2,2),1,6*(ntau2-1)+4)
+! ...Tyu
+          CALL read2D(numtau,taudta(1,1,2,3),1,6*(ntau2-1)+6)
+! ...Tyv
+          CALL read2D(numtau,taudta(1,1,2,4),1,6*(ntau2-1)+7)
+
+          IF(lwp) THEN
+          WRITE(numout,*) ' '
+          WRITE(numout,*) ' read Clio stress ok'
+          WRITE(numout,*) ' '
+          WRITE(numout,*) ' month: ', ntau1, '  field: 1 multiply by ', 1.
+          CALL prihre( taudta(1,1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
+          WRITE(numout,*) ' '
+          WRITE(numout,*) ' month: ', ntau2, '  field: 2 multiply by ', 1.
+          CALL prihre( taudta(1,1,2,4), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
+          ENDIF
+
+      ENDIF
+
+ 
+! 4. At every time step compute stress data
+! -----------------------------------------
+
+      zfacto     = 1.
+! zxy : coefficient for linear interpolation in time
+      zxy = FLOAT( nday ) / FLOAT( nobis(ntau1) ) + 0.5 - i15
+
+! ...Txu
+      tauxg (:,:) = zfacto * ( (1.-zxy) * taudta(:,:,1,1) + zxy * taudta(:,:,2,1) )
+! ...Tyu
+      tauyg (:,:) = zfacto * ( (1.-zxy) * taudta(:,:,1,3) + zxy * taudta(:,:,2,3) )
+! ...Txv
+      ztauxg(:,:) = zfacto * ( (1.-zxy) * taudta(:,:,1,2) + zxy * taudta(:,:,2,2) )
+! ...Tyv
+      ztauyg(:,:) = zfacto * ( (1.-zxy) * taudta(:,:,1,4) + zxy * taudta(:,:,2,4) ) 
+
+! 2.4 changing data grid coordinates --> global grid coordinates
+
+      CALL repcmo( tauxg, tauyg, ztauxg, ztauyg, taux, tauy, kt )
+
+! 2.5 Save components 
+
+      tauxg(:,:) = taux(:,:)
+      tauyg(:,:) = tauy(:,:)
+
+      CALL FLUSH(numout)
+      GO TO 412
+ 410  IF(lwp)WRITE(numout,*) 'e r r o r read numtau ', ios
+      nstop = nstop +1
+ 412  CONTINUE
+
+   END SUBROUTINE tau
Index: /branches/nemo/NEMO/OPA_SRC/SBC/taumod.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SBC/taumod.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SBC/taumod.F90	(revision 4)
@@ -0,0 +1,147 @@
+MODULE taumod
+   !!======================================================================
+   !!                       ***  MODULE  taumod  ***
+   !! Ocean forcing : stress at the the ocean surface
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tau          : define the surface stress for the ocean
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tau                ! routine called by step.F90
+
+   !! * Share modules variables
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &
+      taux, tauy,      &  ! surface stress components in (i,j) referential
+      tauxg, tauyg        ! surface stress components in geographical
+      !                   ! referential (used in output)
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+#if defined key_tau_monthly
+   ! Monthly climatology in (i,j) referential  (i-comp. at U-pt and j-comp. at V-pt)
+#  if defined key_fdir
+   !!----------------------------------------------------------------------
+   !!   'key_tau_monthly'                        MONTHLY climatology stress
+   !!   'key_fdir'                                  direct access files
+   !!----------------------------------------------------------------------
+#   include "tau_forced_monthly_fdir.h90"
+#  else
+   !!----------------------------------------------------------------------
+   !!   'key_tau_monthly'                        MONTHLY climatology stress
+   !!   default case                                   NetCDF files
+   !!----------------------------------------------------------------------
+#   include "tau_forced_monthly.h90"
+#  endif
+
+# elif defined key_tau_daily
+   !!----------------------------------------------------------------------
+   !!   'key_tau_daily'                                 DAILY stress
+   !!                                                   NetCDF files
+   !!----------------------------------------------------------------------
+   ! Daily climatology/interannual in (i,j) referential  (i-comp. at U-pt and j-comp. at V-pt)
+#   include "tau_forced_daily.h90"
+
+#elif defined key_coupled
+   ! Coupled case : stress at the coupling frequency
+# if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_coupled'                              Coupled Ocean/Atmosphere
+   !!   'key_ice_lim'                                   LIM sea-ice
+   !!----------------------------------------------------------------------
+   ! New way: 3D referential link to the earth (avoid north pole pb)
+   ! (3 component stress defined at U- and V-points)
+#  include "tau_coupled_ice.h90"
+# else
+   !!----------------------------------------------------------------------
+   !!   'key_coupled'                              Coupled Ocean/Atmosphere
+   !!   Default case                                  NO sea-ice
+   !!----------------------------------------------------------------------
+   ! old fashion: geographical referential
+   ! (zonal and meridional stress defined at U- and V-points)
+#  include "tau_coupled.h90"
+# endif
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                     constant forcing
+   !!----------------------------------------------------------------------
+   !! * local modules variables
+   INTEGER  ::       & !!! * Namelist numtau *
+      ntau000 = 1       ! nb of time-step during which the surface stress
+      !                 ! increase from 0 to its nominal value (taudta) (>0)
+   REAL(wp) ::       & !!! * Namelist numtau *
+      tau0x = 0.e0 , &  ! constant wind stress value in i-direction
+      tau0y = 0.e0      ! constant wind stress value in j-direction
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tau( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE tau  ***
+      !! 
+      !! ** Purpose :   provide the ocean surface stress at each time step
+      !!
+      !! ** Method  :   Constant surface stress increasing from 0 to taudta 
+      !!      value during the first ntau000 time-step (namelist)
+      !!        CAUTION: never mask the surface stress field !
+      !!
+      !! ** Action  : - update taux , tauy the stress in (i,j) ref.
+      !!              - update tauxg, tauyg the stress in geographic ref.
+      !!
+      !! History :
+      !!   4.0  !  91-03  (G. Madec)  Original code
+      !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * Local declarations
+      REAL(wp) ::   zfacto             ! 
+
+      NAMELIST/namtau/ ntau000, tau0x, tau0y
+      !!---------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+
+         ! Read Namelist namtau : surface wind stress
+         ! --------------------
+         REWIND ( numnam )
+         READ   ( numnam, namtau )
+
+         IF(lwp) WRITE(numout,*)' '
+         IF(lwp) WRITE(numout,*)' tau     : Constant surface wind stress read in namelist'
+         IF(lwp) WRITE(numout,*)' ~~~~~~~ '
+         IF(lwp) WRITE(numout,*)'           Namelist namtau: set the constant stress values'
+         IF(lwp) WRITE(numout,*)'              spin up of the stress  ntau000 = ', ntau000, ' time-steps'
+         IF(lwp) WRITE(numout,*)'              constant i-stress      tau0x   = ', tau0x  , ' N/m2'
+         IF(lwp) WRITE(numout,*)'              constant j-stress      tau0y   = ', tau0y  , ' N/m2'
+
+         ntau000 = MAX( ntau000, 1 )   ! must be >= 1
+
+      ENDIF
+
+      ! Increase the surface stress to its nominal value in ntau000 time-step
+      
+      IF( kt <= ntau000 ) THEN
+         zfacto = 0.5 * (  1. - COS( rpi * FLOAT( kt ) / FLOAT( ntau000 ) )  )
+         taux (:,:) = zfacto * tau0x
+         tauy (:,:) = zfacto * tau0y
+         tauxg(:,:) = zfacto * tau0x
+         tauyg(:,:) = zfacto * tau0y
+      ENDIF
+      
+   END SUBROUTINE tau
+#endif
+   !!======================================================================
+END MODULE taumod
Index: /branches/nemo/NEMO/OPA_SRC/SOL/sol_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SOL/sol_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SOL/sol_oce.F90	(revision 4)
@@ -0,0 +1,101 @@
+MODULE sol_oce
+   !!======================================================================
+   !!                    ***  MODULE  sol_oce  ***
+   !! Ocean solver :  solver variables defined in memory 
+   !!=====================================================================
+   !!
+   !! ** Purpose :   Define in memory solver variables
+   !!
+   !! History :
+   !!   9.0  !  02-11  (G. Madec)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce         ! ocean parameters
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! elliptic solver: SOR, PCG or FETI
+   !! ---------------------------------------------------
+   INTEGER  ::              & !!! namsol   elliptic solver / island / free surface
+      nsolv =    1 ,        &  ! = 1/2/3 type of elliptic solver
+      nmax  =  800 ,        &  ! maximum of iterations for the solver
+      nmisl = 4000             ! maximum pcg iterations for island
+     
+   REAL(wp) ::              & !!! namsol   elliptic solver / island / free surface
+      eps    = 1.e-6_wp ,   &  ! absolute precision of the solver
+      sor    = 1.76_wp  ,   &  ! optimal coefficient for sor solver
+      epsisl = 1.e-10_wp,   &  ! absolute precision on stream function solver
+      rnu    = 1.0_wp          ! strength of the additional force used in free surface
+
+   INTEGER  ::   &
+      ncut,         &  ! indicator of solver convergence
+      niter            ! number of iteration done by the solver
+
+   REAL(wp) ::   &
+      epsr,         &  ! relative precision for SOR & PCG solvers
+      epsilo,       &  ! precision for the FETI solver
+      rnorme, res,  &  ! intermediate modulus, solver residu
+      alph,         &  ! coefficient  =(gcr,gcr)/(gcx,gccd)
+      beta,         &  ! coefficient  =(rn+1,rn+1)/(rn,rn)
+      radd,         &  ! coefficient  =(gccd,gcdes)
+      rr               ! coefficient  =(rn,rn)
+
+   REAL(wp), DIMENSION(jpi,jpj,4) ::   &
+      gcp              ! barotropic matrix extra-diagonal elements
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      gcx, gcxb,    &  ! now, before solution of the elliptic equation
+      gcdprc,       &  ! inverse diagonal preconditioning matrix
+      gcdmat,       &  ! diagonal preconditioning matrix
+      gcb,          &  ! second member of the barotropic linear system
+      gcr,          &  ! residu =b-a.x
+      gcdes,        &  ! vector descente
+      gccd             ! vector such that ca.gccd=a.d (ca-1=gcdprc)
+
+#if defined key_feti
+   !!----------------------------------------------------------------------
+   !!   'key_feti' :                                            FETI solver
+   !!----------------------------------------------------------------------
+   !!      noeuds           : total number of nodes for a subdomnain
+   !!      ninterf          : neighbour subdomain number
+   !!      nni              : interface point number
+   !!      ndvois()         : neighbour subdomain list
+   !!      maplistin()      : node pointer at each interface
+   !!      malistin()       : concatened list of interface nodes
+
+   INTEGER :: nim,nxm,   &
+       malxm,malim,malxmax,malimax,   &
+       nifmat,njfmat,nelem,npe,matopo,   &
+       noeuds,nmorse,maan,   &
+       ninterf,ninterfc,nni,nnic,nnih,nnitot,ndir,   &
+       mandvois,mandvoisc,   &
+       maplistin,maplistih,malistin,   &
+       malisdir,npblo,mablo,ndlblo,ndkerep,   &
+       malisblo,mansp,ndimax,   &
+       miax,may,maz,mapoids,   &
+       nmaxd,mjj0,nitmax,ntest,   &
+       mabitw,mautilu,malambda,mag,mamg,mapg,mawj,madwj,madwwj,   &
+       magh,maw,madw,   &
+       mautil,mav,madia,mabufin,mabufout,mawork,maae,magamm,   &
+       maxnul,maynul,numit0ete,nitmaxete,maeteg,maeteag,   &
+       maeted,maetead,maeteadd,maetegamm,maetev,maetew,   &
+       madwork
+
+   INTEGER :: mfet(jpi*jpj+2*jpi+2*jpj+51)
+
+   REAL(wp) ::  wfeti(jpj*jpi*jpi+13*jpi*jpj+19*(jpi+jpj)   &
+       +4*jpnij+33   &
+       +2*(jpi+jpj)*(jpnij-jpni)*jpi   &
+       +2*(jpi+jpj)*(jpnij-jpnj+jperio)*jpj   &
+       +3*(jpnij-jpni)*jpi   &
+       +3*(jpnij-jpnj+jperio)*jpj) 
+
+   REAL(wp) ::   res2, rcompt
+
+#endif
+
+   !!----------------------------------------------------------------------
+END MODULE sol_oce
Index: /branches/nemo/NEMO/OPA_SRC/SOL/solfet.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SOL/solfet.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SOL/solfet.F90	(revision 4)
@@ -0,0 +1,181 @@
+MODULE solfet
+   !!======================================================================
+   !!                     ***  MODULE  solfet
+   !! Ocean solver :  Finite Elements Tearing & Interconnecting solver
+   !!=====================================================================
+#if defined key_feti
+   !!----------------------------------------------------------------------
+   !!   'key_feti' :                                            FETI solver
+   !!----------------------------------------------------------------------
+   !!   sol_fet     : FETI solver
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE sol_oce         ! ocean solver 
+   USE lib_mpp         ! distribued memory computing
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC sol_fet              ! ???
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE sol_fet( kindic )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE sol_fet  ***
+      !!
+      !! ** Purpose :
+      !!     Solve the ellipic equation for the barotropic stream function
+      !!     system (default option) or the transport divergence system
+      !!     ("key_dynspg_fsc") using a Finite Elements Tearing & 
+      !!      Interconnecting (FETI) approach.
+      !!     In the former case, the barotropic stream function trend has a
+      !!     zero boundary condition along all coastlines (i.e. continent
+      !!     as well as islands) while in the latter the boundary condition
+      !!     specification is not required.
+      !!
+      !! ** Method :
+      !!      Resolution of the elliptic equation by a Dual formulation of
+      !!      the Schur Complement Method or Finite Elements Tearing & 
+      !!      Interconnecting (FETI) approach
+      !!
+      !! ** Action :
+      !!
+      !! ** References :
+      !!      Guyon, M, Roux, F-X, Chartier, M and Fraunie, P, 1994 :
+      !!      A domain decomposition solver to compute the barotropic 
+      !!      component of an OGCM in the parallel processing field.
+      !!      Ocean Modelling, issue 105, december 94.
+      !!
+      !! History :
+      !!        !  97-02  (M. Guyon)  original code 
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( inout ) ::   kindic   ! solver indicator, < 0 if the conver-
+      !                                      ! gence is not reached: the model is
+      !                                      ! stopped in step
+
+      !! * Local declarations
+      INTEGER ::   ji, jj                    ! dummy loop indices
+      INTEGER ::   iit0, inn, iju 
+      REAL(wp) ::   zgcad, zgwgt
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+
+      ! Norme(gcr)   = (gcb, gcb)
+      ! gcdes = gsr
+      
+      ! bmask field is filtering the differents contribution on the 
+      ! non-overlapping interface
+      
+      gcb(:,:) = bmask(:,:) * gcb(:,:)
+      
+      ! Mpp: sum over all the global domain
+      
+      ! copy the right hand member
+      
+      CALL feti_vmov(noeuds,gcb(1,1),wfeti(may))
+      
+      ! conservation of descent direction if ntest = 0
+      
+      IF(ntest /= 0) mjj0=0
+      iit0 = mjj0
+      !                      --->
+      !    resolution of the Grad(PS) equation by a Dual formulation of the
+      !    Schur Complement Method or Finite Elements Tearing & Interconnecting
+      !    (FETI) approach
+      !    interface problem (Lagrange  multiplier) : PCPG algorithm
+      !    local problem (trend of the 2D potential field) : LU factorization
+      !    preconditioner : lumped
+      !    optimisation : Krylov initialisation + Krylov correction
+
+      CALL feti_dualschur(noeuds,nifmat+1,njfmat+1,wfeti(maan),   &
+          npblo,wfeti(mablo),ninterf,   &
+          ninterfc,nni,nnic,mfet(mandvois),mfet(mandvoisc),   &
+          mfet(maplistin),mfet(malistin),   &
+          wfeti(mapoids),wfeti(miax),   &
+          wfeti(maz),wfeti(may),   &
+          wfeti(mabitw),wfeti(mautilu),   &
+          wfeti(malambda),wfeti(mag),   &
+          wfeti(mapg),wfeti(mamg),nitmax,nmaxd,mjj0,   &
+          wfeti(mawj),   &
+          wfeti(madwj),wfeti(madwwj),wfeti(magamm),   &
+          wfeti(mawork),   &
+          wfeti(mabufin),wfeti(mabufout),narea,epsilo,   &
+          ndlblo,mfet(malisblo),ndkerep,   &
+          wfeti(maxnul),wfeti(maynul),numit0ete,nitmaxete,   &
+          wfeti(maeteg),wfeti(maeteag),wfeti(maeted),   &
+          wfeti(maetead),wfeti(maeteadd),wfeti(maetegamm),   &
+          wfeti(mansp),   &
+          wfeti(maetev),wfeti(maetew),nnih,mfet(maplistih),   &
+          wfeti(magh),   &
+          wfeti(maw),wfeti(madw),   &
+          res,kindic,inn)
+
+      ! number of iteration of the pcg to solve the interface pb
+
+      inn =  mjj0 - iit0
+
+      ! test of convergence
+      IF( res < epsilo .OR. inn == nmax ) THEN
+          niter = inn
+          ncut  = 999
+      ENDIF
+
+      ! indicator of non-convergence or explosion
+      IF( inn == nmax .OR. rr > 1.e+20 ) kindic = -2
+      IF( ncut == 999 ) GOTO 999
+
+999   CONTINUE
+
+      !  2. Output in gcx
+      !  -----------------
+      
+      CALL feti_vmov( noeuds, wfeti(miax), gcx )
+
+      ! boundary conditions   !!bug ???  check  arguments...
+#   if defined key_dynspg_fsc
+#      if defined key_mpp
+      !   Mpp: export boundary values to neighbouring processors
+      CALL lbc_lnk( gcx, 'S', 1. )
+#      else
+      !   mono- or macro-tasking: W-point, >0, 2D array, no slab
+      IF( nperio /= 0 ) THEN
+         CALL lbc_lnk( gcx, 'T', 1. )
+      ENDIF
+#      endif
+#   else
+#      if defined key_mpp
+      !   Mpp: export boundary values to neighbouring processors
+      CALL lbc_lnk( gcx, 'G', 1. )
+#      else
+      !   mono- or macro-tasking: W-point, >0, 2D array, no slab
+      IF( nperio /= 0 ) THEN
+         CALL lbc_lnk( gcx, 'F', 1. )
+      ENDIF
+#      endif
+#   endif
+
+   END SUBROUTINE sol_fet
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE sol_fet( kindic )        ! Empty routine
+      INTEGER, INTENT( inout ) ::   kindic  ! solver problem 
+      kindic = -100
+   END SUBROUTINE sol_fet
+#endif
+
+   !!=====================================================================
+END MODULE solfet
Index: /branches/nemo/NEMO/OPA_SRC/SOL/solisl.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SOL/solisl.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SOL/solisl.F90	(revision 4)
@@ -0,0 +1,1311 @@
+MODULE solisl
+   !!==============================================================================
+   !!                       ***  MODULE  solisl  ***
+   !! Ocean island : specific treatment of island in rigid-lid case
+   !!==============================================================================
+#if defined key_islands
+   !!----------------------------------------------------------------------
+   !!   'key_islands' :                           islands in rigid-lid case
+   !!----------------------------------------------------------------------
+   !!   isl_dom     : locate islands in the domain
+   !!   isl_pri     : control print of island gridpoint position
+   !!   isl_pth     : Compute coeff. associated with path round each island
+   !!   isl_mat     : Compute the matrix associated with islands
+   !!   isl_bsf     : Compute the barotropic streamfunction of each island
+   !!   isl_dyn_spg : Update the barotropic streamfunction trend with the
+   !!                 Island contribution (call by dyn_spg)
+   !!   isl_stp_ctl : print island information (call by stp_ctl)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE in_out_manager  ! I/O manager
+   USE sol_oce         ! ocean solver 
+   USE obc_oce         ! ocean open boundary condition
+   USE lib_mpp         ! distributed memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC isl_dom        ! routine called by solver_init
+   PUBLIC isl_mat        ! routine called by solver_init
+   PUBLIC isl_bsf        ! routine called by solver_init
+   PUBLIC isl_dyn_spg    ! routine called by dyn_spg
+   PUBLIC isl_stp_ctl    ! routine called by stp_ctl
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC ::   &
+      l_isl = .TRUE.          ! 'key_islands' flag
+
+   !! * module variable
+   INTEGER :: numisl = 11      ! logical unit for island file only used
+   !                           ! here during the initialization phase
+   INTEGER ::   &
+      nimlu, njmlu, nkmlu,  &  ! i-j-k-dimensions read
+      nlmlu, nmmlu, nnmlu      ! read islands number
+   INTEGER, DIMENSION(jpnisl,0:4,jpisl) ::   &
+      miisl, mjisl             ! position of island grid-points
+   INTEGER, DIMENSION(0:4,jpisl) ::   &
+      mnisl                    ! number of grid-points for each island
+ 
+   REAL(wp) ::    &
+      replu                    ! read absolute precision
+   REAL(wp), DIMENSION(jpisl,jpisl) ::   &
+      aisl, aislm1             ! island matrix and its inverse
+   REAL(wp), DIMENSION(jpi,jpj,jpisl) ::   &
+      bsfisl                   ! barotropic streamfunction of island
+   REAL(wp), DIMENSION(jpi,jpj,2,jpisl) ::   &
+      acisl1, acisl2           ! coef. to compute circulations round islands
+   REAL(wp), DIMENSION(jpisl) ::   &
+      bisl,                 &  ! second member of island linear system
+      visl                     ! trend of island stream function
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE isl_dom
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE isl_dom  ***
+      !!                    
+      !! ** Purpose :   Locate island grid-points from mbathy array
+      !!
+      !! ** Method  :   The coordinates of ocean grid-points round an island 
+      !!      are found from mbathy array read or computed in dommba.
+      !!      we first compute zwb, an ocean/land mask defined as follows:
+      !!              zwb(i,j)  =  0. over the main land and the ocean
+      !!                        = -n  over the nth island
+      !!      With the proper boundary conditions (defined by nperio)
+      !!        Note: IF i,j are the coordinates of an ocean grid-point west
+      !!      or east of a island, the corresponding coordinates miisl(ip,4,n)
+      !!      or mjisl(ip,2,n) are those of the western or southern side of
+      !!      the island (i.e. i+1 ou j+1, respectively)
+      !!
+      !! ** Action  :   compute mnisl, miisl, mjisl arrays defined as:
+      !!      mnisl(i,n) : nb of grid-points along (i=0), north (i=1), north
+      !!      (i=1), south (i=2), east (i=3), or west (i=4) of the nth island
+      !!      miisl(ip,i,n), mjisl(ip,i,n) : (i,j) index of ipth u- or v-point
+      !!      along (i=0), north (i=1),south (i=2), east (i=3), or west (i=4)
+      !!      of the nth island
+      !!
+      !! History :
+      !!    4.0  !  88-03  (G. Madec)  Original code
+      !!    6.0  !  96-01  (G. Madec)  Suppress common workspace, use of bmask
+      !!    8.5  !  96-01  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj, jn, jnil   ! dummy loop indices
+      INTEGER ::   ind, inilt, ip, ipn, ips, ipe, ipw, ii, ij, iju
+      INTEGER ::   iista, iiend, ijsta, ijend, ijstm1, ijenm1
+      INTEGER ::   isrchne
+      INTEGER, DIMENSION(jpj) ::   indil
+      INTEGER, DIMENSION(jpi,jpj) ::   idil
+
+      REAL(wp) znil
+      REAL(wp), DIMENSION(jpi,jpj) ::   zwb
+      !!----------------------------------------------------------------------
+
+
+      ! 0. Islands index computed from mbathy
+      ! -------------------------------------
+      ! zwb=0 over the continent and ocean, =-n over the nth island
+      
+      ! Computation
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            zwb(ji,jj) = MIN( 0 , mbathy(ji,jj  ), mbathy(ji+1,jj  ),   &
+                                  mbathy(ji,jj+1), mbathy(ji+1,jj+1)  )
+         END DO
+      END DO
+      
+      ! Lateral boundary conditions on zwb
+
+      !  mono- or macro-tasking environnement:
+      IF( nperio == 2 ) THEN
+         zwb(:, 1 ) = zwb(:, 2 )
+      ELSEIF( nperio == 3 .OR. nperio == 4) THEN
+! om 
+!$$$          DO ji = 1, jpim1
+! On ne peut pas partir de ji=1, car alors jiu=jpi, et cette valeur
+! n'est pas encore initialiee. 
+! Le cas ji=1 est de toute facon traite a partir de la ligne 135
+         DO ji = 2, jpim1
+            iju = jpi-ji+1
+            zwb(ji,jpj  ) = zwb(iju,jpj-3)
+            zwb(ji,jpjm1) = zwb(iju,jpj-2)
+         END DO
+      ELSEIF( nperio == 5 .OR. nperio == 6) THEN
+         DO ji = 1, jpim1
+            iju = jpi-ji
+            zwb(ji,jpj  ) = zwb(iju,jpj-2)
+         END DO
+         DO ji = jpi/2+1, jpi-1
+            iju = jpi-ji
+            zwb(ji,jpjm1) = zwb(iju,jpjm1)
+         END DO
+      ELSE
+         zwb(:,jpj) = 0.e0
+      ENDIF
+
+      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+         zwb( 1 ,:) = zwb(jpim1,:)
+         zwb(jpi,:) = zwb(  2  ,:)
+      ELSE
+         zwb( 1 ,:) = 0.e0
+         zwb(jpi,:) = 0.e0
+      ENDIF
+# if defined key_mpp
+      ! Mpp: export boundary values to neighboring processors
+      CALL lbc_lnk( zwb, 'G', 1. )
+# endif
+
+
+      ! 1. Initialization for the search of island grid-points
+      ! ------------------------------------------------------
+# if defined key_mpp
+
+      ! Mpp : The overlap region are not taken into account
+      ! (islands bondaries are searched over subdomain only)
+      iista =  1   + jpreci
+      iiend = nlci - jpreci
+      ijsta =  1   + jprecj
+      ijend = nlcj - jprecj
+      ijstm1=  1   + jprecj
+      ijenm1= nlcj - jprecj
+      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
+         iista  = 1
+      ENDIF
+      IF( nbondi ==  1 .OR. nbondi == 2 ) THEN
+         iiend  = nlci
+      ENDIF
+      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
+         ijsta  = 1
+         ijstm1 = 2
+      ENDIF
+      IF( nbondj ==  1 .OR. nbondj == 2 ) THEN
+         ijend  = nlcj
+         ijenm1 = nlcj-1
+      ENDIF
+      IF( npolj == 3 .OR. npolj == 4 ) THEN
+         ijend  = nlcj-2
+         ijenm1 = nlcj-2
+      ENDIF 
+# else
+
+      ! mono- or macro-tasking environnement: full domain scan
+      iista  = 1
+      iiend  = jpi
+      ijsta  = 1
+      ijstm1 = 2
+      IF( nperio == 3 .OR. nperio == 4 ) THEN
+         ijend  = jpj-2
+         ijenm1 = jpj-2
+      ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN
+         ijend  = jpj-1
+         ijenm1 = jpj-1
+      ELSE
+         ijend  = jpj
+         ijenm1 = jpj-1
+      ENDIF
+# endif
+
+
+      ! 2. Loop over island
+      ! -------------------
+
+      DO jnil = 1, jpisl
+
+         ! 2.1 Initialization to zero of miisl, mjisl of the jnil island
+
+         miisl(:,:,jnil) = 0
+         mjisl(:,:,jnil) = 0
+         
+         ! 2.2 Search grid-points of island jnil
+ 
+         indil(:)   = 0
+         idil (:,:) = 0
+         
+         znil = - FLOAT( jnil )
+         DO jj = ijsta, ijend
+            indil(jj) = 0
+            ind = 0
+            DO ji = iista, iiend
+               IF( zwb(ji,jj) == znil ) THEN
+                  ind = ind + 1
+                  idil(ind,jj) = ji
+                  indil(jj) = indil(jj) + 1
+               ENDIF
+            END DO
+         END DO
+         
+         ! 2.3 Check the number of island
+         
+         inilt = 0
+         DO jj = ijsta, ijend
+            inilt = inilt + indil(jj)
+         END DO
+# if defined key_mpp
+         CALL mpp_sum( inilt )
+# endif
+         IF( inilt == 0 ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*) ' isldom: there is not island number: ', jnil,' while jpisl= ', jpisl
+               WRITE(numout,*) ' change parameter.h'
+            ENDIF
+            STOP 'isldom'
+         ENDIF
+         
+         ! 2.4 Coastal island grid-points (miisl,mjisl)
+         
+         ip  = 0
+         ipn = 0
+         ips = 0
+         ipe = 0
+         ipw = 0
+
+         ! South line (ij=1)
+         ij = 1
+         DO jn = 1, indil(ij)
+            ii = idil(jn,ij)
+            IF( (ij+njmpp-1) == 1 .AND. ii > jpreci .AND. ii < (nlci-jpreci+1) ) THEN
+               IF(  zwb(ii-1,ij) * zwb(ii+1,ij) * zwb(ii,ij+1)  == 0. ) THEN
+                  ip = ip + 1
+                  miisl(ip,0,jnil) = ii
+                  mjisl(ip,0,jnil) = ij
+                  IF( zwb(ii-1,ij) == 0. ) THEN
+                     ipw = ipw + 1
+                     miisl(ipw,4,jnil) = ii
+                     mjisl(ipw,4,jnil) = ij
+                  ENDIF
+                  IF( zwb(ii+1,ij) == 0. ) THEN
+                     ipe = ipe+1
+                     IF( (nperio == 1 .OR. nperio == 4.OR. nperio == 6)  &
+                        .AND. ii == (nlci-jpreci) ) THEN
+                        miisl(ipe,3,jnil) = 1+jpreci
+                     ELSE
+                        miisl(ipe,3,jnil) = ii + 1
+                     ENDIF
+                     mjisl(ipe,3,jnil) = ij
+                  ENDIF
+                  IF( zwb(ii,ij+1) == 0. ) THEN
+                     ipn = ipn+1
+                     miisl(ipn,1,jnil) = ii
+                     mjisl(ipn,1,jnil) = ij + 1
+                  ENDIF
+               ENDIF
+            ENDIF
+         END DO
+         
+         ! Middle lines (2=<jj=<jpjm1 or jpj-2 if north fold b.c.)
+         DO jj = ijstm1, ijenm1
+            DO jn = 1, indil(jj)
+               ii = idil(jn,jj)
+               IF( ii > jpreci .AND. ii < (nlci-jpreci+1) ) THEN
+                  IF( (zwb(ii-1, jj )*zwb(ii+1, jj )*   &
+                       zwb( ii ,jj-1)*zwb( ii ,jj+1)) == 0. ) THEN
+                     ip = ip + 1
+                     miisl(ip,0,jnil) = ii
+                     mjisl(ip,0,jnil) = jj
+                     IF( zwb(ii-1,jj) == 0. ) THEN
+                        ipw = ipw + 1
+                        miisl(ipw,4,jnil) = ii
+                        mjisl(ipw,4,jnil) = jj
+                     ENDIF
+                     IF( zwb(ii+1,jj) == 0. ) THEN
+                        ipe = ipe + 1
+                        IF((nperio == 1.OR.nperio == 4.OR.nperio == 6)   &
+                           .AND.ii == (nlci-jpreci) ) THEN
+                           miisl(ipe,3,jnil) = 1 + jpreci
+                        ELSE
+                           miisl(ipe,3,jnil) = ii + 1
+                        ENDIF
+                        mjisl(ipe,3,jnil) = jj
+                     ENDIF
+                     IF( zwb(ii,jj-1) == 0. ) THEN
+                        ips = ips + 1
+                        miisl(ips,2,jnil) = ii
+                        mjisl(ips,2,jnil) = jj
+                     ENDIF
+                     IF( zwb(ii,jj+1) == 0. ) THEN
+                        ipn = ipn + 1
+                        miisl(ipn,1,jnil) = ii
+                        mjisl(ipn,1,jnil) = jj + 1
+                     ENDIF
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+         
+         ! North line (jj=jpj) only if not north fold b.c.
+         IF( nperio /= 3 .AND. nperio /= 4 .AND. nperio /= 5 .AND. nperio /= 6 ) THEN
+            ij = jpj
+            DO jn = 1, indil(ij)
+               ii = idil(jn,ij)
+               IF( (ij+njmpp-1) == jpjglo .AND. ii > jpreci .AND. ii < (nlci-jpreci+1) ) THEN
+                  IF( (zwb(ii-1, ij )*zwb(ii+1, ij )* zwb( ii ,ij-1) ) == 0. ) THEN
+                     ip = ip+1
+                     miisl(ip,0,jnil) = ii
+                     mjisl(ip,0,jnil) = ij
+                     IF( zwb(ii-1,ij) == 0. ) THEN
+                        ipw = ipw+1
+                        miisl(ipw,4,jnil) = ii
+                        mjisl(ipw,4,jnil) = ij
+                     ENDIF
+                     IF( zwb(ii+1,ij) == 0. ) THEN
+                        ipe = ipe+1
+                        IF( (nperio == 1) .AND. ii == (nlci-jpreci) ) THEN
+                           miisl(ipe,3,jnil) = 1+jpreci
+                        ELSE
+                           miisl(ipe,3,jnil) = ii+1
+                        ENDIF
+                        mjisl(ipe,3,jnil) = ij
+                     ENDIF
+                     IF( zwb(ii,ij-1) == 0. ) THEN
+                        ips = ips+1
+                        miisl(ips,2,jnil) = ii
+                        mjisl(ips,2,jnil) = ij
+                     ENDIF
+                  ENDIF
+               ENDIF
+            END DO
+         ENDIF
+         
+         mnisl(0,jnil) = ip
+         mnisl(1,jnil) = ipn
+         mnisl(2,jnil) = ips
+         mnisl(3,jnil) = ipe
+         mnisl(4,jnil) = ipw
+         
+         ! Take account of redundant points
+         
+# if defined key_mpp
+         CALL mpp_sum( ip )
+# endif
+         
+         IF( ip > jpnisl ) THEN
+            IF(lwp) THEN
+               WRITE(numout,*) ' isldom: the island ',jnil,' has ',   &
+                  mnisl(0,jnil),' grid-points, while jpnisl= ', jpnisl,ip
+               WRITE(numout,*) ' change parameter.h'
+            ENDIF
+            STOP 'isldom'
+         ENDIF
+         
+         ! 2.5 Set to zero the grid-points of the jnil island in x
+         
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( zwb(ji,jj)+FLOAT(jnil) == 0. ) zwb(ji,jj) = 0. 
+            END DO
+         END DO
+         
+      END DO
+      
+
+      ! 3. Check the number of island
+      ! -----------------------------
+
+      inilt = isrchne( jpij, zwb(1,1), 1, 0. )
+# if defined key_mpp
+      CALL mpp_min( inilt )
+# endif
+
+      IF( inilt /= jpij+1 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) ' isldom: there is at least one more ',   &
+                  'island in the domain and jpisl=', jpisl
+            WRITE(numout,*) ' change parameter.h'
+         ENDIF
+         STOP 'isldom'
+      ENDIF
+
+
+      ! 4. Print of island parametres and arrays
+      ! ----------------------------------------
+
+      CALL islpri
+
+
+      ! 5. Array for computation of circulation arround islands
+      ! -------------------------------------------------------
+
+      CALL islpth
+
+   END SUBROUTINE isl_dom
+
+
+   SUBROUTINE isl_pri
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE isl_pri  ***
+      !!              
+      !! ** Purpose :   Print islands variables and islands arrays
+      !!
+      !! ** Method  :
+      !!
+      !! History :
+      !!   1.0  !  88-03  (G. Madec)  Original code
+      !!   8.5  !  02-08  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jni, jnp      ! dummy loop variables
+      INTEGER ::   &
+         ip, ipn, ips, ipe, ipw      ! temporary integers
+      !!----------------------------------------------------------------------
+      
+      IF(lwp) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) '*** islpri number of islands : jpisl =',jpisl
+      ENDIF
+
+      DO jni = 1, jpisl
+         ip  = mnisl(0,jni)
+         ipn = mnisl(1,jni)
+         ips = mnisl(2,jni)
+         ipe = mnisl(3,jni)
+         ipw = mnisl(4,jni)
+# if defined key_mpp
+         CALL mpp_sum( ip  )
+         CALL mpp_sum( ipn )
+         CALL mpp_sum( ips )
+         CALL mpp_sum( ipe )
+         CALL mpp_sum( ipw )
+# endif
+         IF(lwp) THEN
+            WRITE(numout,9000) jni
+            WRITE(numout,9010) ip, ipn, ips, ipe, ipw
+            WRITE(numout,9020)
+            DO jnp = 1, mnisl(0,jni)
+               WRITE(numout,9030) jnp, ( miisl(jnp,ji,jni)+nimpp-1,   &
+                                         mjisl(jnp,ji,jni)+njmpp-1, ji = 0, 4 )
+            END DO
+         ENDIF
+      END DO
+
+      ! FORMAT 
+
+ 9000 FORMAT(/, /, 'island number= ', i2 )
+ 9010 FORMAT(/, 'npil=',i4,' npn=',i3,' nps=',i3,' npe=',i3,' npw=',i3 )
+ 9020 FORMAT(/,'     * isl point *  point n  *  point s  *  point e ', '*  point w  *')
+ 9030 FORMAT(i4,' * (',i3,',',i3,') * (',i3,',',i3,') * (',i3,',',i3,   &
+          ') * (',i3,',',i3,') * (',i3,',',i3,') *' )
+
+   END SUBROUTINE isl_pri
+
+
+   SUBROUTINE isl_pth
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE isl_pth  ***
+      !!             
+      !! ** Purpose :   intialize arrays for the computation of streamfunction
+      !!      around islands
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  : - acisl1(i,j,ii,n): coefficient n-s (ii=1) and e-w (ii=2)
+      !!                for the calculation of mu and mv around the island n      
+      !!              - acisl2(i,j,ii,n): coefficient n-s (ii=1) and e-w (ii=2)
+      !!                for the calculation of bsfd around the island n
+      !!
+      !! History :
+      !!   1.0  !  88-03  (G. Madec)  Original code
+      !!   8.5  !  02-08  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj, jni, jii, jnp    ! dummy loop indices
+      INTEGER ::   ii, ij                   ! temporary integers
+      !!----------------------------------------------------------------------
+      
+      ! 1. Initialisation
+      ! -----------------
+      acisl1(:,:,:,:) = 0.e0
+      acisl2(:,:,:,:) = 0.e0
+      bsfisl(:,:,:)   = 0.e0
+
+      ! 2. Coefficient arrays
+      ! ---------------------
+      DO jni = 1, jpisl
+         DO jii = 1, 4
+            DO jnp = 1,mnisl(jii,jni)
+               ii = miisl(jnp,jii,jni)
+               ij = mjisl(jnp,jii,jni)
+               IF( jii <= 2 ) THEN
+                  ! north and south points
+                  acisl1(ii,ij,1,jni) = float( 2*jii-3) * e1u(ii,ij)
+                  acisl2(ii,ij,1,jni) = float( 2*jii-3) * e1u(ii,ij) * hur(ii,ij) / e2u(ii,ij)
+               ELSE
+                  ! east and west points
+                  acisl1(ii,ij,2,jni) = float(-2*jii+7) * e2v(ii,ij)
+                  acisl2(ii,ij,2,jni) = float(-2*jii+7) * e2v(ii,ij) * hvr(ii,ij) / e1v(ii,ij)
+               ENDIF
+            END DO
+         END DO
+      END DO
+      
+   END SUBROUTINE isl_pth
+
+# if defined key_fdir
+   !!----------------------------------------------------------------------
+   !!   'key_fdir' :                                     direct access file
+   !!----------------------------------------------------------------------
+#  include "solisl_fdir.h90"
+
+# else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                        NetCDF file
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE isl_mat
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE isl_mat  ***
+      !!                
+      !! ** Purpose :   Compute and invert the island matrix 
+      !!
+      !! ** Method  :   aisl(jni,jnj) matrix constituted by bsfisl circulation
+      !!
+      !! ** Action  : - aisl     : island matrix
+      !!              - aislm1   : invert of the island matrix
+      !!      file
+      !!              - islands  : contain bsfisl, aisl and aislm1
+      !!
+      !! History :
+      !!   1.0  !  88-10  (G. Madec)  Original code
+      !!   7.0  !  96-01  (G. Madec)  suppression of common work arrays
+      !!   8.5  !  02-08  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+      
+      !! * Local declarations
+      INTEGER ::   ji, jj, jni, jnj, jn, jl   ! dummy loop indices
+      INTEGER ::   itime, ibvar, ios          ! temporary integers
+      LOGICAL ::   llog
+      CHARACTER (len=32) ::   clname
+      CHARACTER (len=8 ) ::   clvnames(100)
+      REAL(wp), DIMENSION(1) ::   zdept
+      REAL(wp), DIMENSION(jpi,jpj) ::   zlamt, zphit
+      REAL(wp), DIMENSION(jpi,jpj,2) ::   zwx
+# if defined key_mpp
+      REAL(wp), DIMENSION(jpisl*jpisl) ::   ztab
+# endif
+      !!----------------------------------------------------------------------
+
+
+      ! I. Island matrix lecture in numisl (if it exists)
+      ! ==================================
+
+      ! Lecture
+      zlamt(:,:) = 0.
+      zphit(:,:) = 0.
+      zdept(1)   = 0.
+      itime = 0
+      clvnames="        "
+      clname = 'islands'
+      CALL ioget_vname(numisl, ibvar, clvnames)
+      IF(lwp) WRITE(numout,*) clvnames
+      ios=0
+      DO jn=1,100
+        IF(clvnames(jn) == 'aisl') ios=1
+      END DO
+      IF( ios == 0 ) go to 110 
+
+      CALL restget( numisl, 'aisl'  , jpisl, jpisl, 1, 0, llog, aisl   )
+      CALL restget( numisl, 'aislm1', jpisl, jpisl, 1, 0, llog, aislm1 )
+      CALL restclo( numisl )
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)' islmat: lecture aisl/aislm1 in numisl done'
+         WRITE(numout,*)' ~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) '        island matrix : '
+         WRITE(numout,*)
+         
+         DO jnj = 1, jpisl
+            WRITE(numout,'(8e12.4)') ( aisl(jni,jnj), jni = 1, jpisl )
+         END DO
+
+         WRITE(numout,*)
+         WRITE(numout,*) '       inverse of the island matrix'
+         WRITE(numout,*)
+
+         DO jnj = 1, jpisl
+            WRITE(numout,'(12e11.3)') ( aislm1(jni,jnj), jni=1,jpisl )
+         END DO
+      ENDIF
+      
+      RETURN
+
+ 110  CONTINUE
+
+
+      ! II. Island matrix computation
+      ! =============================
+
+      DO jnj = 1, jpisl
+
+         ! Circulation of bsf(jnj) around island jni
+         
+         DO jj = 2, jpj
+               zwx(:,jj,1) = -( bsfisl(:,jj,jnj) - bsfisl(:,jj-1,jnj) )
+         END DO
+         zwx(:,1,1) = 0.e0
+         
+         DO jj = 1, jpj
+            DO ji = 2, jpi
+               zwx(ji,jj,2) = ( bsfisl(ji,jj,jnj) - bsfisl(ji-1,jj,jnj) )
+            END DO
+         END DO
+         zwx(1,:,2) = 0.e0
+         
+         ! Island matrix
+         
+         DO jni = 1, jpisl
+            aisl(jni,jnj) = 0.e0
+            DO jl = 1, 2
+               DO jj=1,jpj
+                  DO ji=1,jpi
+                     aisl(jni,jnj) = aisl(jni,jnj) + acisl2(ji,jj,jl,jni)*zwx(ji,jj,jl)
+                  END DO
+               END DO
+            END DO
+         END DO
+         
+      END DO
+# if defined key_mpp
+      DO jnj=1,jpisl
+         DO jni=1,jpisl
+            ztab(jni+(jnj-1)*jpisl) = aisl(jni,jnj)
+         END DO
+      END DO
+
+      CALL mpp_sum( ztab, jpisl*jpisl )
+!!    CALL mpp_sum( aisl, jpisl*jpisl )
+# endif
+
+      ! 1.3 Control print
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'islmat : island matrix'
+         WRITE(numout,*) '~~~~~~'
+         WRITE(numout,*)
+         
+         DO jnj = 1, jpisl
+            WRITE(numout,'(8e12.4)') ( aisl(jni,jnj), jni = 1, jpisl )
+         END DO
+      ENDIF
+      
+
+      ! 2. Invertion of the island matrix
+      ! ---------------------------------
+      
+      ! 2.1 Call of an imsl routine for the matrix invertion
+
+      CALL linrg( jpisl, aisl, jpisl, aislm1, jpisl )
+
+! 2.2 Control print
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'islmat : inverse of the island matrix'
+         WRITE(numout,*) '~~~~~~'
+         WRITE(numout,*)
+         
+         DO jnj = 1, jpisl
+            WRITE(numout, '(12e11.3)')  '        ', ( aislm1(jni,jnj), jni=1, jpisl )
+         END DO
+      ENDIF
+      
+
+! 3. Output of aisl and aislm1 in numisl
+! --------------------------------------
+
+      CALL restput( numisl, 'aisl'  , jpisl, jpisl, 1, 0, aisl   )
+      CALL restput( numisl, 'aislm1', jpisl, jpisl, 1, 0, aislm1 )
+      CALL restclo( numisl )
+
+   END SUBROUTINE isl_mat
+
+
+   SUBROUTINE isl_bsf
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE isl_bsf  ***
+      !!          
+      !! ** Purpose :
+      !!         Compute the barotropic stream function associated with each
+      !!      island using FETI or preconditioned conjugate gradient method
+      !!      or read them in numisl.
+      !!
+      !! ** Method :
+      !!
+      !! ** input/output file :
+      !!            numisl            : barotropic stream function associated
+      !!                          with each island of the domain
+      !!
+      !! ** Action :
+      !!       bsfisl, the streamfunction which takes the value 1 over island ni,
+      !!    and 0 over the others islands
+      !!       file 'numisl' barotropic stream function associated
+      !!                              with each island of the domain
+      !!
+      !! History :
+      !!        !  87-10  (G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  93-03  (G. Madec)  release 7.1
+      !!        !  93-04  (M. Guyon)  loops and suppress pointers
+      !!        !  96-11  (A. Weaver)  correction to preconditioning
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
+      !!   8.5  !  02-08  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Local declarations
+      LOGICAL  ::   llog, llbon
+      CHARACTER (len=10) ::  clisl
+      CHARACTER (len=32) ::  clname, clname2
+      INTEGER  ::   ji, jj, jni, jii, jnp, je   ! dummy loop indices
+      INTEGER  ::   iimlu, ijmlu, inmlu, iju
+      INTEGER  ::   ii, ij, icile, icut, inmax, indic
+      INTEGER  ::   itime, ie
+      REAL(wp) ::   zepsr, zeplu, zgwgt
+      REAL(wp) ::   zep(jpisl), zlamt(jpi,jpj), zphit(jpi,jpj), zdept(1), zprec(4)
+      REAL(wp) ::   zdate0, zdt
+# if defined key_mpp
+      INTEGER  ::   iloc
+# endif
+      !!----------------------------------------------------------------------
+
+
+      ! 0. Initializations
+      ! ==================
+
+      icile         = 0      ! set to zero the convergence indicator
+      bsfisl(:,:,:) = 0.e0   ! set to zero of bsfisl
+
+
+      ! I. Lecture of bsfisl in numisl (if it exists)
+      ! =============================================
+
+      icut  = 0
+      iimlu = 0
+      ijmlu = 0
+      inmlu = 0
+      zeplu = 0.
+      zlamt(:,:) = 0.
+      zphit(:,:) = 0.
+      zdept(1)   = 0.
+      itime = 0
+      clname = 'islands'
+      ie=1
+      DO je = 1, 32
+        IF( clname(je:je) /= ' ' ) ie = je
+      END DO
+      clname2 = clname(1:ie)//".nc"
+      INQUIRE( FILE=clname2, EXIST=llbon )
+! islands FILE does not EXIST : icut=999
+      IF( llbon ) THEN 
+         ! island FILE is present 
+         CALL restini(clname,jpi,jpj,zlamt,zphit,1,zdept   &
+                     ,clname,itime,zdate0,zdt,numisl)          
+         CALL restget(numisl,'PRECISION',1,1,4,0,llog,zprec)
+         iimlu = NINT( zprec(1) )
+         ijmlu = NINT( zprec(2) )
+         inmlu = NINT( zprec(3) )
+         zeplu = zprec(4)
+         ! the read domain does not correspond to the model one : icut=999
+         IF( iimlu /= jpi .OR. ijmlu /= jpj .OR. inmlu /= jpisl ) THEN
+            icut = 999
+            CALL restclo(numisl)
+         ELSE 
+            DO jni = 1, jpisl
+               IF( jni < 10 ) THEN
+                  WRITE(clisl,'("island",I1)') jni
+               ELSEIF( jni < 100 ) THEN
+                  WRITE(clisl,'("island",I2)') jni
+               ELSE 
+                  WRITE(clisl,'("island",I3)') jni
+               ENDIF
+               CALL restget(numisl,clisl,jpi,jpj,1,0,llog, bsfisl(:,:,jni))
+            END DO
+         ENDIF
+      ELSE 
+         ! islands FILE does not EXIST : icut=999 
+         icut = 999
+         CALL restclo(numisl)
+      ENDIF
+      
+      ! the read precision is not the required one : icut=888
+      IF( zeplu > epsisl ) THEN 
+         icut = 888
+         CALL restclo(numisl)
+      ENDIF
+
+      ! Control print
+      IF( icut == 999 ) THEN
+          IF(lwp) THEN
+              WRITE(numout,*)
+              WRITE(numout,*) 'islbsf : lecture bsfisl in numisl failed'
+              WRITE(numout,*) '~~~~~~'
+              WRITE(numout,*) '         icut= ', icut
+              WRITE(numout,*) '         imlu= ', iimlu, ' jmlu= ', ijmlu,   &
+                                      ' nilu= ', inmlu, ' epsisl lu= ', zeplu
+              WRITE(numout,*) '         the bsfisl are computed from zero'
+          ENDIF
+        ELSEIF( icut == 888 ) THEN
+          IF(lwp) THEN
+              WRITE(numout,*)
+              WRITE(numout,*) 'islbsf : lecture bsfisl in numisl done'
+              WRITE(numout,*) '~~~~~~'
+              WRITE(numout,*) '         the required accuracy is not reached'
+              WRITE(numout,*) '         epsisl lu= ', zeplu,' epsisl required ', epsisl
+              WRITE(numout,*) '         the bsfisl are computed from the read values'
+          ENDIF
+        ELSE
+          IF(lwp) THEN
+              WRITE(numout,*)
+              WRITE(numout,*) 'islbsf : lecture bsfisl in numisl done'
+              WRITE(numout,*) '~~~~~~'
+          ENDIF
+          RETURN
+      ENDIF
+      
+      
+      ! II. Compute the bsfisl (if icut=888 or 999)
+      ! ============================================
+
+      ! save nmax
+      inmax = nmax
+
+      ! set the number of iteration of island computation
+      nmax = nmisl
+
+      ! Loop over islands
+      ! -----------------
+      
+      DO jni = 1, jpisl
+
+
+         ! 1. Initalizations of island computation
+         ! ---------------------------------------
+         
+         ! Set the pcg solution gcb to zero
+         gcb(:,:) = 0.e0
+
+         ! Set first guess gcx either to zero or to the read bsfisl
+         IF( icut == 999 ) THEN
+            gcx(:,:) = 0.e0
+         ELSEIF( icut == 888 ) THEN
+            IF(lwp) WRITE(numout,*) ' islbsf: bsfisl read are used as first guess'
+            ! c a u t i o n: bsfisl masked because it contains 1 along island seaside
+            gcx(:,:) = bsfisl(:,:,jni) * bmask(:,:)
+         ENDIF
+         
+         ! Right hand side of the streamfunction equation
+         
+# if defined key_mpp
+
+         ! north fold treatment
+         IF( npolj == 3 .OR. npolj == 5)   iloc=jpiglo-(nimpp-1+nimppt(nono+1)-1)
+         IF( npolj == 4 .OR. npolj == 6)   iloc=jpiglo-2*(nimpp-1)
+         t2p1(:,1,1) = 0.e0
+         ! north and south grid-points
+         DO jii = 1, 2
+            DO jnp = 1, mnisl(jii,jni)
+               ii = miisl(jnp,jii,jni)
+               ij = mjisl(jnp,jii,jni)
+               IF( ( npolj == 3 .OR. npolj == 4 ) .AND.   &
+                  ( ij == nlcj-1 .AND. jii == 1) ) THEN 
+                  iju=iloc-ii+1
+                  t2p1(iju,1,1) =  t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
+               ELSEIF( ( npolj == 5 .OR. npolj == 6 ) .AND.   &
+                  ( ij == nlcj-1 .AND. jii == 1) ) THEN 
+                  iju=iloc-ii
+                  gcb(ii,ij) =  gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
+                  t2p1(iju,1,1) =  t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
+               ELSE  
+                  gcb(ii,ij-jii+1) =  gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
+               ENDIF
+            END DO
+         END DO
+         
+         ! east and west grid-points
+         
+         DO jii = 3, 4
+            DO jnp = 1, mnisl(jii,jni)
+               ii = miisl(jnp,jii,jni)
+               ij = mjisl(jnp,jii,jni)
+               gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij)
+            END DO
+         END DO
+         CALL mpplnks( gcb )
+
+# else
+
+         ! north and south grid-points
+         DO jii = 1, 2
+            DO jnp = 1, mnisl(jii,jni)
+               ii = miisl(jnp,jii,jni)
+               ij = mjisl(jnp,jii,jni)
+               IF( ( nperio == 3 .OR. nperio == 4 ) .AND.   &
+                  ( ij == jpj-1 .AND. jii == 1) ) THEN 
+                  gcb(jpi-ii+1,ij-1) = gcb(jpi-ii+1,ij-1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
+               ELSEIF( ( nperio == 5 .OR. nperio == 6 ) .AND.   &
+                  ( ij == jpj-1 .AND. jii == 1) ) THEN 
+                  gcb(ii,ij) =  gcb(ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)
+                  gcb(jpi-ii,ij) = gcb(jpi-ii,ij) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
+               ELSE  
+                  gcb(ii,ij-jii+1) =  gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)
+               ENDIF
+            END DO
+         END DO
+
+         ! east and west grid-points
+         DO jii = 3, 4
+            DO jnp = 1, mnisl(jii,jni)
+               ii = miisl(jnp,jii,jni)
+               ij = mjisl(jnp,jii,jni)
+               IF( bmask(ii-jii+3,ij) /= 0. ) THEN
+                  gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij)
+               ELSE
+
+                  ! east-west cyclic boundary conditions
+                  IF( ii-jii+3 == 1 ) THEN
+                     gcb(jpim1,ij) = gcb(jpim1,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij)
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+
+# endif
+
+         ! Preconditioned right hand side and absolute precision
+
+         IF( nsolv == 3 ) THEN 
+            ! FETI method
+            ncut    = 0
+            rnorme  = 0.e0
+            gcb(:,:) = bmask(:,:) * gcb(:,:)
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  rnorme = rnorme + gcb(ji,jj) * gcb(ji,jj)
+               END DO
+            END DO
+            
+            CALL mpp_sum( rnorme )
+
+            IF(lwp) WRITE(numout,*) 'rnorme ', rnorme
+            epsr  = epsisl * epsisl * rnorme
+            indic = 0
+         ELSE 
+            ncut   = 0
+            rnorme = 0.e0
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  gcb  (ji,jj) = gcdprc(ji,jj) * gcb(ji,jj)
+                  zgwgt  = gcdmat(ji,jj) * gcb(ji,jj)
+                  rnorme = rnorme + gcb(ji,jj) * zgwgt
+               END DO
+            END DO
+# if defined key_mpp
+            CALL mpp_sum( rnorme )
+# endif
+            IF(lwp) WRITE(numout,*) 'rnorme ', rnorme
+            epsr = epsisl * epsisl * rnorme
+            indic = 0
+         ENDIF
+
+
+         ! 3. PCG solver for gcp.gcx=gcb in monotask
+         ! -------------------------------------------
+
+         IF( nsolv == 3 ) THEN 
+            epsilo = epsisl       ! precision to compute Islands matrix A
+            CALL solfet( indic )  ! FETI method
+            epsilo = eps          ! precision to compute grad PS
+         ELSE 
+            CALL solpcg( indic )  ! pcg method
+         ENDIF
+
+
+         ! 4. Save the solution in bsfisl
+         ! ------------------------------
+
+         bsfisl(:,:,jni) = gcx(:,:)
+
+
+         ! 5. Boundary conditions
+         ! ----------------------
+
+         ! set to 1. coastal gridpoints of the island
+         DO jnp = 1, mnisl(0,jni)
+            ii = miisl(jnp,0,jni)
+            ij = mjisl(jnp,0,jni)
+            bsfisl(ii,ij,jni) = 1.
+         END DO
+
+         ! cyclic boundary conditions
+         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+            bsfisl( 1 ,:,jni) = bsfisl(jpim1,:,jni)
+            bsfisl(jpi,:,jni) = bsfisl(  2  ,:,jni)
+         ENDIF
+         IF( nperio == 3 .OR. nperio == 4 ) THEN
+            DO ji = 1, jpim1
+               iju = jpi-ji+1
+               bsfisl(ji,jpj-1,jni) = bsfisl(iju,jpj-2,jni)
+               bsfisl(ji, jpj ,jni) = bsfisl(iju,jpj-3,jni)
+            END DO
+         ENDIF
+         IF( nperio == 5 .OR. nperio == 6 ) THEN
+            DO ji = 1, jpi-1
+               iju=jpi-ji
+               bsfisl(ji,jpj,jni) = bsfisl(iju,jpj-2,jni)
+            END DO
+            DO ji = jpi/2+1, jpi-1
+               iju=jpi-ji
+               bsfisl (ji,jpjm1,jni) = bsfisl(iju,jpjm1,jni)
+            END DO
+         ENDIF
+# if defined key_mpp
+         CALL lbc_lnk( bsfisl(:,:,jni), 'G', 1. )
+# endif
+
+
+         ! 6. Control print
+         ! ----------------
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' islbsf: island number: ', jni
+         IF(lwp) WRITE (numout,9290) niter, res, SQRT(epsr)/epsisl
+         zep(jni) =  MAX(epsisl, res/(SQRT(epsr)/epsisl))
+         IF( indic <  0 ) THEN
+            icile = icile-1
+            IF(lwp) WRITE(numout,*) '  pcg do not converge for island: ', jni
+            IF(lwp) WRITE(numout,*) '      Precision reached: ',zep(jni)
+         ENDIF
+
+9290     FORMAT('        niter :',i4,' , res :',e20.10,' , gcb :',e20.10)
+
+         !                                          !====================
+      END DO                                        !  End Loop islands
+      !                                             !====================
+
+      ! 7. Reset PCG
+      ! ------------
+
+      ! reset the number of iteration for pcg
+      nmax = inmax
+
+      ! reset to zero pcg arrays
+      gcx  (:,:) = 0.e0
+      gcxb (:,:) = 0.e0
+      gcb  (:,:) = 0.e0
+      gcr  (:,:) = 0.e0
+      gcdes(:,:) = 0.e0
+      gccd (:,:) = 0.e0
+
+
+      ! III. Output of bsfisl in numisl
+      ! ===============================
+
+      CALL ymds2ju( 0, 1, 1, 0.e0, zdate0 )
+      zprec(1) = FLOAT(jpi)
+      zprec(2) = FLOAT(jpj)
+      zprec(3) = FLOAT(jpisl)
+      IF(lwp) WRITE(numout,*) clname
+      CALL restini( 'NONE', jpi, jpj, glamt, gphit, 1, zdept   &
+         , clname, itime, zdate0, rdt, numisl )
+      IF( icile == 0 .AND. icut /= 0 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*)' islbsf: write bsfisl in numisl ', numisl
+            WRITE(numout,*)' -------------------------------------'
+         ENDIF
+         zprec(4) = epsisl
+         CALL restput(numisl,'PRECISION',1,1,4,0,zprec)
+         DO jni = 1, jpisl
+            IF(jni < 10) THEN
+               WRITE(clisl,'("island",I1)') jni
+            ELSE IF(jni < 100) THEN
+               WRITE(clisl,'("island",I2)') jni
+            ELSE 
+               WRITE(clisl,'("island",I3)') jni
+            ENDIF
+            CALL restput( numisl, clisl, jpi, jpj, 1, 0, bsfisl(:,:,jni) )
+         END DO
+      ENDIF
+
+      IF( icile < 0 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' islbsf: number of island without convergence : ',ABS(icile)
+            WRITE(numout,*) ' ---------------------------------------------'
+         ENDIF
+         zepsr = epsisl
+         DO jni = 1, jpisl
+            IF(lwp) WRITE(numout,*) '    isl ',jni,' precision reached ', zep(jni)
+            zepsr = MAX( zep(jni), zepsr )
+         END DO
+         IF( zepsr == 0. ) zepsr = epsisl
+         IF(lwp) THEN
+            WRITE(numout,*) ' save value of precision reached: ',zepsr
+            WRITE(numout,*)
+            WRITE(numout,*)' islbsf: save bsfisl in numisl ',numisl
+            WRITE(numout,*)' -------------------------------------'
+         ENDIF
+
+         zprec(4) = zepsr
+         CALL restput( numisl, 'PRECISION', 1, 1, 1, 0, zprec )
+         DO jni = 1, jpisl
+            IF( jni < 10 ) THEN
+               WRITE(clisl,'("island",I1)') jni
+            ELSE IF( jni < 100 ) THEN
+               WRITE(clisl,'("island",I2)') jni
+            ELSE 
+               WRITE(clisl,'("island",I3)') jni
+            ENDIF
+            CALL restput( numisl, clisl, jpi, jpj, 1, 0, bsfisl(:,:,jni) )
+         END DO
+         CALL restclo(numisl)
+         nstop = nstop + 1
+      ENDIF
+
+   END SUBROUTINE isl_bsf
+
+#endif
+
+   SUBROUTINE isl_dyn_spg
+      !!----------------------------------------------------------------------
+      !!                  ***  routine isl_dyn_spg  ***
+      !!
+      !! ** Purpose :   Compute and add the island contribution to the 
+      !!      barotropic stream function trend.
+      !!
+      !!
+      !! ** Method  :   Rigid-lid appromimation: ...????
+      !!
+      !! ** Action : - Update bsfd with the island contribution
+      !!
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  isolate island computation
+      !!---------------------------------------------------------------------
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jni, jnj    ! dummy loop indices
+      !!----------------------------------------------------------------------
+      
+
+      ! compute the island potential
+      ! ----------------------------
+      DO jni = 1, jpisl                      ! second member
+         bisl(jni) =  0.e0
+         DO jj = 2, jpj
+            DO ji = 2, jpi
+               bisl(jni) =  bisl(jni) + acisl1(ji,jj,1,jni) *  spgu(ji,jj)                  &
+                  &                   + acisl1(ji,jj,2,jni) *  spgv(ji,jj)                  &
+                  &                   + acisl2(ji,jj,1,jni) * ( gcx(ji,jj)-gcx(ji,jj-1) )   &
+                  &                   - acisl2(ji,jj,2,jni) * ( gcx(ji,jj)-gcx(ji-1,jj) )
+            END DO
+         END DO
+      END DO
+#   if defined key_mpp
+      !  Mpp : global sum to obtain global dot from local ones
+      CALL mpp_sum( bisl, jpisl )
+#   endif
+      DO jni = 1, jpisl                     ! Island stream function trend
+         visl(jni) = 0.e0
+         DO jnj = 1, jpisl
+            visl(jni) = visl(jni) + aislm1(jni,jnj) * bisl(jnj)
+         END DO
+      END DO
+
+      ! update the bsf trend ( caution : bsfd is not zero along island coastlines, dont mask it ! )
+      ! --------------------
+      DO jj = 1, jpj
+         DO jni = 1, jpisl
+            DO ji = 1, jpi
+               bsfd(ji,jj) = bsfd(ji,jj) + visl(jni) * bsfisl(ji,jj,jni)
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE isl_dyn_spg
+
+
+   SUBROUTINE isl_stp_ctl( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE isl_stp_ctl  ***
+      !!                     
+      !! ** Purpose :   ???
+      !!
+      !! ** Method  : - print island potential
+      !!
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  isolated from stp_ctl
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(in   ) ::   kt        ! ocean time-step index
+      INTEGER, INTENT(inout) ::   kindic    ! indicator of solver convergence
+
+      !! * local declarations
+      INTEGER  ::   jni                     ! dummy loop indice
+      REAL(wp) ::   zfact                   ! temporary scalar
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'isl_stp_ctl : time-stepping control'
+         WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      ! Island trends
+      DO jni = 1, jpisl
+         zfact = 0.
+         IF( miisl(1,0,jni) /= 0 .AND. mjisl(1,0,jni) /= 0 ) THEN
+            zfact = 1.e-6 * bsfn(miisl(1,0,jni),mjisl(1,0,jni))
+         ENDIF
+#      if defined key_mpp
+         CALL mpp_isl( zfact )
+#      endif
+         IF(lwp) WRITE(numisp,9300) kt, jni, zfact, visl(jni)
+         IF( MOD( kt, nwrite ) == 0 .OR. kindic < 0     &
+            .OR. ( kt == nit000 .AND. kindic > 0 )      &
+            .OR.   kt == nitend                         ) THEN
+            IF( jni == 1 .AND. lwp ) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) 'isl_stp_ctl : island bsf'
+               WRITE(numout,*) '~~~~~~~~~~~'
+            ENDIF
+            IF(lwp) WRITE(numout,9300) kt, jni, zfact, visl(jni)
+         ENDIF
+      END DO
+9300  FORMAT(' it : ',i8,' island  :',i4,'   BSF (Sverdrup) : ',f7.2, '   visl : ',e15.6)
+
+   END SUBROUTINE isl_stp_ctl
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC ::   l_isl = .FALSE.    ! 'key_islands' flag
+CONTAINS
+   SUBROUTINE isl_dom                        ! Empty routine
+   END SUBROUTINE isl_dom
+   SUBROUTINE isl_bsf                        ! Empty routine
+   END SUBROUTINE isl_bsf
+   SUBROUTINE isl_mat                        ! Empty routine
+   END SUBROUTINE isl_mat
+   SUBROUTINE isl_dyn_spg                    ! Empty routine
+   END SUBROUTINE isl_dyn_spg
+   SUBROUTINE isl_stp_ctl( kt, kindic )      ! Empty routine
+      WRITE(*,*) kt, kindic                     ! no compilation warning
+   END SUBROUTINE isl_stp_ctl
+#endif
+
+   !!======================================================================
+END MODULE solisl
Index: /branches/nemo/NEMO/OPA_SRC/SOL/solisl_fdir.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SOL/solisl_fdir.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SOL/solisl_fdir.h90	(revision 4)
@@ -0,0 +1,537 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  solisl_fdir.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   islmat     : Compute the matrix associated with islands
+   !!                and save it in a direct access file
+   !!   islbsf     : Compute the barotropic streamfunction of each island
+   !!                and save it in a direct access file
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE islmat
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE islmat  ***
+      !!                   
+      !! ** Purpose :   Compute and invert the island matrix 
+      !!
+      !! ** Method  :   aisl(jni,jnj) matrix constituted by bsfisl circulation
+      !!
+      !! ** Action  : - aisl   : island matrix
+      !!              - aislm1 : invert of the island matrix
+      !!
+      !! ** file    :   islands: contain bsfisl, aisl and aislm1
+      !!
+      !! History :
+      !!   1.0  !  88-10  (G. Madec)  Original code
+      !!   7.0  !  96-01  (G. Madec)  suppression of common work arrays
+      !!   8.5  !  02-08  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jni, jnj, ios, jl
+      REAL(wp) ::   zwx(jpi,jpj,2)
+      !!----------------------------------------------------------------------
+
+
+      ! I. Island matrix lecture in numisl (if it exists)
+      ! ==================================
+      ! file already open in islbsf routine
+      ! Lecture
+      READ( numisl, REC=jpisl+2, IOSTAT=ios ) aisl, aislm1
+      IF( ios /= 0 ) GOTO 110
+
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' islmat: lecture aisl/aislm1 in numisl done'
+         WRITE(numout,*) ' ~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' island matrix'
+         WRITE(numout,*) ' -------------'
+         WRITE(numout,*)
+         
+         DO jnj = 1, jpisl
+            WRITE(numout,'(8e12.4)') ( aisl(jni,jnj), jni = 1, jpisl )
+         END DO
+         
+         WRITE(numout,*)
+         WRITE(numout,*) ' inverse of the island matrix'
+         WRITE(numout,*) ' ----------------------------'
+         WRITE(numout,*)
+         
+         DO jnj = 1, jpisl
+            WRITE(numout,'(12e11.3)') ( aislm1(jni,jnj), jni=1, jpisl )
+         END DO
+      ENDIF
+
+      CLOSE(numisl)
+
+      RETURN
+
+ 110  CONTINUE
+
+
+      ! II. Island matrix computation
+      ! =============================
+
+      DO jnj = 1, jpisl
+
+         ! 1.1 Circulation of bsf(jnj) around island jni
+         
+         DO jj = 2, jpj
+            zwx(:,jj,1) = -( bsfisl(:,jj,jnj) - bsfisl(:,jj-1,jnj) )
+         END DO
+         DO ji = 1, jpi
+            zwx(ji,1,1) = 0.e0
+         END DO
+         
+         DO jj = 1, jpj
+            DO ji = 2, jpi
+               zwx(ji,jj,2) = ( bsfisl(ji,jj,jnj) - bsfisl(ji-1,jj,jnj) )
+            END DO
+         END DO
+         DO jj = 1, jpj
+            zwx(1,jj,2) = 0.e0
+         END DO
+
+         ! 1.2 Island matrix
+
+         DO jni = 1, jpisl
+            aisl(jni,jnj) = 0.
+            DO jl = 1, 2
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     aisl(jni,jnj) = aisl(jni,jnj) + acisl2(ji,jj,jl,jni) * zwx(ji,jj,jl)
+                  END DO
+               END DO
+            END DO
+         END DO
+
+      END DO
+#   if defined key_mpp
+      CALL mpp_sum( aisl, jpisl*jpisl )
+#   endif
+
+      ! 1.3 Control print
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' islmat: island matrix'
+         WRITE(numout,*) ' ~~~~~~'
+         WRITE(numout,*)
+         
+         DO jnj = 1, jpisl
+            WRITE(numout,'(8e12.4)') ( aisl(jni,jnj), jni = 1, jpisl )
+         END DO
+      ENDIF
+
+
+      ! 2. Invertion of the island matrix
+      ! ---------------------------------
+
+      ! 2.1 Call of an imsl routine for the matrix invertion
+
+      CALL linrg( jpisl, aisl, jpisl, aislm1, jpisl )
+
+      ! 2.2 Control print
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' islmat: inverse of the island matrix'
+         WRITE(numout,*) ' ~~~~~~'
+         WRITE(numout,*)
+         
+         DO jnj = 1, jpisl
+            WRITE(numout, '(12e11.3)') ( aislm1(jni,jnj), jni=1, jpisl )
+         END DO
+      ENDIF
+
+
+      ! 3. Output of aisl and aislm1 in numisl
+      ! --------------------------------------
+
+      IF(lwp) WRITE(numisl,REC=jpisl+2) aisl, aislm1
+
+      CLOSE( numisl )
+      
+   END SUBROUTINE islmat
+
+
+   SUBROUTINE islbsf
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE islbsf  ***
+      !!
+      !! ** Purpose :   Compute the barotropic stream function associated with
+      !!      each island using FETI or preconditioned conjugate gradient 
+      !!      method or read them in numisl.
+      !!
+      !! ** Method  :   Direct acces file
+      !!
+      !! ** file    :   numisl: barotropic stream function associated
+      !!                        with each island of the domain
+      !!
+      !! ** Action  : - bsfisl, the streamfunction which takes the value 1 
+      !!                over island ni, and 0 over the others islands
+      !!              - update 'numisl' file
+      !!
+      !! History :
+      !!        !  87-10  (G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  93-03  (G. Madec)  release 7.1
+      !!        !  93-04  (M. Guyon)  loops and suppress pointers
+      !!        !  96-11  (A. Weaver)  correction to preconditioning
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with IOIPSL
+      !!   8.5  !  02-08  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jni, jii, jnp
+      INTEGER  ::   iimlu, ijmlu, inmlu, ios, iju, iloc
+      INTEGER  ::   ii, ij, icile, icut, inmax, indic
+      REAL(wp) ::   zepsr, zeplu, zgwgt
+      REAL(wp) ::   zep(jpisl)
+      !!----------------------------------------------------------------------
+
+
+      ! 0. Initializations
+      ! ==================
+
+      ! set to zero the convergence indicator
+      icile = 0
+
+      ! set to zero of bsfisl
+      bsfisl(:,:,1:jpisl) = 0.e0
+
+
+      ! I. Lecture of bsfisl in numisl (if it exists)
+      ! =============================================
+
+      ! open islands file
+      ibloc = 4096
+      ilglo = ibloc*((jpiglo*jpjglo*jpbyt-1 )/ibloc+1)
+      clname = 'islands'
+      CALL ctlopn( numisl, 'islands', 'UNKNOWN', 'UNFORMATTED', 'DIRECT',   &
+                   ilglo,numout,lwp,0)
+
+      icut  = 0
+      iimlu = 0
+      ijmlu = 0
+      inmlu = 0
+      zeplu = 0.
+      READ (numisl, REC=1, IOSTAT=ios) iimlu, ijmlu, inmlu, zeplu
+      IF( ios /= 0 ) GOTO 110
+      DO jni = 1, jpisl
+         CALL read2( numisl, bsfisl(1,1,jni), 1, jni+1 )
+      END DO
+
+ 110  CONTINUE
+
+      ! the read precision is not the required one : icut=888
+      IF( zeplu > epsisl ) icut = 888
+
+      ! the read domain does not correspond to the model one : icut=999
+      IF( iimlu /= jpiglo .OR. ijmlu /= jpjglo .OR. inmlu /= jpisl   ) icut = 999
+
+      ! Control print
+      IF( icut == 999 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' islbsf : lecture bsfisl in numisl failed'
+            WRITE(numout,*) ' ~~~~~~'
+            WRITE(numout,*) ' icut= ', icut
+            WRITE(numout,*) ' imlu= ', iimlu, ' jmlu= ', ijmlu,   &
+               ' nilu= ', inmlu, ' epsisl lu= ', zeplu
+            WRITE(numout,*) ' the bsfisl are computed from zero'
+         ENDIF
+      ELSEIF( icut == 888 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' islbsf : lecture bsfisl in numisl done'
+            WRITE(numout,*) ' ~~~~~~'
+            WRITE(numout,*) ' the required accuracy is not reached'
+            WRITE(numout,*) ' epsisl lu= ', zeplu,' epsisl required ', epsisl
+            WRITE(numout,*) ' the bsfisl are computed from the read values'
+         ENDIF
+      ELSE
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' islbsf : lecture bsfisl in numisl done'
+            WRITE(numout,*) ' ~~~~~~'
+         ENDIF
+         RETURN
+      ENDIF
+
+
+      ! II. Compute the bsfisl (if icut=888 or 999)
+      ! ======================
+
+      ! save nmax
+      inmax  = nmax
+
+      ! set the number of iteration of island computation
+      nmax = nmisl
+
+      ! Loop over islands
+      ! -----------------
+
+      DO jni = 1, jpisl
+
+
+         ! 1. Initalizations of island computation
+         ! ---------------------------------------
+         
+         ! 1.0 Set the pcg solution gcb to zero
+         gcb(:,:) = 0.e0
+
+         ! 1.1 Set first guess gcx either to zero or to the read bsfisl
+
+         IF( icut == 999 ) THEN
+            gcx(:,:) = 0.e0
+         ELSEIF( icut == 888 ) THEN
+            IF(lwp) WRITE(numout,*) ' islbsf: bsfisl read are used as first guess'
+            ! C a u t i o n : bsfisl masked because it contains 1 along island seaside
+            gcx(:,:) = bsfisl(:,:,jni) * bmask(:,:)
+         ENDIF
+         
+         ! 1.2 Right hand side of the stream FUNCTION equation
+         
+#    if defined key_mpp
+         
+         ! north fold treatment
+         IF( npolj == 3 ) iloc = jpiglo -(nimpp-1+nimppt(nono+1)-1)
+         IF( npolj == 4 ) iloc = jpiglo - 2*(nimpp-1)
+         t2p1(:,1,1) = 0.
+         ! north and south grid-points
+         DO jii = 1, 2
+            DO jnp = 1, mnisl(jii,jni)
+               ii = miisl(jnp,jii,jni)
+               ij = mjisl(jnp,jii,jni)
+               IF( ( npolj == 3 .OR. npolj == 4 ) .AND. ( ij == nlcj-1 .AND. jii == 1) ) THEN 
+                  iju=iloc-ii+1
+                  t2p1(iju,1,1) =  t2p1(iju,1,1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
+               ELSE  
+                  gcb(ii,ij-jii+1) =  gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
+               ENDIF
+            END DO
+         END DO
+         
+         ! east and west grid-points
+
+         DO jii = 3, 4
+            DO jnp = 1, mnisl(jii,jni)
+               ii = miisl(jnp,jii,jni)
+               ij = mjisl(jnp,jii,jni)
+               gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij)
+            END DO
+         END DO
+         CALL mpplnks( gcb )
+        
+#      else
+
+         ! north and south grid-points
+         DO jii = 1, 2
+            DO jnp = 1, mnisl(jii,jni)
+               ii = miisl(jnp,jii,jni)
+               ij = mjisl(jnp,jii,jni)
+               IF( ( nperio == 3 .OR. nperio == 4 ) .AND. ( ij == jpj-1 .AND. jii == 1) ) THEN 
+                  gcb(jpi-ii+1,ij-1) = gcb(jpi-ii+1,ij-1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij) 
+               ELSE  
+                  gcb(ii,ij-jii+1) =  gcb(ii,ij-jii+1) + hur(ii,ij) * e1u(ii,ij) / e2u(ii,ij)
+               ENDIF
+            END DO
+         END DO
+
+         ! east and west grid-points
+         DO jii = 3, 4
+            DO jnp = 1, mnisl(jii,jni)
+               ii = miisl(jnp,jii,jni)
+               ij = mjisl(jnp,jii,jni)
+               IF( bmask(ii-jii+3,ij) /= 0. ) THEN
+                  gcb(ii-jii+3,ij) = gcb(ii-jii+3,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij)
+               ELSE
+                  ! east-west cyclic boundary conditions
+                  IF( ii-jii+3 == 1 ) THEN
+                     gcb(jpim1,ij) = gcb(jpim1,ij) + hvr(ii,ij) * e2v(ii,ij) / e1v(ii,ij)
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+        
+#    endif
+
+         ! 1.4 Preconditioned right hand side and absolute precision
+
+         IF( nsolv == 3 ) THEN 
+            ! FETI method
+            ncut = 0
+            rnorme=0.
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  gcb  (ji,jj) = bmask(ji,jj) * gcb(ji,jj)
+                  rnorme = rnorme + gcb(ji,jj) * gcb(ji,jj)
+               END DO
+            END DO
+            
+            CALL mpp_sum( rnorme )
+
+            IF(lwp) WRITE(numout,*) 'rnorme ', rnorme
+            epsr = epsisl * epsisl * rnorme
+            indic = 0
+         ELSE
+            ncut = 0
+            rnorme = 0.
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  gcb  (ji,jj) = gcdprc(ji,jj) * gcb(ji,jj)
+                  zgwgt = gcdmat(ji,jj) * gcb(ji,jj)
+                  rnorme = rnorme + gcb(ji,jj) * zgwgt
+               END DO
+            END DO
+#if defined key_mpp
+            CALL mpp_sum( rnorme )
+#endif
+            IF(lwp) WRITE(numout,*) 'rnorme ', rnorme
+            epsr = epsisl * epsisl * rnorme
+            indic = 0
+         ENDIF
+
+
+         ! 3. PCG solver for gcp.gcx=gcb in monotask
+         ! -------------------------------------------
+
+         IF(nsolv == 3) THEN 
+            ! FETI method
+            ! precision to compute Islands matrix A
+            
+            epsilo = epsisl
+            CALL solfet( indic )
+            !                      --->
+            ! precision to compute grad PS
+            
+            epsilo = eps
+         ELSE 
+            
+            CALL solpcg( indic )
+            
+         ENDIF
+         
+         
+         ! 4. Save the solution in bsfisl
+         ! ------------------------------
+         
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               bsfisl(ji,jj,jni) = gcx(ji,jj)
+            END DO
+         END DO
+
+
+         ! 5. Boundary conditions
+         ! ----------------------
+         
+         ! set to 1. coastal gridpoints of the island
+         DO jnp = 1, mnisl(0,jni)
+            ii = miisl(jnp,0,jni)
+            ij = mjisl(jnp,0,jni)
+            bsfisl(ii,ij,jni) = 1.
+         END DO
+         
+         ! cyclic boundary conditions
+         IF( nperio == 1 .OR. nperio == 4 ) THEN
+            DO jj = 1, jpj
+               bsfisl( 1 ,jj,jni) = bsfisl(jpim1,jj,jni)
+               bsfisl(jpi,jj,jni) = bsfisl(  2  ,jj,jni)
+            END DO
+         ENDIF
+         IF( nperio == 3 .OR. nperio == 4 ) THEN
+            DO ji = 1, jpim1
+               iju = jpi-ji+1
+               bsfisl(ji,jpj-1,jni) = bsfisl(iju,jpj-2,jni)
+               bsfisl(ji, jpj ,jni) = bsfisl(iju,jpj-3,jni)
+            END DO
+         ENDIF
+#if defined key_mpp
+         CALL lbc_lnk( bsfisl(:,:,jni), 'G', 1. )
+#endif
+         
+         
+         ! 6. Control print
+         ! ----------------
+         
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) ' islbsf: island number: ', jni
+         IF(lwp)WRITE (numout,9290) niter, res, SQRT(epsr)/epsisl
+         zep(jni) =  MAX(epsisl, res/(SQRT(epsr)/epsisl))
+         IF(indic < 0) THEN
+            icile = icile-1
+            IF(lwp)WRITE(numout,*) '  pcg do not converge for island: ', jni
+            IF(lwp)WRITE(numout,*) '      Precision reached: ',zep(jni)
+         ENDIF
+         
+ 9290    FORMAT('        niter :',i4,' , res :',e20.10,' , gcb :',e20.10)
+
+
+         ! End loop for islands
+         ! --------------------
+         
+      END DO
+
+
+      ! 7. Reset PCG
+      ! ------------
+
+      ! reset the number of iteration for pcg
+      nmax = inmax
+
+      ! reset to zero pcg arrays
+      gcx  (:,:) = 0.e0
+      gcxb (:,:) = 0.e0
+      gcb  (:,:) = 0.e0
+      gcr  (:,:) = 0.e0
+      gcdes(:,:) = 0.e0
+      gccd (:,:) = 0.e0
+
+
+      ! III. Output of bsfisl in numisl
+      ! ===============================
+
+      IF( icile == 0 .AND. icut /= 0 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*)' islbsf : write bsfisl in numisl ', numisl
+            WRITE(numout,*)' ~~~~~~'
+         ENDIF
+         
+         IF(lwp) WRITE(numisl,REC=1) jpiglo, jpjglo, jpisl, epsisl
+         DO jni = 1, jpisl
+            CALL write2( numisl, bsfisl(1,1,jni), 1, jni+1 )
+         END DO
+      ENDIF
+
+      IF( icile < 0 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' islbsf : number of island without convergence: ',ABS(icile)
+            WRITE(numout,*) ' ~~~~~~'
+         ENDIF
+         zepsr = epsisl
+         DO jni = 1, jpisl
+            IF(lwp)WRITE(numout,*) '    isl ',jni,' precision reached ', zep(jni)
+            zepsr = MAX( zep(jni), zepsr )
+         END DO
+         IF( zepsr == 0. ) zepsr = epsisl
+         IF(lwp) THEN
+            WRITE(numout,*) ' save value of precision reached: ',zepsr
+            WRITE(numout,*)
+            WRITE(numout,*)' islbsf : save bsfisl in numisl ',numisl
+            WRITE(numout,*)' ~~~~~~'
+         ENDIF
+         
+         IF(lwp) WRITE(numisl,REC=1) jpiglo, jpjglo, jpisl, zepsr
+         DO jni = 1, jpisl
+            CALL write2( numisl, bsfisl(1,1,jni), 1, jni+1 )
+         END DO
+         nstop = nstop + 1
+      ENDIF
+      
+   END SUBROUTINE islbsf
Index: /branches/nemo/NEMO/OPA_SRC/SOL/solmat.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SOL/solmat.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SOL/solmat.F90	(revision 4)
@@ -0,0 +1,816 @@
+MODULE solmat
+   !!======================================================================
+   !!                       ***  MODULE  solmat  ***
+   !! solver       : construction of the matrix 
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   sol_mat       : Construction of the matrix of used by the elliptic solvers
+   !!   fetsch        :
+   !!   fetmat        :
+   !!   fetstr        :
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sol_oce         ! ocean solver
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE lib_mpp         ! distributed memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC sol_mat     ! routine called by inisol.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE sol_mat
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sol_mat  ***
+      !!
+      !! ** Purpose :   Construction of the matrix of used by the elliptic 
+      !!      solvers (either sor, pcg or feti methods).
+      !!
+      !! ** Method  :   The matrix depends on the type of free surface:
+      !!       * default option: rigid lid and bsf
+      !!      The matrix is built for the barotropic stream function system.
+      !!      a diagonal preconditioning matrix is also defined.
+      !!       * 'key_dynspg_fsc' defined: free surface
+      !!      The matrix is built for the divergence of the transport system
+      !!      a diagonal preconditioning matrix is also defined.
+      !!        Note that for feti solver (nsolv=3) a specific initialization 
+      !!      is required (call to fetstr.F) for memory allocation and inter-
+      !!      face definition.
+      !! 
+      !! ** Action  : - gcp    : extra-diagonal elements of the matrix
+      !!              - gcdmat : preconditioning matrix (diagonal elements)
+      !!              - gcdprc : inverse of the preconditioning matrix
+      !!
+      !! History :
+      !!   1.0  !  88-04  (G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  93-03  (M. Guyon)  symetrical conditions
+      !!        !  93-06  (M. Guyon)  suppress pointers
+      !!        !  96-05  (G. Madec)  merge sor and pcg formulations
+      !!        !  96-11  (A. Weaver)  correction to preconditioning
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form
+      !!        !  02-11  (C. Talandier, A-M. Treguier) Free surface & Open boundaries
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj                    ! dummy loop indices
+      INTEGER ::   ii, ij, iiend, ijend      ! temporary integers
+      REAL(wp) ::   zcoefs, zcoefw, zcoefe, zcoefn  ! temporary scalars
+      REAL(wp) ::   z2dt
+#if defined key_dynspg_fsc
+      REAL(wp) ::   zcoef
+#endif
+      !!----------------------------------------------------------------------
+
+      ! FETI method ( nsolv = 3)
+      ! memory allocation and interface definition for the solver
+
+      IF( nsolv == 3 )   CALL fetstr
+
+      
+      ! 1. Construction of the matrix
+      ! -----------------------------
+      
+      ! initialize to zero
+      gcp(:,:,1) = 0.e0
+      gcp(:,:,2) = 0.e0
+      gcp(:,:,3) = 0.e0
+      gcp(:,:,4) = 0.e0
+      
+      gcdprc(:,:) = 0.e0
+      gcdmat(:,:) = 0.e0
+      
+      z2dt = 2. * rdt
+
+#if defined key_dynspg_fsc && ! defined key_obc
+
+      ! defined the coefficients for free surface elliptic system
+
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            zcoef = z2dt * z2dt * g * rnu * bmask(ji,jj)
+            zcoefs = -zcoef * hv(ji  ,jj-1) * e1v(ji  ,jj-1) / e2v(ji  ,jj-1)    ! south coefficient
+            zcoefw = -zcoef * hu(ji-1,jj  ) * e2u(ji-1,jj  ) / e1u(ji-1,jj  )    ! west coefficient
+            zcoefe = -zcoef * hu(ji  ,jj  ) * e2u(ji  ,jj  ) / e1u(ji  ,jj  )    ! east coefficient
+            zcoefn = -zcoef * hv(ji  ,jj  ) * e1v(ji  ,jj  ) / e2v(ji  ,jj  )    ! north coefficient
+            gcp(ji,jj,1) = zcoefs
+            gcp(ji,jj,2) = zcoefw
+            gcp(ji,jj,3) = zcoefe
+            gcp(ji,jj,4) = zcoefn
+            gcdmat(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * bmask(ji,jj)    &          ! diagonal coefficient
+                          - zcoefs -zcoefw -zcoefe -zcoefn
+         END DO
+      END DO
+      
+#  elif defined key_dynspg_fsc && defined key_obc
+
+      !   defined gcdmat in the case of open boundaries
+
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            zcoef = z2dt * z2dt * g * rnu * bmask(ji,jj)
+            !  south coefficient
+            IF( ( lpsouthobc ) .AND. ( jj == njs0p1 ) ) THEN
+               zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vsmsk(ji,1))
+            ELSE
+               zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)
+            END IF
+            gcp(ji,jj,1) = zcoefs
+
+            !  west coefficient
+            IF( ( lpwestobc ) .AND. ( ji == niw0p1 ) ) THEN
+               zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-uwmsk(jj,1))
+            ELSE
+               zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)
+            END IF
+            gcp(ji,jj,2) = zcoefw
+
+            !   east coefficient
+            IF( ( lpeastobc ) .AND. ( ji == nie0 ) ) THEN
+               zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-uemsk(jj,1))
+            ELSE
+               zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)
+            END IF
+            gcp(ji,jj,3) = zcoefe
+
+            !   north coefficient
+            IF( ( lpnorthobc ) .AND. ( jj == njn0 ) ) THEN
+               zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vnmsk(ji,1))
+            ELSE
+               zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)
+            END IF
+            gcp(ji,jj,4) = zcoefn
+
+            ! diagonal coefficient
+            gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) &
+                            - zcoefs -zcoefw -zcoefe -zcoefn
+         END DO
+      END DO
+
+#  else
+
+      !   defined the coefficients for bsf elliptic system
+      
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            zcoefs = -hur(ji  ,jj  ) * e1u(ji  ,jj  ) / e2u(ji  ,jj  ) * bmask(ji,jj)   ! south coefficient
+            zcoefw = -hvr(ji  ,jj  ) * e2v(ji  ,jj  ) / e1v(ji  ,jj  ) * bmask(ji,jj)   ! west coefficient
+            zcoefe = -hvr(ji+1,jj  ) * e2v(ji+1,jj  ) / e1v(ji+1,jj  ) * bmask(ji,jj)   ! east coefficient
+            zcoefn = -hur(ji  ,jj+1) * e1u(ji  ,jj+1) / e2u(ji  ,jj+1) * bmask(ji,jj)   ! north coefficient
+            gcp(ji,jj,1) = zcoefs
+            gcp(ji,jj,2) = zcoefw
+            gcp(ji,jj,3) = zcoefe
+            gcp(ji,jj,4) = zcoefn
+            gcdmat(ji,jj) = -zcoefs -zcoefw -zcoefe -zcoefn                             ! diagonal coefficient
+            
+         END DO
+      END DO
+      
+#endif
+
+      ! 2. Boundary conditions 
+      ! ----------------------
+      
+      ! Cyclic east-west boundary conditions
+      !     ji=2 is the column east of ji=jpim1 and reciprocally,
+      !     ji=jpim1 is the column west of ji=2
+      !     all the coef are already set to zero as bmask is initialized to
+      !     zero for ji=1 and ji=jpj in dommsk.
+      
+      ! Symetrical conditions
+      ! free surface: no specific action
+      ! bsf system: n-s gradient of bsf = 0 along j=2 (perhaps a bug !!!!!!)
+      ! the diagonal coefficient of the southern grid points must be modify to
+      ! account for the existence of the south symmetric bassin.
+      
+#if ! defined key_dynspg_fsc
+      IF( nperio == 2 ) THEN
+         DO ji = 1, jpi
+            IF( bmask(ji,2) /= 0.e0 ) THEN
+               zcoefs = - hur(ji,2)*e1u(ji,2)/e2u(ji,2)
+               gcdmat(ji,2) = gcdmat(ji,2) - zcoefs
+            ENDIF
+         END DO
+      ENDIF
+#endif
+      
+      ! North fold boundary condition
+      !     all the coef are already set to zero as bmask is initialized to
+      !     zero on duplicated lignes and portion of lignes
+      
+      ! 3. Preconditioned matrix
+      ! ------------------------
+      
+      IF( nsolv /= 3 ) THEN
+         
+         ! SOR and PCG solvers
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( bmask(ji,jj) /= 0. )   gcdprc(ji,jj) = 1.e0 / gcdmat(ji,jj)
+            END DO
+         END DO
+         
+         gcp(:,:,1) = gcp(:,:,1) * gcdprc(:,:)
+         gcp(:,:,2) = gcp(:,:,2) * gcdprc(:,:)
+         gcp(:,:,3) = gcp(:,:,3) * gcdprc(:,:)
+         gcp(:,:,4) = gcp(:,:,4) * gcdprc(:,:)
+
+      ELSE
+         
+         ! FETI method
+         ! if feti solver : gcdprc is a mask for the non-overlapping
+         !   data structuring
+         
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( bmask(ji,jj) /= 0. ) THEN
+                  gcdprc(ji,jj) = 1.
+               ELSE
+                  gcdprc(ji,jj) = 0.
+               ENDIF
+            END DO
+         END DO
+         
+         ! so "common" line & "common" column have to be !=0 except on global
+         !   domain boundaries
+         ! pbs with nbondi if nperio != 2 ?
+         !   ii = nldi-1
+         ! pb with nldi value if jperio==1 : nbondi modifyed at the end
+         !   of inimpp.F => pb
+         ! pb with periodicity conditions : iiend, ijend
+         
+         ijend = nlej
+         iiend = nlei
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 )   iiend = nlci - jpreci
+         ii = jpreci
+         
+         ! case number 1
+         
+         IF( nbondi /= -1 .AND. nbondi /= 2 ) THEN
+            DO jj = 1, ijend
+               IF( fmask(ii,jj,1) == 1. ) gcdprc(ii,jj) = 1.
+            END DO
+         ENDIF
+         
+         ! case number 2
+         
+         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+            DO jj = 1, ijend
+               IF( fmask(ii,jj,1) == 1. ) gcdprc(ii,jj) = 1.
+            END DO
+         ENDIF
+         
+         !      ij = nldj-1
+         ! pb with nldi value if jperio==1 : nbondi modifyed at the end
+         !   of inimpp.F => pb, here homogeneisation...
+         
+         ij = jprecj
+         IF( nbondj /= -1 .AND. nbondj /= 2 ) THEN
+            DO ji = 1, iiend
+               IF( fmask(ji,ij,1) == 1. ) gcdprc(ji,ij) = 1.
+            END DO
+         ENDIF
+      ENDIF
+      
+      
+      ! 4. Initialization the arrays used in pcg
+      ! ----------------------------------------
+      gcx  (:,:) = 0.e0
+      gcxb (:,:) = 0.e0
+      gcb  (:,:) = 0.e0
+      gcr  (:,:) = 0.e0
+      gcdes(:,:) = 0.e0
+      gccd (:,:) = 0.e0
+      
+      ! FETI method
+      IF( nsolv == 3 ) THEN
+         CALL fetmat       ! Matrix treatment : Neumann condition, inverse computation
+         CALL fetsch       ! data framework for the Schur Dual solver
+      ENDIF
+      
+   END SUBROUTINE sol_mat
+
+#if defined key_feti
+
+   SUBROUTINE fetstr
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE fetstr  ***
+      !!               
+      !! ** Purpose :   Construction of the matrix of the barotropic stream 
+      !!      function system.
+      !!      Finite Elements Tearing & Interconnecting (FETI) approach
+      !!      Memory allocation and interface definition for the solver
+      !!
+      !! ** Method :
+      !!
+      !! References :
+      !!      Guyon, M, Roux, F-X, Chartier, M and Fraunie, P, 1994 :
+      !!      A domain decomposition solver to compute the barotropic 
+      !!      component of an OGCM in the parallel processing field.
+      !!      Ocean Modelling, issue 105, december 94.
+      !!
+      !! History :
+      !!        !  98-02 (M. Guyon)  Original code
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE lib_feti            ! feti librairy
+      !! * Local declarations
+      INTEGER ::   iiend, ijend, iperio   ! temporary integers
+      !!---------------------------------------------------------------------
+      
+      
+      ! Preconditioning technics of the Dual Schur Operator
+      ! <= definition of the Coarse Grid solver
+      ! <= dimension of the nullspace of the local operators
+      ! <= Neumann boundaries conditions
+      
+      ! 0. Initializations
+      ! ------------------
+      
+      ndkerep = 1
+
+      ! initialization of the superstructures management
+
+      malxm = 1
+      malim = 1
+
+      ! memory space for the pcpg associated with the FETI dual formulation
+      ! ndkerep is associated to the list of rigid modes, 
+      ! ndkerep == 1 because the Dual Operator
+      ! is a first order operator due to SPG elliptic Operator is a
+      ! second order operator
+
+      nim = 50
+      nim = nim + ndkerep
+      nim = nim + 2*jpi + 2*jpj
+      nim = nim + jpi*jpj
+
+      nxm = 33
+      nxm = nxm + 4*jpnij
+      nxm = nxm + 19*(jpi+jpj)
+      nxm = nxm + 13*jpi*jpj
+      nxm = nxm + jpi*jpi*jpj
+
+      ! krylov space memory
+
+      iperio = 0
+      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6) iperio = 1
+      nxm = nxm + 3*(jpnij-jpni)*jpi
+      nxm = nxm + 3*(jpnij-jpnj+iperio)*jpj
+      nxm = nxm + 2*(jpi+jpj)*(jpnij-jpni)*jpi
+      nxm = nxm + 2*(jpi+jpj)*(jpnij-jpnj+iperio)*jpj
+
+      ! Resolution with the Schur dual Method ( frontal and local solver by
+      ! blocks
+      ! Case with a local symetrical matrix
+      ! The local matrix is stored in a multi-column form
+      ! The total number of nodes for this subdomain is named "noeuds"
+
+      noeuds = jpi*jpj
+      nifmat = jpi-1
+      njfmat = jpj-1
+      nelem = nifmat*njfmat
+      npe = 4
+      nmorse = 5*noeuds
+      
+      ! 1. mesh building
+      ! ----------------
+      
+      ! definition of specific information for a subdomain
+      !  narea           : subdomain number = processor number +1 
+      !  ninterf         : neighbour subdomain number
+      !  nni             : interface point number
+      !  ndvois array    : neighbour subdomain list 
+      !  maplistin array : node pointer at each interface
+      !  maplistin array : concatened list of interface nodes
+      
+      !  messag coding is necessary by interface type for avoid collision
+      !  if nperio == 1 
+      
+      !  lint  array     : indoor interface list / type
+      !  lext  array     : outdoor interface list / type
+      
+      !  domain with jpniXjpnj subdomains
+      
+      CALL feti_inisub(nifmat,njfmat,nbondi,nbondj,nperio,   &
+          nbsw,nbnw,nbse,nbne,ninterf,ninterfc,nni,nnic)
+
+      CALL feti_creadr(malim,malimax,nim,3*ninterf ,mandvois ,'ndvois' )
+      CALL feti_creadr(malim,malimax,nim,3*ninterfc,mandvoisc,'ndvoisc')
+      CALL feti_creadr(malim,malimax,nim,ninterfc+1,maplistin,'plistin')
+      CALL feti_creadr(malim,malimax,nim,nnic      ,malistin ,'listin' )
+
+      ! pb with periodicity conditions : iiend, ijend
+
+      ijend = nlej
+      iiend = nlei
+      IF (jperio == 1) iiend = nlci - jpreci
+
+      CALL feti_subound(nifmat,njfmat,nldi,iiend,nldj,ijend,   &
+          narea,nbondi,nbondj,nperio,   &
+          ninterf,ninterfc,   &
+          nowe,noea,noso,nono,   &
+          nbsw,nbnw,nbse,nbne,   &
+          npsw,npnw,npse,npne,   &
+          mfet(mandvois),mfet(mandvoisc),   &
+          mfet(maplistin),nnic,mfet(malistin) )
+
+   END SUBROUTINE fetstr
+
+
+   SUBROUTINE fetmat
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE fetmat  ***
+      !!            
+      !! ** Purpose :   Construction of the matrix of the barotropic stream 
+      !!      function system.
+      !!      Finite Elements Tearing & Interconnecting (FETI) approach
+      !!      Matrix treatment : Neumann condition, inverse computation
+      !!
+      !! ** Method :
+      !!
+      !! References :
+      !!      Guyon, M, Roux, F-X, Chartier, M and Fraunie, P, 1994 :
+      !!      A domain decomposition solver to compute the barotropic 
+      !!      component of an OGCM in the parallel processing field.
+      !!      Ocean Modelling, issue 105, december 94.
+      !!
+      !! History :
+      !!        !  98-02 (M. Guyon)  Original code
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE lib_feti            ! feti librairy
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk, jl
+      INTEGER ::   iimask(jpi,jpj)
+      INTEGER ::   iiend, ijend
+      REAL(wp) ::   zres, zres2, zdemi
+      !!---------------------------------------------------------------------
+
+      ! Matrix computation
+      ! ------------------
+
+      CALL feti_creadr(malxm,malxmax,nxm,nmorse,maan,'matrice a')
+
+      nnitot = nni
+
+      CALL mpp_sum(nnitot,1,numit0ete)
+      CALL feti_creadr(malxm,malxmax,nxm,npe*npe,maae,'ae')
+
+      ! initialisation of the local barotropic matrix
+      ! local boundary conditions on the halo
+
+      CALL lbc_lnk( gcp(:,:,1), 'F', 1)
+      CALL lbc_lnk( gcp(:,:,2), 'F', 1) 
+      CALL lbc_lnk( gcp(:,:,3), 'F', 1) 
+      CALL lbc_lnk( gcp(:,:,4), 'F', 1) 
+      CALL lbc_lnk( gcdmat    , 'T', 1)
+
+      ! Neumann conditions
+      ! initialisation of the integer Neumann Mask
+
+      CALL feti_iclr(jpi*jpj,iimask)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            iimask(ji,jj) = INT( gcdprc(ji,jj) )
+         END DO
+      END DO
+
+      ! regularization of the local matrix
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            gcdmat(ji,jj) = gcdmat(ji,jj) * gcdprc(ji,jj) + 1. - gcdprc(ji,jj)
+         END DO
+      END DO
+
+      DO jk = 1, 4
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               gcp(ji,jj,jk) = gcp(ji,jj,jk) * gcdprc(ji,jj)
+            END DO
+         END DO
+      END DO
+      
+      ! implementation of the west, east, north & south Neumann conditions
+
+      zdemi  = 0.5
+
+      ! pb with periodicity conditions : iiend, ijend
+
+      ijend = nlej
+      iiend = nlei
+      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) iiend = nlci - jpreci
+
+      IF( nbondi == 2 .AND. (nperio /= 1 .OR. nperio /= 4 .OR. nperio == 6) ) THEN
+
+         ! with the periodicity : no east/west interface if nbondi = 2
+         ! and nperio != 1
+
+      ELSE 
+         ! west
+         IF( nbondi /= -1 ) THEN 
+            DO jj = 1, jpj
+               IF( iimask(1,jj) /= 0 ) THEN
+                  gcp(1,jj,2) = 0.
+                  gcp(1,jj,1) = zdemi * gcp(1,jj,1)
+                  gcp(1,jj,4) = zdemi * gcp(1,jj,4)
+               ENDIF
+            END DO
+            DO jj = 1, jpj
+               IF( iimask(1,jj) /= 0 ) THEN
+                  gcdmat(1,jj) = - ( gcp(1,jj,1) + gcp(1,jj,2) + gcp(1,jj,3) + gcp(1,jj,4) )
+               ENDIF
+            END DO
+         ENDIF
+         ! east
+         IF( nbondi /= 1 ) THEN 
+            DO jj = 1, jpj
+               IF( iimask(iiend,jj) /= 0 ) THEN
+                  gcp(iiend,jj,3) = 0.
+                  gcp(iiend,jj,1) = zdemi * gcp(iiend,jj,1)
+                  gcp(iiend,jj,4) = zdemi * gcp(iiend,jj,4)
+               ENDIF
+            END DO
+            DO jj = 1, jpj
+               IF( iimask(iiend,jj) /= 0 ) THEN
+                  gcdmat(iiend,jj) = - ( gcp(iiend,jj,1) + gcp(iiend,jj,2)   &
+                                       + gcp(iiend,jj,3) + gcp(iiend,jj,4) )
+               ENDIF
+            END DO
+         ENDIF
+      ENDIF
+
+      ! south
+      IF( nbondj /= -1 .AND. nbondj /= 2 ) THEN 
+         DO ji = 1, jpi
+            IF( iimask(ji,1) /= 0 ) THEN
+               gcp(ji,1,1) = 0.
+               gcp(ji,1,2) = zdemi * gcp(ji,1,2)
+               gcp(ji,1,3) = zdemi * gcp(ji,1,3)
+            ENDIF
+         END DO
+         DO ji = 1, jpi
+            IF( iimask(ji,1) /= 0 ) THEN
+               gcdmat(ji,1) = - ( gcp(ji,1,1) + gcp(ji,1,2) + gcp(ji,1,3) + gcp(ji,1,4) )
+            ENDIF
+         END DO
+      ENDIF
+      
+      ! north
+      IF( nbondj /= 1 .AND. nbondj /= 2 ) THEN 
+         DO ji = 1, jpi
+            IF( iimask(ji,ijend) /= 0 ) THEN
+               gcp(ji,ijend,4) = 0.
+               gcp(ji,ijend,2) = zdemi * gcp(ji,ijend,2) 
+               gcp(ji,ijend,3) = zdemi * gcp(ji,ijend,3)
+            ENDIF
+         END DO
+         DO ji = 1, jpi
+            IF( iimask(ji,ijend) /= 0 ) THEN
+               gcdmat(ji,ijend) = - ( gcp(ji,ijend,1) + gcp(ji,ijend,2)   &
+                                    + gcp(ji,ijend,3) + gcp(ji,ijend,4) )
+            ENDIF
+         END DO
+      ENDIF
+
+      ! matrix terms are  saved in FETI solver arrays
+      CALL feti_vmov(noeuds,gcp(1,1,1),wfeti(maan))
+      CALL feti_vmov(noeuds,gcp(1,1,2),wfeti(maan+noeuds))
+      CALL feti_vmov(noeuds,gcdmat,wfeti(maan+2*noeuds))
+      CALL feti_vmov(noeuds,gcp(1,1,3),wfeti(maan+3*noeuds))
+      CALL feti_vmov(noeuds,gcp(1,1,4),wfeti(maan+4*noeuds))
+
+      ! construction of Dirichlet liberty degrees array
+      CALL feti_subdir(nifmat,njfmat,noeuds,ndir,iimask)
+      CALL feti_creadr(malim,malimax,nim,ndir,malisdir,'lisdir')
+      CALL feti_listdir(jpi,jpj,iimask,ndir,mfet(malisdir))
+
+      ! stop onto  matrix term for Dirichlet conditions
+      CALL feti_blomat(nifmat+1,njfmat+1,wfeti(maan),ndir,mfet(malisdir))
+
+      ! reservation of factorized diagonal blocs and temporary array for
+      ! factorization
+      npblo = (njfmat+1) * (nifmat+1) * (nifmat+1)
+      ndimax = nifmat+1
+
+      CALL feti_creadr(malxm,malxmax,nxm,npblo,mablo,'blo')
+      CALL feti_creadr(malxm,malxmax,nxm,noeuds,madia,'dia')
+      CALL feti_creadr(malxm,malxmax,nxm,noeuds,mav,'v')
+      CALL feti_creadr(malxm,malxmax,nxm,ndimax*ndimax,mautil,'util')
+
+      ! stoping the rigid modes
+
+      ! the number of rigid modes =< Max [dim(Ker(Ep))]
+      !                                p=1,Np
+
+      CALL feti_creadr(malim,malimax,nim,ndkerep,malisblo,'lisblo')
+
+      ! Matrix factorization
+
+      CALL feti_front(noeuds,nifmat+1,njfmat+1,wfeti(maan),npblo,   &
+          wfeti(mablo),wfeti(madia),   &
+          wfeti(mautil),wfeti(mav),ndlblo,mfet(malisblo),ndkerep)
+      CALL feti_prext(noeuds,wfeti(madia))
+
+      ! virtual dealloc => we have to see for a light f90 version
+      ! the super structure is removed to clean the coarse grid
+      ! solver structure
+
+      malxm = madia
+      CALL feti_vclr(noeuds,wfeti(madia))
+      CALL feti_vclr(noeuds,wfeti(mav))
+      CALL feti_vclr(ndimax*ndimax,wfeti(mautil))
+
+      ! ndlblo is the dimension of the local nullspace .=<. the size of the 
+      ! memory of the superstructure associated to the nullspace : ndkerep
+      ! ndkerep is introduced to avoid messages "out of bounds" when memory
+      ! is checked
+
+      ! copy matrix for Dirichlet condition
+
+      CALL feti_creadr(malxm,malxmax,nxm,noeuds,miax,'x')
+      CALL feti_creadr(malxm,malxmax,nxm,noeuds,may,'y')
+      CALL feti_creadr(malxm,malxmax,nxm,noeuds,maz,'z')
+
+      ! stoping the rigid modes
+
+      ! ndlblo is the dimension of the local nullspace .=<. the size of the 
+      ! memory of the superstructure associated to the nullspace : ndkerep
+      ! ndkerep is introduced to avoid messages "out of bounds" when memory
+      ! is checked
+
+      CALL feti_creadr(malxm,malxmax,nxm,ndkerep*noeuds,mansp,'nsp')
+      CALL feti_blomat1(nifmat+1,njfmat+1,wfeti(maan),ndlblo,   &
+          mfet(malisblo),wfeti(mansp))      
+
+      ! computation of operator kernel
+
+      CALL feti_nullsp(noeuds,nifmat+1,njfmat+1,npblo,wfeti(mablo),   &
+          wfeti(maan),ndlblo,mfet(malisblo),wfeti(mansp),   &
+          wfeti(maz))
+
+      ! test of the factorisation onto each sub domain
+
+      CALL feti_init(noeuds,wfeti(may))
+      CALL feti_blodir(noeuds,wfeti(may),ndir,mfet(malisdir))
+      CALL feti_blodir(noeuds,wfeti(may),ndlblo,mfet(malisblo))
+      CALL feti_vclr(noeuds,wfeti(miax))
+      CALL feti_resloc(noeuds,nifmat+1,njfmat+1,wfeti(maan),npblo,   &
+          wfeti(mablo),wfeti(may),wfeti(miax),wfeti(maz)) 
+      CALL feti_proax(noeuds,nifmat+1,njfmat+1,wfeti(maan),wfeti(miax),   &
+          wfeti(maz))
+      CALL feti_blodir(noeuds,wfeti(maz),ndlblo,mfet(malisblo))
+      CALL feti_vsub(noeuds,wfeti(may),wfeti(maz),wfeti(maz))
+
+      zres2 = 0.
+      DO jl = 1, noeuds
+         zres2 = zres2 + wfeti(may+jl-1) * wfeti(may+jl-1)
+      END DO
+      CALL mpp_sum(zres2,1,zres)
+
+      res2 = 0.
+      DO jl = 1, noeuds
+         res2 = res2 + wfeti(maz+jl-1) * wfeti(maz+jl-1)
+      END DO 
+      res2 = res2 / zres2
+      CALL mpp_sum(res2,1,zres)
+
+      res2 = SQRT(res2)
+      IF(lwp) WRITE(numout,*) 'global residu : sqrt((Ax-b,Ax-b)/(b.b)) =', res2
+
+      IF( res2 > (eps/100.) ) THEN 
+         IF(lwp) WRITE (numout,*) 'eps is :',eps
+         IF(lwp) WRITE (numout,*) 'factorized matrix precision :',res2
+         STOP 
+      ENDIF
+
+   END SUBROUTINE fetmat
+
+
+   SUBROUTINE fetsch
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE fetsch  ***
+      !!        
+      !! ** Purpose :
+      !!     Construction of the matrix of the barotropic stream function
+      !!     system.
+      !!     Finite Elements Tearing & Interconnecting (FETI) approach
+      !!     Data framework for the Schur Dual solve
+      !!
+      !! ** Method :
+      !!
+      !! References :
+      !!      Guyon, M, Roux, F-X, Chartier, M and Fraunie, P, 1994 :
+      !!      A domain decomposition solver to compute the barotropic 
+      !!      component of an OGCM in the parallel processing field.
+      !!      Ocean Modelling, issue 105, december 94.
+      !!
+      !! History :
+      !!        !  98-02 (M. Guyon)  Original code
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE lib_feti            ! feti librairy
+      !! * Local declarations
+      !!---------------------------------------------------------------------
+
+      !  computing weights for the conform construction
+
+      CALL feti_creadr(malxm,malxmax,nxm,noeuds,mapoids ,'poids' )
+      CALL feti_creadr(malxm,malxmax,nxm,nnic  ,mabufin ,'bufin' )
+      CALL feti_creadr(malxm,malxmax,nxm,nnic  ,mabufout,'bufout')
+
+!!    CALL feti_poids(ninterfc,mfet(mandvoisc),mfet(maplistin),nnic,   &
+!!        mfet(malistin),narea,noeuds,wfeti(mapoids),wfeti(mabufin),   &
+!!        wfeti(mabufout) )
+      CALL feti_poids(ninterfc,                                nnic,   &
+          mfet(malistin),      noeuds,wfeti(mapoids)                )
+
+
+      ! Schur dual arrays
+ 
+      CALL feti_creadr(malxm,malxmax,nxm,noeuds,mabitw,'bitw') 
+      CALL feti_creadr(malxm,malxmax,nxm,noeuds,mautilu,'utilu') 
+      CALL feti_creadr(malxm,malxmax,nxm,nni,malambda,'lambda') 
+      CALL feti_creadr(malxm,malxmax,nxm,nni,mag,'g') 
+      CALL feti_creadr(malxm,malxmax,nxm,nni,mapg,'pg') 
+      CALL feti_creadr(malxm,malxmax,nxm,nni,mamg,'mg') 
+      CALL feti_creadr(malxm,malxmax,nxm,nni,maw,'w') 
+      CALL feti_creadr(malxm,malxmax,nxm,nni,madw,'dw')
+
+      !  coarse grid solver dimension and arrays
+
+      nitmaxete = ndlblo
+      CALL  mpp_sum(nitmaxete,1,numit0ete)
+
+      nitmaxete = nitmaxete + 1
+      CALL feti_creadr(malxm,malxmax,nxm,ndkerep,maxnul,'xnul')
+      CALL feti_creadr(malxm,malxmax,nxm,ndkerep,maynul,'ynul')
+      CALL feti_creadr(malxm,malxmax,nxm,ndkerep,maeteg,'eteg')
+      CALL feti_creadr(malxm,malxmax,nxm,ndkerep,maeteag,'eteag')
+      CALL feti_creadr(malxm,malxmax,nxm,ndkerep*nitmaxete,maeted,'eted')
+      CALL feti_creadr(malxm,malxmax,nxm,ndkerep*nitmaxete,maetead,'etead')
+      CALL feti_creadr(malxm,malxmax,nxm,nitmaxete,maeteadd,'eteadd')
+      CALL feti_creadr(malxm,malxmax,nxm,nitmaxete,maetegamm,'etegamm')
+      CALL feti_creadr(malxm,malxmax,nxm,nni,maetew,'etew') 
+      CALL feti_creadr(malxm,malxmax,nxm,noeuds,maetev,'etev') 
+
+      ! construction of semi interface arrays
+
+      CALL feti_creadr(malim,malimax,nim,ninterf+1,maplistih,'plistih')
+!!    CALL feti_halfint(ninterf,mfet(mandvois),mfet(maplistin),nni,   &
+!!        mfet(maplistih),nnih,narea)
+      CALL feti_halfint(ninterf,mfet(mandvois),mfet(maplistin),       & 
+          mfet(maplistih),nnih      )
+
+      CALL feti_creadr(malxm,malxmax,nxm,nnih,magh,'gh') 
+
+      ! Schur Dual Method
+
+      nmaxd = nnitot / 2
+
+      !  computation of the remain array for descent directions
+
+      nmaxd = min0(nmaxd,(nxm-nitmaxete-malxm)/(2*nnih+3))
+      CALL mpp_min(nmaxd,1,numit0ete)
+
+      nitmax = nnitot/2
+      epsilo = eps
+      ntest = 0
+
+      ! Krylov space construction
+
+      CALL feti_creadr(malxm,malxmax,nxm,nnih*nmaxd,mawj,'wj') 
+      CALL feti_creadr(malxm,malxmax,nxm,nnih*nmaxd,madwj,'dwj') 
+      CALL feti_creadr(malxm,malxmax,nxm,nmaxd,madwwj,'dwwj') 
+      CALL feti_creadr(malxm,malxmax,nxm,nmaxd,magamm,'gamm') 
+      CALL feti_creadr(malxm,malxmax,nxm,max0(nmaxd,nitmaxete),mawork,'work')
+      mjj0 = 0 
+      numit0ete = 0 
+
+   END SUBROUTINE fetsch
+
+#else
+   SUBROUTINE fetstr                 ! Empty routine
+   END SUBROUTINE fetstr
+   SUBROUTINE fetmat                 ! Empty routine
+   END SUBROUTINE fetmat
+   SUBROUTINE fetsch                 ! Empty routine
+   END SUBROUTINE fetsch
+#endif
+
+   !!======================================================================
+END MODULE solmat
Index: /branches/nemo/NEMO/OPA_SRC/SOL/solpcg.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SOL/solpcg.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SOL/solpcg.F90	(revision 4)
@@ -0,0 +1,278 @@
+MODULE solpcg
+   !!======================================================================
+   !!                     ***  MODULE  solfet
+   !! Ocean solver :  preconditionned conjugate gradient solver
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   sol_pcg    : preconditionned conjugate gradient solver
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE sol_oce         ! ocean solver variables
+   USE lib_mpp         ! distributed memory computing
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC sol_pcg              ! ???
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE sol_pcg( kindic )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sol_pcg  ***
+      !!                    
+      !! ** Purpose :   Solve the ellipic equation for the barotropic stream 
+      !!      function system (default option) or the transport divergence 
+      !!      system ("key_dynspg_fsc") using a diagonal preconditionned
+      !!      conjugate gradient method.
+      !!      In the former case, the barotropic stream function trend has a
+      !!      zero boundary condition along all coastlines (i.e. continent
+      !!      as well as islands) while in the latter the boundary condition
+      !!      specification is not required.
+      !!
+      !! ** Method  :   Diagonal preconditionned conjugate gradient method.
+      !!      the algorithm is multitasked. (case of 5 points matrix)
+      !!      define              pa  = q^-1 * a
+      !!                        pgcb  = q^-1 * gcb
+      !!                 < . ; . >_q  = ( . )^t q ( . )
+      !!      where q is the preconditioning matrix = diagonal matrix of the
+      !!                                              diagonal elements of a
+      !!      Initialization:
+      !!         x(o) = gcx
+      !!         r(o) = d(o) = pgcb - pa.x(o)
+      !!         rr(o)= < r(o) , r(o) >_q
+      !!      Iteration n   :
+      !!         z(n)   = pa.d(n)
+      !!         alp(n) = rr(n) / < z(n) , d(n) >_q
+      !!         x(n+1) = x(n) + alp(n) d(n)
+      !!         r(n+1) = r(n) - alp(n) z(n)
+      !!         rr(n+1)= < r(n+1) , r(n+1) >_q
+      !!         bet(n) = rr(n+1) / rr(n)
+      !!         r(n+1) = r(n+1) + bet(n+1) d(n)
+      !!      Convergence test :
+      !!         rr(n+1) / < gcb , gcb >_q   =< epsr
+      !!
+      !! ** Action : - niter  : solver number of iteration done
+      !!             - res    : solver residu reached
+      !!             - gcx()  : solution of the elliptic system
+      !!
+      !! References :
+      !!      Madec et al. 1988, Ocean Modelling, issue 78, 1-6.
+      !!
+      !! History :
+      !!        !  90-10  (G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  93-04  (M. Guyon)  loops and suppress pointers
+      !!        !  95-09  (M. Imbard, J. Escobar)  mpp exchange 
+      !!        !  96-05  (G. Madec)  merge sor and pcg formulations
+      !!        !  96-11  (A. Weaver)  correction to preconditioning
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( inout ) ::   kindic   ! solver indicator, < 0 if the conver-
+      !                                      ! gence is not reached: the model is
+      !                                      ! stopped in step
+      !                                      ! set to zero before the call of solpcg
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jn                ! dummy loop indices
+      REAL(wp) ::   zgcad                    ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      !                                                !================
+      DO jn = 1, nmax                                  ! Iterative loop
+         !                                             !================
+
+         !,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+         
+         IF( jn == 1 ) THEN
+            
+            ! 1.0 Initialization of the algorithm
+            ! -----------------------------------
+            
+#if defined key_dynspg_fsc
+#   if defined key_mpp
+            ! Mpp: export boundary values to neighbouring processors
+            CALL lbc_lnk( gcx, 'S', 1. )
+#   else
+            !   mono- or macro-tasking: W-point, >0, 2D array, no slab
+            CALL lbc_lnk( gcx, 'T', 1. )
+#   endif
+#else
+#   if defined key_mpp
+            ! ... Mpp: export boundary values to neighbouring processors
+            CALL lbc_lnk( gcx, 'G', 1. )
+#   else
+            !   ... mono- or macro-tasking: F-point, >0, 2D array, no slab
+            CALL lbc_lnk( gcx, 'F', 1. )
+#   endif
+#endif
+
+            !,,,,,,,,,,,,,,,,,,,,,,,,synchro ,,,,,,,,,,,,,,,,,,,,,,,
+            
+            ! gcr   = gcb-a.gcx
+            ! gcdes = gsr
+            
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zgcad = bmask(ji,jj)*(                         &
+                    gcb(ji,jj  ) -              gcx(ji  ,jj  )   &
+                                 - gcp(ji,jj,1)*gcx(ji  ,jj-1)   &
+                                 - gcp(ji,jj,2)*gcx(ji-1,jj  )   &
+                                 - gcp(ji,jj,3)*gcx(ji+1,jj  )   &
+                                 - gcp(ji,jj,4)*gcx(ji  ,jj+1)   )
+                  gcr  (ji,jj) = zgcad
+                  gcdes(ji,jj) = zgcad
+               END DO
+            END DO
+            
+            !,,,,,,,,,,,,,,,,,,,,,,,,synchro ,,,,,,,,,,,,,,,,,,,,,,,
+            
+            rnorme = SUM(  gcr(:,:) * gcdmat(:,:) * gcr(:,:)  )
+
+#if defined key_mpp
+            ! Mpp: sum over all the global domain
+            CALL mpp_sum( rnorme )
+#endif
+            rr = rnorme
+
+        ENDIF
+        !,,,,,,,,,,,,,,,,,,,,,,,,synchro ,,,,,,,,,,,,,,,,,,,,,,,
+        
+        
+        ! 1.1 Algorithm
+        ! -------------
+        
+        ! boundary condition on gcdes (only cyclic bc are required)
+#if defined key_dynspg_fsc
+#   if defined key_mpp
+        !   Mpp: export boundary values to neighbouring processors
+        CALL lbc_lnk( gcdes, 'S', 1. )
+#   else
+        !   mono- or macro-tasking: W-point, >0, 2D array, no slab
+        CALL lbc_lnk( gcdes, 'T', 1. )
+#   endif
+#else
+#   if defined key_mpp
+        !   Mpp: export boundary values to neighbouring processors
+        CALL lbc_lnk( gcdes, 'G', 1. )
+#   else
+        !   mono- or macro-tasking: F-point, >0, 2D array, no slab
+        CALL lbc_lnk( gcdes, 'F', 1. )
+#   endif
+#endif
+        
+        !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,,
+        
+        ! ... gccd = matrix . gcdes
+        DO jj = 2, jpjm1
+           DO ji = fs_2, fs_jpim1   ! vector opt.
+              gccd(ji,jj) = bmask(ji,jj)*(   &
+                 gcdes(ji,jj)   &
+                +gcp(ji,jj,1)*gcdes(ji,jj-1)+gcp(ji,jj,2)*gcdes(ji-1,jj)   &
+                +gcp(ji,jj,4)*gcdes(ji,jj+1)+gcp(ji,jj,3)*gcdes(ji+1,jj)   &
+                )
+           END DO
+        END DO
+
+        !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,,
+        
+        ! alph = (gcr,gcr)/(gcdes,gccd)
+
+        radd = SUM(  gcdes(:,:) * gcdmat(:,:) * gccd(:,:)  )
+
+#if defined key_mpp
+        ! Mpp: sum over all the global domain
+        CALL mpp_sum( radd )
+#endif
+        alph = rr / radd
+        
+        !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,,
+        
+        ! gcx = gcx + alph * gcdes
+        ! gcr = gcr - alph * gccd
+        DO jj = 2, jpjm1
+           DO ji = fs_2, fs_jpim1   ! vector opt.
+              gcx(ji,jj) = bmask(ji,jj) * ( gcx(ji,jj) + alph * gcdes(ji,jj) )
+              gcr(ji,jj) = bmask(ji,jj) * ( gcr(ji,jj) - alph * gccd (ji,jj) )
+           END DO
+        END DO
+        
+        !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,,
+        
+        ! rnorme = (gcr,gcr)
+
+        rnorme = SUM(  gcr(:,:) * gcdmat(:,:) * gcr(:,:)  )
+
+#if defined key_mpp
+        ! Mpp: sum over all the global domain
+        CALL  mpp_sum( rnorme )
+#endif
+        
+        ! test of convergence
+        IF ( rnorme < epsr .OR. jn == nmax ) THEN
+           res = SQRT( rnorme )
+           niter = jn
+           ncut = 999
+        ENDIF
+        
+        ! beta = (rk+1,rk+1)/(rk,rk)
+        beta = rnorme / rr
+        rr   = rnorme
+
+        !,,,,,,,,,,,,,,,,,,,,,,,,synchro if macrotasking,,,,,,,,,,,,,,,,,,,,,,,
+
+        ! indicator of non-convergence or explosion
+        IF( jn == nmax .OR. sqrt(epsr)/eps > 1.e+20 ) kindic = -2
+        IF( ncut == 999 ) GOTO 999
+
+        ! gcdes = gcr + beta * gcdes
+        DO jj = 2, jpjm1
+           DO ji = fs_2, fs_jpim1   ! vector opt.
+              gcdes(ji,jj) = bmask(ji,jj)*( gcr(ji,jj) + beta * gcdes(ji,jj) )
+           END DO
+        END DO
+        
+        !                                             !================
+     END DO                                           !    End Loop
+     !                                                !================
+     
+999  CONTINUE
+     
+     
+     !  2. Output in gcx with lateral b.c. applied
+     !  ------------------------------------------
+     
+     ! boundary conditions   !!bug ???
+#if defined key_mpp
+     ! Mpp: export boundary values to neighbouring processors
+# if defined key_dynspg_fsc
+     CALL lbc_lnk( gcx, 'S', 1. )
+# else
+     CALL lbc_lnk( gcx, 'G', 1. )
+# endif
+#else
+     IF ( nperio /= 0 ) THEN
+# if defined key_dynspg_fsc
+        ! mono- or macro-tasking: W-point, >0, 2D array, no slab
+        CALL lbc_lnk( gcx, 'T', 1. )
+# else
+        ! mono- or macro-tasking: F-point, >0, 2D array, no slab
+        CALL lbc_lnk( gcx, 'F', 1. )
+# endif
+     ENDIF
+#endif
+     
+   END SUBROUTINE sol_pcg
+
+   !!=====================================================================
+END MODULE solpcg
Index: /branches/nemo/NEMO/OPA_SRC/SOL/solsor.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SOL/solsor.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SOL/solsor.F90	(revision 4)
@@ -0,0 +1,263 @@
+MODULE solsor
+   !!======================================================================
+   !!                     ***  MODULE  solsor
+   !! Ocean solver :  Successive Over-Relaxation solver
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   sol_sor     : Successive Over-Relaxation solver
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE zdf_oce         ! ocean vertical physics variables
+   USE sol_oce         ! solver variables
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC sol_sor              ! ???
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+      
+   SUBROUTINE sol_sor( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sol_sor  ***
+      !!                 
+      !! ** Purpose :   Solve the ellipic equation for the barotropic stream 
+      !!      function system (default option) or the transport divergence 
+      !!      system (key_dynspg_fsc = T) using a successive-over-relaxation
+      !!      method.
+      !!       In the former case, the barotropic stream function trend has a
+      !!     zero boundary condition along all coastlines (i.e. continent
+      !!     as well as islands) while in the latter the boundary condition
+      !!     specification is not required.
+      !!
+      !! ** Method  :   Successive-over-relaxation method using the red-black 
+      !!      technique. The former technique used was not compatible with 
+      !!      the north-fold boundary condition used in orca configurations.
+      !!
+      !! References :
+      !!      Madec et al. 1988, Ocean Modelling, issue 78, 1-6.
+      !!
+      !! History :
+      !!        !  90-10  (G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!   7.1  !  93-04  (G. Madec)  time filter
+      !!        !  96-05  (G. Madec)  merge sor and pcg formulations
+      !!        !  96-11  (A. Weaver)  correction to preconditioning
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form
+      !!        !  03-02  (C. Deltel)  Red-Black SOR <== Not done yet!!!
+      !!                                                *************
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(  in   ) ::   kt       ! ocean time-step
+      INTEGER, INTENT( inout ) ::   kindic   ! solver indicator, < 0 if the conver-
+      !                                      ! gence is not reached: the model is
+      !                                      ! stopped in step
+      !                                      ! set to zero before the call of solsor
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jn               ! dummy loop indices
+      REAL(wp) ::   zgwgt                    ! temporary scalar
+      !!----------------------------------------------------------------------
+      
+      
+      ! Iterative loop 
+      ! ==============
+      
+      IF( kt == nit000 )  gccd(:,:) = sor * gcp(:,:,2)
+
+
+      DO jn = 1, nmax
+
+         !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+         
+         ! boundary conditions (at each sor iteration) only cyclic b. c. are required
+#if defined key_dynspg_fsc
+# if defined key_mpp
+            ! Mpp: export boundary values to neighbouring processors
+            CALL lbc_lnk( gcx, 'S', 1. )   ! S=T with special staff ???
+# else
+            CALL lbc_lnk( gcx, 'T', 1. )
+# endif
+#else
+# if defined key_mpp
+            ! Mpp: export boundary values to neighbouring processors
+            CALL lbc_lnk( gcx, 'G', 1. )   ! G= F with special staff ???
+# else
+            CALL lbc_lnk( gcx, 'F', 1. )
+# endif
+#endif
+         
+         !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+         
+         ! 1. Residus
+         ! ----------
+ 
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               gcr(ji,jj) =  gcb(ji,jj  ) -             gcx(ji  ,jj  )   &
+                                          -gcp(ji,jj,1)*gcx(ji  ,jj-1)   &
+                                          -gcp(ji,jj,2)*gcx(ji-1,jj  )   &
+                                          -gcp(ji,jj,3)*gcx(ji+1,jj  )   &
+                                          -gcp(ji,jj,4)*gcx(ji  ,jj+1)
+            END DO
+         END DO
+
+         !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+         
+         ! 1.1 Boundary conditions (at each sor iteration) only cyclic b. c. are required
+#if defined key_dynspg_fsc
+#   if defined key_mpp
+            ! Mpp: export boundary values to neighbouring processors
+            CALL lbc_lnk( gcr, 'S', 1. )
+#   else
+            ! mono- or macro-tasking: W-point, >0, 2D array, no slab
+            CALL lbc_lnk( gcr, 'T', 1. )
+#   endif
+#else
+#   if defined key_mpp
+            ! Mpp: export boundary values to neighbouring processors
+            CALL lbc_lnk( gcr, 'G', 1. )
+#   else
+            ! mono- or macro-tasking: W-point, >0, 2D array, no slab
+            CALL lbc_lnk( gcr, 'F', 1. )
+#   endif
+#endif
+
+         ! 1.2 Successive over relaxation
+         
+         DO jj = 2, jpj
+            DO ji = 1, jpi
+               gcr(ji,jj) = gcr(ji,jj) - sor*gcp(ji,jj,1)*gcr(ji,jj-1)
+            END DO
+            DO ji = 2, jpi
+               gcr(ji,jj) = gcr(ji,jj) - sor*gcp(ji,jj,2)*gcr(ji-1,jj)
+            END DO
+         END DO
+         
+         !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+         
+         ! gcx guess
+         
+         DO jj = 2, jpjm1
+            DO ji = 1, jpi
+               gcx(ji,jj)  = (gcx(ji,jj)+sor*gcr(ji,jj))*bmask(ji,jj)
+            END DO
+         END DO
+         
+         !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+         
+         ! boundary conditions (at each sor iteration) only cyclic b. c. are required
+#if defined key_dynspg_fsc
+#   if defined key_mpp
+         ! Mpp: export boundary values to neighbouring processors
+         CALL lbc_lnk( gcx, 'S', 1. )
+#   else
+         ! mono- or macro-tasking: W-point, >0, 2D array, no slab
+         CALL lbc_lnk( gcx, 'T', 1. )
+#   endif
+#else
+#   if defined key_mpp
+         ! Mpp: export boundary values to neighbouring processors
+         CALL lbc_lnk( gcx, 'G', 1. )
+#   else
+         ! mono- or macro-tasking: W-point, >0, 2D array, no slab
+         CALL lbc_lnk( gcx, 'F', 1. )
+#   endif
+#endif
+         
+         ! maximal residu (old exit test on the maximum value of residus)
+         ! 
+         ! imax = isamax( jpi*jpj, gcr, 1 )
+         
+         ! avoid an out of bound in no bounds compilation
+         
+         ! iimax1 = mod( imax, jpi )
+         ! ijmax1 = int( float(imax) / float(jpi)) + 1
+         ! resmax = abs( gcr(iimax1,ijmax1) )
+         
+         ! relative precision
+         
+         rnorme = 0.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zgwgt = gcdmat(ji,jj) * gcr(ji,jj)
+               rnorme= rnorme + gcr(ji,jj)*zgwgt
+            END DO
+         END DO
+         
+#if defined key_mpp
+         ! mpp sum over all the global domain
+         CALL  mpp_sum( rnorme )
+#endif
+         
+         ! test of convergence
+         ! old test (either res<resmax or jn=nmax)
+         !           IF( res < resmax .OR. jn == nmax ) THEN
+         ! relative precision
+         IF( rnorme < epsr .OR. jn == nmax ) THEN
+            res = SQRT( rnorme )
+            niter = jn
+            ncut = 999
+         ENDIF
+         
+         !****
+         !     IF(lwp)WRITE(numsol,9300) jn, res, sqrt( epsr ) / eps
+9300     FORMAT('          niter :',i4,' res :',e20.10,' b :',e20.10)
+         !****
+         
+         !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+         
+         ! indicator of non-convergence or explosion
+         
+         IF( jn == nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2
+         IF( ncut == 999 ) GOTO 999
+         
+         
+         ! END of iterative loop
+         ! =====================
+         
+      END DO
+      
+      
+999   CONTINUE
+      
+      
+      !  2. Output in gcx
+      !  -----------------
+      
+      ! boundary conditions (est-ce necessaire? je ne crois pas!!!!)
+      
+#if defined key_dynspg_fsc
+# if defined key_mpp
+      ! Mpp: export boundary values to neighbouring processors
+      CALL lbc_lnk( gcx, 'S', 1. )
+# else
+      IF( nperio /= 0 ) THEN
+         CALL lbc_lnk( gcx, 'T', 1. )
+      ENDIF
+# endif
+#else
+# if defined key_mpp
+      ! Mpp: export boundary values to neighbouring processors
+      CALL lbc_lnk( gcx, 'G', 1. )
+# else
+      IF( nperio /= 0 ) THEN
+         CALL lbc_lnk( gcx, 'F', 1. )
+      ENDIF
+# endif
+#endif
+      
+   END SUBROUTINE sol_sor
+
+   !!=====================================================================
+END MODULE solsor
Index: /branches/nemo/NEMO/OPA_SRC/SOL/solver.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/SOL/solver.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/SOL/solver.F90	(revision 4)
@@ -0,0 +1,203 @@
+MODULE solver
+   !!======================================================================
+   !!                     ***  MODULE  solver  ***
+   !! Ocean solver :  initialization of ocean solver
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   solver_init: solver initialization
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE zdf_oce         ! ocean vertical physics variables
+   USE sol_oce         ! solver variables
+   USE solmat          ! ???
+   USE solisl          ! ???
+   USE obc_oce         ! Lateral open boundary condition
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE solver_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE solver_init  ***
+      !!                   
+      !! ** Purpose :   Initialization for the solver of the elliptic equation:
+      !!       * default option: barotropic stream function system
+      !!         and islands initialization (if l_isl=T)
+      !!       * key_dynspg_fsc = T : transport divergence system. No specific
+      !!         treatment of islands.
+      !!      
+      !! ** Method :
+      !!       - Compute the local depth of the water column at u- and v-point
+      !!      (key_dynspg_fsc = T) or its inverse (key_dynspg_rl = T).
+      !!      The local depth of the water column is computed by summing 
+      !!      the vertical scale factors. For its inverse, the thickness of
+      !!      the first model level is imposed as lower bound. The inverse of
+      !!      this depth is THEN taken and masked, so that the inverse of the
+      !!      local depth is zero when the local depth is zero.
+      !!       - Construct the matrix of the elliptic system by a call to
+      !!      solmat.F routine.
+      !!       - island (if l_isl=T)
+      !!            isl_dom: find islands from the bathymetry file
+      !!            isl_bsf: compute the island barotropic stream function
+      !!            isl_mat: compute the inverse island matrix
+      !!            set mbathy to the number of non-zero w-levels of a water
+      !!            column (the minimum value of mbathy is 2):
+      !!                  mbathy = min( mbathy, 1 ) + 1
+      !!
+      !! ** Action : - hur, hvr : masked inverse of the local depth at
+      !!                                u- and v-point. (key_dynspg_rl = T)
+      !!             - hu, hv   : masked local depth at u- and v- points
+      !!                                (key_dynspg_fsc = T)
+      !! References :
+      !!      Jensen, 1986: adv. phys. oceanogr. num. mod.,ed. o brien,87-110.
+      !!      Madec & Marti, 1990: internal rep. LODYC, 90/03., 29pp.
+      !!
+      !! History :
+      !!        !  90-10  (G. Madec)  Original code           
+      !!        !  93-02  (O. Marti)                         
+      !!        !  97-02  (G. Madec)  local depth inverse computation
+      !!        !  98-10  (G. Roullet, G. Madec)  free surface 
+      !!   9.0  !  03-07  (G. Madec)  free form, F90
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER :: ji, jj   ! dummy loop indices
+
+      NAMELIST/namsol/ nsolv, nmax, eps, sor, epsisl, nmisl, rnu
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'ini_sol : solver to compute the surface pressure gradient'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      ! open elliptic solver statistics file
+      CALL ctlopn( numsol, 'solver.stat', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   &
+                   1, numout, lwp, 1 )
+
+
+      ! 0. Define the solver parameters
+      !    ----------------------------
+      ! Namelist namsol : elliptic solver / islands / free surface
+      REWIND( numnam )
+      READ  ( numnam, namsol )
+
+#if defined key_feti
+      ! FETI algorithm, we force nsolv at 3
+      nsolv = 3
+#endif
+
+
+      ! 0. Parameter control and print
+      !    ---------------------------
+
+      ! Control print
+      IF(lwp) WRITE(numout,*) '          Namelist namsol : set solver parameters'
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '             type of elliptic solver        nsolv  = ', nsolv
+         WRITE(numout,*) '             maximum iterations for solver  nmax   = ', nmax
+         WRITE(numout,*) '             absolute precision of solver   eps    = ', eps
+         WRITE(numout,*) '             optimal coefficient of sor     sor    = ', sor
+         IF(l_isl) WRITE(numout,*) '             absolute precision stream fct  epsisl = ', epsisl
+         IF(l_isl) WRITE(numout,*) '             maximum pcg iterations island  nmisl  = ', nmisl
+         WRITE(numout,*) '             free surface parameter         rnu    = ', rnu
+         WRITE(numout,*)
+      ENDIF
+
+#if defined key_dynspg_fsc 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          *** free surface formulation'
+         IF( l_isl ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) ' key_islands inconsistent with key_dynspg_fsc'
+            nstop = nstop + 1
+         ENDIF
+#endif
+#if defined key_dynspg_rl
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          *** Rigid lid formulation'
+#endif
+#if defined key_dynspg_fsc && defined key_dynspg_rl
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          Chose between free surface or rigid-lid, not both'
+         nstop = nstop + 1
+#endif
+
+      SELECT CASE ( nsolv )
+
+      CASE ( 1 )                ! preconditioned conjugate gradient solver
+         IF(lwp) WRITE(numout,*) '          use a preconditioned conjugate gradient solver'
+
+      CASE ( 2 )                ! successive-over-relaxation solver
+         IF(lwp) WRITE(numout,*) '          use a successive-over-relaxation solver'
+
+      CASE ( 3 )                ! FETI solver
+         IF(lwp) WRITE(numout,*) '          use the FETI solver'
+#if ! defined key_mpp
+         IF(lwp) WRITE(numout,*) ' The FETI algorithm is used only with the key_mpp option'
+         nstop = nstop + 1
+#else
+         IF( jpnij == 1 ) THEN
+            IF(lwp) WRITE(numout,*) ' The FETI algorithm needs more than one processor'
+            nstop = nstop + 1
+         ENDIF
+#endif
+         
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for nsolv = ', nsolv
+         nstop = nstop + 1
+         
+      END SELECT
+
+
+      ! Construction of the elliptic system matrix
+      ! ------------------------------------------
+
+      CALL sol_mat
+
+
+      IF( l_isl ) THEN
+      
+         ! Islands in the domain
+         ! ---------------------
+
+         IF ( jpisl == 0 ) THEN
+             IF(lwp)WRITE(numout,cform_err)
+             IF(lwp)WRITE(numout,*) ' bad islands parameter jpisl =', jpisl
+             nstop = nstop + 1
+         ENDIF
+
+         ! open Island streamfunction statistic file
+         CALL ctlopn( numisp, 'islands.stat', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   &
+            &         1     , numout        , lwp      , 1                         )
+   
+         CALL isl_dom       ! Island identification
+
+         CALL isl_bsf       ! Island barotropic stream function
+
+         CALL isl_mat       ! Comput and invert the island matrix
+
+         ! mbathy set to the number of w-level (minimum value 2)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               mbathy(ji,jj) = MAX( 1, mbathy(ji,jj) ) + 1
+            END DO
+         END DO
+
+      ENDIF
+
+   END SUBROUTINE solver_init
+
+   !!======================================================================
+END MODULE solver
Index: /branches/nemo/NEMO/OPA_SRC/TRA/traadv_cen2.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 4)
@@ -0,0 +1,408 @@
+MODULE traadv_cen2
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_cen2  ***
+   !! Ocean active tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+ 
+   !!----------------------------------------------------------------------
+   !!   tra_adv_cen2 : update the tracer trend with the horizontal
+   !!                  and vertical advection trends using a 2nd order 
+   !!                  centered finite difference scheme
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trdtra_oce     ! ocean active tracer trends
+   USE flxrnf          !
+   USE trabbl          ! advective term in the BBL
+   USE ocfzpt           !
+   USE lib_mpp
+   USE lbclnk
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC tra_adv_cen2    ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined key_autotasking
+   !!----------------------------------------------------------------------
+   !!   'key_autotasking' :      2nd order centered scheme (k- and j-slabs)
+   !!----------------------------------------------------------------------
+#  include "traadv_cen2_atsk.h90"
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :             2nd order centered scheme (k-j-i loop)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE tra_adv_cen2( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_cen2  ***
+      !!                 
+      !! ** Purpose :   Compute the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations.
+      !!
+      !! ** Method  :   The advection is evaluated by a second order centered
+      !!      scheme using now fields (leap-frog scheme). In specific areas
+      !!      (vicinity of major river mouths, some straits, or where tn is
+      !!      is approaching the freezing point) it is mixed with an upstream
+      !!      scheme for stability reasons.
+      !!        Part 0 : compute the upstream / centered flag
+      !!                 (3D array, zind, defined at T-point (0<zind<1))
+      !!        Part I : horizontal advection
+      !!      * centered flux:
+      !!         * s-coordinate ('key_s_coord') or
+      !!         * z-coordinate with partial steps ('key_partial_steps'),
+      !!        the vertical scale factors e3. are inside the derivatives:
+      !!               zcenu = e2u*e3u  un  mi(tn)
+      !!               zcenv = e1v*e3v  vn  mj(tn)
+      !!         * z-coordinate (default key), e3t=e3u=e3v:
+      !!               zcenu = e2u  un  mi(tn)
+      !!               zcenv = e1v  vn  mj(tn)
+      !!      * upstream flux:
+      !!         * s-coordinate ('key_s_coord') or
+      !!         * z-coordinate with partial steps ('key_partial_steps')
+      !!               zupsu = e2u*e3u  un  (tb(i) or tb(i-1) ) [un>0 or <0]
+      !!               zupsv = e1v*e3v  vn  (tb(j) or tb(j-1) ) [vn>0 or <0]
+      !!         * z-coordinate (default key)
+      !!               zupsu = e2u*e3u  un  (tb(i) or tb(i-1) ) [un>0 or <0]
+      !!               zupsv = e1v*e3v  vn  (tb(j) or tb(j-1) ) [vn>0 or <0]
+      !!      * mixed upstream / centered horizontal advection scheme
+      !!               zcofi = max(zind(i+1), zind(i))
+      !!               zcofj = max(zind(j+1), zind(j))
+      !!               zwx = zcofi * zupsu + (1-zcofi) * zcenu
+      !!               zwy = zcofj * zupsv + (1-zcofj) * zcenv
+      !!      * horizontal advective trend (divergence of the fluxes)
+      !!         * s-coordinate ('key_s_coord') or
+      !!         * z-coordinate with partial steps ('key_partial_steps')
+      !!               zta = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] }
+      !!         * z-coordinate (default key), e3t=e3u=e3v:
+      !!               zta = 1/(e1t*e2t) { di-1[zwx] + dj-1[zwy] }
+      !!      * Add this trend now to the general trend of tracer (ta,sa):
+      !!              (ta,sa) = (ta,sa) + ( zta , zsa )
+      !!      * trend diagnostic ('key_trdtra'): the trend is saved
+      !!      for diagnostics. The trends saved is expressed as
+      !!      Uh.gradh(T), (save trend = zta + tn divn).
+      !!         In addition, the advective trend in the two horizontal direc-
+      !!      tion is also re-computed as Uh gradh(T). Indeed hadt+tn divn is
+      !!      equal to (in s-coordinates, and similarly in z-coord.):
+      !!         zta+tn*divn=1/(e1t*e2t*e3t) { mi-1( e2u*e3u  un  di[tn] )
+      !!                                      +mj-1( e1v*e3v  vn  mj[tn] )  }
+      !!         C A U T I O N : the trend saved is the centered trend only.
+      !!      It doesn't take into account the upstream part of the scheme.
+      !!
+      !!         Part II : vertical advection
+      !!      For temperature (idem for salinity) the advective trend is com-
+      !!      puted as follows :
+      !!            zta = 1/e3t dk+1[ zwz ]
+      !!      where the vertical advective flux, zwz, is given by :
+      !!            zwz = zcofk * zupst + (1-zcofk) * zcent
+      !!      with 
+      !!        zupsv = upstream flux = wn * (tb(k) or tb(k-1) ) [wn>0 or <0]
+      !!        zcenu = centered flux = wn * mk(tn)
+      !!         The surface boundary condition is : 
+      !!      rigid-lid (default option) : zero advective flux
+      !!      free-surf ("key_fresurf_cstvol") : wn(:,:,1) * tn(:,:,1)
+      !!         Add this trend now to the general trend of tracer (ta,sa):
+      !!            (ta,sa) = (ta,sa) + ( zta , zsa )
+      !!         Trend diagnostic ('key_trdtra'): the trend is saved for
+      !!      diagnostics. The trends saved is expressed as :
+      !!             save trend =  w.gradz(T) = zta - tn divn.
+      !!
+      !! ** Action : - update (ta,sa) with the now advective tracer trends
+      !!             - save the trends in (ttrdh,strdh) ('key_trdtra')
+      !!
+      !! History :
+      !!   8.2  !  01-08  (G. Madec, E. Durand)  trahad+trazad = traadv 
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce                , zwx => ua,  &  ! use ua as workspace
+         &                     zwy => va      ! use va as workspace
+#if defined key_trabbl_adv
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  &  ! temporary arrays
+         &         zun, zvn, zwn
+#else
+      USE oce                , zun => un,  &  ! When no bbl, zun == un
+         &                     zvn => vn,  &  ! When no bbl, zvn == vn
+         &                     zwn => wn      ! When no bbl, zwn == wn
+#endif
+
+ 
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+ 
+      !! * Local save
+      REAL(wp), DIMENSION(jpi,jpj), SAVE ::   &
+         zbtr2
+ 
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
+      REAL(wp) ::                           &
+         zbtr, zta, zsa, zfui, zfvj,        &  ! temporary scalars
+         zhw, ze3tr, zcofi, zcofj,          &  !    "         "
+         zupsut, zupsvt, zupsus, zupsvs,    &  !    "         "
+         zfp_ui, zfp_vj, zfm_ui, zfm_vj,    &  !    "         "
+         zcofk, zupst, zupss, zcent,        &  !    "         "
+         zcens, zfp_w, zfm_w,               &  !    "         "
+         zcenut, zcenvt, zcenus, zcenvs        !    "         "
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zwz, zww, zind                        ! temporary workspace arrays
+#if defined key_trdtra || defined key_trdmld
+      REAL(wp) ::                           &
+         ztai, ztaj, zsai, zsaj,            &  ! temporary scalars
+         zfui1, zfvj1                          !    "         "
+#endif
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   Vector optimization case'
+         IF(lwp) WRITE(numout,*)
+   
+         zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
+      ENDIF
+
+#if defined key_trabbl_adv
+
+      ! Advective bottom boundary layer 
+      ! -------------------------------
+      zun(:,:,:) = un (:,:,:) - u_bbl(:,:,:)
+      zvn(:,:,:) = vn (:,:,:) - v_bbl(:,:,:)
+      zwn(:,:,:) = wn (:,:,:) + w_bbl(:,:,:)
+#endif
+
+
+      ! Upstream / centered scheme indicator
+      ! ------------------------------------
+ 
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zind(ji,jj,jk) =  MAX ( upsrnfh(ji,jj) * upsrnfz(jk),     &  ! changing advection scheme near runoff
+                  &                    upsadv(ji,jj)                     &  ! in the vicinity of some straits
+#if defined key_ice_lim
+                  &                  , tmask(ji,jj,jk)                   &  ! half upstream tracer fluxes
+                  &                  * MAX( 0., SIGN( 1., fzptn(ji,jj)   &  ! if tn < ("freezing"+0.1 )
+                  &                                +0.1-tn(ji,jj,jk) ) ) &
+#endif
+                  &                  )
+            END DO
+         END DO
+      END DO
+
+
+      ! I. Horizontal advective fluxes
+      ! ------------------------------
+
+      ! Second order centered tracer flux at u and v-points
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               ! upstream indicator
+               zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
+               zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) )
+               ! volume fluxes * 1/2
+#if defined key_s_coord || defined key_partial_steps
+               zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
+               zfvj = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
+#else
+               zfui = 0.5 * e2u(ji,jj) * zun(ji,jj,jk)
+               zfvj = 0.5 * e1v(ji,jj) * zvn(ji,jj,jk)
+#endif
+               ! upstream scheme
+               zfp_ui = zfui + ABS( zfui )
+               zfp_vj = zfvj + ABS( zfvj )
+               zfm_ui = zfui - ABS( zfui )
+               zfm_vj = zfvj - ABS( zfvj )
+               zupsut = zfp_ui * tb(ji,jj,jk) + zfm_ui * tb(ji+1,jj  ,jk)
+               zupsvt = zfp_vj * tb(ji,jj,jk) + zfm_vj * tb(ji  ,jj+1,jk)
+               zupsus = zfp_ui * sb(ji,jj,jk) + zfm_ui * sb(ji+1,jj  ,jk)
+               zupsvs = zfp_vj * sb(ji,jj,jk) + zfm_vj * sb(ji  ,jj+1,jk)
+               ! centered scheme
+               zcenut = zfui * ( tn(ji,jj,jk) + tn(ji+1,jj  ,jk) )
+               zcenvt = zfvj * ( tn(ji,jj,jk) + tn(ji  ,jj+1,jk) )
+               zcenus = zfui * ( sn(ji,jj,jk) + sn(ji+1,jj  ,jk) )
+               zcenvs = zfvj * ( sn(ji,jj,jk) + sn(ji  ,jj+1,jk) )
+               ! mixed centered / upstream scheme
+               zwx(ji,jj,jk) = zcofi * zupsut + (1.-zcofi) * zcenut
+               zwy(ji,jj,jk) = zcofj * zupsvt + (1.-zcofj) * zcenvt
+               zww(ji,jj,jk) = zcofi * zupsus + (1.-zcofi) * zcenus
+               zwz(ji,jj,jk) = zcofj * zupsvs + (1.-zcofj) * zcenvs
+            END DO
+         END DO
+
+
+         ! 2. Tracer flux divergence at t-point added to the general trend
+         ! -------------------------
+
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_s_coord || defined key_partial_steps
+               zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk)
+#else
+               zbtr = zbtr2(ji,jj) 
+#endif
+               ! horizontal advective trends
+               zta = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
+                  &            + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
+               zsa = - zbtr * (  zww(ji,jj,jk) - zww(ji-1,jj  ,jk)   &
+                  &            + zwz(ji,jj,jk) - zwz(ji  ,jj-1,jk)  )
+               ! add it to the general tracer trends
+               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
+               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
+#if defined key_trdtra || defined key_trdmld
+               ! save the horizontal advective trend of tracer
+               ttrd(ji,jj,jk,1) = zta + tn(ji,jj,jk) * hdivn(ji,jj,jk)
+               strd(ji,jj,jk,1) = zsa + sn(ji,jj,jk) * hdivn(ji,jj,jk)
+               ! recompute the trends in i- and j-direction as Uh gradh(T)
+# if defined key_s_coord || defined key_partial_steps
+               zfui = 0.5 * e2u(ji  ,jj) * fse3u(ji,  jj,jk) * zun(ji,  jj,jk)
+               zfui1= 0.5 * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk)
+               zfvj = 0.5 * e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * zvn(ji,jj  ,jk)
+               zfvj1= 0.5 * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * zvn(ji,jj-1,jk)
+# else
+               zfui = 0.5 * e2u(ji  ,jj) * zun(ji,  jj,jk)
+               zfui1= 0.5 * e2u(ji-1,jj) * zun(ji-1,jj,jk)
+               zfvj = 0.5 * e1v(ji,jj  ) * zvn(ji,jj  ,jk)
+               zfvj1= 0.5 * e1v(ji,jj-1) * zvn(ji,jj-1,jk)
+# endif
+               ztai = - zbtr * ( zfui * ( tn(ji+1,jj  ,jk) - tn(ji,jj,jk) ) + zfui1 * ( tn(ji,jj,jk) - tn(ji-1,jj  ,jk) ) )
+               ztaj = - zbtr * ( zfvj * ( tn(ji  ,jj+1,jk) - tn(ji,jj,jk) ) + zfvj1 * ( tn(ji,jj,jk) - tn(ji  ,jj-1,jk) ) )
+               zsai = - zbtr * ( zfui * ( sn(ji+1,jj  ,jk) - sn(ji,jj,jk) ) + zfui1 * ( sn(ji,jj,jk) - sn(ji-1,jj  ,jk) ) )
+               zsaj = - zbtr * ( zfvj * ( sn(ji  ,jj+1,jk) - sn(ji,jj,jk) ) + zfvj1 * ( sn(ji,jj,jk) - sn(ji  ,jj-1,jk) ) )
+               ! save i- and j- advective trends computed as Uh gradh(T)
+               ttrdh(ji,jj,jk,1) = ztai
+               ttrdh(ji,jj,jk,2) = ztaj
+               strdh(ji,jj,jk,1) = zsai
+               strdh(ji,jj,jk,2) = zsaj
+#endif
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' had  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+#if defined key_diaptr
+      ! "zonal" mean advective heat and salt transport 
+      IF( MOD( kt, nf_ptr ) == 0 ) THEN
+# if defined key_s_coord || defined key_partial_steps
+         pht_adv(:,:) = prt_vj( zwy(:,:,:) )
+         pst_adv(:,:) = prt_vj( zwz(:,:,:) )
+# else
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk)
+                  zwz(ji,jj,jk) = zwz(ji,jj,jk) * fse3v(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         pht_adv(:,:) = prt_vj( zwy(:,:,:) )
+         pst_adv(:,:) = prt_vj( zwz(:,:,:) )
+# endif
+      ENDIF
+#endif
+
+
+      ! II. Vertical advection
+      ! ----------------------
+
+      ! Bottom value : flux set to zero
+      zwx(:,:,jpk) = 0.e0     ;    zwy(:,:,jpk) = 0.e0
+
+      ! Surface value
+#if defined key_dynspg_fsc
+      ! free surface-constant volume
+      zwx(:,:, 1 ) = zwn(:,:,1) * tn(:,:,1)
+      zwy(:,:, 1 ) = zwn(:,:,1) * sn(:,:,1)
+#else
+      ! rigid lid : flux set to zero
+      zwx(:,:, 1 ) = 0.e0    ;    zwy(:,:, 1 ) = 0.e0
+#endif
+
+      ! 1. Vertical advective fluxes
+      ! ----------------------------
+
+      ! Second order centered tracer flux at w-point
+
+      DO jk = 2, jpk
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! upstream indicator
+               zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) )
+               ! velocity * 1/2
+               zhw = 0.5 * zwn(ji,jj,jk)
+               ! upstream scheme
+               zfp_w = zhw + ABS( zhw )
+               zfm_w = zhw - ABS( zhw )
+               zupst = zfp_w * tb(ji,jj,jk) + zfm_w * tb(ji,jj,jk-1)
+               zupss = zfp_w * sb(ji,jj,jk) + zfm_w * sb(ji,jj,jk-1)
+               ! centered scheme
+               zcent = zhw * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) )
+               zcens = zhw * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) )
+               ! mixed centered / upstream scheme
+               zwx(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent
+               zwy(ji,jj,jk) = zcofk * zupss + (1.-zcofk) * zcens
+            END DO
+         END DO
+      END DO
+
+
+      ! 2. Tracer flux divergence at t-point added to the general trend
+      ! -------------------------
+  
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ze3tr = 1. / fse3t(ji,jj,jk)
+               ! vertical advective trends
+               zta = - ze3tr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
+               zsa = - ze3tr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) )
+               ! add it to the general tracer trends
+               ta(ji,jj,jk) =  ta(ji,jj,jk) + zta
+               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsa
+#if defined key_trdtra || defined key_trdmld
+               ! save the vertical advective trends computed as w gradz(T)
+               ttrd(ji,jj,jk,2) = zta - tn(ji,jj,jk) * hdivn(ji,jj,jk)
+               strd(ji,jj,jk,2) = zsa - sn(ji,jj,jk) * hdivn(ji,jj,jk)
+#endif
+            END DO
+         END DO
+      END DO
+
+      IF( l_ctl .AND. lwp ) THEN
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' zad  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl, ' centered2'
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+   END SUBROUTINE tra_adv_cen2
+
+#endif
+
+   !!======================================================================
+END MODULE traadv_cen2
Index: /branches/nemo/NEMO/OPA_SRC/TRA/traadv_cen2_atsk.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/traadv_cen2_atsk.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/traadv_cen2_atsk.h90	(revision 4)
@@ -0,0 +1,351 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  traadv_cen2_atsk.h90   ***
+   !!----------------------------------------------------------------------
+   !!   tra_adv_cen2 : update the tracer trend with the horizontal and
+   !!                  vertical advection trends using a seconder order
+   !!                  centered scheme. Auto-tasking case, k-slab for
+   !!                  hor. adv., j-slab for vert. adv.
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE tra_adv_cen2( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE tra_adv_cen2  ***
+      !!              
+      !! ** Purpose :   Compute the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations.
+      !!
+      !! ** Method  :   The advection is evaluated by a second order centered
+      !!      scheme using now fields (leap-frog scheme). In specific areas
+      !!      (vicinity of major river mouths, some straits, or where tn is
+      !!      approaching the freezing point) it is mixed with an upstream 
+      !!      scheme for stability reasons.
+      !!         Part 0 : compute the upstream / centered flag
+      !!                  (3D array, zind, defined at T-point (0<zind<1))
+      !!         Part I : horizontal advection
+      !!       * centered flux:
+      !!            * s-coordinate ('key_s_coord' defined) or
+      !!            * z-coordinate with partial steps ('key_partial_steps'),
+      !!         the vertical scale factors e3. are inside the derivatives:
+      !!               zcenu = e2u*e3u  un  mi(tn)
+      !!               zcenv = e1v*e3v  vn  mj(tn)
+      !!            * z-coordinate (default key), e3t=e3u=e3v:
+      !!               zcenu = e2u  un  mi(tn)
+      !!               zcenv = e1v  vn  mj(tn)
+      !!       * upstream flux:
+      !!            * s-coordinate ('key_s_coord' defined) or
+      !!            * z-coordinate with partial steps ('key_partial_steps')
+      !!               zupsu = e2u*e3u  un  (tb(i) or tb(i-1) ) [un>0 or <0]
+      !!               zupsv = e1v*e3v  vn  (tb(j) or tb(j-1) ) [vn>0 or <0]
+      !!            * z-coordinate (default key)
+      !!               zupsu = e2u*e3u  un  (tb(i) or tb(i-1) ) [un>0 or <0]
+      !!               zupsv = e1v*e3v  vn  (tb(j) or tb(j-1) ) [vn>0 or <0]
+      !!       * mixed upstream / centered horizontal advection scheme
+      !!               zcofi = max(zind(i+1), zind(i))
+      !!               zcofj = max(zind(j+1), zind(j))
+      !!               zwx = zcofi * zupsu + (1-zcofi) * zcenu
+      !!               zwy = zcofj * zupsv + (1-zcofj) * zcenv
+      !!       * horizontal advective trend (divergence of the fluxes)
+      !!            * s-coordinate ('key_s_coord' defined)
+      !!              or z-coordinate with partial steps ('key_partial_steps')
+      !!               zta = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] }
+      !!            * z-coordinate (default key), e3t=e3u=e3v:
+      !!               zta = 1/(e1t*e2t) { di-1[zwx] + dj-1[zwy] }
+      !!       * Add this trend now to the general trend of tracer (ta,sa):
+      !!              (ta,sa) = (ta,sa) + ( zta , zsa )
+      !!       * trend diagnostic ('key_trdtra' defined): the trend is
+      !!      saved for diagnostics. The trends saved is expressed as
+      !!      Uh.gradh(T), i.e.
+      !!                     save trend = zta + tn divn
+      !!         In addition, the advective trend in the two horizontal direc-
+      !!      tion is also re-computed as Uh gradh(T). Indeed hadt+tn divn is
+      !!      equal to (in s-coordinates, and similarly in z-coord.):
+      !!         zta+tn*divn=1/(e1t*e2t*e3t) { mi-1( e2u*e3u  un  di[tn] )
+      !!                                      +mj-1( e1v*e3v  vn  mj[tn] )  }
+      !!         C A U T I O N : the trend saved is the centered trend only.
+      !!      It doesn't take into account the upstream part of the scheme.
+      !!
+      !!         Part II : vertical advection
+      !!      For temperature (idem for salinity) the advective trend is com-
+      !!      puted as follows :
+      !!            zta = 1/e3t dk+1[ zwz ]
+      !!      where the vertical advective flux, zwz, is given by :
+      !!            zwz = zcofk * zupst + (1-zcofk) * zcent
+      !!      with 
+      !!        zupsv = upstream flux = wn * (tb(k) or tb(k-1) ) [wn>0 or <0]
+      !!        zcenu = centered flux = wn * mk(tn)
+      !!         The surface boundary condition is : 
+      !!      rigid-lid (key_dynspg_frd = T) : zero advective flux
+      !!      free-surf (key_dynspg_fsc = T) : wn(:,:,1) * tn(:,:,1)
+      !!         Add this trend now to the general trend of tracer (ta,sa):
+      !!            (ta,sa) = (ta,sa) + ( zta , zsa )
+      !!         Trend diagnostic ('key_trdtra' defined): the trend is
+      !!      saved for diagnostics. The trends saved is expressed as :
+      !!             save trend =  w.gradz(T) = zta - tn divn.
+      !!
+      !! ** Action :  - update (ta,sa) with the now advective tracer trends
+      !!              - save trends in (ttrdh,ttrd,strdhi,strd) ('key_trdtra')
+      !!
+      !! History :
+      !!   8.2  !  01-08  (G. Madec, E. Durand)  trahad+trazad = traadv 
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce              , zwx => ua,  &  ! use ua as workspace
+         &                   zwy => va      ! use va as workspace
+#if defined key_trabbl_adv
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  &  ! temporary arrays
+         &         zun, zvn, zwn
+#else
+      USE oce                , zun => un,  &  ! When no bbl, zun == un
+         &                     zvn => vn,  &  ! When no bbl, zvn == vn
+         &                     zwn => wn      ! When no bbl, zwn == wn
+#endif
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+
+      !! * Local save
+      REAL(wp), DIMENSION(jpi,jpj), SAVE ::   &
+         zbtr2
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk               ! dummy loop indices
+      REAL(wp) ::   zbtr, zta, zsa, zfui, zfvj
+      REAL(wp) ::   zhw, ze3tr
+      REAL(wp) ::   zcofi, zcofj, zupsut, zupsvt, zupsus, zupsvs,   &
+                               zfp_ui, zfp_vj, zfm_ui, zfm_vj
+      REAL(wp) ::   zcofk, zupst, zupss, zcent, zcens, zfp_w, zfm_w
+      REAL(wp) ::   zcenut, zcenvt, zcenus, zcenvs
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zwz, zww, zind                     ! workspace
+#if defined key_trdtra || defined key_trdmld
+      REAL(wp) ::   ztai, ztaj, zsai, zsaj
+      REAL(wp) ::   zfui1, zfvj1
+#endif
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~   Auto-tasking case'
+         IF(lwp) WRITE(numout,*)
+         
+         zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
+      ENDIF
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+#if defined key_trabbl_adv
+
+         ! Advective bottom boundary layer
+         ! -------------------------------
+         zun(:,:,jk) = un (:,:,jk) - u_bbl(:,:,jk)
+         zvn(:,:,jk) = vn (:,:,jk) - v_bbl(:,:,jk)
+         zwn(:,:,jk) = wn (:,:,jk) + w_bbl(:,:,jk)
+#endif
+
+
+         ! 0. Upstream / centered scheme indicator
+         ! ---------------------------------------
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zind(ji,jj,jk) =  MAX (              &
+                  upsrnfh(ji,jj) * upsrnfz(jk),     &  ! changing advection scheme near runoff
+                  upsadv(ji,jj)                     &  ! in the vicinity of some straits
+#if defined key_ice_lim
+                  , tmask(ji,jj,jk)                 &  ! half upstream tracer fluxes if tn < ("freezing"+0.1 )
+                  * MAX( 0., SIGN( 1., fzptn(ji,jj)+0.1-tn(ji,jj,jk) ) )   &
+#endif
+               )
+            END DO
+         END DO
+
+
+         ! I. Horizontal advective fluxes
+         ! ------------------------------
+         ! Second order centered tracer flux at u and v-points
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               ! upstream indicator
+               zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
+               zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) )
+               ! volume fluxes * 1/2
+#if defined key_s_coord || defined key_partial_steps
+               zfui = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
+               zfvj = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
+#else
+               zfui = 0.5 * e2u(ji,jj) * zun(ji,jj,jk)
+               zfvj = 0.5 * e1v(ji,jj) * zvn(ji,jj,jk)
+#endif
+               ! upstream scheme
+               zfp_ui = zfui + ABS( zfui )
+               zfp_vj = zfvj + ABS( zfvj )
+               zfm_ui = zfui - ABS( zfui )
+               zfm_vj = zfvj - ABS( zfvj )
+               zupsut = zfp_ui * tb(ji,jj,jk) + zfm_ui * tb(ji+1,jj  ,jk)
+               zupsvt = zfp_vj * tb(ji,jj,jk) + zfm_vj * tb(ji  ,jj+1,jk)
+               zupsus = zfp_ui * sb(ji,jj,jk) + zfm_ui * sb(ji+1,jj  ,jk)
+               zupsvs = zfp_vj * sb(ji,jj,jk) + zfm_vj * sb(ji  ,jj+1,jk)
+               ! centered scheme
+               zcenut = zfui * ( tn(ji,jj,jk) + tn(ji+1,jj  ,jk) )
+               zcenvt = zfvj * ( tn(ji,jj,jk) + tn(ji  ,jj+1,jk) )
+               zcenus = zfui * ( sn(ji,jj,jk) + sn(ji+1,jj  ,jk) )
+               zcenvs = zfvj * ( sn(ji,jj,jk) + sn(ji  ,jj+1,jk) )
+               ! mixed centered / upstream scheme
+               zwx(ji,jj,jk) = zcofi * zupsut + (1.-zcofi) * zcenut
+               zwy(ji,jj,jk) = zcofj * zupsvt + (1.-zcofj) * zcenvt
+               zww(ji,jj,jk) = zcofi * zupsus + (1.-zcofi) * zcenus
+               zwz(ji,jj,jk) = zcofj * zupsvs + (1.-zcofj) * zcenvs
+            END DO
+         END DO
+
+         ! 2. Tracer flux divergence at t-point added to the general trend
+         ! -------------------------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_s_coord || defined key_partial_steps
+               zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk)
+#else
+               zbtr = zbtr2(ji,jj) 
+#endif
+               ! horizontal advective trends
+               zta = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj,jk) + zwy(ji,jj,jk) - zwy(ji,jj-1,jk)  )
+               zsa = - zbtr * (  zww(ji,jj,jk) - zww(ji-1,jj,jk) + zwz(ji,jj,jk) - zwz(ji,jj-1,jk)  )
+               ! add it to the general tracer trends
+               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
+               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
+#if defined key_trdtra || defined key_trdmld
+               ! save the horizontal advective trend of tracer
+               ttrd(ji,jj,jk,1) = zta + tn(ji,jj,jk) * hdivn(ji,jj,jk)
+               strd(ji,jj,jk,1) = zsa + sn(ji,jj,jk) * hdivn(ji,jj,jk)
+               ! recompute the trends in i- and j-direction as Uh gradh(T)
+#   if defined key_s_coord || defined key_partial_steps
+               zfui = 0.5 * e2u(ji  ,jj) * fse3u(ji,  jj,jk) * zun(ji,  jj,jk)
+               zfui1= 0.5 * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zun(ji-1,jj,jk)
+               zfvj = 0.5 * e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * zvn(ji,jj  ,jk)
+               zfvj1= 0.5 * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * zvn(ji,jj-1,jk)
+#   else
+               zfui = 0.5 * e2u(ji  ,jj) * zun(ji,  jj,jk)
+               zfui1= 0.5 * e2u(ji-1,jj) * zun(ji-1,jj,jk)
+               zfvj = 0.5 * e1v(ji,jj  ) * zvn(ji,jj  ,jk)
+               zfvj1= 0.5 * e1v(ji,jj-1) * zvn(ji,jj-1,jk)
+#   endif
+               ztai = -zbtr * (  zfui * ( tn(ji+1,jj,jk) - tn(ji,jj,jk) ) + zfui1* ( tn(ji,jj,jk) - tn(ji-1,jj,jk) )  )
+               zsai = -zbtr * (  zfui * ( sn(ji+1,jj,jk) - sn(ji,jj,jk) ) + zfui1* ( sn(ji,jj,jk) - sn(ji-1,jj,jk) )  )
+               ztaj = -zbtr * (  zfvj * ( tn(ji,jj+1,jk) - tn(ji,jj,jk) ) + zfvj1* ( tn(ji,jj,jk) - tn(ji,jj-1,jk) )  )
+               zsaj = -zbtr * (  zfvj * ( sn(ji,jj+1,jk) - sn(ji,jj,jk) ) + zfvj1* ( sn(ji,jj,jk) - sn(ji,jj-1,jk) )  )
+               ! save i- and j- advective trends computed as Uh gradh(T)
+               ttrdh(ji,jj,jk,1) = ztai
+               ttrdh(ji,jj,jk,2) = ztaj
+               strdh(ji,jj,jk,1) = zsai
+               strdh(ji,jj,jk,2) = zsaj
+#endif
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' had  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+#if defined key_diaptr
+      ! "zonal" mean advective heat and salt transport
+      IF( MOD( kt, nf_ptr ) == 0 ) THEN
+# if defined key_s_coord || defined key_partial_steps
+         pht_adv(:,:) = prt_vj( zwy(:,:,:) )
+         pst_adv(:,:) = prt_vj( zwz(:,:,:) )
+# else
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                 zwy(ji,jj,jk) = zwy(ji,jj,jk) * fse3v(ji,jj,jk)
+                 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fse3v(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         pht_adv(:,:) = prt_vj( zwy(:,:,:) )
+         pst_adv(:,:) = prt_vj( zwz(:,:,:) )
+# endif
+      ENDIF
+#endif
+
+      ! II. Vertical advection
+      ! ----------------------
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+         ! Bottom value : flux and indicator set to zero
+         zwz (:,jj,jpk) = 0.e0     ;    zww(:,jj,jpk) = 0.e0
+         zind(:,jj,jpk) = 0.e0
+
+         ! Surface value
+#if defined key_dynspg_fsc
+         ! free surface-constant volume
+         zwz(:,jj, 1 ) = zwn(:,jj,1) * tn(:,jj,1)
+         zww(:,jj, 1 ) = zwn(:,jj,1) * sn(:,jj,1)
+#endif
+#if defined key_dynspg_rl
+         ! rigid lid : flux set to zero
+         zwz(:,jj, 1 ) = 0.e0    ;    zww(:,jj, 1 ) = 0.e0
+#endif
+         
+         ! 1. Vertical advective fluxes
+         ! ----------------------------
+         ! Second order centered tracer flux at w-point
+         DO jk = 2, jpk
+            DO ji = 2, jpim1
+               ! upstream indicator
+               zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) )
+               ! velocity * 1/2
+               zhw = 0.5 * zwn(ji,jj,jk)
+               ! upstream scheme
+               zfp_w = zhw + ABS( zhw )
+               zfm_w = zhw - ABS( zhw )
+               zupst = zfp_w * tb(ji,jj,jk) + zfm_w * tb(ji,jj,jk-1)
+               zupss = zfp_w * sb(ji,jj,jk) + zfm_w * sb(ji,jj,jk-1)
+               ! centered scheme
+               zcent = zhw * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) )
+               zcens = zhw * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) )
+               ! mixed centered / upstream scheme
+               zwz(ji,jj,jk) = zcofk * zupst + (1.-zcofk) * zcent
+               zww(ji,jj,jk) = zcofk * zupss + (1.-zcofk) * zcens
+            END DO
+         END DO
+
+         ! 2. Tracer flux divergence at t-point added to the general trend
+         ! -------------------------
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ze3tr = 1. / fse3t(ji,jj,jk)
+               ! vertical advective trends
+               zta = - ze3tr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )
+               zsa = - ze3tr * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) )
+               ! add it to the general tracer trends
+               ta(ji,jj,jk) =  ta(ji,jj,jk) + zta
+               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsa
+#if defined key_trdtra || defined key_trdmld
+               ! save the vertical advective trends computed as w gradz(T)
+               ttrd(ji,jj,jk,2) = zta - tn(ji,jj,jk) * hdivn(ji,jj,jk)
+               strd(ji,jj,jk,2) = zsa - sn(ji,jj,jk) * hdivn(ji,jj,jk)
+#endif
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' zad  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl, ' centered2 autotsk'
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+   END SUBROUTINE tra_adv_cen2
Index: /branches/nemo/NEMO/OPA_SRC/TRA/traadv_ctl.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/traadv_ctl.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/traadv_ctl.F90	(revision 4)
@@ -0,0 +1,110 @@
+MODULE traadv_ctl
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_ctl  ***
+   !! Ocean active tracers:  advection scheme control
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_ctl  : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC tra_adv_ctl     ! routine called by step module
+ 
+   !! * Share module variables
+   LOGICAL, PUBLIC ::   &
+      ln_traadv_cen2   = .TRUE.  ,   &  ! 2nd order centered scheme flag
+      ln_traadv_tvd    = .FALSE. ,   &  ! TVD scheme flag
+      ln_traadv_muscl  = .FALSE. ,   &  ! MUSCL scheme flag
+      ln_traadv_muscl2 = .FALSE.        ! MUSCL2 scheme flag
+
+   !! * Substitutions
+#   include "domzgr_substitute.h90"
+#   include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_adv_ctl
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_ctl  ***
+      !!                
+      !! ** Purpose :   Control the consistency between cpp options for 
+      !!      tracer advection schemes
+      !!
+      !! History :
+      !!   8.5  !  02-11  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE traadv_tvd
+      USE traadv_muscl
+      USE traadv_muscl2
+      USE in_out_manager  ! I/O manager
+
+      !! * Local declarations
+      INTEGER ::   ioptio
+
+      NAMELIST/nam_traadv/ ln_traadv_cen2 , ln_traadv_tvd,   &
+         &                 ln_traadv_muscl, ln_traadv_muscl2
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist nam_traadv : tracer advection scheme
+      ! -------------------------
+      REWIND ( numnam )
+      READ   ( numnam, nam_traadv )
+
+      ! Parameter control and print
+      ! ---------------------------
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_adv_ctl : choice/control of the tracer advection scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '          Namelist nam_tra_adv : chose a advection scheme for tracers'
+         WRITE(numout,*)
+         WRITE(numout,*) '             2nd order advection scheme     ln_traadv_cen2   = ', ln_traadv_cen2
+         WRITE(numout,*) '             TVD advection scheme           ln_traadv_tvd    = ', ln_traadv_tvd
+         WRITE(numout,*) '             MUSCL  advection scheme        ln_traadv_muscl  = ', ln_traadv_muscl
+         WRITE(numout,*) '             MUSCL2 advection scheme        ln_traadv_muscl2 = ', ln_traadv_muscl2
+      ENDIF
+
+      ! Control of Advection scheme options
+      ! -----------------------------------
+      ioptio = 0
+      IF( ln_traadv_cen2   )   ioptio = ioptio + 1
+      IF( ln_traadv_tvd    )   ioptio = ioptio + 1
+      IF( ln_traadv_muscl  )   ioptio = ioptio + 1
+      IF( ln_traadv_muscl2 )   ioptio = ioptio + 1
+
+      IF( lk_esopa ) THEN
+         IF(lwp) WRITE(numout,*) ' esopa control : the use of all scheme is forced'
+         ln_traadv_cen2   = .TRUE.
+         ln_traadv_tvd    = .TRUE.
+         ln_traadv_muscl  = .TRUE.
+         ln_traadv_muscl2 = .TRUE.
+      ELSEIF( ioptio > 1 .OR. ioptio == 0 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' Choose one advection scheme in namelist nam_traadv'
+         IF(lwp) WRITE(numout,*) '        ***                              ***********'
+         nstop = nstop + 1
+      ENDIF
+
+      IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '     cross-land advection only with 2nd order advection scheme'
+         nstop = nstop + 1
+      ENDIF
+
+   END SUBROUTINE tra_adv_ctl
+
+  !!======================================================================
+END MODULE traadv_ctl
Index: /branches/nemo/NEMO/OPA_SRC/TRA/traadv_muscl.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 4)
@@ -0,0 +1,424 @@
+MODULE traadv_muscl
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_muscl  ***
+   !! Ocean active tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_muscl : update the tracer trend with the horizontal
+   !!                   and vertical advection trends using MUSCL scheme
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trdtra_oce     ! ocean active tracer trends
+   USE in_out_manager  ! I/O manager
+   USE dynspg_fsc      ! surface pressure gradient 
+   USE dynspg_fsc_atsk ! autotasked surface pressure gradient
+   USE trabbl          ! tracers: bottom boundary layer
+   USE lib_mpp
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC tra_adv_muscl  ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_adv_muscl( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE tra_adv_muscl  ***
+      !!          
+      !! ** Purpose :   Compute the now trend due to total advection of T and 
+      !!      S using a MUSCL scheme (Monotone Upstream-centered Scheme for
+      !!      Conservation Laws) and add it to the general tracer trend.
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  : - update (ta,sa) with the now advective tracer trends
+      !!              - save trends in (ttrdh,ttrd,strdh,strd) ('key_trdtra')
+      !!
+      !! References :                
+      !!      Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
+      !!	IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
+      !!
+      !! History :
+      !!        !  06-00  (A.Estublier)  for passive tracers
+      !!        !  01-08  (E.Durand G.Madec)  adapted for T & S
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * modules used
+#if defined key_trabbl_adv
+      USE oce                , zun => ua,  &  ! use ua as workspace
+         &                     zvn => va      ! use va as workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwn
+#else
+      USE oce                , zun => un,  &  ! When no bbl, zun == un
+                               zvn => vn,  &  !              zvn == vn
+                               zwn => wn      !              zwn == wn
+#endif
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk               ! dummy loop indices
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   &
+         zt1, zt2, ztp1, ztp2,   &
+         zs1, zs2, zsp1, zsp2
+      REAL(wp) ::   zu, zv, zw, zeu, zev, zew, zbtr, zstep, zta, zsa
+      REAL(wp) ::   z0u, z0v, z0w
+      REAL(wp) ::   z1u, z1v, z1w
+      REAL(wp) ::   zzt1, zzt2, zalpha
+      REAL(wp) ::   zzs1, zzs2
+      REAL(wp) ::   z2
+#if defined key_trdtra || defined key_trdmld
+      REAL(wp) ::   ztai, ztaj, zsai, zsaj
+      REAL(wp) ::   zfui, zfvj
+#endif
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_adv : MUSCL advection scheme'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+          z2=1.
+      ELSE
+          z2=2.
+      ENDIF
+
+#if defined key_trabbl_adv
+
+      ! Advective bottom boundary layer
+      ! -------------------------------
+      zun(:,:,:) = un (:,:,:) - u_bbl(:,:,:)
+      zvn(:,:,:) = vn (:,:,:) - v_bbl(:,:,:)
+      zwn(:,:,:) = wn (:,:,:) + w_bbl( :,:,:)
+#endif
+
+
+      ! I. Horizontal advective fluxes
+      ! ------------------------------
+
+      ! first guess of the slopes
+      ! interior values
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1      
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zt1(ji,jj,jk) = umask(ji,jj,jk) * ( tb(ji+1,jj,jk) - tb(ji,jj,jk) )
+               zs1(ji,jj,jk) = umask(ji,jj,jk) * ( sb(ji+1,jj,jk) - sb(ji,jj,jk) )
+               zt2(ji,jj,jk) = vmask(ji,jj,jk) * ( tb(ji,jj+1,jk) - tb(ji,jj,jk) )
+               zs2(ji,jj,jk) = vmask(ji,jj,jk) * ( sb(ji,jj+1,jk) - sb(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      ! bottom values
+      zt1(:,:,jpk) = 0.e0    ;    zt2(:,:,jpk) = 0.e0
+      zs1(:,:,jpk) = 0.e0    ;    zs2(:,:,jpk) = 0.e0
+
+      ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign)
+      CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. )
+      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. )
+
+      ! Slopes
+      ! interior values
+      DO jk = 1, jpkm1
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               z0u = zt1(ji,jj,jk) * zt1(ji-1,jj,jk)
+               IF( z0u > 0. ) THEN
+                  ztp1(ji,jj,jk) = 0.5 * ( zt1(ji,jj,jk)+zt1(ji-1,jj,jk) )
+               ELSE
+                  ztp1(ji,jj,jk) = 0.e0
+               ENDIF
+               z1u = zs1(ji,jj,jk) * zs1(ji-1,jj,jk)
+               IF( z1u > 0. ) THEN
+                  zsp1(ji,jj,jk) = 0.5 * ( zs1(ji,jj,jk)+zs1(ji-1,jj,jk) )
+               ELSE
+                  zsp1(ji,jj,jk) = 0.e0
+               ENDIF
+
+               z0v = zt2(ji,jj,jk) * zt2(ji,jj-1,jk)
+               IF( z0v > 0. ) THEN
+                  ztp2(ji,jj,jk) = 0.5 * ( zt2(ji,jj,jk)+zt2(ji,jj-1,jk) )
+               ELSE
+                  ztp2(ji,jj,jk) = 0.e0
+               ENDIF
+               z1v = zs2(ji,jj,jk) * zs2(ji,jj-1,jk)
+               IF( z1v > 0. ) THEN
+                  zsp2(ji,jj,jk) = 0.5 * ( zs2(ji,jj,jk)+zs2(ji,jj-1,jk) )
+               ELSE
+                  zsp2(ji,jj,jk) = 0.e0
+               ENDIF
+            END DO
+         END DO
+      END DO
+      ! bottom values
+      ztp1(:,:,jpk) = 0.e0    ;    ztp2(:,:,jpk) = 0.e0
+      zsp1(:,:,jpk) = 0.e0    ;    zsp2(:,:,jpk) = 0.e0
+
+! Slopes limitation
+      DO jk = 1, jpkm1
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
+                  &           * MIN(    ABS( ztp1(ji  ,jj,jk) ),   &
+                  &                  2.*ABS( zt1 (ji-1,jj,jk) ),   &
+                  &                  2.*ABS( zt1 (ji  ,jj,jk) ) )
+               zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   &
+                  &           * MIN(    ABS( zsp1(ji  ,jj,jk) ),   &
+                  &                  2.*ABS( zs1 (ji-1,jj,jk) ),   &
+                  &                  2.*ABS( zs1 (ji  ,jj,jk) ) )
+               ztp2(ji,jj,jk) = SIGN( 1., ztp2(ji,jj,jk) )   &
+                  &           * MIN(    ABS( ztp2(ji,jj  ,jk) ),   &
+                  &                  2.*ABS( zt2 (ji,jj-1,jk) ),   &
+                  &                  2.*ABS( zt2 (ji,jj  ,jk) ) )
+               zsp2(ji,jj,jk) = SIGN( 1., zsp2(ji,jj,jk) )   &
+                  &           * MIN(    ABS( zsp2(ji,jj  ,jk) ),   &
+                  &                  2.*ABS( zs2 (ji,jj-1,jk) ),   &
+                  &                  2.*ABS( zs2 (ji,jj  ,jk) ) )
+            END DO
+         END DO
+      END DO        
+
+      ! Advection terms
+      ! interior values
+      DO jk = 1, jpkm1
+         zstep  = z2 * rdttra(jk)
+         DO jj = 2, jpjm1      
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! volume fluxes
+#if defined key_s_coord || defined key_partial_steps
+               zeu = e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
+               zev = e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
+#else
+               zeu = e2u(ji,jj) * zun(ji,jj,jk)
+               zev = e1v(ji,jj) * zvn(ji,jj,jk)
+#endif
+               ! MUSCL fluxes
+               z0u = SIGN( 0.5, zun(ji,jj,jk) )            
+               zalpha = 0.5 - z0u
+               zu  = z0u - 0.5 * zun(ji,jj,jk) * zstep / e1u(ji,jj)
+               zzt1 = tb(ji+1,jj,jk) + zu*ztp1(ji+1,jj,jk)
+               zzt2 = tb(ji  ,jj,jk) + zu*ztp1(ji  ,jj,jk)
+               zzs1 = sb(ji+1,jj,jk) + zu*zsp1(ji+1,jj,jk)
+               zzs2 = sb(ji  ,jj,jk) + zu*zsp1(ji  ,jj,jk)
+               zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
+               zs1(ji,jj,jk) = zeu * ( zalpha * zzs1 + (1.-zalpha) * zzs2 )
+
+               z0v = SIGN( 0.5, zvn(ji,jj,jk) )            
+               zalpha = 0.5 - z0v
+               zv  = z0v - 0.5 * zvn(ji,jj,jk) * zstep / e2v(ji,jj)
+               zzt1 = tb(ji,jj+1,jk) + zv*ztp2(ji,jj+1,jk)
+               zzt2 = tb(ji,jj  ,jk) + zv*ztp2(ji,jj  ,jk)
+               zzs1 = sb(ji,jj+1,jk) + zv*zsp2(ji,jj+1,jk)
+               zzs2 = sb(ji,jj  ,jk) + zv*zsp2(ji,jj  ,jk)
+               zt2(ji,jj,jk) = zev * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
+               zs2(ji,jj,jk) = zev * ( zalpha * zzs1 + (1.-zalpha) * zzs2 )
+            END DO
+         END DO
+      END DO
+
+      ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign)
+      CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. )  
+      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. )
+
+      ! Compute & add the horizontal advective trend
+
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1      
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_s_coord || defined key_partial_steps
+               zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+#else
+               zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
+#endif
+               ! horizontal advective trends
+               zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk  )   &
+                  &           + zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk  ) )
+               zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj  ,jk  )   &
+                  &           + zs2(ji,jj,jk) - zs2(ji  ,jj-1,jk  ) ) 
+               ! add it to the general tracer trends
+               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
+               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
+#if defined key_trdtra || defined key_trdmld
+               ! save the horizontal advective trend of tracer
+               ttrd(ji,jj,jk,1) = zta + tn(ji,jj,jk) * hdivn(ji,jj,jk)
+               strd(ji,jj,jk,1) = zsa + sn(ji,jj,jk) * hdivn(ji,jj,jk)
+               ! recompute the trends in i- and j-direction as Uh gradh(T)
+#   if defined key_s_coord || defined key_partial_steps
+               zfui =  e2u(ji  ,jj) * fse3u(ji,  jj,jk) * un(ji,  jj,jk)   &
+                  & -  e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)
+               zfvj =  e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vn(ji,jj  ,jk)   &
+                  & -  e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)
+#   else
+               zfui = e2u(ji  ,jj) * un(ji,  jj,jk)   &
+                  & - e2u(ji-1,jj) * un(ji-1,jj,jk)
+               zfvj = e1v(ji,jj  ) * vn(ji,jj  ,jk)   &
+                  & - e1v(ji,jj-1) * vn(ji,jj-1,jk)
+#   endif
+               ztai =-zbtr * (  zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk) + tn(ji,jj,jk) * zfui  )
+               ztaj =-zbtr * (  zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk) + tn(ji,jj,jk) * zfvj  )
+               zsai =-zbtr * (  zs1(ji,jj,jk) - zs1(ji-1,jj  ,jk) + sn(ji,jj,jk) * zfui  )
+               zsaj =-zbtr * (  zs2(ji,jj,jk) - zs2(ji  ,jj-1,jk) + sn(ji,jj,jk) * zfvj  )
+               ! save i- and j- advective trends computed as Uh gradh(T)
+               ttrdh(ji,jj,jk,1) = ztai
+               ttrdh(ji,jj,jk,2) = ztaj
+               strdh(ji,jj,jk,1) = zsai
+               strdh(ji,jj,jk,2) = zsaj
+#endif
+            END DO
+        END DO
+      END DO        
+
+#if defined key_diaptr 
+      ! "zonal" mean advective heat and salt transport 
+      IF( MOD( kt, nf_ptr ) == 0 ) THEN
+# if defined key_s_coord || defined key_partial_steps
+         pht_adv(:,:) = prt_vj( zt2(:,:,:) )
+         pst_adv(:,:) = prt_vj( zs2(:,:,:) )
+# else
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                 zt2(ji,jj,jk) = zt2(ji,jj,jk) * fse3v(ji,jj,jk)
+                 zs2(ji,jj,jk) = zs2(ji,jj,jk) * fse3v(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         pht_adv(:,:) = prt_vj( zt2(:,:,:) )
+         pst_adv(:,:) = prt_vj( zs2(:,:,:) )
+# endif
+      ENDIF
+#endif
+
+
+      ! II. Vertical advective fluxes
+      ! -----------------------------
+      
+      ! First guess of the slope
+      ! interior values
+      DO jk = 2, jpkm1
+         zt1(:,:,jk) = tmask(:,:,jk) * ( tb(:,:,jk-1) - tb(:,:,jk) )
+         zs1(:,:,jk) = tmask(:,:,jk) * ( sb(:,:,jk-1) - sb(:,:,jk) )
+      END DO
+      ! surface & bottom boundary conditions
+      zt1 (:,:, 1 ) = 0.e0    ;    zt1 (:,:,jpk) = 0.e0
+      zs1 (:,:, 1 ) = 0.e0    ;    zs1 (:,:,jpk) = 0.e0
+
+      ! Slopes
+      DO jk = 2, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               z0w = zt1(ji,jj,jk) * zt1(ji,jj,jk+1) 
+               IF( z0w > 0. ) THEN
+                  ztp1(ji,jj,jk) = 0.5 * ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) )
+               ELSE
+                  ztp1(ji,jj,jk) = 0.e0
+               ENDIF
+               z1w = zs1(ji,jj,jk) * zs1(ji,jj,jk+1) 
+               IF( z1w > 0. ) THEN
+                  zsp1(ji,jj,jk) = 0.5 * ( zs1(ji,jj,jk) + zs1(ji,jj,jk+1) )
+               ELSE
+                  zsp1(ji,jj,jk) = 0.e0
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Slopes limitation
+      ! interior values
+      DO jk = 2, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
+                  &           * MIN(    ABS( ztp1(ji,jj,jk  ) ),   &
+                  &                  2.*ABS( zt1 (ji,jj,jk+1) ),   &
+                  &                  2.*ABS( zt1 (ji,jj,jk  ) ) )
+               zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   &
+                  &           * MIN(    ABS( zsp1(ji,jj,jk  ) ),   &
+                  &                  2.*ABS( zs1 (ji,jj,jk+1) ),   &
+                  &                  2.*ABS( zs1 (ji,jj,jk  ) ) )
+            END DO
+         END DO
+      END DO
+      ! surface values
+      ztp1(:,:,1) = 0. 
+      zsp1(:,:,1) = 0.
+
+      ! vertical advective flux
+      ! interior values
+      DO jk = 1, jpkm1
+         zstep  = z2 * rdttra(jk)
+         DO jj = 2, jpjm1      
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zew = zwn(ji,jj,jk+1)
+               z0w = SIGN( 0.5, zwn(ji,jj,jk+1) )
+               zalpha = 0.5 + z0w
+               zw  = z0w - 0.5 * zwn(ji,jj,jk+1)*zstep / fse3w(ji,jj,jk+1)
+               zzt1 = tb(ji,jj,jk+1) + zw*ztp1(ji,jj,jk+1)
+               zzt2 = tb(ji,jj,jk  ) + zw*ztp1(ji,jj,jk  )
+               zzs1 = sb(ji,jj,jk+1) + zw*zsp1(ji,jj,jk+1)
+               zzs2 = sb(ji,jj,jk  ) + zw*zsp1(ji,jj,jk  )
+               zt1(ji,jj,jk+1) = zew * ( zalpha * zzt1 + (1.-zalpha)*zzt2 )
+               zs1(ji,jj,jk+1) = zew * ( zalpha * zzs1 + (1.-zalpha)*zzs2 )
+            END DO
+         END DO
+      END DO
+      ! surface values
+      IF( lk_dynspg_fsc .OR. lk_dynspg_fsc_tsk ) THEN   ! free surface-constant volume
+         zt1(:,:, 1 ) = zwn(:,:,1) * tb(:,:,1)
+         zs1(:,:, 1 ) = zwn(:,:,1) * sb(:,:,1)
+      ELSE                                  ! rigid lid : flux set to zero
+         zt1(:,:, 1 ) = 0.e0
+         zs1(:,:, 1 ) = 0.e0
+      ENDIF
+      ! bottom values
+      zt1(:,:,jpk) = 0.e0
+      zs1(:,:,jpk) = 0.e0
+
+
+      ! Compute & add the vertical advective trend
+
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1      
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbtr = 1. / fse3t(ji,jj,jk)
+               ! horizontal advective trends
+               zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) )
+               zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji,jj,jk+1) )
+               ! add it to the general tracer trends
+               ta(ji,jj,jk) =  ta(ji,jj,jk) + zta
+               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsa
+#if defined key_trdtra || defined key_trdmld
+               ! save the vertical advective trends computed as w gradz(T)
+               ttrd(ji,jj,jk,2) = zta - tn(ji,jj,jk) * hdivn(ji,jj,jk)
+               strd(ji,jj,jk,2) = zsa - sn(ji,jj,jk) * hdivn(ji,jj,jk)
+#endif
+            END DO
+         END DO
+      END DO
+
+      IF( l_ctl .AND. lwp ) THEN
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' zad  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl, ' muscl'
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+   END SUBROUTINE tra_adv_muscl
+
+   !!======================================================================
+END MODULE traadv_muscl
Index: /branches/nemo/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 4)
@@ -0,0 +1,497 @@
+MODULE traadv_muscl2
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_muscl2  ***
+   !! Ocean active tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_muscl2 : update the tracer trend with the horizontal
+   !!                    and vertical advection trends using MUSCL2 scheme
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trdtra_oce     ! ocean active tracer trends
+   USE in_out_manager  ! I/O manager
+   USE dynspg_fsc      ! surface pressure gradient 
+   USE dynspg_fsc_atsk ! autotasked surface pressure gradient 
+   USE trabbl          ! tracers: bottom boudary layer
+   USE lib_mpp
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC tra_adv_muscl2        ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_adv_muscl2( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_adv_muscl2  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to total advection of tempe-
+      !!      rature and salinity using a MUSCL scheme (Monotone Upstream-
+      !!      centered Scheme for Conservation Laws) and add it to the general
+      !!      tracer trend.
+      !!
+      !! ** Method : MUSCL scheme plus centered scheme at ocean boundaries
+      !!
+      !! ** Action : - update (ta,sa) with the now advective tracer trends
+      !!             - save trends in (ttrdh,strdh) ('key_trdtra')
+      !!
+      !! References :                
+      !!      Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
+      !!	IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
+      !!
+      !! History :
+      !!        !  06-00  (A.Estublier)  for passive tracers
+      !!        !  01-08  (E.Durand G.Madec)  adapted for T & S
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * modules used
+#if defined key_trabbl_adv
+      USE oce                , zun => ua,  &  ! use ua as workspace
+         &                     zvn => va      ! use va as workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwn
+#else
+      USE oce                , zun => un,  &  ! When no bbl, zun == un
+                               zvn => vn,  &  !              zvn == vn
+                               zwn => wn      !              zwn == wn
+#endif
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk               ! dummy loop indices
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   &
+         zt1, zt2, ztp1, ztp2,   &
+         zs1, zs2, zsp1, zsp2
+      REAL(wp) ::   zu, zv, zw, zeu, zev, zew, zbtr, zstep, zta, zsa
+      REAL(wp) ::   z0u, z0v, z0w
+      REAL(wp) ::   z1u, z1v, z1w
+      REAL(wp) ::   zzt1, zzt2, zalpha
+      REAL(wp) ::   zzs1, zzs2
+      REAL(wp) ::   z2
+#if defined key_trdtra || defined key_trdmld
+      REAL(wp) ::   ztai, ztaj, zsai, zsaj
+      REAL(wp) ::   zfui, zfvj
+#endif
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme'
+         WRITE(numout,*) '~~~~~~~~~~~~~~~'
+      ENDIF
+
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+          z2=1.
+      ELSE
+          z2=2.
+      ENDIF
+
+#if defined key_trabbl_adv
+
+      ! Advective bottom boundary layer
+      ! -------------------------------
+      zun(:,:,:) = un (:,:,:) - u_bbl(:,:,:)
+      zvn(:,:,:) = vn (:,:,:) - v_bbl(:,:,:)
+      zwn(:,:,:) = wn (:,:,:) + w_bbl( :,:,:)
+#endif
+
+
+      ! I. Horizontal advective fluxes
+      ! ------------------------------
+
+      ! first guess of the slopes
+      ! interior values
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1      
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zt1(ji,jj,jk) = umask(ji,jj,jk) * ( tb(ji+1,jj,jk) - tb(ji,jj,jk) )
+               zs1(ji,jj,jk) = umask(ji,jj,jk) * ( sb(ji+1,jj,jk) - sb(ji,jj,jk) )
+               zt2(ji,jj,jk) = vmask(ji,jj,jk) * ( tb(ji,jj+1,jk) - tb(ji,jj,jk) )
+               zs2(ji,jj,jk) = vmask(ji,jj,jk) * ( sb(ji,jj+1,jk) - sb(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      ! bottom values
+      zt1(:,:,jpk) = 0.e0    ;    zt2(:,:,jpk) = 0.e0
+      zs1(:,:,jpk) = 0.e0    ;    zs2(:,:,jpk) = 0.e0
+
+      ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign)
+      CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. )
+      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. )
+
+      ! Slopes
+      ! interior values
+      DO jk = 1, jpkm1
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               z0u = zt1(ji,jj,jk) * zt1(ji-1,jj,jk)
+               IF( z0u > 0. ) THEN
+                  ztp1(ji,jj,jk) = 0.5 * ( zt1(ji,jj,jk)+zt1(ji-1,jj,jk) )
+               ELSE
+                  ztp1(ji,jj,jk) = 0.e0
+               ENDIF
+               z1u = zs1(ji,jj,jk) * zs1(ji-1,jj,jk)
+               IF( z1u > 0. ) THEN
+                  zsp1(ji,jj,jk) = 0.5 * ( zs1(ji,jj,jk)+zs1(ji-1,jj,jk) )
+               ELSE
+                  zsp1(ji,jj,jk) = 0.e0
+               ENDIF
+
+               z0v = zt2(ji,jj,jk) * zt2(ji,jj-1,jk)
+               IF( z0v > 0. ) THEN
+                  ztp2(ji,jj,jk) = 0.5 * ( zt2(ji,jj,jk)+zt2(ji,jj-1,jk) )
+               ELSE
+                  ztp2(ji,jj,jk) = 0.e0
+               ENDIF
+               z1v = zs2(ji,jj,jk) * zs2(ji,jj-1,jk)
+               IF( z1v > 0. ) THEN
+                  zsp2(ji,jj,jk) = 0.5 * ( zs2(ji,jj,jk)+zs2(ji,jj-1,jk) )
+               ELSE
+                  zsp2(ji,jj,jk) = 0.e0
+               ENDIF
+            END DO
+         END DO
+      END DO
+      ! bottom values
+      ztp1(:,:,jpk) = 0.e0    ;    ztp2(:,:,jpk) = 0.e0
+      zsp1(:,:,jpk) = 0.e0    ;    zsp2(:,:,jpk) = 0.e0
+
+! Slopes limitation
+      DO jk = 1, jpkm1
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
+                  &           * MIN(    ABS( ztp1(ji  ,jj,jk) ),   &
+                  &                  2.*ABS( zt1 (ji-1,jj,jk) ),   &
+                  &                  2.*ABS( zt1 (ji  ,jj,jk) ) )
+               zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   &
+                  &           * MIN(    ABS( zsp1(ji  ,jj,jk) ),   &
+                  &                  2.*ABS( zs1 (ji-1,jj,jk) ),   &
+                  &                  2.*ABS( zs1 (ji  ,jj,jk) ) )
+               ztp2(ji,jj,jk) = SIGN( 1., ztp2(ji,jj,jk) )   &
+                  &           * MIN(    ABS( ztp2(ji,jj  ,jk) ),   &
+                  &                  2.*ABS( zt2 (ji,jj-1,jk) ),   &
+                  &                  2.*ABS( zt2 (ji,jj  ,jk) ) )
+               zsp2(ji,jj,jk) = SIGN( 1., zsp2(ji,jj,jk) )   &
+                  &           * MIN(    ABS( zsp2(ji,jj  ,jk) ),   &
+                  &                  2.*ABS( zs2 (ji,jj-1,jk) ),   &
+                  &                  2.*ABS( zs2 (ji,jj  ,jk) ) )
+            END DO
+         END DO
+      END DO        
+
+      ! Advection terms
+      ! interior values
+      DO jk = 1, jpkm1
+         zstep  = z2 * rdttra(jk)
+         DO jj = 2, jpjm1      
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! volume fluxes
+#if defined key_s_coord || defined key_partial_steps
+               zeu = e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
+               zev = e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
+#else
+               zeu = e2u(ji,jj) * zun(ji,jj,jk)
+               zev = e1v(ji,jj) * zvn(ji,jj,jk)
+#endif
+               ! MUSCL fluxes
+               z0u = SIGN( 0.5, zun(ji,jj,jk) )            
+               zalpha = 0.5 - z0u
+               zu  = z0u - 0.5 * zun(ji,jj,jk) * zstep / e1u(ji,jj)
+               zzt1 = tb(ji+1,jj,jk) + zu*ztp1(ji+1,jj,jk)
+               zzt2 = tb(ji  ,jj,jk) + zu*ztp1(ji  ,jj,jk)
+               zzs1 = sb(ji+1,jj,jk) + zu*zsp1(ji+1,jj,jk)
+               zzs2 = sb(ji  ,jj,jk) + zu*zsp1(ji  ,jj,jk)
+               zt1(ji,jj,jk) = zeu * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
+               zs1(ji,jj,jk) = zeu * ( zalpha * zzs1 + (1.-zalpha) * zzs2 )
+
+               z0v = SIGN( 0.5, zvn(ji,jj,jk) )            
+               zalpha = 0.5 - z0v
+               zv  = z0v - 0.5 * zvn(ji,jj,jk) * zstep / e2v(ji,jj)
+               zzt1 = tb(ji,jj+1,jk) + zv*ztp2(ji,jj+1,jk)
+               zzt2 = tb(ji,jj  ,jk) + zv*ztp2(ji,jj  ,jk)
+               zzs1 = sb(ji,jj+1,jk) + zv*zsp2(ji,jj+1,jk)
+               zzs2 = sb(ji,jj  ,jk) + zv*zsp2(ji,jj  ,jk)
+               zt2(ji,jj,jk) = zev * ( zalpha * zzt1 + (1.-zalpha) * zzt2 )
+               zs2(ji,jj,jk) = zev * ( zalpha * zzs1 + (1.-zalpha) * zzs2 )
+            END DO
+         END DO
+      END DO
+
+      !!!!  centered scheme at lateral b.C. if off-shore velocity
+      DO jk = 1, jpkm1
+        DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_s_coord || defined key_partial_steps
+               zev = e1v(ji,jj) * fse3v(ji,jj,jk)
+               IF( umask(ji,jj,jk) == 0. ) THEN
+                  IF( zun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
+                     zt1(ji+1,jj,jk) = e2u(ji+1,jj)* fse3u(ji+1,jj,jk)   &
+                        &            * zun(ji+1,jj,jk) * ( tb(ji+1,jj,jk) + tb(ji+2,jj,jk) ) * 0.5
+                     zs1(ji+1,jj,jk) = e2u(ji+1,jj)* fse3u(ji+1,jj,jk)   &
+                        &            * zun(ji+1,jj,jk) * ( sb(ji+1,jj,jk) + sb(ji+2,jj,jk) ) * 0.5
+                  ENDIF
+                  IF( zun(ji-1,jj,jk) < 0. ) THEN
+                     zt1(ji-1,jj,jk) = e2u(ji-1,jj)* fse3u(ji-1,jj,jk)   &
+                        &            * zun(ji-1,jj,jk) * ( tb(ji-1,jj,jk) + tb(ji  ,jj,jk) ) * 0.5
+                     zs1(ji-1,jj,jk) = e2u(ji-1,jj)* fse3u(ji-1,jj,jk)   &
+                        &            * zun(ji-1,jj,jk) * ( sb(ji-1,jj,jk) + sb(ji  ,jj,jk) ) * 0.5
+                  ENDIF
+               ENDIF
+               IF( vmask(ji,jj,jk) == 0. ) THEN
+                  IF( zvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
+                     zt2(ji,jj+1,jk) = e1v(ji,jj+1) * fse3v(ji,jj+1,jk)   &
+                        &            * zvn(ji,jj+1,jk) * ( tb(ji,jj+1,jk) + tb(ji,jj+2,jk) ) * 0.5
+                     zs2(ji,jj+1,jk) = e1v(ji,jj+1) * fse3v(ji,jj+1,jk)   &
+                        &            * zvn(ji,jj+1,jk) * ( sb(ji,jj+1,jk) + sb(ji,jj+2,jk) ) * 0.5
+                  ENDIF
+                  IF( zvn(ji,jj-1,jk) < 0. ) THEN
+                     zt2(ji,jj-1,jk) = e1v(ji,jj-1)* fse3v(ji,jj-1,jk)   &
+                        &            * zvn(ji,jj-1,jk) * ( tb(ji,jj-1,jk) + tb(ji  ,jj,jk) ) * 0.5
+                     zs2(ji,jj-1,jk) = e1v(ji,jj-1)* fse3v(ji,jj-1,jk)   &
+                        &            * zvn(ji,jj-1,jk) * ( sb(ji,jj-1,jk) + sb(ji  ,jj,jk) ) * 0.5
+                  ENDIF
+               ENDIF
+
+#else
+               IF( umask(ji,jj,jk) == 0. ) THEN
+                  IF( zun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
+                     zt1(ji+1,jj,jk) = e2u(ji+1,jj) * zun(ji+1,jj,jk) * ( tb(ji+1,jj,jk) + tb(ji+2,jj,jk) ) * 0.5
+                     zs1(ji+1,jj,jk) = e2u(ji+1,jj) * zun(ji+1,jj,jk) * ( sb(ji+1,jj,jk) + sb(ji+2,jj,jk) ) * 0.5
+                  ENDIF
+                  IF( zun(ji-1,jj,jk) < 0. ) THEN
+                     zt1(ji-1,jj,jk) = e2u(ji-1,jj) * zun(ji-1,jj,jk) * ( tb(ji-1,jj,jk) + tb(ji  ,jj,jk) ) * 0.5
+                     zs1(ji-1,jj,jk) = e2u(ji-1,jj) * zun(ji-1,jj,jk) * ( sb(ji-1,jj,jk) + sb(ji  ,jj,jk) ) * 0.5
+                  ENDIF
+               ENDIF
+               IF( vmask(ji,jj,jk) == 0. ) THEN
+                  IF( zvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
+                     zt2(ji,jj+1,jk) = e1v(ji,jj+1) * zvn(ji,jj+1,jk) * ( tb(ji,jj+1,jk) + tb(ji,jj+2,jk) ) * 0.5
+                     zs2(ji,jj+1,jk) = e1v(ji,jj+1) * zvn(ji,jj+1,jk) * ( sb(ji,jj+1,jk) + sb(ji,jj+2,jk) ) * 0.5
+                  ENDIF
+                  IF( zvn(ji,jj-1,jk) < 0. ) THEN
+                     zt2(ji,jj-1,jk) = e1v(ji,jj-1) * zvn(ji,jj-1,jk) * ( tb(ji,jj-1,jk) + tb(ji  ,jj,jk) ) * 0.5
+                     zs2(ji,jj-1,jk) = e1v(ji,jj-1) * zvn(ji,jj-1,jk) * ( sb(ji,jj-1,jk) + sb(ji  ,jj,jk) ) * 0.5
+                  ENDIF
+               ENDIF
+#endif
+            END DO
+         END DO
+      END DO
+
+      ! lateral boundary conditions on zt1, zt2 ; zs1, zs2   (changed sign)
+      CALL lbc_lnk( zt1, 'U', -1. )   ;   CALL lbc_lnk( zs1, 'U', -1. ) 
+      CALL lbc_lnk( zt2, 'V', -1. )   ;   CALL lbc_lnk( zs2, 'V', -1. )
+
+      ! Compute & add the horizontal advective trend
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1      
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_s_coord || defined key_partial_steps
+               zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+#else
+               zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
+#endif
+               ! horizontal advective trends
+               zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk  )   &
+                  &           + zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk  ) )
+               zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji-1,jj  ,jk  )   &
+                  &           + zs2(ji,jj,jk) - zs2(ji  ,jj-1,jk  ) ) 
+               ! add it to the general tracer trends
+               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
+               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
+#if defined key_trdtra || defined key_trdmld
+               ! save the horizontal advective trend of tracer
+               ttrd(ji,jj,jk,1) = zta + tn(ji,jj,jk) * hdivn(ji,jj,jk)
+               strd(ji,jj,jk,1) = zsa + sn(ji,jj,jk) * hdivn(ji,jj,jk)
+               ! recompute the trends in i- and j-direction as Uh gradh(T)
+#   if defined key_s_coord || defined key_partial_steps
+               zfui =  e2u(ji  ,jj) * fse3u(ji,  jj,jk) * un(ji,  jj,jk)   &
+                  & -  e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)
+               zfvj =  e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vn(ji,jj  ,jk)   &
+                  & -  e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)
+#   else
+               zfui = e2u(ji  ,jj) * un(ji,  jj,jk)   &
+                  & - e2u(ji-1,jj) * un(ji-1,jj,jk)
+               zfvj = e1v(ji,jj  ) * vn(ji,jj  ,jk)   &
+                  & - e1v(ji,jj-1) * vn(ji,jj-1,jk)
+#   endif
+               ztai =-zbtr * (  zt1(ji,jj,jk) - zt1(ji-1,jj  ,jk) + tn(ji,jj,jk) * zfui  )
+               ztaj =-zbtr * (  zt2(ji,jj,jk) - zt2(ji  ,jj-1,jk) + tn(ji,jj,jk) * zfvj  )
+               zsai =-zbtr * (  zs1(ji,jj,jk) - zs1(ji-1,jj  ,jk) + sn(ji,jj,jk) * zfui  )
+               zsaj =-zbtr * (  zs2(ji,jj,jk) - zs2(ji  ,jj-1,jk) + sn(ji,jj,jk) * zfvj  )
+               ! save i- and j- advective trends computed as Uh gradh(T)
+               ttrdh(ji,jj,jk,1) = ztai
+               ttrdh(ji,jj,jk,2) = ztaj
+               strdh(ji,jj,jk,1) = zsai
+               strdh(ji,jj,jk,2) = zsaj
+#endif
+            END DO
+        END DO
+      END DO        
+
+#if defined key_diaptr
+      ! "zonal" mean advective heat and salt transport
+      IF( MOD( kt, nf_ptr ) == 0 ) THEN
+# if defined key_s_coord || defined key_partial_steps
+         pht_adv(:,:) = prt_vj( zt2(:,:,:) )
+         pst_adv(:,:) = prt_vj( zs2(:,:,:) )
+# else
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                 zt2(ji,jj,jk) = zt2(ji,jj,jk) * fse3v(ji,jj,jk)
+                 zs2(ji,jj,jk) = zs2(ji,jj,jk) * fse3v(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         pht_adv(:,:) = prt_vj( zt2(:,:,:) )
+         pst_adv(:,:) = prt_vj( zs2(:,:,:) )
+# endif
+      ENDIF
+#endif
+
+      ! II. Vertical advective fluxes
+      ! -----------------------------
+      
+      ! First guess of the slope
+      ! interior values
+      DO jk = 2, jpkm1
+         zt1(:,:,jk) = tmask(:,:,jk) * ( tb(:,:,jk-1) - tb(:,:,jk) )
+         zs1(:,:,jk) = tmask(:,:,jk) * ( sb(:,:,jk-1) - sb(:,:,jk) )
+      END DO
+      ! surface & bottom boundary conditions
+      zt1 (:,:, 1 ) = 0.e0    ;    zt1 (:,:,jpk) = 0.e0
+      zs1 (:,:, 1 ) = 0.e0    ;    zs1 (:,:,jpk) = 0.e0
+
+      ! Slopes
+      DO jk = 2, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               z0w = zt1(ji,jj,jk) * zt1(ji,jj,jk+1) 
+               IF( z0w > 0. ) THEN
+                  ztp1(ji,jj,jk) = 0.5 * ( zt1(ji,jj,jk) + zt1(ji,jj,jk+1) )
+               ELSE
+                  ztp1(ji,jj,jk) = 0.e0
+               ENDIF
+               z1w = zs1(ji,jj,jk) * zs1(ji,jj,jk+1) 
+               IF( z1w > 0. ) THEN
+                  zsp1(ji,jj,jk) = 0.5 * ( zs1(ji,jj,jk) + zs1(ji,jj,jk+1) )
+               ELSE
+                  zsp1(ji,jj,jk) = 0.e0
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Slopes limitation
+      ! interior values
+      DO jk = 2, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztp1(ji,jj,jk) = SIGN( 1., ztp1(ji,jj,jk) )   &
+                  &           * MIN(    ABS( ztp1(ji,jj,jk  ) ),   &
+                  &                  2.*ABS( zt1 (ji,jj,jk+1) ),   &
+                  &                  2.*ABS( zt1 (ji,jj,jk  ) ) )
+               zsp1(ji,jj,jk) = SIGN( 1., zsp1(ji,jj,jk) )   &
+                  &           * MIN(    ABS( zsp1(ji,jj,jk  ) ),   &
+                  &                  2.*ABS( zs1 (ji,jj,jk+1) ),   &
+                  &                  2.*ABS( zs1 (ji,jj,jk  ) ) )
+            END DO
+         END DO
+      END DO
+      ! surface values
+      ztp1(:,:,1) = 0. 
+      zsp1(:,:,1) = 0.
+
+      ! vertical advective flux
+      ! interior values
+      DO jk = 1, jpkm1
+         zstep  = z2 * rdttra(jk)
+         DO jj = 2, jpjm1      
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zew = zwn(ji,jj,jk+1)
+               z0w = SIGN( 0.5, zwn(ji,jj,jk+1) )
+               zalpha = 0.5 + z0w
+               zw  = z0w - 0.5 * zwn(ji,jj,jk+1)*zstep / fse3w(ji,jj,jk+1)
+               zzt1 = tb(ji,jj,jk+1) + zw*ztp1(ji,jj,jk+1)
+               zzt2 = tb(ji,jj,jk  ) + zw*ztp1(ji,jj,jk  )
+               zzs1 = sb(ji,jj,jk+1) + zw*zsp1(ji,jj,jk+1)
+               zzs2 = sb(ji,jj,jk  ) + zw*zsp1(ji,jj,jk  )
+               zt1(ji,jj,jk+1) = zew * ( zalpha * zzt1 + (1.-zalpha)*zzt2 )
+               zs1(ji,jj,jk+1) = zew * ( zalpha * zzs1 + (1.-zalpha)*zzs2 )
+            END DO
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+        DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               IF( tmask(ji,jj,jk+1) == 0. ) THEN
+                  IF( zwn(ji,jj,jk) > 0. ) THEN
+                     zt1(ji,jj,jk) = zwn(ji,jj,jk) * ( tb(ji,jj,jk-1) + tb(ji,jj,jk) ) * 0.5
+                     zs1(ji,jj,jk) = zwn(ji,jj,jk) * ( sb(ji,jj,jk-1) + sb(ji,jj,jk) ) * 0.5
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! surface values
+      IF( lk_dynspg_fsc .OR. lk_dynspg_fsc_tsk ) THEN   ! free surface-constant volume
+         zt1(:,:, 1 ) = zwn(:,:,1) * tb(:,:,1)
+         zs1(:,:, 1 ) = zwn(:,:,1) * sb(:,:,1)
+      ELSE                                      ! rigid lid : flux set to zero
+         zt1(:,:, 1 ) = 0.e0
+         zs1(:,:, 1 ) = 0.e0
+      ENDIF
+
+      ! bottom values
+      zt1(:,:,jpk) = 0.e0
+      zs1(:,:,jpk) = 0.e0
+
+
+      ! Compute & add the vertical advective trend
+
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1      
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbtr = 1. / fse3t(ji,jj,jk)
+               ! horizontal advective trends
+               zta = - zbtr * ( zt1(ji,jj,jk) - zt1(ji,jj,jk+1) )
+               zsa = - zbtr * ( zs1(ji,jj,jk) - zs1(ji,jj,jk+1) )
+               ! add it to the general tracer trends
+               ta(ji,jj,jk) =  ta(ji,jj,jk) + zta
+               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsa
+#if defined key_trdtra || defined key_trdmld
+               ! save the vertical advective trends computed as w gradz(T)
+               ttrd(ji,jj,jk,2) = zta - tn(ji,jj,jk) * hdivn(ji,jj,jk)
+               strd(ji,jj,jk,2) = zsa - sn(ji,jj,jk) * hdivn(ji,jj,jk)
+#endif
+            END DO
+         END DO
+      END DO
+
+      IF( l_ctl .AND. lwp ) THEN
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' zad  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl, ' muscl2'
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+   END SUBROUTINE tra_adv_muscl2
+
+   !!======================================================================
+END MODULE traadv_muscl2
Index: /branches/nemo/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 4)
@@ -0,0 +1,459 @@
+MODULE traadv_tvd
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_tvd  ***
+   !! Ocean active tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_tvd  : update the tracer trend with the horizontal
+   !!                  and vertical advection trends using a TVD scheme
+   !!   nonosc       : compute monotonic tracer fluxes by a nonoscillatory
+   !!                  algorithm 
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trdtra_oce     ! ocean active tracer trends
+   USE in_out_manager  ! I/O manager
+   USE dynspg_fsc      ! surface pressure gradient 
+   USE dynspg_fsc_atsk ! autotasked surface pressure gradient
+   USE trabbl          ! Advective term of BBL
+   USE lib_mpp
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC tra_adv_tvd    ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_adv_tvd( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_tvd  ***
+      !! 
+      !! **  Purpose :   Compute the now trend due to total advection of 
+      !!       tracers and add it to the general trend of tracer equations
+      !!
+      !! **  Method  :   TVD scheme, i.e. 2nd order centered scheme with
+      !!       corrected flux (monotonic correction)
+      !!       note: - this advection scheme needs a leap-frog time scheme
+      !!
+      !! ** Action : - update (ta,sa) with the now advective tracer trends
+      !!             - save the trends in (ttrdh,strdh) ('key_trdtra')
+      !!
+      !! History :
+      !!        !  95-12  (L. Mortier)  Original code
+      !!        !  00-01  (H. Loukos)  adapted to ORCA 
+      !!        !  00-10  (MA Foujols E.Kestenare)  include file not routine
+      !!        !  00-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes
+      !!        !  01-07  (E. Durand G. Madec)  adaptation to ORCA config
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!   9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl
+      !!----------------------------------------------------------------------
+      !! * Modules used
+#if defined key_trabbl_adv
+      USE oce                , zun => ua,  &  ! use ua as workspace
+         &                     zvn => va      ! use va as workspace
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwn
+#else
+      USE oce                , zun => un,  &  ! When no bbl, zun == un
+                               zvn => vn,  &  !             zvn == vn
+                               zwn => wn      !             zwn == wn
+#endif
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk              ! dummy loop indices
+      REAL(wp) ::   zta, zsa                ! temporary scalar
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   &
+         zti, ztu, ztv, ztw,             &  ! temporary workspace
+         zsi, zsu, zsv, zsw                 !    "           "
+      REAL(wp) ::   &
+         z2dtt, zbtr, zeu, zev, zew, z2, &  ! temporary scalar
+         zfp_ui, zfp_vj, zfp_wk,         &  !    "         "
+         zfm_ui, zfm_vj, zfm_wk             !    "         "
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+         z2=1.
+      ELSE
+         z2=2.
+      ENDIF
+
+#if defined key_trabbl_adv
+
+      ! Advective Bottom boundary layer: add the velocity
+      ! -------------------------------------------------
+      zun(:,:,:) = un (:,:,:) - u_bbl(:,:,:)
+      zvn(:,:,:) = vn (:,:,:) - v_bbl(:,:,:)
+      zwn(:,:,:) = wn (:,:,:) + w_bbl(:,:,:)
+#endif
+
+      ! 1. Bottom value : flux set to zero
+      ! ---------------
+      ztu(:,:,jpk) = 0.e0   ;   zsu(:,:,jpk) = 0.e0
+      ztv(:,:,jpk) = 0.e0   ;   zsv(:,:,jpk) = 0.e0
+      ztw(:,:,jpk) = 0.e0   ;   zsw(:,:,jpk) = 0.e0
+      zti(:,:,jpk) = 0.e0   ;   zsi(:,:,jpk) = 0.e0
+
+
+      ! 2. upstream advection with initial mass fluxes & intermediate update
+      ! --------------------------------------------------------------------
+      ! upstream tracer flux in the i and j direction
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zeu = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
+               zev = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
+               ! upstream scheme
+               zfp_ui = zeu + ABS( zeu )
+               zfm_ui = zeu - ABS( zeu )
+               zfp_vj = zev + ABS( zev )
+               zfm_vj = zev - ABS( zev )
+               ztu(ji,jj,jk) = zfp_ui * tb(ji,jj,jk) + zfm_ui * tb(ji+1,jj  ,jk)
+               ztv(ji,jj,jk) = zfp_vj * tb(ji,jj,jk) + zfm_vj * tb(ji  ,jj+1,jk)
+               zsu(ji,jj,jk) = zfp_ui * sb(ji,jj,jk) + zfm_ui * sb(ji+1,jj  ,jk)
+               zsv(ji,jj,jk) = zfp_vj * sb(ji,jj,jk) + zfm_vj * sb(ji  ,jj+1,jk)
+            END DO
+         END DO
+      END DO
+
+      ! upstream tracer flux in the k direction
+      ! Surface value
+      IF( lk_dynspg_fsc .OR. lk_dynspg_fsc_tsk ) THEN   ! free surface-constant volume
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zew = e1t(ji,jj) * e2t(ji,jj) * zwn(ji,jj,1)
+               ztw(ji,jj,1) = zew * tb(ji,jj,1)
+               zsw(ji,jj,1) = zew * sb(ji,jj,1)
+            END DO
+         END DO
+      ELSE                                      ! rigid lid : flux set to zero
+         ztw(:,:,1) = 0.e0
+         zsw(:,:,1) = 0.e0
+      ENDIF
+
+      ! Interior value
+      DO jk = 2, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * zwn(ji,jj,jk)
+               zfp_wk = zew + ABS( zew )
+               zfm_wk = zew - ABS( zew )
+               ztw(ji,jj,jk) = zfp_wk * tb(ji,jj,jk) + zfm_wk * tb(ji,jj,jk-1)
+               zsw(ji,jj,jk) = zfp_wk * sb(ji,jj,jk) + zfm_wk * sb(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      ! total advective trend
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbtr = 1./ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               zti(ji,jj,jk) = - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  )   &
+                  &              + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )   &
+                  &              + ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr
+               zsi(ji,jj,jk) = - ( zsu(ji,jj,jk) - zsu(ji-1,jj  ,jk  )   &
+                  &              + zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  )   &
+                  &              + zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1) ) * zbtr
+            END DO
+         END DO
+      END DO
+      
+
+      ! update and guess with monotonic sheme
+      DO jk = 1, jpkm1
+         z2dtt = z2 * rdttra(jk)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ta(ji,jj,jk) =  ta(ji,jj,jk) + zti(ji,jj,jk)
+               sa(ji,jj,jk) =  sa(ji,jj,jk) + zsi(ji,jj,jk)
+               zti (ji,jj,jk) = ( tb(ji,jj,jk) + z2dtt * zti(ji,jj,jk) ) * tmask(ji,jj,jk)
+               zsi (ji,jj,jk) = ( sb(ji,jj,jk) + z2dtt * zsi(ji,jj,jk) ) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
+      CALL lbc_lnk( zti, 'T', 1. )
+      CALL lbc_lnk( zsi, 'T', 1. )
+
+
+      ! 3. antidiffusive flux : high order minus low order
+      ! --------------------------------------------------
+      ! antidiffusive flux on i and j
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zeu = 0.5 * e2u(ji,jj) * fse3u(ji,jj,jk) * zun(ji,jj,jk)
+               zev = 0.5 * e1v(ji,jj) * fse3v(ji,jj,jk) * zvn(ji,jj,jk)
+               ztu(ji,jj,jk) = zeu * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) - ztu(ji,jj,jk)
+               zsu(ji,jj,jk) = zeu * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) ) - zsu(ji,jj,jk)
+               ztv(ji,jj,jk) = zev * ( tn(ji,jj,jk) + tn(ji,jj+1,jk) ) - ztv(ji,jj,jk)
+               zsv(ji,jj,jk) = zev * ( sn(ji,jj,jk) + sn(ji,jj+1,jk) ) - zsv(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      
+      ! antidiffusive flux on k
+      ! Surface value
+      ztw(:,:,1) = 0.
+      zsw(:,:,1) = 0.
+
+      ! Interior value
+      DO jk = 2, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zew = 0.5 * e1t(ji,jj) * e2t(ji,jj) * zwn(ji,jj,jk)
+               ztw(ji,jj,jk) = zew * ( tn(ji,jj,jk) + tn(ji,jj,jk-1) ) - ztw(ji,jj,jk)
+               zsw(ji,jj,jk) = zew * ( sn(ji,jj,jk) + sn(ji,jj,jk-1) ) - zsw(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! Lateral bondary conditions
+      CALL lbc_lnk( ztu, 'U', -1. )   ;   CALL lbc_lnk( zsu, 'U', -1. )
+      CALL lbc_lnk( ztv, 'V', -1. )   ;   CALL lbc_lnk( zsv, 'V', -1. )
+      CALL lbc_lnk( ztw, 'W',  1. )   ;   CALL lbc_lnk( zsw, 'W',  1. )
+
+      ! 4. monotonicity algorithm
+      ! -------------------------
+      CALL nonosc( tb, ztu, ztv, ztw, zti, z2 )
+      CALL nonosc( sb, zsu, zsv, zsw, zsi, z2 )
+
+
+      ! 5. final trend with corrected fluxes
+      ! ------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               ta(ji,jj,jk) = ta(ji,jj,jk)   &
+                  &         - ( ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk  )   &
+                  &           + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk  )   &
+                  &           + ztw(ji,jj,jk) - ztw(ji  ,jj  ,jk+1) ) * zbtr
+               sa(ji,jj,jk) = sa(ji,jj,jk)   &
+                  &         - ( zsu(ji,jj,jk) - zsu(ji-1,jj  ,jk  )   &
+                  &           + zsv(ji,jj,jk) - zsv(ji  ,jj-1,jk  )   &
+                  &           + zsw(ji,jj,jk) - zsw(ji  ,jj  ,jk+1) ) * zbtr
+            END DO
+         END DO
+      END DO
+
+      IF( l_ctl .AND. lwp ) THEN
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' zad  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl, ' tvd'
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+#if defined key_diaptr
+      IF( MOD( kt, nf_ptr ) == 0 ) THEN
+         ! "zonal" mean advective heat and salt transport
+         pht_adv(:,:) = prt_vj( ztv(:,:,:) )
+         pst_adv(:,:) = prt_vj( zsv(:,:,:) )
+      ENDIF
+#endif
+
+   END SUBROUTINE tra_adv_tvd
+
+
+   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, prdt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE nonosc  ***
+      !!     
+      !! **  Purpose :   compute monotonic tracer fluxes from the upstream 
+      !!       scheme and the before field by a nonoscillatory algorithm 
+      !!
+      !! **  Method  :   ... ???
+      !!       warning : pbef and paft must be masked, but the boundaries
+      !!       conditions on the fluxes are not necessary zalezak (1979)
+      !!       drange (1995) multi-dimensional forward-in-time and upstream-
+      !!       in-space based differencing for fluid
+      !!
+      !! History :
+      !!        !  97-04  (L. Mortier) Original code
+      !!        !  00-02  (H. Loukos)  rewritting for opa8
+      !!        !  00-10  (M.A Foujols, E. Kestenare)  lateral b.c.
+      !!        !  01-03  (E. Kestenare)  add key_passivetrc
+      !!        !  01-07  (E. Durand G. Madec)  adapted for T & S
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), INTENT( in ) ::   &
+         prdt                               ! ???
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT( inout ) ::   &
+         pbef,                            & ! before field
+         paft,                            & ! after field
+         paa,                             & ! monotonic flux in the i direction
+         pbb,                             & ! monotonic flux in the j direction
+         pcc                                ! monotonic flux in the k direction
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk               ! dummy loop indices
+      INTEGER ::   ikm1
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zbetup, zbetdo
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt
+      !!----------------------------------------------------------------------
+
+      zbig = 1.e+40
+      zrtrn = 1.e-15
+
+      ! Search local extrema
+      ! --------------------
+      ! large negative value (-zbig) inside land
+      WHERE( tmask(:,:,:) == 0. )
+         pbef(:,:,:) = -zbig
+         paft(:,:,:) = -zbig
+      ENDWHERE 
+      ! search maximum in neighbourhood
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbetup(ji,jj,jk) = MAX(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
+                  &                     pbef(ji-1,jj  ,jk  ), pbef(ji+1,jj  ,jk  ),   &
+                  &                     paft(ji-1,jj  ,jk  ), paft(ji+1,jj  ,jk  ),   &
+                  &                     pbef(ji  ,jj-1,jk  ), pbef(ji  ,jj+1,jk  ),   &
+                  &                     paft(ji  ,jj-1,jk  ), paft(ji  ,jj+1,jk  ),   &
+                  &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
+                  &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
+            END DO
+         END DO
+      END DO
+      ! large positive value (+zbig) inside land
+      WHERE( tmask(:,:,:) == 0. )
+         pbef(:,:,:) = +zbig
+         paft(:,:,:) = +zbig
+      ENDWHERE
+      ! search minimum in neighbourhood
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbetdo(ji,jj,jk) = MIN(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
+                  &                     pbef(ji-1,jj  ,jk  ), pbef(ji+1,jj  ,jk  ),   &
+                  &                     paft(ji-1,jj  ,jk  ), paft(ji+1,jj  ,jk  ),   &
+                  &                     pbef(ji  ,jj-1,jk  ), pbef(ji  ,jj+1,jk  ),   &
+                  &                     paft(ji  ,jj-1,jk  ), paft(ji  ,jj+1,jk  ),   &
+                  &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
+                  &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
+            END DO
+         END DO
+      END DO
+
+      ! restore masked values to zero
+      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:)
+      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:)
+ 
+
+      ! 2. Positive and negative part of fluxes and beta terms
+      ! ------------------------------------------------------
+
+      DO jk = 1, jpkm1
+         z2dtt = prdt * rdttra(jk)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! positive & negative part of the flux
+               zpos = MAX( 0., paa(ji-1,jj  ,jk  ) ) - MIN( 0., paa(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj-1,jk  ) ) - MIN( 0., pbb(ji  ,jj  ,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk+1) ) - MIN( 0., pcc(ji  ,jj  ,jk  ) )
+               zneg = MAX( 0., paa(ji  ,jj  ,jk  ) ) - MIN( 0., paa(ji-1,jj  ,jk  ) )   &
+                  & + MAX( 0., pbb(ji  ,jj  ,jk  ) ) - MIN( 0., pbb(ji  ,jj-1,jk  ) )   &
+                  & + MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) )
+               ! up & down beta terms
+               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
+               zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt
+               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt
+            END DO
+         END DO
+      END DO
+
+      ! lateral boundary condition on zbetup & zbetdo   (unchanged sign)
+      CALL lbc_lnk( zbetup, 'T', 1. )
+      CALL lbc_lnk( zbetdo, 'T', 1. )
+
+
+      ! 3. monotonic flux in the i direction, i.e. paa
+      ! ----------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zc = paa(ji,jj,jk)
+               IF( zc >= 0. ) THEN
+                  za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+                  paa(ji,jj,jk) = za * zc
+               ELSE
+                  zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) )
+                  paa(ji,jj,jk) = zb * zc
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! lateral boundary condition on paa   (changed sign)
+      CALL lbc_lnk( paa, 'U', -1. )
+
+
+      ! 4. monotonic flux in the j direction, i.e. pbb
+      ! ----------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zc = pbb(ji,jj,jk)
+               IF( zc >= 0. ) THEN
+                  za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+                  pbb(ji,jj,jk) = za * zc
+               ELSE
+                  zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj+1,jk) )
+                  pbb(ji,jj,jk) = zb * zc
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! lateral boundary condition on pbb   (changed sign)
+      CALL lbc_lnk( pbb, 'V', -1. )
+
+
+      ! monotonic flux in the k direction, i.e. pcc
+      ! -------------------------------------------
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zc = pcc(ji,jj,jk)
+               IF( zc >= 0. ) THEN
+                  za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) )
+                  pcc(ji,jj,jk) = za * zc
+               ELSE
+                  zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) )
+                  pcc(ji,jj,jk) = zb * zc
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! lateral boundary condition on pcc   (unchanged sign)
+      CALL lbc_lnk( pcc, 'W', 1. )
+
+   END SUBROUTINE nonosc
+
+   !!======================================================================
+END MODULE traadv_tvd
Index: /branches/nemo/NEMO/OPA_SRC/TRA/trabbc.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 4)
@@ -0,0 +1,247 @@
+MODULE trabbc
+   !!==============================================================================
+   !!                       ***  MODULE  trabbc  ***
+   !! Ocean active tracers:  bottom boundary condition
+   !!==============================================================================
+#if defined key_trabbc
+   !!----------------------------------------------------------------------
+   !!   'key_trabbc'                                  geothermal heat flux
+   !!----------------------------------------------------------------------
+   !!   tra_bbc      : update the tracer trend at ocean bottom 
+   !!   tra_bbc_init : initialization of geothermal heat flux trend
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC tra_bbc          ! routine called by step.F90
+
+   !! to be transfert in the namelist ???!   
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .TRUE.   ! bbc flag
+
+   !! * Module variables
+   INTEGER ::                       & !!! ** bbc namelist (nambbc) **
+      ngeo_flux = 1                    ! Geothermal flux (0:no flux, 1:constant flux,
+      !                                !                  2:read in file )
+   REAL(wp) ::                      & !!! ** bbc namlist **
+      ngeo_flux_const = 86.4e-3        ! Constant value of geothermal heat flux
+
+   INTEGER, DIMENSION(jpi,jpj) ::   &
+      nbotlevt                         ! ocean bottom level index at T-pt
+   REAL(wp), DIMENSION(jpi,jpj) ::  &
+      qgh_trd                          ! geothermal heating trend
+ 
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_bbc( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbc  ***
+      !!
+      !! ** Purpose :   Compute the bottom boundary contition on temperature 
+      !!      associated with geothermal heating and add it to the general
+      !!      trend of temperature equations.
+      !!
+      !! ** Method  :   The geothermal heat flux set to its constant value of 
+      !!       86.4 mW/m2 (Stein and Stein 1992, Huang 1999).
+      !!       The temperature trend associated to this heat flux through the
+      !!       ocean bottom can be computed once and is added to the temperature
+      !!       trend juste above the bottom at each time step:
+      !!            ta = ta + Qsf / (rau0 rcp e3T) for k= mbathy -1
+      !!       Where Qsf is the geothermal heat flux.
+      !!
+      !! ** Action  : - update the temperature trends (ta) with the trend of
+      !!                the ocean bottom boundary condition
+      !!
+      !! References :
+      !!      Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129.
+      !!
+      !! History :
+      !!   8.1  !  99-10  (G. Madec)  original code
+      !!   8.5  !  02-08  (G. Madec)  free form + modules
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index
+
+      !! * Local declarations
+#if defined key_vectopt_loop   &&   ! defined key_autotasking
+      INTEGER ::   ji                  ! dummy loop indices
+#else
+      INTEGER ::   ji, jj              ! dummy loop indices
+#endif
+      REAL(wp) ::   zta                ! temporary scalar
+      !!----------------------------------------------------------------------
+
+      ! 0. Initialization
+      IF( kt == nit000 )   CALL tra_bbc_init
+
+      ! 1. Add the geothermal heat flux trend on temperature
+
+      SELECT CASE ( ngeo_flux )
+
+      CASE ( 1:2 )                !  geothermal heat flux
+
+#if defined key_vectopt_loop   &&   ! defined key_autotasking
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+            ta(ji,1,nbotlevt(ji,1)) = ta(ji,1,nbotlevt(ji,1)) + qgh_trd(ji,1)
+         END DO
+#else
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               ta(ji,jj,nbotlevt(ji,jj)) = ta(ji,jj,nbotlevt(ji,jj)) + qgh_trd(ji,jj)
+            END DO
+         END DO
+#endif
+      IF( l_ctl .AND. lwp ) THEN
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' bbc  - Ta: ', zta-t_ctl
+         t_ctl = zta
+      ENDIF
+
+      END SELECT
+
+   END SUBROUTINE tra_bbc
+
+
+   SUBROUTINE tra_bbc_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbc_init  ***
+      !!
+      !! ** Purpose :   Compute once for all the trend associated with geo-
+      !!      thermal heating that will be applied at each time step at the
+      !!      bottom ocean level
+      !!
+      !! ** Method  :   Read the nambbc namelist and check the parameters.
+      !!      called at the first time step (nit000)
+      !!
+      !! ** Input   : - Namlist nambbc
+      !!              - NetCDF file  : geothermal_heating.nc ( if necessary )
+      !!
+      !! ** Action  : - compute the heat geothermal trend qgh_trd
+      !!              - compute the bottom ocean level nbotlevt
+      !!
+      !! history :
+      !!  8.5  ! 02-11 (A. Bozec) original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * local declarations
+      CHARACTER (len=32) ::   clname
+      INTEGER  ::   ji, jj              ! dummy loop indices
+      INTEGER  ::   inum = 11           ! temporary logical unit
+      INTEGER  ::   itime               ! temporary integers
+      REAL(wp) ::   zdate0, zdt         ! temporary scalars
+      REAL(wp), DIMENSION(1) :: zdept   ! temporary workspace
+      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
+         zlamt, zphit, zdta   ! temporary workspace
+
+      NAMELIST/nambbc/ngeo_flux, ngeo_flux_const 
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist nambbc : bottom momentum boundary condition
+      REWIND ( numnam )
+      READ   ( numnam, nambbc )
+
+      ! Control print
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'tra_bbc : tempearture Bottom Boundary Condition (bbc)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~   Geothermal heatflux'
+      IF(lwp) WRITE(numout,*) '          Namelist nambbc : set bbc parameters'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '             Geothermal flux           ngeo_flux       = ', ngeo_flux
+      IF(lwp) WRITE(numout,*) '             Constant geothermal flux  ngeo_flux_const = ', ngeo_flux_const
+      IF(lwp) WRITE(numout,*)
+
+      ! level of the ocean bottom at T-point
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            nbotlevt(ji,jj) = MAX( mbathy(ji,jj)-1, 1 )
+         END DO
+      END DO
+
+      ! initialization of geothermal heat flux
+
+      SELECT CASE ( ngeo_flux )
+
+      CASE ( 0 )                ! no geothermal heat flux
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '             *** no geothermal heat flux'
+
+      CASE ( 1 )                ! constant flux
+         IF(lwp) WRITE(numout,*) '             *** constant heat flux  =   ', ngeo_flux_const
+         qgh_trd(:,:) = ngeo_flux_const
+
+      CASE ( 2 )                ! variable geothermal heat flux
+         ! read the geothermal fluxes in mW/m2
+         clname = 'geothermal_heating'
+         itime = 1
+         zlamt(:,:) = 0.
+         zphit(:,:) = 0.
+         IF(lwp) WRITE(numout,*) '             *** variable geothermal heat flux read in ', clname, ' file'
+         CALL restini( clname, jpidta, jpjdta, zlamt, zphit, 1, zdept , clname,   &
+                       itime, zdate0, zdt, inum )
+         CALL restget( inum, 'heatflow', jpidta, jpjdta, 1, 0, .FALSE., zdta )
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+              qgh_trd(ji,jj) = zdta(mig(ji),mjg(jj))
+            END DO
+         END DO
+
+         CALL restclo( inum )
+         qgh_trd(:,:) = qgh_trd(:,:) * 1.e-3 ! conversion in W/m2
+
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '     bad flag value for ngeo_flux = ', ngeo_flux
+         nstop = nstop + 1
+
+      END SELECT
+
+      ! geothermal heat flux trend
+
+      SELECT CASE ( ngeo_flux )
+
+      CASE ( 1:2 )                !  geothermal heat flux
+
+#if defined key_vectopt_loop   &&   ! defined key_autotasking
+         DO ji = 1, jpij   ! vector opt. (forced unrolling)
+            qgh_trd(ji,1) = ro0cpr * qgh_trd(ji,1) / fse3t(ji,1,nbotlevt(ji,1) )
+         END DO
+#else
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               qgh_trd(ji,jj) = ro0cpr * qgh_trd(ji,jj) / fse3t(ji,jj,nbotlevt(ji,jj))
+            END DO
+         END DO
+#endif
+
+      END SELECT
+
+   END SUBROUTINE tra_bbc_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .FALSE.  ! bbc flag
+CONTAINS
+   SUBROUTINE tra_bbc( kt )           ! Empty routine
+      WRITE(*,*) kt                      ! suppress a warning when compiling
+   END SUBROUTINE tra_bbc
+#endif
+
+   !!======================================================================
+END MODULE trabbc
Index: /branches/nemo/NEMO/OPA_SRC/TRA/trabbl.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 4)
@@ -0,0 +1,434 @@
+MODULE trabbl
+   !!==============================================================================
+   !!                       ***  MODULE  trabbl  ***
+   !! Ocean physics :  advective and/or diffusive bottom boundary layer scheme
+   !!==============================================================================
+#if   defined key_trabbl_dif   ||   defined key_trabbl_adv   || defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trabbl_dif'   or            diffusive bottom boundary layer
+   !!   'key_trabbl_adv'                 advective bottom boundary layer
+   !!----------------------------------------------------------------------
+   !!   tra_bbl_dif  : update the active tracer trends due to the bottom
+   !!                  boundary layer (diffusive only)
+   !!   tra_bbl_adv  : update the active tracer trends due to the bottom
+   !!                  boundary layer (advective and/or diffusive)
+   !!   tra_bbl_init : initialization, namlist read, parameters control
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trdtra_oce     ! ocean active tracer trends
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_bbl_dif    ! routine called by step.F90
+   PUBLIC tra_bbl_adv    ! routine called by step.F90
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   &
+      lk_trabbl_dif = .TRUE.   ! diffusive bottom boundary layer flag
+# if defined key_trabbl_adv
+   LOGICAL, PUBLIC, PARAMETER ::    &
+      lk_trabbl_adv = .TRUE.   ! bottom boundary layer flag
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &
+       w_bbl,      &  ! vertical increment of velocity due to advective BBL
+       !              ! only affect tracer vertical advection
+       u_bbl, v_bbl   ! velocity involved in exhanges in the advective BBL
+# else
+   LOGICAL, PUBLIC, PARAMETER ::    &
+      lk_trabbl_adv = .FALSE.  ! advective bottom boundary layer flag
+# endif
+
+   !! * Module variables
+   INTEGER, DIMENSION(jpi,jpj) ::   &
+      mbkt, mbku, mbkv                 ! ???
+   REAL(wp) ::        &  !!! * bbl namelist *
+      atrbbl = 1.e+3      ! lateral coeff. for bottom boundary layer scheme (m2/s)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_bbl_dif( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_bbl_dif  ***
+      !!
+      !! ** Purpose :   Compute the before tracer (t & s) trend associated 
+      !!      with the bottom boundary layer and add it to the general trend 
+      !!      of tracer equations. The bottom boundary layer is supposed to be
+      !!      a purely diffusive bottom boundary layer.
+      !!
+      !! ** Method  :   When the product grad( rho) * grad(h) < 0 (where grad 
+      !!      is an along bottom slope gradient) an additional lateral diffu-
+      !!      sive trend along the bottom slope is added to the general tracer
+      !!      trend, otherwise nothing is done.
+      !!      Second order operator (laplacian type) with variable coefficient
+      !!      computed as follow for temperature (idem on s): 
+      !!         difft = 1/(e1t*e2t*e3t) { di-1[ ahbt e2u*e3u/e1u di[ztb] ]
+      !!                                 + dj-1[ ahbt e1v*e3v/e2v dj[ztb] ] }
+      !!      where ztb is a 2D array: the bottom ocean temperature and ahtb
+      !!      is a time and space varying diffusive coefficient defined by:
+      !!         ahbt = zahbp    if grad(rho).grad(h) < 0
+      !!              = 0.       otherwise.
+      !!      Note that grad(.) is the along bottom slope gradient. grad(rho)
+      !!      is evaluated using the local density (i.e. referenced at the
+      !!      local depth). Typical value of ahbt is 2000 m2/s (equivalent to
+      !!      a downslope velocity of 20 cm/s if the condition for slope
+      !!      convection is satified)
+      !!      Add this before trend to the general trend (ta,sa) of the 
+      !!      botton ocean tracer point:
+      !!         ta = ta + difft
+      !!
+      !! ** Action  : - update (ta,sa) at the bottom level with the bottom
+      !!                boundary layer trend
+      !!              - save the trends in bbltrd ('key_diatrends')
+      !!
+      !! References :
+      !!     Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!
+      !! History :
+      !!   8.0  !  96-06  (L. Mortier)  Original code
+      !!   8.0  !  97-11  (G. Madec)  Optimization
+      !!   8.5  !  02-08  (G. Madec)  free form + modules
+      !!----------------------------------------------------------------------
+      !! * Arguments 
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+      !! * Local declarations
+      INTEGER ::   ji, jj                   ! dummy loop indices
+      INTEGER ::   ik
+#  if defined key_partial_steps
+      INTEGER  ::   iku1, iku2, ikv1,ikv2   ! temporary intergers
+      REAL(wp) ::   ze3u, ze3v              ! temporary scalars
+#  else
+      INTEGER ::   iku, ikv
+#  endif
+      REAL(wp) ::   &
+         zsign, zt, zs, zh, zalbet,      &  ! temporary scalars
+         zgdrho, zbtr, zta, zsa
+      REAL(wp), DIMENSION(jpi,jpj) ::    &
+        zki, zkj, zkw, zkx, zky, zkz,    &  ! temporary workspace arrays
+        ztnb, zsnb, zdep,                &
+        ztbb, zsbb, zahu, zahv
+      REAL(wp) ::   &
+         fsalbt, pft, pfs, pfh              ! statement function
+      !!----------------------------------------------------------------------
+      ! ratio alpha/beta
+      ! ================
+      !  fsalbt: ratio of thermal over saline expension coefficients
+      !       pft :  potential temperature in degrees celcius
+      !       pfs :  salinity anomaly (s-35) in psu
+      !       pfh :  depth in meters
+
+      fsalbt( pft, pfs, pfh ) =                                              &
+         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
+                                   - 0.203814e-03 ) * pft                    &
+                                   + 0.170907e-01 ) * pft                    &
+                                   + 0.665157e-01                            &
+         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
+         +  ( ( - 0.302285e-13 * pfh                                         &
+                - 0.251520e-11 * pfs                                         &
+                + 0.512857e-12 * pft * pft          ) * pfh                  &
+                                     - 0.164759e-06   * pfs                  &
+             +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
+                                     + 0.380374e-04 ) * pfh   
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 )   CALL tra_bbl_init
+
+      ! 0. 2D fields of bottom temperature and salinity, and bottom slope
+      ! -----------------------------------------------------------------
+      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F)
+
+#  if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij   ! vector opt. (forced unrolling)
+#  else
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+#  endif
+            ik = mbkt(ji,jj)                              ! index of the bottom ocean T-level
+            ztnb(ji,jj) = tn(ji,jj,ik) * tmask(ji,jj,1)   ! masked now T and S at ocean bottom 
+            zsnb(ji,jj) = sn(ji,jj,ik) * tmask(ji,jj,1)
+            ztbb(ji,jj) = tb(ji,jj,ik) * tmask(ji,jj,1)   ! masked before T and S at ocean bottom 
+            zsbb(ji,jj) = sb(ji,jj,ik) * tmask(ji,jj,1)
+            zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level
+#  if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+#  endif
+      END DO
+
+#  if defined key_partial_steps
+      ! partial steps correction 
+#   if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+#   else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+#   endif
+            iku1 = MAX( mbathy(ji+1,jj  )-1, 1 )
+            iku2 = MAX( mbathy(ji  ,jj  )-1, 1 )
+            ikv1 = MAX( mbathy(ji  ,jj+1)-1, 1 )
+            ikv2 = MAX( mbathy(ji  ,jj  )-1, 1 )
+            ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) ) 
+            ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) ) 
+            zahu(ji,jj) = atrbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1)
+            zahv(ji,jj) = atrbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1)
+#   if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+#   endif
+      END DO
+#  else
+#   if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+#   else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+#   endif
+            iku = mbku(ji,jj)
+            ikv = mbkv(ji,jj)
+            zahu(ji,jj) = atrbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1)
+            zahv(ji,jj) = atrbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1)
+#   if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+#   endif
+      END DO
+#  endif
+
+      ! 1. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0
+      ! --------------------------------------------
+      ! Sign of the local density gradient along the i- and j-slopes
+      ! multiplied by the slope of the ocean bottom
+
+#  if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+#  else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+#  endif
+            ! temperature, salinity anomalie and depth
+            zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
+            zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0
+            zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+            ! masked ratio alpha/beta
+            zalbet = fsalbt( zt, zs, zh )*umask(ji,jj,1)
+            ! local density gradient along i-bathymetric slope
+            zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   &
+                   -          ( zsnb(ji+1,jj) - zsnb(ji,jj) )
+            ! sign of local i-gradient of density multiplied by the i-slope
+            zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
+            zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj)
+#  if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+#  endif
+      END DO
+
+#  if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+#  else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+#  endif
+            ! temperature, salinity anomalie and depth
+            zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) )
+            zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0
+            zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
+            ! masked ratio alpha/beta
+            zalbet = fsalbt( zt, zs, zh )*vmask(ji,jj,1)
+            ! local density gradient along j-bathymetric slope
+            zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   &
+                   -          ( zsnb(ji,jj+1) - zsnb(ji,jj) )
+            ! sign of local j-gradient of density multiplied by the j-slope
+            zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
+            zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj)
+#  if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+#  endif
+      END DO
+
+
+      ! 2. Additional second order diffusive trends
+      ! -------------------------------------------
+
+      ! first derivative (gradient)
+#  if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+#  else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+#  endif
+            zkx(ji,jj) = zki(ji,jj) * ( ztbb(ji+1,jj) - ztbb(ji,jj) )
+            zkz(ji,jj) = zki(ji,jj) * ( zsbb(ji+1,jj) - zsbb(ji,jj) )
+
+            zky(ji,jj) = zkj(ji,jj) * ( ztbb(ji,jj+1) - ztbb(ji,jj) )
+            zkw(ji,jj) = zkj(ji,jj) * ( zsbb(ji,jj+1) - zsbb(ji,jj) )
+#  if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+#  endif
+      END DO
+
+      IF( cp_cfg == "orca" ) THEN
+
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration
+            !                                        ! =======================
+            ! Gibraltar enhancement of BBL
+            zkx( mi0(139):mi1(140) , mj0(102):mj1(102) ) = 4.e0 * zkx( mi0(139):mi1(140) , mj0(102):mj1(102) )
+            zky( mi0(139):mi1(140) , mj0(102):mj1(102) ) = 4.e0 * zky( mi0(139):mi1(140) , mj0(102):mj1(102) )
+
+            ! Red Sea enhancement of BBL
+            zkx( mi0(161):mi1(162) , mj0(88):mj1(88) ) = 10.e0 * zkx( mi0(161):mi1(162) , mj0(88):mj1(88) )
+            zky( mi0(161):mi1(162) , mj0(88):mj1(88) ) = 10.e0 * zky( mi0(161):mi1(162) , mj0(88):mj1(88) )
+
+            !                                        ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration
+            !                                        ! =======================
+            ! Gibraltar enhancement of BBL
+            zkx( mi0(70):mi1(71) , mj0(52):mj1(52) ) = 4.e0 * zkx( mi0(70):mi1(71) , mj0(52):mj1(52) )
+            zky( mi0(70):mi1(71) , mj0(52):mj1(52) ) = 4.e0 * zky( mi0(70):mi1(71) , mj0(52):mj1(52) )
+
+         END SELECT
+
+      ENDIF
+
+
+      ! second derivative (divergence) and add to the general tracer trend
+#  if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+#  else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+#  endif
+            ik = max( mbathy(ji,jj)-1, 1 )
+            zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik) )
+            zta = (  zkx(ji,jj) - zkx(ji-1,jj  )    &
+                   + zky(ji,jj) - zky(ji  ,jj-1)  ) * zbtr
+            zsa = (  zkz(ji,jj) - zkz(ji-1,jj  )    &
+                   + zkw(ji,jj) - zkw(ji  ,jj-1)  ) * zbtr
+            ta(ji,jj,ik) = ta(ji,jj,ik) + zta
+            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa
+#  if defined key_trdtra || defined key_trdmld
+            bbltrd(ji,jj,1) = + zta
+            bbltrd(ji,jj,2) = + zsa
+#  endif
+#  if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+#  endif
+      END DO
+
+      IF( l_ctl .AND. lwp ) THEN
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' bbl  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+   END SUBROUTINE tra_bbl_dif
+
+# if defined key_trabbl_adv
+   !!----------------------------------------------------------------------
+   !!   'key_trabbl_adv'                    advective bottom boundary layer
+   !!----------------------------------------------------------------------
+#  include "trabbl_adv.h90"
+# else
+   !!----------------------------------------------------------------------
+   !!   Default option :                 NO advective bottom boundary layer
+   !!----------------------------------------------------------------------
+   SUBROUTINE tra_bbl_adv (kt )              ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) kt
+   END SUBROUTINE tra_bbl_adv
+# endif
+
+   SUBROUTINE tra_bbl_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbl_init  ***
+      !!
+      !! ** Purpose :   Initialization for the bottom boundary layer scheme.
+      !!
+      !! ** Method  :   Read the nambbl namelist and check the parameters
+      !!      called by tra_bbl at the first timestep (nit000)
+      !!
+      !! History :
+      !!    8.5  !  02-08  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj      ! dummy loop indices
+      NAMELIST/nambbl/ atrbbl
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist nambbl : bottom boundary layer scheme
+      ! --------------------
+      REWIND ( numnam )
+      READ   ( numnam, nambbl )
+
+
+      ! Parameter control and print
+      ! ---------------------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_bbl_init : * Diffusive Bottom Boundary Layer'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         IF( lk_trabbl_adv ) THEN
+            WRITE(numout,*) '               * Advective Bottom Boundary Layer'
+         ENDIF
+         WRITE(numout,*) '          Namelist nambbl : set bbl parameters'
+         WRITE(numout,*)
+         WRITE(numout,*) '          bottom boundary layer coef.    atrbbl = ', atrbbl
+         WRITE(numout,*)
+      ENDIF
+ 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            mbkt(ji,jj) = MAX( mbathy(ji,jj) - 1, 1 )   ! vertical index of the bottom ocean T-level
+         END DO
+      END DO
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            mbku(ji,jj) = MAX( MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) ) - 1, 1 )
+            mbkv(ji,jj) = MAX( MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) ) - 1, 1 )
+         END DO
+      END DO
+!!bug ???
+!!bug Caution : define the vakue of mbku & mbkv everywhere!!! but lbc mpp lnk : pb when closed (0)
+
+# if defined key_trabbl_adv
+      w_bbl(:,:,:) = 0.e0    ! initialisation of w_bbl to zero
+# endif
+
+   END SUBROUTINE tra_bbl_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                      No bottom boundary layer scheme
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_dif = .FALSE.
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl_adv = .FALSE.
+CONTAINS
+   SUBROUTINE tra_bbl_dif (kt )              ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) kt
+   END SUBROUTINE tra_bbl_dif
+   SUBROUTINE tra_bbl_adv (kt )              ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) kt
+   END SUBROUTINE tra_bbl_adv
+#endif
+
+   !!======================================================================
+END MODULE trabbl
Index: /branches/nemo/NEMO/OPA_SRC/TRA/trabbl_adv.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/trabbl_adv.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/trabbl_adv.h90	(revision 4)
@@ -0,0 +1,505 @@
+   !!----------------------------------------------------------------------
+   !!                     ***  trabbl_adv.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE tra_bbl_adv( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_bbl_adv  ***
+      !!                   
+      !! ** Purpose :   Compute the before tracer (t & s) trend associated 
+      !!     with the bottom boundary layer and add it to the general trend
+      !!     of tracer equations. The bottom boundary layer is supposed to be 
+      !!     both an advective and diffusive bottom boundary layer.
+      !!
+      !! ** Method  :   Computes the bottom boundary horizontal and vertical 
+      !!      advection terms. Add it to the general trend : ta =ta + adv_bbl.
+      !!        When the product grad( rho) * grad(h) < 0 (where grad is a
+      !!      along bottom slope gradient) an additional lateral 2nd order
+      !!      diffusion along the bottom slope is added to the general
+      !!      tracer trend, otherwise the additional trend is set to 0.
+      !!      Second order operator (laplacian type) with variable coefficient
+      !!      computed as follow for temperature (idem on s):
+      !!         difft = 1/(e1t*e2t*e3t) { di-1[ ahbt e2u*e3u/e1u di[ztb] ]
+      !!                                 + dj-1[ ahbt e1v*e3v/e2v dj[ztb] ] }
+      !!      where ztb is a 2D array: the bottom ocean te;perature and ahtb
+      !!      is a time and space varying diffusive coefficient defined by:
+      !!         ahbt = zahbp    if grad(rho).grad(h) < 0
+      !!              = 0.       otherwise.
+      !!      Note that grad(.) is the along bottom slope gradient. grad(rho)
+      !!      is evaluated using the local density (i.e. referenced at the
+      !!      local depth). Typical value of ahbt is 2000 m2/s (equivalent to
+      !!      a downslope velocity of 20 cm/s if the condition for slope
+      !!      convection is satified)
+      !!        Add this before trend to the general trend (ta,sa) of the
+      !!      botton ocean tracer point:
+      !!              ta = ta + difft
+      !!
+      !! ** Action  : - update (ta,sa) at the bottom level with the bottom
+      !!                boundary layer trend
+      !!              - save the trend in bbltrd ('key_diatrends')
+      !!
+      !! References :
+      !!     Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591.
+      !!
+      !! History :
+      !!   8.5  !  02-12  (A. de Miranda, G. Madec)  Original Code 
+      !!   9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines )
+      !!----------------------------------------------------------------------     
+      !! * Modules used
+      USE eosbn2
+      USE flxrnf
+      USE ocfzpt
+      USE lbclnk
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt        ! ocean time-step 
+      
+      !! * Local declarations
+      INTEGER :: ji, jj, jk                   ! dummy loop indices
+      INTEGER :: ik, iku, ikv                 ! temporary integers
+
+      REAL(wp) ::   &
+         zsign, zt, zs, zh, zalbet,     &  ! temporary scalars
+         zgdrho, zbtr, zta, zsa            !    "         " 
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zki, zkj, zkw, zkx, zky, zkz,  &  ! temporary workspace arrays
+         ztnb, zsnb, zdep, ztbb, zsbb,  &  !    "                  "
+         zahu, zahv                        !    "                  "
+      REAL(wp), DIMENSION(jpi,jpj) ::   &  ! temporary workspace arrays
+         zalphax,zalphay, zwu, zwv,     &  !    "                  "
+         zunb, zvnb, zind,              &  !    "                  "
+         zwx, zwy, zww, zwz                !    "                  "
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zhdivn                            ! temporary workspace arrays
+      REAL(wp) ::   &
+         zfui, zfvj, zbt, zsigna,       &  ! temporary scalars
+         zcofi , zupsut, zupsus,        &  !    "         "
+         zcofj , zupsvt, zupsvs,        &  !    "         "
+         zcenut, zcenus,                &  !    "         "
+         zcenvt, zcenvs                    !    "         "
+      REAL(wp) ::   &
+         fsalbt, pft, pfs, pfh,         &  ! statement function
+         fsx, fsy, pfx1, pfx2,          &  !    "          "
+         pfu, pfv, pfy1, pfy2              !    "          "
+      !!----------------------------------------------------------------------
+      ! ratio alpha/beta
+      ! ================
+      !  fsalbt: ratio of thermal over saline expension coefficients
+      !       pft :  potential temperature in degrees celcius
+      !       pfs :  salinity anomaly (s-35) in psu
+      !       pfh :  depth in meters
+
+      fsalbt( pft, pfs, pfh ) =                                              &
+         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
+                                   - 0.203814e-03 ) * pft                    &
+                                   + 0.170907e-01 ) * pft                    &
+                                   + 0.665157e-01                            &
+         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
+         +  ( ( - 0.302285e-13 * pfh                                         &
+                - 0.251520e-11 * pfs                                         &
+                + 0.512857e-12 * pft * pft          ) * pfh                  &
+                                     - 0.164759e-06   * pfs                  &
+             +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
+                                     + 0.380374e-04 ) * pfh
+      ! Up Stream Advection Scheme
+      ! ==========================
+      !  fsx: along i-direction
+      !  fsy: along j-direction
+
+      fsx( pfx1, pfx2, pfu ) = ( ( pfu + abs(pfu) ) * pfx1   &
+                                +( pfu - abs(pfu) ) * pfx2 ) * 0.5
+      fsy( pfy1, pfy2, pfv ) = ( ( pfv + abs(pfv) ) * pfy1   &
+                                +( pfv - abs(pfv) ) * pfy2 ) * 0.5
+      !!----------------------------------------------------------------------
+
+
+      IF( kt == nit000 )   CALL tra_bbl_init    ! initialization at first time-step
+
+
+      ! 1. 2D fields of bottom temperature and salinity, and bottom slope
+      ! -----------------------------------------------------------------
+      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F)
+
+#if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij   ! vector opt. (forced unrolling)
+#else
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+#endif
+            ik = mbkt(ji,jj)                               ! index of the bottom ocean T-level
+            ztnb(ji,jj) = tn(ji,jj,ik) * tmask(ji,jj,1)    ! masked now T at the ocean bottom 
+            zsnb(ji,jj) = sn(ji,jj,ik) * tmask(ji,jj,1)    ! masked now S at the ocean bottom
+            ztbb(ji,jj) = tb(ji,jj,ik) * tmask(ji,jj,1)    ! masked before T at the ocean bottom 
+            zsbb(ji,jj) = sb(ji,jj,ik) * tmask(ji,jj,1)    ! masked before S at the ocean bottom
+            zdep(ji,jj) = fsdept(ji,jj,ik)                 ! depth of the ocean bottom T-level
+#if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+#endif
+      END DO
+# if defined key_vectopt_loop   &&   ! defined key_autotasking 
+      j = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+            zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) * umask(ji,jj,1)
+            zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) * vmask(ji,jj,1)   ! retirer le mask en u, v et t !
+      END DO
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) * umask(ji,jj,1)
+            zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) * vmask(ji,jj,1)
+         END DO
+      END DO
+#endif
+ 
+      ! boundary conditions on zunb and zvnb   (changed sign)
+       CALL lbc_lnk( zunb, 'U', -1. )   ;   CALL lbc_lnk( zvnb, 'V', -1. )
+      ! boundary condition on ztnb and znbb
+       CALL lbc_lnk( ztnb, 'T', 1. )    ;   CALL lbc_lnk( ztbb, 'T', 1. )
+      ! boundary condition on zsnb and zsbb
+       CALL lbc_lnk( zsnb, 'T', 1. )    ;   CALL lbc_lnk( zsbb, 'T', 1. )
+
+      ! Conditional diffusion along the slope in the bottom boundary layer
+
+#if defined key_trabbl_dif
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            iku = mbku(ji,jj)
+            ikv = mbkv(ji,jj)
+            zahu(ji,jj) = atrbbl*e2u(ji,jj)*fse3u(ji,jj,iku)/e1u(ji,jj) * umask(ji,jj,1)
+            zahv(ji,jj) = atrbbl*e1v(ji,jj)*fse3v(ji,jj,ikv)/e2v(ji,jj) * vmask(ji,jj,1)
+#if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+#endif
+      END DO
+#endif
+
+
+      ! 2. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0
+      ! --------------------------------------------
+      ! Sign of the local density gradient along the i- and j-slopes
+      ! multiplied by the slope of the ocean bottom
+
+      SELECT CASE ( neos )
+
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+
+      DO jj = 1, jpjm1
+        DO ji = 1, fs_jpim1   ! vector opt.
+      !   ... temperature, salinity anomalie and depth
+          zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
+          zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0
+          zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+      !   ... masked ratio alpha/beta
+          zalbet = fsalbt( zt, zs, zh )*umask(ji,jj,1)
+      !   ... local density gradient along i-bathymetric slope
+          zgdrho = zalbet*( ztnb(ji+1,jj) - ztnb(ji,jj) )   &
+                     -    ( zsnb(ji+1,jj) - zsnb(ji,jj) )
+          zgdrho = zgdrho * umask(ji,jj,1)
+      !   ... sign of local i-gradient of density multiplied by the i-slope
+          zsign = sign( 0.5, -zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) )
+          zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj)
+
+          zsigna= sign(0.5, zunb(ji,jj)*(  zdep(ji+1,jj) - zdep(ji,jj) ))
+          zalphax(ji,jj)=(0.5+zsigna)*(0.5-zsign)*umask(ji,jj,1)
+        END DO
+      END DO
+
+      DO jj = 1, jpjm1
+        DO ji = 1, fs_jpim1   ! vector opt.
+      !   ... temperature, salinity anomalie and depth
+          zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) )
+          zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0
+          zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
+      !   ... masked ratio alpha/beta
+          zalbet = fsalbt( zt, zs, zh )*vmask(ji,jj,1)
+      !   ... local density gradient along j-bathymetric slope
+          zgdrho = zalbet*( ztnb(ji,jj+1) - ztnb(ji,jj) )   &
+                     -    ( zsnb(ji,jj+1) - zsnb(ji,jj) )
+          zgdrho = zgdrho*vmask(ji,jj,1)
+      !   ... sign of local j-gradient of density multiplied by the j-slope
+          zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )
+          zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj)
+
+          zsigna= sign(0.5, zvnb(ji,jj)*(zdep(ji,jj+1) - zdep(ji,jj) ) )
+          zalphay(ji,jj)=(0.5+zsigna)*(0.5-zsign)*vmask(ji,jj,1)
+        END DO
+      END DO
+
+
+      CASE ( 1 )               ! Linear formulation function of temperature only
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )'
+         IF(lwp) WRITE(numout,*) '          bbl not implented: easy to do it '
+         nstop = nstop + 1
+
+      CASE ( 2 )               ! Linear formulation function of temperature and salinity
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )'
+         IF(lwp) WRITE(numout,*) '          bbl not implented: easy to do it '
+         nstop = nstop + 1
+
+      CASE DEFAULT
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+
+      END SELECT
+
+
+      ! lateral boundary conditions on zalphax and zalphay   (unchanged sign)
+       CALL lbc_lnk( zalphax, 'U', 1. )   ;   CALL lbc_lnk( zalphay, 'V', 1. )
+#endif
+
+      ! 3. Velocities that are exchanged between ajacent bottom boxes.
+      !---------------------------------------------------------------
+
+      ! ... is equal to zero but where bbl will work.
+          u_bbl(:,:,:) = 0.e0
+          v_bbl(:,:,:) = 0.e0
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            iku = mbku(ji,jj)
+            ikv = mbkv(ji,jj)
+            IF( MAX(iku,ikv) >  1 ) THEN
+               u_bbl(ji,jj,iku) = zalphax(ji,jj) * un(ji,jj,iku) * umask(ji,jj,1)
+               v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * vmask(ji,jj,1)
+            ENDIF
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+          END DO
+
+      ! lateral boundary conditions on uzbbl and vzbbl   (changed sign)
+       CALL lbc_lnk( uzbbl, 'U', -1. )   ;   CALL lbc_lnk( vzbbl, 'V', -1. )
+
+
+
+#if defined key_trabbl_dif
+      ! 4. Additional second order diffusive trends
+      ! -------------------------------------------
+
+      ! ... first derivative (gradient)
+        DO jj = 1, jpjm1
+          DO ji = 1, fs_jpim1   ! vertor opt.
+
+            zkx(ji,jj) = zki(ji,jj)*( ztbb(ji+1,jj) - ztbb(ji,jj) )
+            zkz(ji,jj) = zki(ji,jj)*( zsbb(ji+1,jj) - zsbb(ji,jj) )
+
+            zky(ji,jj) = zkj(ji,jj)*( ztbb(ji,jj+1) - ztbb(ji,jj) )
+            zkw(ji,jj) = zkj(ji,jj)*( zsbb(ji,jj+1) - zsbb(ji,jj) )
+        END DO
+      END DO
+
+      IF( cp_cfg == "orca" ) THEN   
+         SELECT CASE ( jp_cfg )
+            !                                        ! =======================
+            CASE ( 2 )                               !  ORCA_R2 configuration
+               !                                     ! =======================
+               ! Gibraltar enhancement of BBL
+               zkx( mi0(139):mi1(140) , mj0(102):mj1(102) ) = 4.e0 * zkx( mi0(139):mi1(140) , mj0(102):mj1(102) )
+               zky( mi0(139):mi1(140) , mj0(102):mj1(102) ) = 4.e0 * zky( mi0(139):mi1(140) , mj0(102):mj1(102) )
+   
+               ! Red Sea enhancement of BBL
+               zkx( mi0(161):mi1(162) , mj0(88):mj1(88) ) = 10.e0 * zkx( mi0(161):mi1(162) , mj0(88):mj1(88) )
+               zky( mi0(161):mi1(162) , mj0(88):mj1(88) ) = 10.e0 * zky( mi0(161):mi1(162) , mj0(88):mj1(88) )
+   
+               !                                     ! =======================
+            CASE ( 4 )                               !  ORCA_R4 configuration
+               !                                     ! =======================
+               ! Gibraltar enhancement of BBL
+               zkx( mi0(70):mi1(71) , mj0(52):mj1(52) ) = 4.e0 * zkx( mi0(70):mi1(71) , mj0(52):mj1(52) )
+               zky( mi0(70):mi1(71) , mj0(52):mj1(52) ) = 4.e0 * zky( mi0(70):mi1(71) , mj0(52):mj1(52) )
+ 
+         END SELECT
+ 
+      ENDIF
+
+      ! ... second derivative (divergence) and add to the general tracer trend
+
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            ik = mbkt(ji,jj)
+            zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik) )
+            zta = (  zkx(ji,jj) - zkx(ji-1,jj  )   & 
+               &   + zky(ji,jj) - zky(ji  ,jj-1)  ) * zbtr
+            zsa = (  zkz(ji,jj) - zkz(ji-1,jj  )   &
+               &   + zkw(ji,jj) - zkw(ji  ,jj-1)  ) * zbtr
+            ta(ji,jj,ik) = ta(ji,jj,ik) + zta
+            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa
+#if defined key_trdtra || defined key_trdmld
+            bbltrd(ji,jj,1) = + zta
+            bbltrd(ji,jj,2) = + zsa
+            ttrd(ji,jj,ik,3) = ttrd(ji,jj,ik,3) + zta
+            strd(ji,jj,ik,3) = strd(ji,jj,ik,3) + zsa
+#endif
+#if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+#endif
+      END DO
+
+#endif
+
+      ! 5. Along sigma advective trend
+      ! -------------------------------
+      ! ... Second order centered tracer flux at u and v-points
+
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            iku = mbku(ji,jj)
+            ikv = mbkv(ji,jj)
+            zfui = zalphax(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,iku) * zunb(ji,jj)
+            zfvj = zalphay(ji,jj) *e1v(ji,jj) * fse3v(ji,jj,ikv) * zvnb(ji,jj)
+            ! centered scheme
+!           zwx(ji,jj) = 0.5* zfui * ( ztnb(ji,jj) + ztnb(ji+1,jj) )
+!           zwy(ji,jj) = 0.5* zfvj * ( ztnb(ji,jj) + ztnb(ji,jj+1) )
+!           zww(ji,jj) = 0.5* zfui * ( zsnb(ji,jj) + zsnb(ji+1,jj) )
+!           zwz(ji,jj) = 0.5* zfvj * ( zsnb(ji,jj) + zsnb(ji,jj+1) )
+            ! upstream scheme
+            zwx(ji,jj) = fsx(ztbb(ji,jj),ztbb(ji+1,jj),zfui)
+            zwy(ji,jj) = fsy(ztbb(ji,jj),ztbb(ji,jj+1),zfvj)
+            zww(ji,jj) = fsx(zsbb(ji,jj),zsbb(ji+1,jj),zfui)
+            zwz(ji,jj) = fsy(zsbb(ji,jj),zsbb(ji,jj+1),zfvj)
+#if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+#endif
+        END DO
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            ik = mbkt(ji,jj)
+            zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,ik) )
+      ! horizontal advective trends
+            zta = - zbtr * (  zwx(ji,jj) - zwx(ji-1,jj  )   &
+               &            + zwy(ji,jj) - zwy(ji  ,jj-1)  )
+            zsa = - zbtr * (  zww(ji,jj) - zww(ji-1,jj  )   &
+               &            + zwz(ji,jj) - zwz(ji  ,jj-1)  )
+
+      ! add it to the general tracer trends
+            ta(ji,jj,ik) = ta(ji,jj,ik) + zta
+            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa
+#if defined key_trdtra
+            ttrd(ji,jj,ik,1) = ttrd(ji,jj,ik,1) + zta
+            strd(ji,jj,ik,1) = strd(ji,jj,ik,1) + zsa
+#endif
+#if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+#endif
+      END DO
+
+      IF( l_ctl .AND. lwp ) THEN
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' bbl  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+
+      ! 6. Vertical advection velocities
+      ! --------------------------------
+      ! ... computes divergence perturbation (velocties to be removed from upper t boxes :
+      DO jk= 1, jpkm1
+         DO jj=1, jpjm1
+            DO ji = 1, fs_jpim1   ! vertor opt.
+               zwu(ji,jj) = -e2u(ji,jj) * u_bbl(ji,jj,jk)
+               zwv(ji,jj) = -e1v(ji,jj) * v_bbl(ji,jj,jk)
+            END DO
+         END DO
+
+      ! ... horizontal divergence
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbt = e1t(ji,jj) * e2t(ji,jj)
+               zhdivn(ji,jj,jk) = (  zwu(ji,jj) - zwu(ji-1,jj  )   &
+                                   + zwv(ji,jj) - zwv(ji  ,jj-1)  ) / zbt
+            END DO
+         END DO
+      END DO
+
+
+      ! ... horizontal bottom divergence
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            iku = mbku(ji,jj)
+            ikv = mbkv(ji,jj)
+            zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,iku) 
+            zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * fse3v(ji,jj,ikv) 
+#if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+#endif
+        END DO
+
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+      jj = 1
+      DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            ik = mbkt(ji,jj)
+            zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik)
+            zhdivn(ji,jj,ik) =   &
+               &   (  zwu(ji  ,jj  ) * ( zunb(ji  ,jj  ) - un(ji  ,jj  ,ik) *umask(ji  ,jj  ,1) )   &
+               &    - zwu(ji-1,jj  ) * ( zunb(ji-1,jj  ) - un(ji-1,jj  ,ik) *umask(ji-1,jj  ,1) )   &
+               &    + zwv(ji  ,jj  ) * ( zvnb(ji  ,jj  ) - vn(ji  ,jj  ,ik) *vmask(ji  ,jj  ,1) )   &
+               &    - zwv(ji  ,jj-1) * ( zvnb(ji  ,jj-1) - vn(ji  ,jj-1,ik) *vmask(ji  ,jj-1,1) )   &
+               &   ) / zbt
+
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+        END DO
+
+      ! 7. compute additional vertical velocity to be used in t boxes
+      ! -------------------------------------------------------------
+
+      ! ... Computation from the bottom
+      ! Note that w_bbl(:,:,jpk) has been set to 0 in tra_bbl_init
+      DO jk = jpkm1, 1, -1
+         DO jj= 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               w_bbl(ji,jj,jk) = w_bbl(ji,jj,jk+1) - fse3t(ji,jj,jk)*zhdivn(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! Boundary condition on w_bbl   (unchanged sign)
+      CALL lbc_lnk( w_bbl, 'W', 1. )
+
+   END SUBROUTINE tra_bbl_adv
Index: /branches/nemo/NEMO/OPA_SRC/TRA/tradmp.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 4)
@@ -0,0 +1,884 @@
+MODULE tradmp
+   !!======================================================================
+   !!                       ***  MODULE  tradmp  ***
+   !! Ocean physics: internal restoring trend on active tracers (T and S)
+   !!======================================================================
+#if defined key_tradmp 
+   !!----------------------------------------------------------------------
+   !!   key_tradmp                                         internal damping
+   !!----------------------------------------------------------------------
+   !!   tra_dmp      : update the tracer trend with the internal damping
+   !!   tra_dmp_init : initialization, namlist read, parameters control
+   !!   dtacof_zoom  : restoring coefficient for zoom domain
+   !!   dtacof       : restoring coefficient for global domain
+   !!   cofdis       : compute the distance to the coastline
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE trdtra_oce     ! ocean active tracer trend variables
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE phycst          ! Define parameters for the routines
+   USE dtatem          ! temperature data
+   USE dtasal          ! salinity data
+   USE zdfmxl          ! mixed layer depth
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_dmp   ! routine called by step.F90
+
+   !! * Shared module variables
+   LOGICAL , PUBLIC ::   lk_tradmp = .TRUE.    ! internal damping flag
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &
+      strdmp        ! damping salinity trend (psu/s)
+
+   !! * Module variables
+   INTEGER  ::             & !!! * newtonian damping namelist (mandmp) *
+      ndmp   =   -1 ,      &  ! = 0/-1/'latitude' for damping over T and S
+      ndmpf  =    2 ,      &  ! = 1 create a damping.coeff NetCDF file 
+      nmldmp =    0           ! = 0/1/2 flag for damping in the mixed layer
+   REAL(wp) ::             & !!!  * newtonian damping namelist *
+      sdmp   =   50.,      &  ! surface time scale for internal damping (days)
+      bdmp   =  360.,      &  ! bottom time scale for internal damping (days)
+      hdmp   =  800.          ! depth of transition between sdmp and bdmp (meters)
+
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+      resto         ! restoring coeff. on T and S (s-1)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_dmp( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_dmp  ***
+      !!                  
+      !! ** Purpose :   Compute the tracer trend due to a newtonian damping
+      !!      of the tracer field towards given data field and add it to the
+      !!      general tracer trends.
+      !!
+      !! ** Method  :   Newtonian damping towards t_dta and s_dta computed 
+      !!      and add to the general tracer trends:
+      !!                     ta = ta + resto * (t_dta - tb)
+      !!                     sa = sa + resto * (s_dta - sb)
+      !!         The trend is computed either throughout the water column
+      !!      (nlmdmp=0) or in area of weak vertical mixing (nlmdmp=1) or
+      !!      below the well mixed layer (nlmdmp=2)
+      !!
+      !! ** Action  : - update the tracer trends (ta,sa) with the newtonian 
+      !!                damping trends.
+      !!              - save the trends in (ttrd,strd) ('key_trdtra')
+      !!
+      !! History :
+      !!   7.0  !         (G. Madec)  Original code
+      !!        !  96-01  (G. Madec) 
+      !!        !  97-05  (G. Madec)  macro-tasked on jk-slab
+      !!   8.5  !  02-08  (G. Madec)  free form + modules
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk         ! dummy loop indices
+      REAL(wp) ::   ztest, zta, zsa    ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      ! 0. Initialization (first time-step only)
+      !    --------------
+      IF( kt == nit000 ) CALL tra_dmp_init
+
+      ! 1. Newtonian damping trends on tracer fields
+      ! --------------------------------------------
+      !    compute the newtonian damping trends depending on nmldmp
+
+      SELECT CASE ( nmldmp )
+
+      CASE( 0 )                ! newtonian damping throughout the water column
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) )
+                  zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) )
+                  ! add the trends to the general tracer trends
+                  ta(ji,jj,jk) = ta(ji,jj,jk) + zta
+                  sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
+                  ! save the salinity trend (used in flx to close the salt budget)
+                  strdmp(ji,jj,jk) = zsa
+#    if defined key_trdtra
+                  ! save the trends for diagnostics
+                  ttrd(ji,jj,jk,6) = zta
+                  strd(ji,jj,jk,6) = zsa
+#    endif
+               END DO
+            END DO
+         END DO
+
+      CASE ( 1 )                ! no damping in the turbocline (avt > 5 cm2/s)
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ztest = avt(ji,jj,jk) - 5.e-4
+                  IF( ztest < 0. ) THEN
+                     zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) )
+                     zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) )
+                  ELSE
+                     zta = 0.e0
+                     zsa = 0.e0
+                  ENDIF
+                  ! add the trends to the general tracer trends
+                  ta(ji,jj,jk) = ta(ji,jj,jk) + zta
+                  sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
+                  ! save the salinity trend (used in flx to close the salt budget)
+                  strdmp(ji,jj,jk) = zsa
+#    if defined key_trdtra
+                  ! save the trends for diagnostics
+                  ttrd(ji,jj,jk,6) = zta
+                  strd(ji,jj,jk,6) = zsa
+#    endif
+               END DO
+            END DO
+         END DO
+
+      CASE ( 2 )                ! no damping in the mixed layer 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
+                     zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) )
+                     zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) )
+                  ELSE
+                     zta = 0.e0
+                     zsa = 0.e0
+                  ENDIF
+                  ! add the trends to the general tracer trends
+                  ta(ji,jj,jk) = ta(ji,jj,jk) + zta
+                  sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
+                  ! save the salinity trend (used in flx to close the salt budget)
+                  strdmp(ji,jj,jk) = zsa
+#    if defined key_trdtra
+                  ! save the trends for diagnostics
+                  ttrd(ji,jj,jk,6) = zta
+                  strd(ji,jj,jk,6) = zsa
+#    endif
+               END DO
+            END DO
+         END DO
+
+      END SELECT
+
+      IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging)
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' dmp  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+
+   END SUBROUTINE tra_dmp
+
+
+   SUBROUTINE tra_dmp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_dmp_init  ***
+      !! 
+      !! ** Purpose :   Initialization for the newtonian damping 
+      !!
+      !! ** Method  :   read the nammbf namelist and check the parameters
+      !!      called by tra_dmp at the first timestep (nit000)
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      NAMELIST/namtdp/ ndmp, ndmpf, nmldmp, sdmp, bdmp, hdmp
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist namtdp : temperature and salinity damping term
+      ! --------------------
+      REWIND ( numnam )
+      READ   ( numnam, namtdp )
+      IF( lzoom ) THEN
+         nmldmp = 0           ! restoring to climatology at closed north or south boundaries
+      ENDIF
+
+      ! Parameter control and print
+      ! ---------------------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_dmp : T and S newtonian damping'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '          Namelist namtdp : set damping parameter'
+         WRITE(numout,*)
+         WRITE(numout,*) '             T and S damping option         ndmp   = ', ndmp
+         WRITE(numout,*) '             create a damping.coeff file    ndmpf  = ', ndmpf
+         WRITE(numout,*) '             mixed layer damping option     nmldmp = ', nmldmp, '(zoom: forced to 0)'
+         WRITE(numout,*) '             surface time scale (days)      sdmp   = ', sdmp
+         WRITE(numout,*) '             bottom time scale (days)       bdmp   = ', bdmp
+         WRITE(numout,*) '             depth of transition (meters)   hdmp   = ', hdmp
+         WRITE(numout,*)
+      ENDIF
+
+      SELECT CASE ( ndmp )
+
+      CASE ( -1 )               ! ORCA: damping in Red & Med Seas only
+         IF(lwp) WRITE(numout,*) '          tracer damping in the Med & Red seas only'
+
+      CASE ( 1:90 )             ! Damping poleward of 'ndmp' degrees
+         IF(lwp) WRITE(numout,*) '          tracer damping poleward of', ndmp, ' degrees'
+
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for ndmp = ', ndmp
+         nstop = nstop + 1
+
+      END SELECT
+
+
+      SELECT CASE ( nmldmp )
+
+      CASE ( 0 )                ! newtonian damping throughout the water column
+         IF(lwp) WRITE(numout,*) '          tracer damping throughout the water column'
+
+      CASE ( 1 )                ! no damping in the turbocline (avt > 5 cm2/s)
+         IF(lwp) WRITE(numout,*) '          no tracer damping in the turbocline'
+
+      CASE ( 2 )                ! no damping in the mixed layer 
+         IF(lwp) WRITE(numout,*) '          no tracer damping in the mixed layer'
+
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for nmldmp = ', nmldmp
+         nstop = nstop + 1
+
+      END SELECT
+
+      IF( .NOT.lk_dtasal .OR. .NOT.lk_dtatem ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          no temperature and/or salinity data '
+         IF(lwp) WRITE(numout,*) '          define key_dtatem and key_dtasal'
+         nstop = nstop + 1
+      ENDIF
+
+      ! 3. Damping coefficients initialization
+      ! --------------------------------------
+
+      IF( lzoom ) THEN
+         CALL dtacof_zoom
+      ELSE
+         CALL dtacof
+      ENDIF
+
+   END SUBROUTINE tra_dmp_init
+
+
+   SUBROUTINE dtacof_zoom
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dtacof_zoom  ***
+      !!
+      !! ** Purpose :   Compute the damping coefficient for zoom domain
+      !!
+      !! ** Method  : - set along closed boundary due to zoom a damping over
+      !!      6 points with a max time scale of 5 days.
+      !!              - ORCA arctic/antarctic zoom: set the damping along
+      !!      south/north boundary over a latitude strip.
+      !!
+      !! ** Action  : - resto, the damping coeff. for T and S
+      !!
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk, jn      ! dummy loop indices
+      REAL(wp) ::   &
+         zlat, zlat0, zlat1, zlat2     ! temporary scalar
+      REAL(wp), DIMENSION(6)  ::   &
+         zfact                         ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      zfact(1) =  1.
+      zfact(2) =  1. 
+      zfact(3) = 11./12.
+      zfact(4) =  8./12.
+      zfact(5) =  4./12.
+      zfact(6) =  1./12.
+      zfact(:) = zfact(:) / ( 5. * rday )    ! 5 days max restoring time scale
+
+      resto(:,:,:) = 0.e0
+
+      ! damping along the forced closed boundary over 6 grid-points
+      DO jn = 1, 6
+         IF( lzoom_e )   resto( mi0(jn+1) , : , : ) = zfact(jn)         ! east  closed
+         IF( lzoom_s )   resto( : , mj0(jn+1) , : ) = zfact(jn)         ! south closed 
+         IF( lzoom_w )   resto( mi0(jpiglo-jn) , : , : ) = zfact(jn)    ! west  closed 
+         IF( lzoom_n )   resto( : , mi0(jpjglo-jn) , : ) = zfact(jn)    ! north closed
+      END DO
+
+
+      IF( lzoom_arct .AND. lzoom_anta ) THEN
+
+         ! ====================================================
+         !  ORCA configuration : arctic zoom or antarctic zoom
+         ! ====================================================
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp .AND. lzoom_arct ) WRITE(numout,*) '              dtacof_zoom : ORCA    Arctic zoom'
+         IF(lwp .AND. lzoom_arct ) WRITE(numout,*) '              dtacof_zoom : ORCA Antarctic zoom'
+         IF(lwp) WRITE(numout,*)
+
+         ! ... Initialization : 
+         !     zlat0 : latitude strip where resto decreases
+         !     zlat1 : resto = 1 before zlat1
+         !     zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2
+         resto(:,:,:) = 0.e0
+         zlat0 = 10.
+         zlat1 = 30.
+         zlat2 = zlat1 + zlat0
+
+         ! ... Compute arrays resto ; value for internal damping : 5 days
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zlat = ABS( gphit(ji,jj) )
+                  IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
+                     resto(ji,jj,jk) = 0.5 * ( 1./(5.*rday) ) *   &
+                        ( 1. - cos(rpi*(zlat2-zlat)/zlat0) ) 
+                  ELSE IF ( zlat < zlat1 ) THEN
+                     resto(ji,jj,jk) = 1./(5.*rday)
+                  ENDIF
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+
+      ! ... Mask resto array
+      resto(:,:,:) = resto(:,:,:) * tmask(:,:,:)
+
+   END SUBROUTINE dtacof_zoom
+
+   SUBROUTINE dtacof
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dtacof  ***
+      !!
+      !! ** Purpose :   Compute the damping coefficient
+      !!
+      !! ** Method  :   Arrays defining the damping are computed for each grid
+      !!      point for temperature and salinity (resto)
+      !!      Damping depends on distance to coast, depth and latitude
+      !!
+      !! ** Action  : - resto, the damping coeff. for T and S
+      !!
+      !! History :
+      !!   5.0  !  91-03  (O. Marti, G. Madec)  Original code
+      !!        !  92-06  (M. Imbard)  doctor norme
+      !!        !  96-01  (G. Madec) statement function for e3
+      !!        !  98-07  (M. Imbard, G. Madec) ORCA version
+      !!        !  00-08  (G. Madec, D. Ludicone) 
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk, je      ! dummy loop indices
+      INTEGER, PARAMETER ::   jpmois=1
+      INTEGER ::   ipi, ipj, ipk       ! temporary integers
+      INTEGER ::   &
+         idmp,     &  ! logical unit for file restoring damping term
+         icot         ! logical unit for file distance to the coast
+      INTEGER :: itime, istep(jpmois), ie
+      LOGICAL :: llbon
+      CHARACTER (len=32) ::  clname, clname2, clname3
+      REAL(wp) ::   &
+         zdate0, zinfl, zlon,         & ! temporary scalars
+         zlat, zlat0, zlat1, zlat2,   & !    "         "
+         zsdmp, zbdmp                   !    "         "
+      REAL(wp), DIMENSION(jpk) ::   &
+         zdept, zhfac
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zmrs, zlamt, zphit
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zdct
+
+      INTEGER :: ii0, ii1, ij0, ij1
+      !!----------------------------------------------------------------------
+
+      ! ====================================
+      !  ORCA configuration : global domain
+      ! ====================================
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '              dtacof : Global domain of ORCA'
+      IF(lwp) WRITE(numout,*) '              ------------------------------'
+
+      ! ... Initialization : 
+      !   zdct()      : distant to the coastline
+      !   resto()     : array of restoring coeff. on T and S
+
+      zdct (:,:,:) = 0.e0
+      resto(:,:,:) = 0.e0
+
+      IF ( ndmp > 0 ) THEN
+
+         !    ------------------------------------
+         !     Damping poleward of 'ndmp' degrees
+         !    ------------------------------------
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '              Damping poleward of ', ndmp,' deg.'
+         IF(lwp) WRITE(numout,*)
+
+         ! ... Distance to coast (zdct)
+
+         !   ... Test the existance of distance-to-coast file
+         itime = jpmois
+         ipi = jpiglo
+         ipj = jpjglo
+         ipk = jpk
+         clname = 'dist.coast'
+         DO je = 1,32
+            IF( clname(je:je) == ' ' ) go to 140
+         END DO
+140      CONTINUE
+         ie = je
+         clname2 = clname(1:ie-1)//".nc"
+         inquire( FILE = clname2, EXIST = llbon )
+
+         IF ( llbon ) THEN
+
+            !   ... Read file distance to coast if possible
+            CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj, .false.,   &
+               ipi, ipj, ipk, zlamt, zphit, zdept, jpmois,   &
+               istep, zdate0, rdt, icot )
+            CALL flinget( icot, 'Tcoast', jpidta, jpjdta, jpk,    &
+               jpmois, 1, 1, mig(1), nlci, mjg(1), nlcj, zdct(1:nlci,1:nlcj,1:jpk) )
+            CALL flinclo( icot )
+            IF(lwp)WRITE(numout,*) '    ** : File dist.coast.nc read'
+
+         ELSE
+
+            !   ... Compute and save the distance-to-coast array (output in zdct)
+            CALL cofdis ( zdct )
+
+         ENDIF
+
+         ! ... Compute arrays resto 
+         !      zinfl : distance of influence for damping term
+         !      zlat0 : latitude strip where resto decreases
+         !      zlat1 : resto = 0 between -zlat1 and zlat1
+         !      zlat2 : resto increases from 0 to 1 between |zlat1| and |zlat2|
+         !          and resto = 1 between |zlat2| and 90 deg.
+         zinfl = 1000.e3
+         zlat0 = 10
+         zlat1 = ndmp
+         zlat2 = zlat1 + zlat0
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zlat = ABS( gphit(ji,jj) )
+               IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
+                  resto(ji,jj,1) = 0.5 * ( 1. - cos(rpi*(zlat-zlat1)/zlat0 ) )
+               ELSEIF ( zlat > zlat2 ) THEN
+                  resto(ji,jj,1) = 1.
+               ENDIF
+            END DO
+         END DO
+
+         !   ... North Indian ocean (20N/30N x 45E/100E) : resto=0
+         IF ( ndmp == 20 ) THEN
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zlat = gphit(ji,jj)
+                  zlon = MOD( glamt(ji,jj), 360. )
+                  IF ( zlat1 < zlat .AND. zlat < zlat2 .AND.   &
+                     45.  < zlon .AND. zlon < 100. ) THEN
+                     resto(ji,jj,1) = 0.
+                  ENDIF
+               END DO
+            END DO
+         ENDIF
+
+         zsdmp = 1./(sdmp * rday)
+         zbdmp = 1./(bdmp * rday)
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zdct(ji,jj,jk) = min( zinfl, zdct(ji,jj,jk) )
+
+                  !   ... Decrease the value in the vicinity of the coast
+                  resto(ji,jj,jk) = resto(ji,jj,1)*0.5   &
+                     * ( 1. - cos( rpi*zdct(ji,jj,jk)/zinfl) )
+
+                  !   ... Vertical variation from zsdmp (sea surface) to zbdmp (bottom)
+                  resto(ji,jj,jk) = resto(ji,jj,jk)*   &
+                     ( zbdmp + (zsdmp-zbdmp)*exp(-fsdept(ji,jj,jk)/hdmp) )
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+
+
+      IF( cp_cfg == "orca" .AND. ( ndmp > 0 .OR. ndmp == -1 ) ) THEN
+
+         !                                         ! =========================
+         !                                         !  Med and Red Sea damping
+         !                                         ! =========================
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) '              ORCA configuration: Damping in Med and Red Seas'
+
+
+         zmrs(:,:) = 0.e0                             ! damping term on the Med or Red Sea
+
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration 
+            !                                        ! =======================
+
+            ! Mediterranean Sea
+            zmrs( mi0(81):mi1(91) , mj0(50):mj1(56) ) = 1.e0 
+            zmrs( mi0(81):mi1(91) , mj0(50):mj1(56) ) = 1.e0
+            zmrs( mi0(75):mi1(80) , mj0(50):mj1(55) ) = 1.e0
+            zmrs( mi0(70):mi1(74) , mj0(52):mj1(53) ) = 1.e0
+            ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea
+            DO jk = 1, 17
+               zhfac (jk) = 0.5*( 1.- COS( rpi*(jk-1)/16. ) ) / rday
+            END DO
+            DO jk = 18, jpkm1
+               zhfac (jk) = 1./rday
+            END DO
+
+            !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration 
+            !                                        ! =======================
+
+            ! Mediterranean Sea
+            zmrs( mi0(157):mi1(181) , mj0( 96):mj1(110) ) = 1.e0
+            zmrs( mi0(144):mi1(156) , mj0(100):mj1(110) ) = 1.e0
+            zmrs( mi0(139):mi1(143) , mj0(100):mj1(103) ) = 1.e0
+            ! Decrease before Gibraltar Strait
+            zmrs( mi0(139):mi1(141) , mj0(101):mj1(102) ) = 0.e0
+            zmrs( mi0(142):mi1(142) , mj0(101):mj1(102) ) = 1.e0 / 90.e0
+            zmrs( mi0(143):mi1(143) , mj0(101):mj1(102) ) = 0.40e0
+            zmrs( mi0(144):mi1(144) , mj0(101):mj1(102) ) = 0.75e0
+            ! Red Sea
+            zmrs( mi0(147):mi1(163) , mj0( 87):mj1( 96) ) = 1.e0
+            ! Decrease before Bab el Mandeb Strait
+            zmrs( mi0(153):mi1(160) , mj0( 91):mj1( 91) ) = 0.80e0
+            zmrs( mi0(153):mi1(160) , mj0( 90):mj1( 90) ) = 0.40e0
+            zmrs( mi0(158):mi1(160) , mj0( 89):mj1( 89) ) = 1.e0 / 90.e0
+            zmrs( mi0(160):mi1(163) , mj0( 88):mj1( 88) ) = 0.e0
+            ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea
+            DO jk = 1, 17
+               zhfac (jk) = 0.5*( 1.- COS( rpi*(jk-1)/16. ) ) / rday
+            END DO
+            DO jk = 18, jpkm1
+               zhfac (jk) = 1./rday
+            END DO
+
+            !                                        ! =======================
+         CASE ( 05 )                                 !  ORCA_R05 configuration
+            !                                        ! =======================
+
+            ! Mediterranean Sea
+            ii0 = 568   ;   ii1 = 574 
+            ij0 = 324   ;   ij1 = 333   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ii0 = 575   ;   ii1 = 314
+            ij0 = 314   ;   ij1 = 366   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ! Black Sea (remaining part
+            ii0 = 641   ;   ii1 = 651
+            ij0 = 367   ;   ij1 = 372   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ! Decrease before Gibraltar Strait
+            ii0 = 324   ;   ii1 = 333
+            ij0 = 565   ;   ij1 = 565   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0
+            ij0 = 566   ;   ij1 = 566   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
+            ij0 = 567   ;   ij1 = 567   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75
+            ! Red Sea
+            ii0 = 641   ;   ii1 = 665
+            ij0 = 270   ;   ij1 = 310   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0
+            ! Decrease before Bab el Mandeb Strait
+            ii0 = 666   ;   ii1 = 675
+            ij0 = 270   ;   ij1 = 290   
+            DO ji = mi0(ii0), mi1(ii1)
+               zmrs( ji , mj0(ij0):mj1(ij1) ) = 0.1 * ABS( FLOAT(ji - mi1(ii1)) )
+            END DO 
+            zsdmp = 1./(sdmp * rday)
+            zbdmp = 1./(bdmp * rday)
+            DO jk = 1, jpk
+               zhfac (jk) = ( zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(1,1,jk)/hdmp) )
+            END DO
+
+            !                                       ! ========================
+         CASE ( 025 )                               !  ORCA_R025 configuration 
+            !                                       ! ========================
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*)' Not yet implemented in ORCA_R025'
+            nstop = nstop + 1
+
+         END SELECT
+
+         DO jk = 1, jpkm1
+            resto(:,:,jk) = zmrs(:,:) * zhfac(jk) + ( 1. - zmrs(:,:) ) * resto(:,:,jk)
+         END DO
+
+         ! Mask resto array and set to 0 first and last levels
+         resto(:,:, : ) = resto(:,:,:) * tmask(:,:,:)
+         resto(:,:, 1 ) = 0.e0
+         resto(:,:,jpk) = 0.e0
+
+      ELSE
+         !    ------------
+         !     No damping
+         !    ------------
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) 'Choose a correct value of ndmp or DO NOT defined key_tradmp'
+         nstop = nstop + 1
+      ENDIF
+
+      !    ----------------------------
+      !     Create Print damping array
+      !    ----------------------------
+
+      ! ndmpf   : = 1 create a damping.coeff NetCDF file
+
+      IF( ndmpf == 1 ) THEN
+         IF(lwp) WRITE(numout,*) '              create damping.coeff.nc file'
+         itime   = 0
+         clname3 = 'damping.coeff'
+         CALL ymds2ju( 0     , 1     , 1      , 0.e0 , zdate0 )
+         CALL restini( 'NONE', jpi   , jpj    , glamt, gphit,    &
+                       jpk   , gdept , clname3, itime, zdate0,   &
+                       rdt   , idmp )
+         CALL restput( idmp, 'Resto', jpi, jpj, jpk,   &
+                       0   , resto  )
+         CALL restclo( idmp )
+      ENDIF
+
+   END SUBROUTINE dtacof
+
+
+   SUBROUTINE cofdis ( pdct )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE cofdis  ***
+      !!
+      !! ** Purpose :   Compute the distance between ocean T-points and the
+      !!      ocean model coastlines. Save the distance in a NetCDF file.
+      !!
+      !! ** Method  :   For each model level, the distance-to-coast is 
+      !!      computed as follows : 
+      !!       - The coastline is defined as the serie of U-,V-,F-points
+      !!      that are at the ocean-land bound.
+      !!       - For each ocean T-point, the distance-to-coast is then 
+      !!      computed as the smallest distance (on the sphere) between the 
+      !!      T-point and all the coastline points.
+      !!       - For land T-points, the distance-to-coast is set to zero.
+      !!      C A U T I O N : Computation not yet implemented in mpp case.
+      !!
+      !! ** Action  : - pdct, distance to the coastline (argument)
+      !!              - NetCDF file 'dist.coast.nc' 
+      !!        
+      !! History :
+      !!   7.0  !  01-02  (M. Imbard)  Original code
+      !!   8.1  !  01-02  (G. Madec, E. Durand)
+      !!   8.5  !  02-08  (G. Madec, E. Durand)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   &
+         pdct                     ! distance to the coastline
+
+      !! * local declarations
+      INTEGER :: ji, jj, jk, jl      ! dummy loop indices
+      INTEGER :: iju, ijt            ! temporary integers
+      INTEGER :: icoast, itime
+      INTEGER ::   &
+         icot         ! logical unit for file distance to the coast
+      LOGICAL, DIMENSION(jpi,jpj) ::   &
+         llcotu, llcotv, llcotf   ! ???
+      CHARACTER (len=32) ::   clname
+      REAL(wp) ::   zdate0
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zxt, zyt, zzt            ! cartesian coordinates for T-points
+      REAL(wp), DIMENSION(3*jpi*jpj) ::   &
+         zxc, zyc, zzc, zdis      ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      ! 0. Initialization
+      ! -----------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cofdis : compute the distance to coastline'
+      IF(lwp) WRITE(numout,*) '~~~~~~'
+      IF(lwp) WRITE(numout,*)
+#if defined key_mpp
+      IF(lwp) WRITE(numout,cform_err)
+      IF(lwp) WRITE(numout,*) '         Computation not yet implemented with key_mpp'
+      IF(lwp) WRITE(numout,*) '         Rerun the code on another computer or '
+      IF(lwp) WRITE(numout,*) '         create the "dist.coast.nc" file using IDL'
+      nstop = nstop + 1
+#endif
+
+      pdct(:,:,:) = 0.e0
+      zxt(:,:) = cos( rad * gphit(:,:) ) * cos( rad * glamt(:,:) )
+      zyt(:,:) = cos( rad * gphit(:,:) ) * sin( rad * glamt(:,:) )
+      zzt(:,:) = sin( rad * gphit(:,:) )
+
+
+      ! 1. Loop on vertical levels
+      ! --------------------------
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! Define the coastline points (U, V and F)
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               llcotu(ji,jj) = ( umask(ji,jj,jk) == 0. ) .AND. ( tmask(ji,jj  ,jk)+tmask(ji+1,jj  ,jk) == 1. ) 
+               llcotv(ji,jj) = ( vmask(ji,jj,jk) == 0. ) .AND. ( tmask(ji,jj  ,jk)+tmask(ji  ,jj+1,jk) == 1. ) 
+               llcotf(ji,jj) = ( fmask(ji,jj,jk) == 0. ) .AND. ( tmask(ji,jj+1,jk)+tmask(ji+1,jj+1,jk)   &
+                                                               + tmask(ji,jj  ,jk)+tmask(ji+1,jj  ,jk) <  4. )
+            END DO
+         END DO
+
+         ! Lateral boundaries conditions
+         llcotu(:, 1 ) = umask(:,  2  ,jk) == 1
+         llcotu(:,jpj) = umask(:,jpjm1,jk) == 1
+         llcotv(:, 1 ) = vmask(:,  2  ,jk) == 1
+         llcotv(:,jpj) = vmask(:,jpjm1,jk) == 1
+         llcotf(:, 1 ) = fmask(:,  2  ,jk) == 1
+         llcotf(:,jpj) = fmask(:,jpjm1,jk) == 1
+
+         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+            llcotu( 1 ,:) = llcotu(jpim1,:)
+            llcotu(jpi,:) = llcotu(  2  ,:)
+            llcotv( 1 ,:) = llcotv(jpim1,:)
+            llcotv(jpi,:) = llcotv(  2  ,:)
+            llcotf( 1 ,:) = llcotf(jpim1,:)
+            llcotf(jpi,:) = llcotf(  2  ,:)
+         ELSE
+            llcotu( 1 ,:) = umask(  2  ,:,jk) == 1
+            llcotu(jpi,:) = umask(jpim1,:,jk) == 1
+            llcotv( 1 ,:) = vmask(  2  ,:,jk) == 1
+            llcotv(jpi,:) = vmask(jpim1,:,jk) == 1
+            llcotf( 1 ,:) = fmask(  2  ,:,jk) == 1
+            llcotf(jpi,:) = fmask(jpim1,:,jk) == 1
+         ENDIF
+         IF( nperio == 3 .OR. nperio == 4 ) THEN
+            DO ji = 1, jpim1
+               iju = jpi - ji + 1
+               llcotu(ji,jpj  ) = llcotu(iju,jpj-2)
+               llcotf(ji,jpj-1) = llcotf(iju,jpj-2)
+               llcotf(ji,jpj  ) = llcotf(iju,jpj-3)
+            END DO
+            DO ji = jpi/2, jpi-1
+               iju = jpi - ji + 1
+               llcotu(ji,jpjm1) = llcotu(iju,jpjm1)
+            END DO
+            DO ji = 2, jpi
+               ijt = jpi - ji + 2
+               llcotv(ji,jpj-1) = llcotv(ijt,jpj-2)
+               llcotv(ji,jpj  ) = llcotv(ijt,jpj-3)
+            END DO
+         ENDIF
+         IF( nperio == 5 .OR. nperio == 6 ) THEN
+            DO ji = 1, jpim1
+               iju = jpi - ji
+               llcotu(ji,jpj  ) = llcotu(iju,jpj-1)
+               llcotf(ji,jpj  ) = llcotf(iju,jpj-2)
+            END DO
+            DO ji = jpi/2, jpi-1
+               iju = jpi - ji
+               llcotf(ji,jpjm1) = llcotf(iju,jpjm1)
+            END DO
+            DO ji = 1, jpi
+               ijt = jpi - ji + 1
+               llcotv(ji,jpj  ) = llcotv(ijt,jpj-1)
+            END DO
+            DO ji = jpi/2+1, jpi
+               ijt = jpi - ji + 1
+               llcotv(ji,jpjm1) = llcotv(ijt,jpjm1)
+            END DO
+         ENDIF
+
+         ! Compute cartesian coordinates of coastline points
+         ! and the number of coastline points
+
+         icoast = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( llcotf(ji,jj) ) THEN
+                  icoast = icoast + 1
+                  zxc(icoast) = COS( rad*gphif(ji,jj) ) * COS( rad*glamf(ji,jj) )
+                  zyc(icoast) = COS( rad*gphif(ji,jj) ) * SIN( rad*glamf(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphif(ji,jj) )
+               ENDIF
+               IF( llcotu(ji,jj) ) THEN
+                  icoast = icoast+1
+                  zxc(icoast) = COS( rad*gphiu(ji,jj) ) * COS( rad*glamu(ji,jj) )
+                  zyc(icoast) = COS( rad*gphiu(ji,jj) ) * SIN( rad*glamu(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphiu(ji,jj) )
+               ENDIF
+               IF( llcotv(ji,jj) ) THEN
+                  icoast = icoast+1
+                  zxc(icoast) = COS( rad*gphiv(ji,jj) ) * COS( rad*glamv(ji,jj) )
+                  zyc(icoast) = COS( rad*gphiv(ji,jj) ) * SIN( rad*glamv(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphiv(ji,jj) )
+               ENDIF
+            END DO
+         END DO
+
+         ! Distance for the T-points
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tmask(ji,jj,jk) == 0. ) THEN
+                  pdct(ji,jj,jk) = 0.
+               ELSE
+                  DO jl = 1, icoast
+                     zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2   &
+                              + ( zyt(ji,jj) - zyc(jl) )**2   &
+                              + ( zzt(ji,jj) - zzc(jl) )**2
+                  END DO
+                  pdct(ji,jj,jk) = ra * SQRT( MINVAL( zdis(1:icoast) ) )
+               ENDIF
+            END DO
+         END DO
+         !                                                ! ===============
+      END DO                                              !   End of slab
+      !                                                   ! ===============
+
+
+      ! 2. Create the  distance to the coast file in NetCDF format
+      ! ----------------------------------------------------------    
+      clname = 'dist.coast'
+      itime = 0
+      CALL ymds2ju( 0     , 1     , 1     , 0.e0 , zdate0 )
+      CALL restini( 'NONE', jpi   , jpj   , glamt, gphit ,   &
+                    jpk   , gdept , clname, itime, zdate0,   &
+                    rdt   , icot                         )
+      CALL restput( icot, 'Tcoast', jpi, jpj, jpk, 0, pdct )
+      CALL restclo( icot )
+
+   END SUBROUTINE cofdis
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                     NO internal damping
+   !!----------------------------------------------------------------------
+   LOGICAL , PUBLIC ::   lk_tradmp = .FALSE.    ! internal damping flag
+CONTAINS
+   SUBROUTINE tra_dmp( kt )        ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE tra_dmp
+#endif
+
+   !!======================================================================
+END MODULE tradmp
Index: /branches/nemo/NEMO/OPA_SRC/TRA/traldf_bilap.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 4)
@@ -0,0 +1,236 @@
+MODULE traldf_bilap
+   !!==============================================================================
+   !!                   ***  MODULE  traldf_bilap  ***
+   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_bilap : update the tracer trend with the horizontal diffusion
+   !!                   using a iso-level biharmonic operator
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce     ! ocean tracer   lateral physics
+   USE trdtra_oce     ! ocean active tracer trend 
+   USE in_out_manager  ! I/O manager
+   USE ldfslp          ! iso-neutral slopes 
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_ldf_bilap   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE tra_ldf_bilap( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_bilap  ***
+      !!
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   4th order diffusive operator along model level surfaces 
+      !!      evaluated using before fields (forward time scheme). The hor.
+      !!      diffusive trends of temperature (idem for salinity) is given by:
+      !!       * s-coordinate ('key_s_coord' defined), the vertical scale 
+      !!      factors e3. are inside the derivatives:
+      !!      Laplacian of tb:
+      !!         zlt   = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(tb) ]
+      !!                                  + dj-1[ e1v*e3v/e2v dj(tb) ]  }
+      !!      Multiply by the eddy diffusivity coef. and insure lateral bc:
+      !!        zlt   = ahtt * zlt
+      !!        call to lbc_lnk
+      !!      Bilaplacian (laplacian of zlt):
+      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(zlt) ]
+      !!                                  + dj-1[ e1v*e3v/e2v dj(zlt) ]  }
+      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
+      !!      Laplacian of tb:
+      !!         zlt   = 1/(e1t*e2t) {  di-1[ e2u/e1u di(tb) ]
+      !!                              + dj-1[ e1v/e2v dj(tb) ] }
+      !!      Multiply by the eddy diffusivity coef. and insure lateral bc:
+      !!        zlt   = ahtt * zlt
+      !!        call to lbc_lnk
+      !!      Bilaplacian (laplacian of zlt):
+      !!         difft = 1/(e1t*e2t) {  di-1[ e2u/e1u di(zlt) ]
+      !!                              + dj-1[ e1v/e2v dj(zlt) ]  }
+      !!
+      !!      Add this trend to the general trend (ta,sa):
+      !!         (ta,sa) = (ta,sa) + ( difft , diffs )
+      !!
+      !! ** Action : - Update (ta,sa) arrays with the before iso-level
+      !!               biharmonic mixing trend.
+      !!             - Save the trends in (ttrd,strd) ('key_diatrends')
+      !!
+      !! History :
+      !!        !  91-11  (G. Madec)  Original code
+      !!        !  93-03  (M. Guyon)  symetrical conditions
+      !!        !  95-11  (G. Madec)  suppress volumetric scale factors
+      !!        !  96-01  (G. Madec)  statement function for e3
+      !!        !  96-01  (M. Imbard)  mpp exchange
+      !!        !  97-07  (G. Madec)  optimization, and ahtt
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk             ! dummy loop indices
+#if defined key_partial_steps
+      INTEGER ::   iku, ikv               ! temporary integers
+#endif
+      REAL(wp) ::   zta, zsa    ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   & 
+         zeeu, zeev, zbtr,             &  ! workspace
+         zlt, ztu, ztv,                &
+         zls, zsu, zsv
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         ! 0. Initialization of metric arrays (for z- or s-coordinates)
+         ! ----------------------------------
+
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+#if defined key_s_coord || defined key_partial_steps
+               ! s-coordinates, vertical scale factor are used
+               zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+               zeeu(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)
+               zeev(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)
+#else
+               ! z-coordinates, no vertical scale factors
+               zbtr(ji,jj) = 1. / ( e1t(ji,jj)*e2t(ji,jj) )
+               zeeu(ji,jj) = e2u(ji,jj) / e1u(ji,jj) * umask(ji,jj,jk)
+               zeev(ji,jj) = e1v(ji,jj) / e2v(ji,jj) * vmask(ji,jj,jk)
+#endif
+            END DO
+         END DO
+
+
+         ! 1. Laplacian
+         ! ------------
+
+         ! First derivative (gradient)
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               ztu(ji,jj) = zeeu(ji,jj) * ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) )
+               zsu(ji,jj) = zeeu(ji,jj) * ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) )
+               ztv(ji,jj) = zeev(ji,jj) * ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) )
+               zsv(ji,jj) = zeev(ji,jj) * ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) )
+            END DO
+         END DO
+#if defined key_partial_steps
+         DO jj = 1, jpj-1
+            DO ji = 1, jpi-1
+               ! last level
+               iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
+               ikv = MIN ( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
+               IF( iku == jk ) THEN
+                  ztu(ji,jj) = zeeu(ji,jj) * gtu(ji,jj)
+                  zsu(ji,jj) = zeeu(ji,jj) * gsu(ji,jj)
+               ENDIF
+               IF( ikv == jk ) THEN
+                  ztv(ji,jj) = zeev(ji,jj) * gtv(ji,jj)
+                  zsv(ji,jj) = zeev(ji,jj) * gsv(ji,jj)
+               ENDIF
+            END DO
+         END DO
+#endif
+
+         ! Second derivative (divergence)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zlt(ji,jj) = zbtr(ji,jj) * (  ztu(ji,jj) - ztu(ji-1,jj) + ztv(ji,jj) - ztv(ji,jj-1)  )
+               zls(ji,jj) = zbtr(ji,jj) * (  zsu(ji,jj) - zsu(ji-1,jj) + zsv(ji,jj) - zsv(ji,jj-1)  )
+            END DO
+         END DO
+
+         ! Multiply by the eddy diffusivity coefficient
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zlt(ji,jj) = fsahtt(ji,jj,jk) * zlt(ji,jj)
+               zls(ji,jj) = fsahtt(ji,jj,jk) * zls(ji,jj)
+            END DO
+         END DO
+
+         ! Lateral boundary conditions on the laplacian (zlt,zls)   (unchanged sgn)
+         CALL lbc_lnk( zlt, 'T', 1. )   ;    CALL lbc_lnk( zls, 'T', 1. )
+
+         ! 2. Bilaplacian
+         ! --------------
+
+         ! third derivative (gradient)
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               ztu(ji,jj) = zeeu(ji,jj) * ( zlt(ji+1,jj  ) - zlt(ji,jj) )
+               zsu(ji,jj) = zeeu(ji,jj) * ( zls(ji+1,jj  ) - zls(ji,jj) )
+               ztv(ji,jj) = zeev(ji,jj) * ( zlt(ji  ,jj+1) - zlt(ji,jj) )
+               zsv(ji,jj) = zeev(ji,jj) * ( zls(ji  ,jj+1) - zls(ji,jj) )
+            END DO
+         END DO
+
+         ! fourth derivative (divergence) and add to the general tracer trend
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! horizontal diffusive trends
+               zta = zbtr(ji,jj) * (  ztu(ji,jj) - ztu(ji-1,jj) + ztv(ji,jj) - ztv(ji,jj-1)  )
+               zsa = zbtr(ji,jj) * (  zsu(ji,jj) - zsu(ji-1,jj) + zsv(ji,jj) - zsv(ji,jj-1)  )
+               ! add it to the general tracer trends
+               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
+               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
+#if defined key_trdtra || defined key_trdmld
+               ! save the horizontal diffusive trends
+               ttrd(ji,jj,jk,3) = zta
+               strd(ji,jj,jk,3) = zsa
+#endif
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           ! Horizontal slab
+      !                                                ! ===============
+
+#if defined key_diaptr
+      ! "zonal" mean lateral diffusive heat and salt transport
+      == >> forced bug NOT implemented, ztv, zsv not 3D arrays
+      IF( MOD( kt, nf_ptr ) == 0 ) THEN
+# if defined key_s_coord || defined key_partial_steps
+         pht_ldf(:,:) = prt_vj( ztv(:,:,:) )
+         pst_ldf(:,:) = prt_vj( zsv(:,:,:) )
+# else
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                 ztv(ji,jj,jk) = ztv(ji,jj,jk) * fse3v(ji,jj,jk)
+                 zsv(ji,jj,jk) = zsv(ji,jj,jk) * fse3v(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         pht_ldf(:,:) = prt_vj( ztv(:,:,:) )
+         pst_ldf(:,:) = prt_vj( zsv(:,:,:) )
+# endif
+      ENDIF
+#endif
+
+   END SUBROUTINE tra_ldf_bilap
+
+   !!==============================================================================
+END MODULE traldf_bilap
Index: /branches/nemo/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 4)
@@ -0,0 +1,395 @@
+MODULE traldf_bilapg
+   !!==============================================================================
+   !!                       ***  MODULE  traldf_bilapg  ***
+   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+#if defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_bilapg : update the tracer trend with the horizontal diffusion
+   !!                    using an horizontal biharmonic operator in s-coordinate 
+   !!   ldfght         :  ???
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE ldftra_oce     ! ocean active tracers: lateral physics
+   USE trdtra_oce     ! ocean active tracers: trend variables
+   USE in_out_manager  ! I/O manager
+   USE ldfslp          ! iso-neutral slopes available
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_ldf_bilapg    ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+   
+CONTAINS
+
+   SUBROUTINE tra_ldf_bilapg( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tra_ldf_bilapg  ***
+      !!                    
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The lateral diffusive trends is provided by a 4th order
+      !!      operator rotated along geopotential surfaces. It is computed
+      !!      using before fields (forward in time) and geopotential slopes
+      !!      computed in routine inildf.
+      !!         -1- compute the geopotential harmonic operator applied to
+      !!      (tb,sb) and multiply it by the eddy diffusivity coefficient
+      !!      (done by a call to ldfght routine, result in (wk1,wk2) arrays).
+      !!      Applied the domain lateral boundary conditions by call to lbc_lnk
+      !!         -2- compute the geopotential harmonic operator applied to
+      !!      (wk1,wk2) by a second call to ldfght routine (result in (wk3,wk4)
+      !!      arrays).
+      !!         -3- Add this trend to the general trend (ta,sa):
+      !!            (ta,sa) = (ta,sa) + (wk3,wk4)
+      !!
+      !! ** Action : - Update (ta,sa) arrays with the before geopotential 
+      !!               biharmonic mixing trend.
+      !!             - Save the trends  in (ttrd,strd) ('key_diatrends')
+      !!
+      !! History :
+      !!   8.0  !  97-07  (G. Madec)  Original code
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk                 ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         wk1, wk2,            &  ! work array used for rotated biharmonic
+         wk3, wk4                ! operator on tracers and/or momentum
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_bilapg : horizontal biharmonic operator in s-coordinate'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
+      ENDIF
+
+      ! 1. Laplacian of (tb,sb) * aht
+      ! ----------------------------- 
+      ! rotated harmonic operator applied to (tb,sb)
+      ! and multiply by aht (output in (wk1,wk2) )
+
+      CALL ldfght ( tb, sb, wk1, wk2, 1 )
+
+
+      ! Lateral boundary conditions on (wk1,wk2)   (unchanged sign)
+      CALL lbc_lnk( wk1, 'T', 1. )   ;   CALL lbc_lnk( wk2, 'T', 1. )
+
+      ! 2. Bilaplacian of (tb,sb)
+      ! -------------------------
+      ! rotated harmonic operator applied to (wk1,wk2)
+      ! (output in (wk3,wk4) )
+
+      CALL ldfght ( wk1, wk2, wk3, wk4, 2 )
+
+
+      ! 3. Update the tracer trends                    (j-slab :   2, jpj-1)
+      ! ---------------------------
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ! add it to the general tracer trends
+               ta(ji,jj,jk) = ta(ji,jj,jk) + wk3(ji,jj,jk)
+               sa(ji,jj,jk) = sa(ji,jj,jk) + wk4(ji,jj,jk)
+#if defined key_trdtra || defined key_trdmld
+               ! save the horizontal diffusive trends
+               ttrd(ji,jj,jk,3) = wk3(ji,jj,jk)
+               strd(ji,jj,jk,3) = wk4(ji,jj,jk)
+#endif
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE tra_ldf_bilapg
+
+
+   SUBROUTINE ldfght ( pt, ps, plt, pls, kaht )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldfght  ***
+      !!          
+      !! ** Purpose :   Apply a geopotential harmonic operator to (pt,ps) and 
+      !!      multiply it by the eddy diffusivity coefficient (if kaht=1).
+      !!      Routine only used in s-coordinates (l_sco=T) with bilaplacian
+      !!      operator (ln_traldf_bilap=T) acting along geopotential surfaces
+      !!      (ln_traldf_hor).
+      !!
+      !! ** Method  :   The harmonic operator rotated along geopotential 
+      !!      surfaces is applied to (pt,ps) using the slopes of geopotential
+      !!      surfaces computed in inildf routine. The result is provided in
+      !!      (plt,pls) arrays. It is computed in 2 steps:
+      !!
+      !!      First step: horizontal part of the operator. It is computed on
+      !!      ==========  pt as follows (idem on ps)
+      !!      horizontal fluxes :
+      !!         zftu = e2u*e3u/e1u di[ pt ] - e2u*uslp dk[ mi(mk(pt)) ]
+      !!         zftv = e1v*e3v/e2v dj[ pt ] - e1v*vslp dk[ mj(mk(pt)) ]
+      !!      take the horizontal divergence of the fluxes (no divided by
+      !!      the volume element :
+      !!         plt  = di-1[ zftu ] +  dj-1[ zftv ]
+      !!
+      !!      Second step: vertical part of the operator. It is computed on
+      !!      ===========  pt as follows (idem on ps)
+      !!      vertical fluxes :
+      !!         zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2)  dk-1[ pt ]
+      !!              -     e2t     *       wslpi        di[ mi(mk(pt)) ]
+      !!              -     e1t     *       wslpj        dj[ mj(mk(pt)) ]
+      !!      take the vertical divergence of the fluxes add it to the hori-
+      !!      zontal component, divide the result by the volume element and
+      !!      if kaht=1, multiply by the eddy diffusivity coefficient:
+      !!         plt  = aht / (e1t*e2t*e3t) { plt + dk[ zftw ] }
+      !!      else:
+      !!         plt  =  1  / (e1t*e2t*e3t) { plt + dk[ zftw ] }
+      !!
+      !! * Action :
+      !!      'key_trdtra' defined: the trend is saved for diagnostics.
+      !!
+      !! History :
+      !!   8.0  !  97-07  (G. Madec)  Original code
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in  ) ::   &
+         pt, ps           ! tracer fields (before t and s for 1st call
+      !                   ! and laplacian of these fields for 2nd call.
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   &
+         plt, pls         ! partial harmonic operator applied to
+      !                   ! pt & ps components except
+      !                   ! second order vertical derivative term)
+      INTEGER, INTENT( in ) ::   &
+         kaht             ! =1 multiply the laplacian by the eddy diffusivity coeff.
+      !                   ! =2 no multiplication
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk             ! dummy loop indices
+      REAL(wp) ::   &
+         zabe1, zabe2, zmku, zmkv,     &  ! temporary scalars
+         zbtr, ztah, zsah, ztav, zsav, &
+         zcof0, zcof1, zcof2,          &
+         zcof3, zcof4
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zftu, zftv, zfsu, zfsv,       &  ! workspace
+         zdkt, zdk1t,                  &
+         zdks, zdk1s
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         zftw, zfsw,                   &  ! workspace
+         zdit, zdjt, zdj1t,            &
+         zdis, zdjs, zdj1s
+      !!----------------------------------------------------------------------
+
+      !                               ! ********** !   ! ===============
+      DO jk = 1, jpkm1                ! First step !   ! Horizontal slab
+         !                            ! ********** !   ! ===============
+
+         ! I.1 Vertical gradient of pt and ps at level jk and jk+1
+         ! -------------------------------------------------------
+         !     surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+
+         zdk1t(:,:) = ( pt(:,:,jk) - pt(:,:,jk+1) ) * tmask(:,:,jk+1)
+         zdk1s(:,:) = ( ps(:,:,jk) - ps(:,:,jk+1) ) * tmask(:,:,jk+1)
+
+         IF( jk == 1 ) THEN
+            zdkt(:,:) = zdk1t(:,:)
+            zdks(:,:) = zdk1s(:,:)
+         ELSE
+            zdkt(:,:) = ( pt(:,:,jk-1) - pt(:,:,jk) ) * tmask(:,:,jk)
+            zdks(:,:) = ( ps(:,:,jk-1) - ps(:,:,jk) ) * tmask(:,:,jk)
+         ENDIF
+
+
+         ! I.2 Horizontal fluxes
+         ! ---------------------
+
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zabe1 = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
+               zabe2 = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
+
+               zmku=1./MAX( tmask(ji+1,jj,jk  )+tmask(ji,jj,jk+1)   &
+                           +tmask(ji+1,jj,jk+1)+tmask(ji,jj,jk  ),1. )
+               zmkv=1./MAX( tmask(ji,jj+1,jk  )+tmask(ji,jj,jk+1)   &
+                           +tmask(ji,jj+1,jk+1)+tmask(ji,jj,jk  ),1. )
+
+               zcof1= -e2u(ji,jj) * uslp(ji,jj,jk) * zmku
+               zcof2= -e1v(ji,jj) * vslp(ji,jj,jk) * zmkv
+
+               zftu(ji,jj)= umask(ji,jj,jk) *   &
+                  (  zabe1 *( pt(ji+1,jj,jk) - pt(ji,jj,jk) )   &
+                   + zcof1 *( zdkt (ji+1,jj) + zdk1t(ji,jj)     &
+                             +zdk1t(ji+1,jj) + zdkt (ji,jj) )  )
+
+               zftv(ji,jj)= vmask(ji,jj,jk) *   &
+                  (  zabe2 *( pt(ji,jj+1,jk) - pt(ji,jj,jk) )   &
+                   + zcof2 *( zdkt (ji,jj+1) + zdk1t(ji,jj)     &
+                             +zdk1t(ji,jj+1) + zdkt (ji,jj) )  )
+
+               zfsu(ji,jj)= umask(ji,jj,jk) *   &
+                  (  zabe1 *( ps(ji+1,jj,jk) - ps(ji,jj,jk) )   &
+                   + zcof1 *( zdks (ji+1,jj) + zdk1s(ji,jj)     &
+                             +zdk1s(ji+1,jj) + zdks (ji,jj) )  )
+
+               zfsv(ji,jj)= vmask(ji,jj,jk) *   &
+                  (  zabe2 *( ps(ji,jj+1,jk) - ps(ji,jj,jk) )   &
+                   + zcof2 *( zdks (ji,jj+1) + zdk1s(ji,jj)     &
+                             +zdk1s(ji,jj+1) + zdks (ji,jj) )  )
+            END DO
+         END DO
+
+
+         ! I.3 Second derivative (divergence) (not divided by the volume)
+         ! ---------------------
+
+         DO jj = 2 , jpjm1
+            DO ji = 2 , jpim1
+               ztah = zftu(ji,jj) - zftu(ji-1,jj) + zftv(ji,jj) - zftv(ji,jj-1)
+               zsah = zfsu(ji,jj) - zfsu(ji-1,jj) + zfsv(ji,jj) - zfsv(ji,jj-1)
+               plt(ji,jj,jk) = ztah
+               pls(ji,jj,jk) = zsah
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+#if defined key_diaptr
+      IF( kaht == 2 .AND. MOD( kt, nf_ptr ) == 0 ) THEN
+         ! "zonal" mean diffusive heat and salt transport
+         pht_ldf(:,:) = prt_vj( zftv(:,:,:) )
+         pst_ldf(:,:) = prt_vj( zfsv(:,:,:) )
+      ENDIF
+#endif
+
+
+      !                             ! ************ !   ! ===============
+      DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
+         !                          ! ************ !   ! ===============
+
+         ! II.1 horizontal tracer gradient
+         ! -------------------------------
+
+         DO jk = 1, jpk
+            DO ji = 1, jpim1
+               zdit (ji,jk) = ( pt(ji+1,jj  ,jk) - pt(ji,jj  ,jk) ) * umask(ji,jj  ,jk)
+               zdis (ji,jk) = ( ps(ji+1,jj  ,jk) - ps(ji,jj  ,jk) ) * umask(ji,jj  ,jk)
+               zdjt (ji,jk) = ( pt(ji  ,jj+1,jk) - pt(ji,jj  ,jk) ) * vmask(ji,jj  ,jk)
+               zdjs (ji,jk) = ( ps(ji  ,jj+1,jk) - ps(ji,jj  ,jk) ) * vmask(ji,jj  ,jk)
+               zdj1t(ji,jk) = ( pt(ji  ,jj  ,jk) - pt(ji,jj-1,jk) ) * vmask(ji,jj-1,jk)
+               zdj1s(ji,jk) = ( ps(ji  ,jj  ,jk) - ps(ji,jj-1,jk) ) * vmask(ji,jj-1,jk)
+            END DO
+         END DO
+
+
+         ! II.2 Vertical fluxes
+         ! --------------------
+
+         ! Surface and bottom vertical fluxes set to zero
+         zftw(:, 1 ) = 0.e0
+         zfsw(:, 1 ) = 0.e0
+         zftw(:,jpk) = 0.e0
+         zfsw(:,jpk) = 0.e0
+
+         ! interior (2=<jk=<jpk-1)
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               zcof0 = e1t(ji,jj) * e2t(ji,jj) / fse3w(ji,jj,jk)   &
+                     * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)        &
+                        + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
+
+               zmku =1./MAX(  umask(ji  ,jj,jk-1)+umask(ji-1,jj,jk)   &
+                             +umask(ji-1,jj,jk-1)+umask(ji  ,jj,jk), 1. )
+
+               zmkv =1./MAX(  vmask(ji,jj  ,jk-1)+vmask(ji,jj-1,jk)   &
+                             +vmask(ji,jj-1,jk-1)+vmask(ji,jj  ,jk), 1. )
+
+               zcof3 = - e2t(ji,jj) * wslpi (ji,jj,jk) * zmku
+               zcof4 = - e1t(ji,jj) * wslpj (ji,jj,jk) * zmkv
+
+               zftw(ji,jk) = tmask(ji,jj,jk) *   &
+                  (  zcof0 * ( pt  (ji,jj,jk-1) - pt  (ji,jj,jk) )   &
+                   + zcof3 * ( zdit (ji  ,jk-1) + zdit (ji-1,jk)     &
+                              +zdit (ji-1,jk-1) + zdit (ji  ,jk) )   &
+                   + zcof4 * ( zdjt (ji  ,jk-1) + zdj1t(ji  ,jk)     &
+                              +zdj1t(ji  ,jk-1) + zdjt (ji  ,jk) )  )
+
+               zfsw(ji,jk) = tmask(ji,jj,jk) *   &
+                  (  zcof0 * ( ps  (ji,jj,jk-1) - ps  (ji,jj,jk) )   &
+                   + zcof3 * ( zdis (ji  ,jk-1) + zdis (ji-1,jk)     &
+                              +zdis (ji-1,jk-1) + zdis (ji  ,jk) )   &
+                   + zcof4 * ( zdjs (ji  ,jk-1) + zdj1s(ji  ,jk)     &
+                              +zdj1s(ji  ,jk-1) + zdjs (ji  ,jk) )  )
+            END DO
+         END DO
+
+
+         ! II.3 Divergence of vertical fluxes added to the horizontal divergence
+         ! ---------------------------------------------------------------------
+
+         IF( kaht == 1 ) THEN
+            ! multiply the laplacian by the eddy diffusivity coefficient
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  ! eddy coef. divided by the volume element
+                  zbtr = fsahtt(ji,jj,jk) / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+                  ! vertical divergence
+                  ztav = zftw(ji,jk) - zftw(ji,jk+1)
+                  zsav = zfsw(ji,jk) - zfsw(ji,jk+1)
+                  ! harmonic operator applied to (pt,ps) and multiply by aht
+                  plt(ji,jj,jk) = ( plt(ji,jj,jk) + ztav ) * zbtr
+                  pls(ji,jj,jk) = ( pls(ji,jj,jk) + zsav ) * zbtr
+               END DO
+            END DO
+         ELSEIF( kaht == 2 ) THEN
+            ! second call, no multiplication
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  ! inverse of the volume element
+                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+                  ! vertical divergence
+                  ztav = zftw(ji,jk) - zftw(ji,jk+1)
+                  zsav = zfsw(ji,jk) - zfsw(ji,jk+1)
+                  ! harmonic operator applied to (pt,ps) 
+                  plt(ji,jj,jk) = ( plt(ji,jj,jk) + ztav ) * zbtr
+                  pls(ji,jj,jk) = ( pls(ji,jj,jk) + zsav ) * zbtr
+               END DO
+            END DO
+         ELSE
+            IF(lwp) WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht
+            IF(lwp) WRITE(numout,*) '         We stop'
+            STOP 'ldfght'
+         ENDIF
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE ldfght
+
+#else  
+   !!----------------------------------------------------------------------
+   !!   Dummy module :             NO rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE tra_ldf_bilapg( kt )               ! Dummy routine
+      WRITE(*,*) kt
+   END SUBROUTINE tra_ldf_bilapg
+#endif
+
+   !!==============================================================================
+END MODULE traldf_bilapg
Index: /branches/nemo/NEMO/OPA_SRC/TRA/traldf_iso.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 4)
@@ -0,0 +1,260 @@
+MODULE traldf_iso
+   !!==============================================================================
+   !!                    ***  MODULE  traldf_iso  ***
+   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+#if defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_iso : update the tracer trend with the horizontal component
+   !!                 of iso neutral laplacian operator or horizontal 
+   !!                 laplacian operator in s-coordinate
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE ldftra_oce     ! ocean active tracers: lateral physics
+   USE trdtra_oce     ! ocean active tracers: trend variables
+   USE in_out_manager  ! I/O manager
+   USE ldfslp          ! iso-neutral slopes
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_ldf_iso  ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_ldf_iso( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_iso  ***
+      !! 
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The horizontal component of the lateral diffusive trends 
+      !!      is provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      horizontal fluxes associated with the rotated lateral mixing:
+      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
+      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ]
+      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
+      !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ]
+      !!      add horizontal Eddy Induced advective fluxes (lk_traldf_eiv=T):
+      !!         zftu = zftu - dk-1[ aht e2u mi(wslpi) ] mi( tb ) 
+      !!         zftv = zftv - dk-1[ aht e1v mj(wslpj) ] mj( tb ) 
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
+      !!      Add this trend to the general trend (ta,sa):
+      !!         ta = ta + difft
+      !!
+      !! ** Action  : - Update (ta,sa) arrays with the before isopycnal or
+      !!                geopotential s-coord harmonic mixing trend.
+      !!              - Save the trends in (ttrd,strd) ('key_diatrends')
+      !!
+      !! History :
+      !!        !  94-08  (G. Madec, M. Imbard)
+      !!        !  97-05  (G. Madec)  split into traldf and trazdf
+      !!   8.5  !  02-08  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce           , zftu => ua,  &  ! use ua as workspace
+         &                zfsu => va      ! use va as workspace
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk             ! dummy loop indices
+      REAL(wp) ::   &
+         zabe1, zabe2, zcof1, zcof2,   &  ! temporary scalars
+         zmsku, zmskv, zbtr, zta, zsa, &
+         zcg1, zcg2, zuwk, zvwk,       &
+         zuwk1, zvwk1,                 &
+         ztagu, ztagv, zsagu, zsagv
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zdkt, zdk1t,      &  ! workspace
+         zdks, zdk1s,      &
+         zftug, zftvg,                 &
+         zfsug, zfsvg
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zftv, zfsv                       ! workspace
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_iso : iso neutral lateral diffusion or'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   horizontal laplacian diffusion in s-coordinate'
+#if defined key_diaeiv
+         u_eiv(:,:,:) = 0.e0
+         v_eiv(:,:,:) = 0.e0
+#endif
+      ENDIF
+
+      ztagu = 0.e0
+      ztagv = 0.e0
+      zsagu = 0.e0
+      zsagv = 0.e0
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! 1. Vertical tracer gradient at level jk and jk+1
+         ! ------------------------------------------------
+         ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+
+         zdk1t(:,:) = ( tb(:,:,jk) - tb(:,:,jk+1) ) * tmask(:,:,jk+1)
+         zdk1s(:,:) = ( sb(:,:,jk) - sb(:,:,jk+1) ) * tmask(:,:,jk+1)
+
+         IF( jk == 1 ) THEN
+            zdkt(:,:) = zdk1t(:,:)
+            zdks(:,:) = zdk1s(:,:)
+         ELSE
+            zdkt(:,:) = ( tb(:,:,jk-1) - tb(:,:,jk) ) * tmask(:,:,jk)
+            zdks(:,:) = ( sb(:,:,jk-1) - sb(:,:,jk) ) * tmask(:,:,jk)
+         ENDIF
+
+
+         ! 2. Horizontal fluxes
+         ! --------------------
+
+         DO jj = 1 , jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zabe1 = ( fsahtu(ji,jj,jk) + ahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
+               zabe2 = ( fsahtv(ji,jj,jk) + ahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
+
+               zmsku = 1. / MAX(   tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   &
+                                 + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. )
+
+               zmskv = 1. / MAX(   tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   &
+                                 + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. )
+
+               zcof1 = -fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
+               zcof2 = -fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
+
+               zftu(ji,jj,jk) = umask(ji,jj,jk) * (   zabe1 * (   tb(ji+1,jj,jk) - tb(ji,jj,jk)  )   &
+                  &                              + zcof1 * (   zdkt (ji+1,jj) + zdk1t(ji,jj)      &
+                  &                                          + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  )
+
+               zftv(ji,jj,jk) = vmask(ji,jj,jk) * (   zabe2 * (   tb(ji,jj+1,jk) - tb(ji,jj,jk)  )   &
+                  &                              + zcof2 * (   zdkt (ji,jj+1) + zdk1t(ji,jj)      &
+                  &                                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  )
+
+               zfsu(ji,jj,jk) = umask(ji,jj,jk) * (   zabe1 * (   sb(ji+1,jj,jk) - sb(ji,jj,jk)  )   &
+                  &                              + zcof1 * (   zdks (ji+1,jj) + zdk1s(ji,jj)      &
+                  &                              + zdk1s(ji+1,jj) + zdks (ji,jj)  )  )
+
+               zfsv(ji,jj,jk) = vmask(ji,jj,jk) * (   zabe2 * (   sb(ji,jj+1,jk) - sb(ji,jj,jk)  )   &
+                  &                              + zcof2 * (   zdks (ji,jj+1) + zdk1s(ji,jj)      &
+                  &                              + zdk1s(ji,jj+1) + zdks (ji,jj)  )  )
+            END DO
+         END DO
+
+         !                              ! ---------------------------------------!
+         IF( lk_traldf_eiv ) THEN       ! Eddy induced vertical advective fluxes !
+            !                           ! ---------------------------------------!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zuwk = ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk  ) ) * fsaeiu(ji,jj,jk  ) * umask(ji,jj,jk  )
+                  zuwk1= ( wslpi(ji,jj,jk+1) + wslpi(ji+1,jj,jk+1) ) * fsaeiu(ji,jj,jk+1) * umask(ji,jj,jk+1)
+                  zvwk = ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk  ) ) * fsaeiv(ji,jj,jk  ) * vmask(ji,jj,jk  )
+                  zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji,jj+1,jk+1) ) * fsaeiv(ji,jj,jk+1) * vmask(ji,jj,jk+1)
+   
+                  zcg1= -0.25 * e2u(ji,jj) * umask(ji,jj,jk) * ( zuwk-zuwk1 )
+                  zcg2= -0.25 * e1v(ji,jj) * vmask(ji,jj,jk) * ( zvwk-zvwk1 )
+   
+                  zftug(ji,jj) = zcg1 * ( tb(ji+1,jj,jk) + tb(ji,jj,jk) )
+                  zftvg(ji,jj) = zcg2 * ( tb(ji,jj+1,jk) + tb(ji,jj,jk) )
+                  zfsug(ji,jj) = zcg1 * ( sb(ji+1,jj,jk) + sb(ji,jj,jk) )
+                  zfsvg(ji,jj) = zcg2 * ( sb(ji,jj+1,jk) + sb(ji,jj,jk) )
+   
+                  zftu(ji,jj,jk) = zftu(ji,jj,jk) + zftug(ji,jj)
+                  zftv(ji,jj,jk) = zftv(ji,jj,jk) + zftvg(ji,jj)
+                  zfsu(ji,jj,jk) = zfsu(ji,jj,jk) + zfsug(ji,jj)
+                  zfsv(ji,jj,jk) = zfsv(ji,jj,jk) + zfsvg(ji,jj)
+#   if defined key_diaeiv
+                  u_eiv(ji,jj,jk) = -2. * zcg1 / ( e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  v_eiv(ji,jj,jk) = -2. * zcg2 / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
+#   endif
+               END DO
+            END DO
+         ENDIF
+
+         ! II.4 Second derivative (divergence) and add to the general trend
+         ! ----------------------------------------------------------------
+
+         DO jj = 2 , jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbtr= 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+               zta = zbtr * (  zftu(ji,jj,jk) - zftu(ji-1,jj  ,jk)   &
+                  &          + zftv(ji,jj,jk) - zftv(ji  ,jj-1,jk)  )
+               zsa = zbtr * (  zfsu(ji,jj,jk) - zfsu(ji-1,jj  ,jk)   &
+                  &          + zfsv(ji,jj,jk) - zfsv(ji  ,jj-1,jk)  )
+               ta (ji,jj,jk) = ta (ji,jj,jk) + zta
+               sa (ji,jj,jk) = sa (ji,jj,jk) + zsa
+#if defined key_trdtra || defined key_trdmld
+#   if defined key_traldf_eiv
+               ztagu = ( zftug(ji,jj) - zftug(ji-1,jj  ) ) * zbtr
+               ztagv = ( zftvg(ji,jj) - zftvg(ji  ,jj-1) ) * zbtr
+               zsagu = ( zfsug(ji,jj) - zfsug(ji-1,jj  ) ) * zbtr
+               zsagv = ( zfsvg(ji,jj) - zfsvg(ji  ,jj-1) ) * zbtr
+               ttrdh(ji,jj,jk,3) = ztagu
+               ttrdh(ji,jj,jk,4) = ztagv
+               strdh(ji,jj,jk,3) = zsagu
+               strdh(ji,jj,jk,4) = zsagv
+#   endif
+               ttrd (ji,jj,jk,3) = zta - ztagu - ztagv
+               strd (ji,jj,jk,3) = zsa - zsagu - zsagv
+#endif
+            END DO
+         END DO
+         !                                          ! ===============
+      END DO                                        !   End of slab  
+      !                                             ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging)
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' ldf  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+#if defined key_diaptr
+      !!bug  no separation of diff iso and eiv
+      IF( MOD( kt, nf_ptr ) == 0 ) THEN
+      ! "zonal" mean lateral diffusive heat and salt transports
+         pht_ldf(:,:) = prt_vj( zftv(:,:,:) )
+         pst_ldf(:,:) = prt_vj( zfsv(:,:,:) )
+         ! "zonal" mean lateral eddy induced velocity heat and salt transports
+         pht_eiv(:,:) = prt_vj( zftv(:,:,:) )
+         pst_eiv(:,:) = prt_vj( zfsv(:,:,:) )
+      ENDIF
+#endif
+
+   END SUBROUTINE tra_ldf_iso
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :             No rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE tra_ldf_iso( kt )               ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE tra_ldf_iso
+#endif
+
+   !!==============================================================================
+END MODULE traldf_iso
Index: /branches/nemo/NEMO/OPA_SRC/TRA/traldf_iso_zps.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/traldf_iso_zps.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/traldf_iso_zps.F90	(revision 4)
@@ -0,0 +1,296 @@
+MODULE traldf_iso_zps
+   !!==============================================================================
+   !!                   ***  MODULE  traldf_iso_zps  ***
+   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+#if defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'               slope of the lateral diffusive direction
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_iso_zps : update the tracer trend with the horizontal 
+   !!                     component of a iso-neutral laplacian operator
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce     ! ocean active tracers: lateral physics
+   USE trdtra_oce     ! ocean active tracers: trend
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE ldfslp          ! iso-neutral slopes
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC tra_ldf_iso_zps  ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_ldf_iso_zps( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_iso_zps  ***
+      !!
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The horizontal component of the lateral diffusive trends 
+      !!      is provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      horizontal fluxes associated with the rotated lateral mixing:
+      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
+      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ]
+      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
+      !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ]
+      !!      add horizontal Eddy Induced advective fluxes (lk_traldf_eiv=T):
+      !!         zftu = zftu - dk-1[ aht e2u mi(wslpi) ] mi( tb ) 
+      !!         zftv = zftv - dk-1[ aht e1v mj(wslpj) ] mj( tb ) 
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
+      !!      Add this trend to the general trend (ta,sa):
+      !!         ta = ta + difft
+      !!
+      !!      'key_trdtra' defined: the trend is saved for diagnostics.
+      !!
+      !!      macro-tasked on horizontal slab (jk-loop).
+      !!
+      !! ** Action :
+      !!         Update (ta,sa) arrays with the before along level biharmonic
+      !!      mixing trend.
+      !!         Save in (ttrd,strd) arrays the trends if 'key_diatrends' defined
+      !!
+      !! History :
+      !!        !  94-08  (G. Madec, M. Imbard)
+      !!        !  97-05  (G. Madec)  split into traldf and trazdf
+      !!   8.5  !  02-08  (G. Madec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce           , zftu => ua,  &  ! use ua as workspace
+         &                zfsu => va      ! use va as workspace
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk             ! dummy loop indices
+      INTEGER ::   iku, ikv               ! temporary integer
+      REAL(wp) ::   &
+         zabe1, zabe2, zcof1, zcof2,   &  ! temporary scalars
+         zmsku, zmskv, zbtr, zta, zsa, &
+         zcg1, zcg2, zuwk, zvwk,       &
+         zuwk1, zvwk1,                 &
+         ztagu, ztagv, zsagu, zsagv
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zdkt , zdk1t, zftug, zftvg,   &  ! temporary workspace
+         zdks , zdk1s, zfsug, zfsvg       !    "           "
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
+         zftv, zgtbu, zgtbv,           &  ! temporary workspace
+         zfsv, zgsbu, zgsbv               !    "           "
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_iso_zps : iso neutral laplacian diffusion in '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~   z-coordinates with partial steps'
+#if defined key_diaeiv
+         u_eiv(:,:,:) = 0.e0
+         v_eiv(:,:,:) = 0.e0
+#endif
+      ENDIF
+
+      ztagu = 0.e0
+      ztagv = 0.e0
+      zsagu = 0.e0
+      zsagv = 0.e0
+
+      ! Horizontal temperature and salinity gradient 
+      DO jk = 1, jpk
+         DO jj = 1, jpj-1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zgtbu(ji,jj,jk) = tmask(ji,jj,jk) * ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) )
+               zgsbu(ji,jj,jk) = tmask(ji,jj,jk) * ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) )
+               zgtbv(ji,jj,jk) = tmask(ji,jj,jk) * ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) )
+               zgsbv(ji,jj,jk) = tmask(ji,jj,jk) * ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      ! partial steps correction at the last level 
+      DO jj = 1, jpj-1
+         DO ji = 1, jpi-1
+            ! last level
+	    iku = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
+	    ikv = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
+            zgtbu(ji,jj,iku) = gtu(ji,jj) 
+            zgsbu(ji,jj,iku) = gsu(ji,jj)               
+            zgtbv(ji,jj,ikv) = gtv(ji,jj) 
+            zgsbv(ji,jj,ikv) = gsv(ji,jj)               
+         END DO
+      END DO
+      
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! 1. Vertical tracer gradient at level jk and jk+1
+         ! ------------------------------------------------
+         ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+
+         zdk1t(:,:) = ( tb(:,:,jk) - tb(:,:,jk+1) ) * tmask(:,:,jk+1)
+         zdk1s(:,:) = ( sb(:,:,jk) - sb(:,:,jk+1) ) * tmask(:,:,jk+1)
+
+         IF( jk == 1 ) THEN
+            zdkt(:,:) = zdk1t(:,:)
+            zdks(:,:) = zdk1s(:,:)
+         ELSE
+            zdkt(:,:) = ( tb(:,:,jk-1) - tb(:,:,jk) ) * tmask(:,:,jk)
+            zdks(:,:) = ( sb(:,:,jk-1) - sb(:,:,jk) ) * tmask(:,:,jk)
+         ENDIF
+
+
+         ! 2. Horizontal fluxes
+         ! --------------------
+
+         DO jj = 1 , jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zabe1 = ( fsahtu(ji,jj,jk) + ahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
+               zabe2 = ( fsahtv(ji,jj,jk) + ahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
+
+               zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   &
+                                + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. )
+
+               zmskv = 1. / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   &
+                                + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. )
+
+               zcof1 = -fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
+               zcof2 = -fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
+
+               zftu(ji,jj,jk) = umask(ji,jj,jk) * (  zabe1 * zgtbu(ji,jj,jk)   &
+                  &                                + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
+                  &                                           + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  )
+               zftv(ji,jj,jk) = vmask(ji,jj,jk) * (  zabe2 * zgtbv(ji,jj,jk)   &
+                  &                                + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
+                  &                                           + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  )
+               zfsu(ji,jj,jk) = umask(ji,jj,jk) * (  zabe1 * zgsbu(ji,jj,jk)   &
+                  &                                + zcof1 * (  zdks (ji+1,jj) + zdk1s(ji,jj)      &
+                  &                                           + zdk1s(ji+1,jj) + zdks (ji,jj)  )  )
+               zfsv(ji,jj,jk) = vmask(ji,jj,jk) * (  zabe2 * zgsbv(ji,jj,jk)   &
+                  &                                + zcof2 * (  zdks (ji,jj+1) + zdk1s(ji,jj)      &
+                  &                                           + zdk1s(ji,jj+1) + zdks (ji,jj)  )  )
+            END DO
+         END DO
+
+         !                              ! ---------------------------------------!
+         IF( lk_traldf_eiv ) THEN       ! Eddy induced vertical advective fluxes !
+            !                           ! ---------------------------------------!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zuwk = ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj  ,jk  ) ) * fsaeiu(ji,jj,jk  ) * umask(ji,jj,jk  )
+                  zuwk1= ( wslpi(ji,jj,jk+1) + wslpi(ji+1,jj  ,jk+1) ) * fsaeiu(ji,jj,jk+1) * umask(ji,jj,jk+1)
+                  zvwk = ( wslpj(ji,jj,jk  ) + wslpj(ji  ,jj+1,jk  ) ) * fsaeiv(ji,jj,jk  ) * vmask(ji,jj,jk  )
+                  zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji  ,jj+1,jk+1) ) * fsaeiv(ji,jj,jk+1) * vmask(ji,jj,jk+1)
+
+                  zcg1= -0.25 * e2u(ji,jj) * umask(ji,jj,jk) * ( zuwk-zuwk1 )
+                  zcg2= -0.25 * e1v(ji,jj) * vmask(ji,jj,jk) * ( zvwk-zvwk1 )
+
+                  zftug(ji,jj) = zcg1 * ( tb(ji+1,jj,jk) + tb(ji,jj,jk) )
+                  zftvg(ji,jj) = zcg2 * ( tb(ji,jj+1,jk) + tb(ji,jj,jk) )
+                  zfsug(ji,jj) = zcg1 * ( sb(ji+1,jj,jk) + sb(ji,jj,jk) )
+                  zfsvg(ji,jj) = zcg2 * ( sb(ji,jj+1,jk) + sb(ji,jj,jk) )
+
+                  zftu(ji,jj,jk) = zftu(ji,jj,jk) + zftug(ji,jj)
+                  zftv(ji,jj,jk) = zftv(ji,jj,jk) + zftvg(ji,jj)
+                  zfsu(ji,jj,jk) = zfsu(ji,jj,jk) + zfsug(ji,jj)
+                  zfsv(ji,jj,jk) = zfsv(ji,jj,jk) + zfsvg(ji,jj)
+#   if defined key_diaeiv
+                  u_eiv(ji,jj,jk) = -2. * zcg1 / ( e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  v_eiv(ji,jj,jk) = -2. * zcg2 / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
+#   endif
+               END DO
+            END DO
+         ENDIF
+
+         ! II.4 Second derivative (divergence) and add to the general trend
+         ! ----------------------------------------------------------------
+
+         DO jj = 2 , jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbtr= 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+               zta = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
+               zsa = zbtr * ( zfsu(ji,jj,jk) - zfsu(ji-1,jj,jk) + zfsv(ji,jj,jk) - zfsv(ji,jj-1,jk)  )
+               ta (ji,jj,jk) = ta (ji,jj,jk) + zta
+               sa (ji,jj,jk) = sa (ji,jj,jk) + zsa
+#if defined key_trdtra || defined key_trdmld
+               ttrd (ji,jj,jk,3) = zta
+               strd (ji,jj,jk,3) = zsa
+#endif
+            END DO
+         END DO
+#if defined key_trdtra || defined key_trdmld
+         IF( lk_traldf_eiv ) THEN
+         DO jj = 2 , jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbtr= 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               ztagu = ( zftug(ji,jj) - zftug(ji-1,jj  ) ) * zbtr
+               ztagv = ( zftvg(ji,jj) - zftvg(ji  ,jj-1) ) * zbtr
+               zsagu = ( zfsug(ji,jj) - zfsug(ji-1,jj  ) ) * zbtr
+               zsagv = ( zfsvg(ji,jj) - zfsvg(ji  ,jj-1) ) * zbtr
+               ttrdh(ji,jj,jk,3) = ztagu
+               ttrdh(ji,jj,jk,4) = ztagv
+               strdh(ji,jj,jk,3) = zsagu
+               strdh(ji,jj,jk,4) = zsagv
+               ttrd (ji,jj,jk,3) = ttrd(ji,jj,jk,3) - ztagu - ztagv
+               strd (ji,jj,jk,3) = ttrd(ji,jj,jk,3) - zsagu - zsagv
+            END DO
+         END DO
+         ENDIF
+#endif
+         !                                          ! ===============
+      END DO                                        !   End of slab  
+      !                                             ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging)
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' ldf  - Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+
+#if defined key_diaptr
+      !!bug  no separation of diff iso and eiv
+      IF( MOD( kt, nf_ptr ) == 0 ) THEN
+         ! "zonal" mean lateral diffusive heat and salt transports
+         pht_ldf(:,:) = prt_vj( zftv(:,:,:) )
+         pst_ldf(:,:) = prt_vj( zfsv(:,:,:) )
+         ! "zonal" mean lateral eddy induced velocity heat and salt transports
+         pht_eiv(:,:) = prt_vj( zftv(:,:,:) )
+         pst_eiv(:,:) = prt_vj( zfsv(:,:,:) )
+      ENDIF
+#endif
+
+   END SUBROUTINE tra_ldf_iso_zps
+
+#else
+   !!----------------------------------------------------------------------
+   !!   default option :   Dummy code   NO rotation of the diffusive tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE tra_ldf_iso_zps( kt )               ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE tra_ldf_iso_zps
+#endif
+
+   !!==============================================================================
+END MODULE traldf_iso_zps
Index: /branches/nemo/NEMO/OPA_SRC/TRA/traldf_lap.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 4)
@@ -0,0 +1,167 @@
+MODULE traldf_lap
+   !!==============================================================================
+   !!                       ***  MODULE  traldf_lap  ***
+   !! Ocean active tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_lap  : update the tracer trend with the horizontal diffusion
+   !!                 using a iso-level harmonic (laplacien) operator.
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce     ! ocean active tracers: lateral physics
+   USE trdtra_oce     ! ocean active tracer trends
+   USE in_out_manager  ! I/O manager
+   USE lbclnk
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_ldf_lap  ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+   
+CONTAINS
+
+   SUBROUTINE tra_ldf_lap( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_lap  ***
+      !!                   
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   Second order diffusive operator evaluated using before
+      !!      fields (forward time scheme). The horizontal diffusive trends of 
+      !!      temperature (idem for salinity) is given by:
+      !!       * s-coordinate ('key_s_coord' defined), the vertical scale 
+      !!      factors e3. are inside the derivatives:
+      !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(tb) ]
+      !!                                   + dj-1[ aht e1v*e3v/e2v dj(tb) ] }
+      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
+      !!          difft = 1/(e1t*e2t) {  di-1[ aht e2u/e1u di(tb) ]
+      !!                               + dj-1[ aht e1v/e2v dj(tb) ] }
+      !!      Add this trend to the general tracer trend (ta,sa):
+      !!          (ta,sa) = (ta,sa) + ( difft , diffs )
+      !!
+      !! ** Action  : - Update (ta,sa) arrays with the before iso-level 
+      !!                harmonic mixing trend.
+      !!              - Save the trends in (ttrd,strd) ('key_diatrends')
+      !!
+      !! History :
+      !!   1.0  !  87-06  (P. Andrich, D. L Hostis)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  95-11  (G. Madec)  suppress volumetric scale factors
+      !!        !  96-01  (G. Madec)  statement function for e3
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      USE oce              , ztu => ua,  &  ! use ua as workspace
+         &                   zsu => va      ! use va as workspace
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+      
+      !! * Local save
+      REAL(wp), DIMENSION(jpi,jpj), SAVE ::   &
+         ze1ur, ze2vr, zbtr2              ! scale factor coefficients
+      
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk             ! dummy loop indices
+      REAL(wp) ::   &
+         zabe1, zabe2, zbtr, zta, zsa     ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         ztv, zsv               ! workspace
+      !!----------------------------------------------------------------------
+      
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+         ze1ur(:,:) = e2u(:,:) / e1u(:,:)
+         ze2vr(:,:) = e1v(:,:) / e2v(:,:)
+         zbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) )
+      ENDIF
+      
+      !                                                  ! =============
+      DO jk = 1, jpkm1                                   ! Vertical slab
+         !                                               ! =============
+         ! 1. First derivative (gradient)
+         ! -------------------
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+#if defined key_s_coord
+               zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj) * fse3u(ji,jj,jk)
+               zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj) * fse3v(ji,jj,jk)
+#else
+               zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * ze1ur(ji,jj)
+               zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * ze2vr(ji,jj)
+#endif
+               ztu(ji,jj,jk) = zabe1 * ( tb(ji+1,jj  ,jk) - tb(ji,jj,jk) )
+               zsu(ji,jj,jk) = zabe1 * ( sb(ji+1,jj  ,jk) - sb(ji,jj,jk) )
+               ztv(ji,jj,jk) = zabe2 * ( tb(ji  ,jj+1,jk) - tb(ji,jj,jk) )
+               zsv(ji,jj,jk) = zabe2 * ( sb(ji  ,jj+1,jk) - sb(ji,jj,jk) )
+            END DO  
+         END DO  
+         
+         
+         ! 2. Second derivative (divergence)
+         ! --------------------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_s_coord
+               zbtr = zbtr2(ji,jj) / fse3t(ji,jj,jk)
+#else
+               zbtr = zbtr2(ji,jj)
+#endif
+               ! horizontal diffusive trends
+               zta = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
+                  &          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
+               zsa = zbtr * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk)   &
+                  &          + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  )
+               ! add it to the general tracer trends
+               ta(ji,jj,jk) = ta(ji,jj,jk) + zta
+               sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
+#if defined key_trdtra || defined key_trdmld
+               ! save the horizontal diffusive trends
+               ttrd(ji,jj,jk,3) = zta
+               strd(ji,jj,jk,3) = zsa
+#endif
+            END DO  
+         END DO  
+         !                                               ! =============
+      END DO                                             !  End of slab  
+      !                                                  ! =============
+
+#if defined key_diaptr
+      ! "zonal" mean lateral diffusive heat and salt transport 
+      IF( MOD( kt, nf_ptr ) == 0 ) THEN
+# if defined key_s_coord || defined key_partial_steps
+         pht_ldf(:,:) = prt_vj( ztv(:,:,:) )
+         pst_ldf(:,:) = prt_vj( zsv(:,:,:) )
+# else
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                 ztv(ji,jj,jk) = ztv(ji,jj,jk) * fse3v(ji,jj,jk)
+                 zsv(ji,jj,jk) = zsv(ji,jj,jk) * fse3v(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         pht_ldf(:,:) = prt_vj( ztv(:,:,:) )
+         pst_ldf(:,:) = prt_vj( zsv(:,:,:) )
+# endif
+      ENDIF
+#endif
+
+   END SUBROUTINE tra_ldf_lap
+
+   !!==============================================================================
+END MODULE traldf_lap
Index: /branches/nemo/NEMO/OPA_SRC/TRA/tranpc.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 4)
@@ -0,0 +1,306 @@
+MODULE tranpc
+   !!==============================================================================
+   !!                       ***  MODULE  tranpc  ***
+   !! Ocean active tracers:  non penetrative convection scheme
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tra_npc      : apply the non penetrative convection scheme
+   !!   tra_npc_init : initialization and control of the scheme
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE trdtra_oce     ! ocean active tracer trends
+   USE in_out_manager  ! I/O manager
+
+   USE eosbn2          ! equation of state (eos routine) 
+   USE lbclnk          ! lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_npc    ! routine called by step.F90
+
+   !! * Module variable
+   INTEGER ::      &
+      nnpc1 =   1,      &  ! nnpc1   non penetrative convective scheme frequency
+      nnpc2 =  15          ! nnpc2   non penetrative convective scheme print frequency
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_npc( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tranpc  ***
+      !!
+      !! ** Purpose :   Non penetrative convective adjustment scheme. solve 
+      !!      the static instability of the water column (now, after the swap) 
+      !!      while conserving heat and salt contents.
+      !!
+      !! ** Method  :   The algorithm used converges in a maximium of jpk 
+      !!      iterations. instabilities are treated when the vertical density
+      !!      gradient is less than 1.e-5.
+      !!
+      !!      'key_trdtra' defined: the trend associated with this
+      !!                               algorithm is saved.
+      !!
+      !!      macro-tasked on vertical slab (jj-loop)
+      !!
+      !! ** Action  : - (tn,sn) after the application od the npc scheme
+      !!              - save the associated trends (ttrd,strd) ('key_trdtra')
+      !!
+      !! References :
+      !!      Madec, et al., 1991, JPO, 21, 9, 1349-1371.
+      !!
+      !! History :
+      !!   1.0  !  90-09  (G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard)  periodic conditions on t and s
+      !!        !  93-03  (M. Guyon)  symetrical conditions 
+      !!        !  96-01  (G. Madec)  statement function for e3
+      !!                                  suppression of common work arrays
+      !!   8.5  !  02-06  (G. Madec)  free form F90
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk             ! dummy loop indices
+      INTEGER ::   &
+         inpcc ,      &  ! number of statically instable water column
+         inpci ,      &  ! number of iteration for npc scheme
+         jiter, jkdown, jkp,   &
+         ikbot, ik, ikup, ikdown
+      REAL(wp) ::   &           ! temporary arrays
+         ze3tot, zta, zsa, zraua, ze3dwn
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         zwx, zwy, zwz                    ! temporary arrays
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zrhop                            ! temporary arrays
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000  )   CALL tra_npc_init
+
+
+      IF( MOD( kt, nnpc1 ) == 0 ) THEN
+
+         inpcc = 0
+         inpci = 0
+
+         ! 0. Potential density
+         ! --------------------
+
+         CALL eos( tn, sn, rhd, zrhop )
+
+         !                                                ! ===============
+         DO jj = 1, jpj                                   !  Vertical slab
+            !                                             ! ===============
+
+            ! 1. Static instability pointer 
+            ! -----------------------------
+
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  zwx(ji,jk) = ( zrhop(ji,jj,jk) - zrhop(ji,jj,jk+1) ) * tmask(ji,jj,jk+1)
+               END DO
+            END DO
+
+            ! 1.1 do not consider the boundary points
+
+            ! even if east-west cyclic b. c. do not considere ji=1 or jpi
+            DO jk = 1, jpkm1
+               zwx( 1 ,jk) = 0.e0
+               zwx(jpi,jk) = 0.e0
+            END DO
+            ! even if south-symmetric b. c. used, do not considere jj=1
+            IF( jj == 1 ) zwx(:,:) = 0.e0
+
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  zwx(ji,jk) = 1.
+                  IF( zwx(ji,jk) < 1.e-5 ) zwx(ji,jk)=0.
+               END DO
+            END DO
+
+            zwy(:,1) = 0.
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  zwy(ji,1) = zwy(ji,1) + zwx(ji,jk)
+               END DO
+            END DO
+
+            zwz(1,1) = 0.
+            DO ji = 1, jpi
+               zwz(1,1) = zwz(1,1) + zwy(ji,1)
+            END DO
+
+            inpcc = inpcc + NINT( zwz(1,1) )
+
+#   if defined key_trdtra
+            ! save the tracer trends
+            DO jk = 1, jpk
+               DO ji = 1, jpi
+                  ttrd(ji,jj,jk,5) = tn(ji,jj,jk)
+                  strd(ji,jj,jk,5) = sn(ji,jj,jk)
+               END DO
+            END DO
+#   endif
+
+            ! 2. Vertical mixing for each instable portion of the density profil
+            ! ------------------------------------------------------------------
+
+            IF (zwz(1,1) /= 0.) THEN
+
+               ! -->> the density profil is statically instable :
+
+               DO ji = 1, jpi
+                  IF( zwy(ji,1) /= 0. ) THEN
+
+                     ! ikbot: ocean bottom level
+
+                     ikbot = mbathy(ji,jj)
+
+                     ! vertical iteration
+
+                     DO jiter = 1, jpk
+
+                        ! search of ikup : the first static instability from the sea surface
+
+                        ik = 0
+220                     CONTINUE
+                        ik = ik + 1
+                        IF( ik >= ikbot-1 ) GO TO 200
+                        zwx(ji,ik) = zrhop(ji,jj,ik) - zrhop(ji,jj,ik+1)
+                        IF( zwx(ji,ik) <= 0. ) GO TO 220
+                        ikup = ik
+                        ! the density profil is instable below ikup
+   
+                        ! ikdown : bottom of the instable portion of the density profil
+
+                        ! search of ikdown and vertical mixing from ikup to ikdown
+
+                        ze3tot= fse3t(ji,jj,ikup)
+                        zta   = tn   (ji,jj,ikup)
+                        zsa   = sn   (ji,jj,ikup)
+                        zraua = zrhop(ji,jj,ikup)
+
+                        DO jkdown = ikup+1, ikbot-1
+                           IF( zraua <= zrhop(ji,jj,jkdown) ) THEN
+                              ikdown = jkdown
+                              GO TO 240
+                           ENDIF
+                           ze3dwn =  fse3t(ji,jj,jkdown)
+                           ze3tot =  ze3tot + ze3dwn
+                           zta   = ( zta*(ze3tot-ze3dwn) + tn(ji,jj,jkdown)*ze3dwn )/ze3tot
+                           zsa   = ( zsa*(ze3tot-ze3dwn) + sn(ji,jj,jkdown)*ze3dwn )/ze3tot
+                           zraua = ( zraua*(ze3tot-ze3dwn) + zrhop(ji,jj,jkdown)*ze3dwn )/ze3tot
+                           inpci = inpci+1
+                        END DO
+                        ikdown = ikbot-1
+240                     CONTINUE
+
+                        DO jkp = ikup, ikdown-1
+                           tn(ji,jj,jkp) = zta
+                           sn(ji,jj,jkp) = zsa
+                           zrhop(ji,jj,jkp) = zraua
+                        END DO
+                        IF (ikdown == ikbot-1 .AND. zraua >= zrhop(ji,jj,ikdown) ) THEN
+                           tn(ji,jj,ikdown) = zta
+                           sn(ji,jj,ikdown) = zsa
+                           zrhop(ji,jj,ikdown) = zraua
+                        ENDIF
+
+                     END DO
+                  ENDIF
+200               CONTINUE
+               END DO
+
+               ! <<-- no more static instability on slab jj
+
+            ENDIF
+
+#   if defined key_trdtra
+            ! Non penetrative mixing trends
+            ! -----------------------------
+            DO jk = 1, jpk
+               DO ji = 1, jpi
+                  ttrd(ji,jj,jk,5) = tn(ji,jj,jk) - ttrd(ji,jj,jk,5)
+                  strd(ji,jj,jk,5) = sn(ji,jj,jk) - strd(ji,jj,jk,5)
+               END DO
+            END DO
+#   endif
+
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+      
+         ! Lateral boundary conditions on ( tn, sn )   ( Unchanged sign)
+         ! ------------------------------============
+         CALL lbc_lnk( tn, 'T', 1. )
+         CALL lbc_lnk( sn, 'T', 1. )
+      
+
+         !  2. non penetrative convective scheme statistics
+         !  -----------------------------------------------
+
+         IF( nnpc2 /= 0 .AND. MOD( kt, nnpc2 ) == 0 ) THEN
+            IF(lwp) WRITE(numout,*)' kt=',kt, ' number of statically instable',   &
+               ' water column : ',inpcc, ' number of iteration : ',inpci
+         ENDIF
+
+      ENDIF
+      
+   END SUBROUTINE tra_npc
+
+
+   SUBROUTINE tra_npc_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_npc_init  ***
+      !!                   
+      !! ** Purpose :   initializations of the non-penetrative adjustment scheme
+      !!
+      !! History :
+      !!   8.5  !  02-12  (G. Madec)  F90 : free form
+      !!----------------------------------------------------------------------
+      !! * Namelist
+      NAMELIST/namnpc/ nnpc1, nnpc2
+      !!----------------------------------------------------------------------
+
+      ! Namelist namzdf : vertical diffusion
+      REWIND( numnam )
+      READ  ( numnam, namnpc )
+
+      ! Parameter print
+      ! ---------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_npc_init : Non Penetrative Convection (npc) scheme'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '          Namelist namnpc : set npc scheme parameters'
+         WRITE(numout,*)
+         WRITE(numout,*) '             npc scheme frequency           nnpc1  = ', nnpc1
+         WRITE(numout,*) '             npc scheme print frequency     nnpc2  = ', nnpc2
+         WRITE(numout,*)
+      ENDIF
+
+
+      ! Parameter controls
+      ! ------------------
+      IF ( nnpc1 == 0 ) THEN
+          IF(lwp) WRITE(numout,cform_war)
+          IF(lwp) WRITE(numout,*) '             nnpc1 = ', nnpc1, ' is forced to 1'
+          nnpc1 = 1
+          nwarn = nwarn + 1
+      ENDIF
+      
+   END SUBROUTINE tra_npc_init
+
+   !!======================================================================
+END MODULE tranpc
Index: /branches/nemo/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 4)
@@ -0,0 +1,172 @@
+MODULE tranxt
+   !!======================================================================
+   !!                       ***  MODULE  tranxt  ***
+   !! Ocean active tracers:  time stepping on temperature and salinity
+   !!======================================================================
+   
+   !!----------------------------------------------------------------------
+   !!   tra_nxt     : time stepping on temperature and salinity
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE zdf_oce         ! ???
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE obctra          ! open boundary condition (obc_tra routine)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_nxt          ! routine called by step.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_nxt( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tranxt  ***
+      !!
+      !! ** Purpose :   Compute the temperature and salinity fields at the 
+      !!      next time-step from their temporal trends and swap the fields.
+      !! 
+      !! ** Method  :   Apply lateral boundary conditions on (ua,va) through 
+      !!      call to lbc_lnk routine
+      !!      After t and s are compute using a leap-frog scheme environment:
+      !!         ta = tb + 2 rdttra(k) * ta
+      !!         sa = sb + 2 rdttra(k) * sa
+      !!      Compute and save in (ta,sa) an average over three time levels
+      !!      (before,now and after) of temperature and salinity which is
+      !!      used to compute rhd in eos routine and thus the hydrostatic 
+      !!      pressure gradient (ln_dynhpg_imp = T)
+      !!      Apply an Asselin time filter on now tracers (tn,sn) to avoid
+      !!      the divergence of two consecutive time-steps and swap tracer
+      !!      arrays to prepare the next time_step:
+      !!         (zt,zs) = (ta+2tn+tb,sa+2sn+sb)/4       (ln_dynhpg_imp = T)
+      !!         (zt,zs) = (0,0)                            (default option)
+      !!         (tb,sb) = (tn,vn) + atfp [ (tb,sb) + (ta,sa) - 2 (tn,sn) ]
+      !!         (tn,sn) = (ta,sa) 
+      !!         (ta,sa) = (zt,zs)  (NB: reset to 0 after use in eos.F)
+      !!
+      !! ** Action  : - update (tb,sb) and (tn,sn) 
+      !!              - (ta,sa) time averaged (t,s)      (ln_dynhpg_imp = T)
+      !!
+      !! History :
+      !!   7.0  !  91-11  (G. Madec)  Original code
+      !!        !  93-03  (M. Guyon)  symetrical conditions
+      !!        !  96-02  (G. Madec & M. Imbard)  opa release 8.0
+      !!   8.0  !  96-04  (A. Weaver)  Euler forward step
+      !!   8.2  !  99-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!        !  02-11  (C. Talandier, A-M Treguier) Open boundaries
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zt, zs      ! temporary scalars
+      REAL(wp) ::   zfact       ! temporary scalar
+      !!----------------------------------------------------------------------
+
+
+      ! 0. Lateral boundary conditions on ( ta, sa )   (T-point, unchanged sign)
+      ! ---------------------------------============
+      CALL lbc_lnk( ta, 'T', 1. )   
+      CALL lbc_lnk( sa, 'T', 1. )
+
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         ! 1. Leap-frog scheme (only in explicit case, otherwise the 
+         ! -------------------  time stepping is already done in trazdf)
+         IF( l_trazdf_exp ) THEN
+            zfact = 2. * rdttra(jk)
+            IF( neuler == 0 .AND. kt == nit000 ) zfact = rdttra(jk)
+            ta(:,:,jk) = ( tb(:,:,jk) + zfact * ta(:,:,jk) ) * tmask(:,:,jk)
+            sa(:,:,jk) = ( sb(:,:,jk) + zfact * sa(:,:,jk) ) * tmask(:,:,jk)
+         ENDIF
+
+#if defined key_obc
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      ! Update tracers on open boundaries.
+      CALL obc_tra( kt )
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+#endif
+
+
+         ! 2. Time filter and swap of arrays
+         ! ---------------------------------
+
+         IF( ln_dynhpg_imp ) THEN                       ! semi-implicite hpg
+            IF( neuler == 0 .AND. kt == nit000 ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zt = ( ta(ji,jj,jk) + 2. * tn(ji,jj,jk) + tb(ji,jj,jk) ) * 0.25
+                     zs = ( sa(ji,jj,jk) + 2. * sn(ji,jj,jk) + sb(ji,jj,jk) ) * 0.25
+                     tb(ji,jj,jk) = tn(ji,jj,jk)
+                     sb(ji,jj,jk) = sn(ji,jj,jk)
+                     tn(ji,jj,jk) = ta(ji,jj,jk)
+                     sn(ji,jj,jk) = sa(ji,jj,jk)
+                     ta(ji,jj,jk) = zt
+                     sa(ji,jj,jk) = zs
+                  END DO
+               END DO
+            ELSE
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zt = ( ta(ji,jj,jk) + 2. * tn(ji,jj,jk) + tb(ji,jj,jk) ) * 0.25
+                     zs = ( sa(ji,jj,jk) + 2. * sn(ji,jj,jk) + sb(ji,jj,jk) ) * 0.25
+                     tb(ji,jj,jk) = atfp  * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk)
+                     sb(ji,jj,jk) = atfp  * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk)
+                     tn(ji,jj,jk) = ta(ji,jj,jk)
+                     sn(ji,jj,jk) = sa(ji,jj,jk)
+                     ta(ji,jj,jk) = zt
+                     sa(ji,jj,jk) = zs
+                  END DO
+               END DO
+            ENDIF
+         ELSE                                          ! Default case
+            IF( neuler == 0 .AND. kt == nit000 ) THEN
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     tb(ji,jj,jk) = tn(ji,jj,jk)
+                     sb(ji,jj,jk) = sn(ji,jj,jk)
+                     tn(ji,jj,jk) = ta(ji,jj,jk)
+                     sn(ji,jj,jk) = sa(ji,jj,jk)
+                  END DO
+               END DO
+            ELSE
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     tb(ji,jj,jk) = atfp  * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk)
+                     sb(ji,jj,jk) = atfp  * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk)
+                     tn(ji,jj,jk) = ta(ji,jj,jk)
+                     sn(ji,jj,jk) = sa(ji,jj,jk)
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN         ! print mean field (used for debugging)
+         WRITE(numout,*) ' nxt  - Tn: ', SUM(tn*tmask), ' Sn: ', SUM(sn*tmask)
+      ENDIF
+
+   END SUBROUTINE tra_nxt
+
+   !!======================================================================
+END MODULE tranxt
Index: /branches/nemo/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 4)
@@ -0,0 +1,284 @@
+MODULE traqsr
+   !!======================================================================
+   !!                       ***  MODULE  traqsr  ***
+   !! Ocean physics: solar radiation penetration in the top ocean levels
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tra_qsr      : trend due to the solar radiation penetration
+   !!   tra_qsr_init : solar radiation penetration initialization
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trdtra_oce     ! ocean active tracer trends
+   USE in_out_manager  ! I/O manager
+
+   USE ocesbc          ! thermohaline fluxes
+   USE phycst          ! physical constants
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_qsr      ! routine called by step.F90 (ln_traqsr=T)
+   PUBLIC tra_qsr_init ! routine called by opa.F90
+
+   LOGICAL, PUBLIC ::   ln_traqsr = .TRUE.   ! qsr flag (Default=T)
+
+   !! * Module variables
+   REAL(wp) ::          & !!! * penetrative solar radiation namelist *
+      rabs = 0.58_wp,   &  ! fraction associated with xsi1
+      xsi1 = 0.35_wp,   &  ! first depth of extinction 
+      xsi2 = 23.0_wp       ! second depth of extinction 
+      !                    ! (default values: water type Ib)
+   INTEGER ::    &
+      nksr                 ! number of levels
+   REAL(wp), DIMENSION(jpk) ::   &
+      gdsr                 ! profile of the solar flux penetration
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_qsr( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_qsr  ***
+      !!
+      !! ** Purpose :   Compute the temperature trend due to the solar radiation
+      !!      penetration and add it to the general temperature trend.
+      !!
+      !! ** Method  : The profile of the solar radiation within the ocean is
+      !!      defined through two penetration length scale (xsr1,xsr2) and a 
+      !!      ratio (rabs) as :
+      !!         I(k) = Qsr*( rabs*EXP(z(k)/xsr1) + (1.-rabs)*EXP(z(k)/xsr2) )
+      !!         The temperature trend associated with the solar radiation
+      !!      penetration is given by :
+      !!            zta = 1/e3t dk[ I ] / (rau0*Cp)
+      !!         At the bottom, boudary condition for the radiation is no flux :
+      !!      all heat which has not been absorbed in the above levels is put
+      !!      in the last ocean level.
+      !!         In z-coordinate case, the computation is only done down to the
+      !!      level where I(k) < 1.e-15 W/m2. In addition, the coefficients 
+      !!      used for the computation are calculated one for once as they
+      !!      depends on k only.
+      !!
+      !! ** Action  : - update ta with the penetrative solar radiation trend
+      !!              - save the trend in ttrd ('key_trdtra')
+      !!
+      !! History :
+      !!   6.0  !  90-10  (B. Blanke)  Original code
+      !!   7.0  !  91-11  (G. Madec)
+      !!        !  96-01  (G. Madec)  s-coordinates
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt    ! ocean time-step
+
+      !! * Local declarations
+      INTEGER ::    ji, jj, jk         ! dummy loop indexes
+      REAL(wp) ::   zc0, zta           ! temporary scalars
+      REAL(wp) ::   zc1 , zc2 ,     &  ! temporary scalars
+                    zdp1, zdp2         !
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF ( lwp )  WRITE(numout,*)
+         IF ( lwp )  WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation'
+         IF ( lwp )  WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      !                                                ! =================== !
+      IF( lk_sco ) THEN                                !     s-coordinate    !
+         !                                             ! =================== !
+         !
+         !                                                   ! ===============
+         DO jk = 1, jpkm1                                    ! Horizontal slab
+            !                                                ! ===============
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+
+                  zdp1 = -fsdepw(ji,jj,jk  )              ! compute the qsr trend
+                  zdp2 = -fsdepw(ji,jj,jk+1)
+                  zc0  = qsr(ji,jj) * ro0cpr / fse3t(ji,jj,jk)
+                  zc1  =   (  rabs * EXP(zdp1/xsi1) + (1.-rabs) * EXP(zdp1/xsi2)  )
+                  zc2  = - (  rabs * EXP(zdp2/xsi1) + (1.-rabs) * EXP(zdp2/xsi2)  )
+                  zta  = zc0 * (  zc1 * tmask(ji,jj,jk) + zc2 * tmask(ji,jj,jk+1)  )
+
+                  ta(ji,jj,jk) = ta(ji,jj,jk) + zta       ! add qsr trend to the temperature trend
+
+#      if defined key_trdtra || defined key_trdmld
+                  ttrd(ji,jj,jk,7) = zta                  ! save the qsr trend
+#      endif
+               END DO
+            END DO
+            !                                                ! ===============
+         END DO                                              !   End of slab
+         !                                                   ! ===============
+      ENDIF
+      !                                                ! =================== !
+      IF( lk_zps ) THEN                                !    partial steps    !
+         !                                             ! =================== !
+         !
+         !                                                ! ===============
+         DO jk = 1, nksr                                  ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+   
+                  zc0 = qsr(ji,jj) / fse3t(ji,jj,jk)      ! compute the qsr trend
+                  zta = zc0 * ( gdsr(jk) * tmask(ji,jj,jk) - gdsr(jk+1) * tmask(ji,jj,jk+1) )
+   
+                  ta(ji,jj,jk) = ta(ji,jj,jk) + zta       ! add qsr trend to the temperature trend
+   
+#      if defined key_trdtra || defined key_trdmld
+                  ttrd(ji,jj,jk,7) = zta                  ! save the qsr trend
+#      endif
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+      ENDIF
+      !                                                ! =================== !
+      IF( lk_zco ) THEN                                !     z-coordinate    !
+         !                                             ! =================== !
+         !
+         !                                                ! ===============
+         DO jk = 1, nksr                                  ! Horizontal slab
+            !                                             ! ===============
+            zc0 = 1. / fse3t(1,1,jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  !                                       ! compute qsr forcing trend
+                  zta = qsr(ji,jj) * zc0 * ( gdsr(jk)*tmask(ji,jj,jk) - gdsr(jk+1)*tmask(ji,jj,jk+1) )
+   
+                  ta(ji,jj,jk) = ta(ji,jj,jk) + zta       ! add qsr trend to the temperature trend
+   
+#      if defined key_trdtra || defined key_trdmld
+                  ttrd(ji,jj,jk,7) = zta                  ! save the qsr forcing trend
+#      endif
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+      ENDIF
+
+      IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging)
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zta = SUM( ta * tmask ) 
+         WRITE(numout,*) ' qsr  - Ta: ', zta-t_ctl
+         t_ctl = zta 
+      ENDIF
+
+
+      ! 2. Substract qsr from the total heat flux q
+      ! -------------------------------------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            q(ji,jj) = qt(ji,jj) - qsr(ji,jj)
+         END DO
+      END DO
+
+   END SUBROUTINE tra_qsr
+
+
+   SUBROUTINE tra_qsr_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_qsr_init  ***
+      !!
+      !! ** Purpose :   Initialization for the penetrative solar radiation
+      !!
+      !! ** Method  :   The profile of solar radiation within the ocean is set
+      !!      from two length scale of penetration (xsr1,xsr2) and a ratio
+      !!      (rabs). These parameters are read in the namqsr namelist. The
+      !!      default values correspond to clear water (type I in Jerlov' 
+      !!      (1968) classification.
+      !!         called by tra_qsr at the first timestep (nit000)
+      !!
+      !! ** Action  : - initialize xsr1, xsr2 and rabs
+      !!
+      !! Reference :
+      !!   Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
+      !!
+      !! History :
+      !!   8.5  !  02-06  (G. Madec) Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::    jk,     &  ! dummy loop index
+                    indic      ! temporary integer
+      REAL(wp) ::   zdp1       ! temporary scalar
+
+      NAMELIST/namqsr/ ln_traqsr, rabs, xsi1, xsi2
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist namqsr : ratio and length of penetration
+      ! --------------------
+      REWIND ( numnam )
+      READ   ( numnam, namqsr )
+
+      ! Parameter control and print
+      ! ---------------------------
+      IF( ln_traqsr  ) THEN
+        IF ( lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '          Namelist namqsr : set the parameter of penetration'
+         WRITE(numout,*) '             fraction associated with xsi   rabs   = ',rabs
+         WRITE(numout,*) '             first depth of extinction      xsi1   = ',xsi1
+         WRITE(numout,*) '             second depth of extinction     xsi2   = ',xsi2
+         WRITE(numout,*)
+        END IF
+      ELSE
+        IF ( lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_qsr_init : NO solar flux penetration'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+        END IF
+      ENDIF
+
+      IF( rabs > 1.e0 .OR. rabs < 0.e0 .OR. xsi1 < 0.e0 .OR. xsi2 < 0.e0 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '             0<rabs<1, 0<xsi1, or 0<xsi2 not satisfied'
+         nstop = nstop + 1
+      ENDIF
+
+
+      ! Initialization
+      ! --------------
+      IF( .NOT. lk_sco ) THEN
+         ! z-coordinate with or without partial step : same before last ocean w-level everywhere
+         DO jk = 1, jpk
+            zdp1 = -fsdepw(1,1,jk)
+            gdsr(jk) = ro0cpr * (  rabs  * EXP( zdp1/xsi1 ) + (1.-rabs) * EXP( zdp1/xsi2 )  )
+         END DO
+         indic = 0
+         DO jk = 1, jpk
+            IF( gdsr(jk) <= 1.e-15 .AND. indic == 0 ) THEN
+               gdsr(jk) = 0.e0
+               nksr = jk
+               !!bug Edmee chg res   nksr = jk - 1
+               indic = 1
+            ENDIF
+         END DO
+         nksr = MIN( nksr, jpkm1 )
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '        - z-coordinate, level max of computation =', nksr
+            WRITE(numout,*) '             profile of coef. of penetration:'
+            WRITE(numout,"('              ',7e11.2)") ( gdsr(jk), jk = 1, nksr )
+            WRITE(numout,*)
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE tra_qsr_init
+
+   !!======================================================================
+END MODULE traqsr
Index: /branches/nemo/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 4)
@@ -0,0 +1,133 @@
+MODULE trasbc
+   !!==============================================================================
+   !!                       ***  MODULE  trasbc  ***
+   !! Ocean active tracers:  surface boundary condition
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tra_sbc      : update the tracer trend at ocean surface
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space domain variables
+   USE ocesbc          ! surface thermohaline fluxes
+   USE phycst          ! physical constant
+   USE traqsr          ! ???
+   USE trdtra_oce      ! ocean active tracer trends 
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_sbc              ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_sbc ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_sbc  ***
+      !!                   
+      !! ** Purpose :   Compute the tracer surface boundary condition trend of
+      !!      (flux through the interface, concentration/dilution effect)
+      !!      and add it to the general trend of tracer equations.
+      !!
+      !! ** Method :
+      !!      * flux through the air-sea interface:
+      !!            - temperature : heat flux q (w/m2). If penetrative solar
+      !!         radiation q is only the non solar part of the heat flux, the
+      !!         solar part is added in traqsr.F routine.
+      !!            ta = ta + q /(rau0 rcp e3t)  for k=1
+      !!            - salinity    : no salt flux
+      !!      * concentration/dilution effect:
+      !!            The surface freshwater flux modify the ocean volume
+      !!         and thus the concentration of a tracer and the temperature.
+      !!         First order of the effect of surface freshwater exchange 
+      !!         for salinity, it can be neglected on temperature (especially
+      !!         as the temparature of precipitations and runoffs is usually
+      !!         unknown.
+      !!            - temperature : we assume that the temperature of both
+      !!         precipitations and runoffs is equal to the SST, thus there
+      !!         is no additional flux since in this case, the concentration
+      !!         dilution effect is balanced by the net heat flux associated
+      !!         to the freshwater exchange:
+      !!            (Tp P - Te E) + STT (P-E) = 0 when Tp=Te=SST
+      !!            - salinity    : evaporation, precipitation and runoff
+      !!         water has a zero salinity, thus
+      !!            sa = sa + emp * sn / e3t   for k=1
+      !!         where emp, the surface freshwater budget (evaporation minus
+      !!         precipitation minus runoff) given in kg/m2/s is divided
+      !!         by 1000 kg/m3 (density of plain water) to obtain m/s.
+      !!
+      !! ** Action  : - Update the 1st level of (ta,sa) with the trend associated
+      !!                with the tracer surface boundary condition 
+      !!              - save the trend it in ttrd ('key_trdtra')
+      !!
+      !! History :
+      !!   8.2  !  98-10  (G. Madec, G. Roullet, M. Imbard)  Original code
+      !!   8.2  !  01-02  (D. Ludicone)  sea ice and free surface
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj                   ! dummy loop indices
+      REAL(wp) ::   zta, zsa, zsrau, zse3t   ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      ! 0. initialization
+      zsrau = 1. / rauw
+#if ! defined key_s_coord
+      zse3t = 1. / fse3t(1,1,1)
+#endif
+
+      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration
+
+      ! 1. Concentration dillution effect on (t,s)
+      DO jj = 2, jpj
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+#if defined key_s_coord
+            zse3t = 1. / fse3t(ji,jj,1)
+#endif
+            ! temperature : heat flux
+            zta = ro0cpr * ( qt(ji,jj) - qsr(ji,jj) ) * zse3t
+
+            ! salinity :  concent./dilut. effect
+            zsa = emps(ji,jj) * zsrau * sn(ji,jj,1) * zse3t
+            
+            ! add the trend to the general tracer trend
+            ta(ji,jj,1) = ta(ji,jj,1) + zta
+            sa(ji,jj,1) = sa(ji,jj,1) + zsa
+#if defined key_trdtra || defined key_trdmld
+            ! save the trend associated to (t,s) sea surface boundary condition
+            flxtrd(ji,jj,1) = zta
+            flxtrd(ji,jj,2) = zsa
+#endif
+         END DO
+      END DO
+      
+      IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging)
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' sbc  - Ta: ', zta, ' Sa: ', zsa
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+   END SUBROUTINE tra_sbc
+
+   !!======================================================================
+END MODULE trasbc
Index: /branches/nemo/NEMO/OPA_SRC/TRA/trazdf_exp.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 4)
@@ -0,0 +1,173 @@
+MODULE trazdf_exp
+   !!==============================================================================
+   !!                    ***  MODULE  trazdf_exp  ***
+   !! Ocean active tracers:  vertical component of the tracer mixing trend using
+   !!                        an explicit time-stepping (time spllitting scheme)
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tra_zdf_exp  : update the tracer trend with the vertical diffusion
+   !!                  using an explicit time stepping
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers 
+   USE dom_oce         ! ocean space and time domain 
+   USE trdtra_oce      ! ocean active tracer trends
+   USE zdf_oce         ! ocean vertical physics
+   USE zdfddm          ! ocean vertical physics: double diffusion
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_zdf_exp          ! routine called by step.F90
+
+   !! * Module variable
+   REAL(wp), DIMENSION(jpk) ::   &
+      r2dt                     ! vertical profile of 2 x tracer time-step
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0, LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_zdf_exp( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_zdf_exp  ***
+      !!                   
+      !! ** Purpose :   Compute the trend due to the vertical tracer mixing 
+      !!      using an explicit time stepping and add it to the general trend 
+      !!      of the tracer equations.
+      !!
+      !! ** Method  :   The vertical diffusion of tracers (t & s) is given by:
+      !!         difft = dz( avt dz(tb) ) = 1/e3t dk+1( avt/e3w dk(tb) )
+      !!      It is evaluated with an Euler scheme, using a time splitting
+      !!      technique.
+      !!      Surface and bottom boundary conditions: no diffusive flux on
+      !!      both tracers (bottom, applied through the masked field avt).
+      !!      Add this trend to the general trend ta,sa :
+      !!          ta = ta + dz( avt dz(t) )
+      !!         (sa = sa + dz( avs dz(t) ) if lk_zdfddm= T)
+      !!
+      !! ** Action : - Update (ta,sa) with the before vertical diffusion trend
+      !!             - Save the trends  in (ttrd,strd) ('key_diatrends')
+      !!
+      !! History :
+      !!   6.0  !  90-10  (B. Blanke)  Original code
+      !!   7.0  !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard)  correction on tracer trend loops
+      !!        !  96-01  (G. Madec)  statement function for e3
+      !!        !  97-05  (G. Madec)  vertical component of isopycnal
+      !!        !  97-07  (G. Madec)  geopotential diffusion in s-coord
+      !!        !  00-08  (G. Madec)  double diffusive mixing
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+      
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk, jl             ! dummy loop indices
+      REAL(wp) ::   &
+         zlavmr,                 &  ! ???
+         zave3r, ze3tr,          &  ! ???
+         zta, zsa                   !
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         zwx, zwy, zwz, zww
+      !!---------------------------------------------------------------------
+
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      ! time step = 2 rdttra 
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+         r2dt(:) =  rdttra(:)              ! restarting with Euler time stepping
+      ELSEIF( kt <= nit000 + 1) THEN
+         r2dt(:) = 2. * rdttra(:)          ! leapfrog
+      ENDIF
+      zlavmr = 1. / float( n_zdfexp )
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+         ! 1. Initializations
+         ! ------------------
+
+         ! Surface & bottom boundary conditions: no flux
+         DO ji = 2, jpim1
+            zwy(ji, 1 ) = 0.e0
+            zwy(ji,jpk) = 0.e0
+            zww(ji, 1 ) = 0.e0
+            zww(ji,jpk) = 0.e0
+         END DO
+
+         ! zwx and zwz arrays set to before tracer values
+         DO jk = 1, jpk
+            DO ji = 2, jpim1
+               zwx(ji,jk) = tb(ji,jj,jk)
+               zwz(ji,jk) = sb(ji,jj,jk)
+#if defined key_trdtra
+               ! initialize vertical diffusive tracer trends to zero
+               ttrd(ji,jj,jk,4) = 0.e0
+               strd(ji,jj,jk,4) = 0.e0
+#endif
+            END DO
+         END DO
+
+
+         ! 2. Time splitting loop
+         ! ----------------------
+
+         DO jl = 1, n_zdfexp
+
+            ! first vertical derivative
+            IF( lk_zdfddm ) THEN       ! double diffusion: avs /= avt
+               DO jk = 2, jpk
+                  DO ji = 2, jpim1
+                     zave3r = 1.e0 / fse3w(ji,jj,jk) 
+                     zwy(ji,jk) =   avt(ji,jj,jk) * ( zwx(ji,jk-1) - zwx(ji,jk) ) * zave3r
+                     zww(ji,jk) = fsavs(ji,jj,jk) * ( zwz(ji,jk-1) - zwz(ji,jk) ) * zave3r
+                  END DO
+               END DO
+            ELSE                      ! default : avs = avt
+               DO jk = 2, jpk
+                  DO ji = 2, jpim1
+                     zave3r = avt(ji,jj,jk) / fse3w(ji,jj,jk)
+                     zwy(ji,jk) = zave3r *(zwx(ji,jk-1) - zwx(ji,jk) )
+                     zww(ji,jk) = zave3r *(zwz(ji,jk-1) - zwz(ji,jk) )
+                  END DO
+               END DO
+            ENDIF
+
+            ! trend estimation at kt+l*2*rdt/n_zdfexp
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  ze3tr = zlavmr / fse3t(ji,jj,jk)
+                  ! 2nd vertical derivative
+                  zta = ( zwy(ji,jk) - zwy(ji,jk+1) ) * ze3tr
+                  zsa = ( zww(ji,jk) - zww(ji,jk+1) ) * ze3tr
+                  ! update the tracer trends
+                  ta(ji,jj,jk) = ta(ji,jj,jk) + zta
+                  sa(ji,jj,jk) = sa(ji,jj,jk) + zsa
+                  ! update tracer fields at kt+l*2*rdt/n_zdfexp
+                  zwx(ji,jk) = zwx(ji,jk) + r2dt(jk) * zta * tmask(ji,jj,jk)
+                  zwz(ji,jk) = zwz(ji,jk) + r2dt(jk) * zsa * tmask(ji,jj,jk)
+#if defined key_trdtra
+                  ! save tracer trends 
+                  ttrd(ji,jj,jk,4) = ttrd(ji,jj,jk,4) + zta
+                  strd(ji,jj,jk,4) = strd(ji,jj,jk,4) + zsa
+#endif
+               END DO
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+   END SUBROUTINE tra_zdf_exp
+
+   !!==============================================================================
+END MODULE trazdf_exp
Index: /branches/nemo/NEMO/OPA_SRC/TRA/trazdf_imp.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 4)
@@ -0,0 +1,233 @@
+MODULE trazdf_imp
+   !!==============================================================================
+   !!                    ***  MODULE  trazdf_imp  ***
+   !! Ocean active tracers:  vertical component of the tracer mixing trend
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tra_zdf_imp  : update the tracer trend with the vertical diffusion
+   !!                  using an implicit time-stepping.
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE zdf_oce         ! ocean vertical physics
+   USE zdfddm          ! ocean vertical physics: double diffusion
+   USE trdtra_oce     ! tracers trends diagnostics 
+   USE in_out_manager  ! I/O manager
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_zdf_imp          ! routine called by step.F90
+
+   !! * Module variable
+   REAL(wp), DIMENSION(jpk) ::   &
+      r2dt                     ! vertical profile of 2 x tracer time-step
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_zdf_imp( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_zdf_imp  ***
+      !!
+      !! ** Purpose :   Compute the trend due to the vertical tracer mixing 
+      !!      using an implicit time stepping and add it to the general trend
+      !!      of the tracer equations.
+      !!
+      !! ** Method  :   The vertical diffusion of tracers (t & s) is given by:
+      !!          difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(ta) )
+      !!      It is thus evaluated using a backward time scheme
+      !!      Surface and bottom boundary conditions: no diffusive flux on
+      !!      both tracers (bottom, applied through the masked field avt).
+      !!      Add this trend to the general trend ta,sa :
+      !!          ta = ta + dz( avt dz(t) )
+      !!         (sa = sa + dz( avs dz(t) ) if lk_zdfddm=T)
+      !!
+      !! ** Action  : - Update (ta,sa) with the before vertical diffusion trend
+      !!              - save the trends in (ttrd,strd) ('key_trdtra')
+      !!
+      !! History :
+      !!   6.0  !  90-10  (B. Blanke)  Original code
+      !!   7.0  !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard)  correction on tracer trend loops
+      !!        !  96-01  (G. Madec)  statement function for e3
+      !!        !  97-05  (G. Madec)  vertical component of isopycnal
+      !!        !  97-07  (G. Madec)  geopotential diffusion in s-coord
+      !!        !  00-08  (G. Madec)  double diffusive mixing
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk                 ! dummy loop indices
+      INTEGER ::   ikst, ikenm2, ikstp1
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         zwd, zws, zwi,          &  ! ???
+         zwx, zwy, zwz, zwt         ! ???
+#if defined key_trdtra   ||   defined key_trdmld
+      REAL(wp) ::   zta, zsa        ! temporary scalars
+#endif
+      !!---------------------------------------------------------------------
+
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+
+      ! time step = 2 rdttra ex
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+         r2dt(:) =  rdttra(:)              ! restarting with Euler time stepping
+      ELSEIF( kt <= nit000 + 1) THEN
+         r2dt(:) = 2. * rdttra(:)          ! leapfrog
+      ENDIF
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+         ! 0. Matrix construction
+         ! ----------------------
+
+         ! Diagonal, inferior, superior (including the bottom boundary condition via avt masked)
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zwi(ji,jk) = - r2dt(jk) * avt(ji,jj,jk  )   &
+                                       / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) )
+               zws(ji,jk) = - r2dt(jk) * avt(ji,jj,jk+1)   &
+                                       / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )
+               zwd(ji,jk) = 1. - zwi(ji,jk) - zws(ji,jk)
+            END DO
+         END DO
+
+         ! Surface boudary conditions
+         DO ji = 2, jpim1
+            zwi(ji,1) = 0.e0
+            zwd(ji,1) = 1. - zws(ji,1)
+         END DO
+
+         ! 1. Vertical diffusion on temperature
+         ! -------------------------===========
+
+         ! Second member construction
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zwy(ji,jk) = tb(ji,jj,jk) + r2dt(jk) * ta(ji,jj,jk)
+            END DO
+         END DO
+
+         ! Matrix inversion from the first level
+         ikst = 1
+
+#   include "zdf.matrixsolver.h90"
+
+#if defined key_trdtra   ||   defined key_trdmld
+         ! Compute and save the vertical diffusive temperature trends
+         IF( l_traldf_iso ) THEN
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  zta = ( zwx(ji,jk) - tb(ji,jj,jk) ) / r2dt(jk)
+                  ttrd(ji,jj,jk,4) = zta - ta(ji,jj,jk) + ttrd(ji,jj,jk,4)
+               END DO
+            END DO
+         ELSE
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  zta = ( zwx(ji,jk) - tb(ji,jj,jk) ) / r2dt(jk)
+                  ttrd(ji,jj,jk,4) = zta - ta(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+
+#endif
+
+         ! Save the masked temperature after in ta
+         ! (c a u t i o n:  temperature not its trend, Leap-frog scheme done
+         !                  it will not be done in tranxt)
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ta(ji,jj,jk) = zwx(ji,jk) * tmask(ji,jj,jk)
+            END DO
+         END DO
+
+
+         ! 2. Vertical diffusion on salinity
+         ! -------------------------========
+
+#if defined key_zdfddm
+         ! Rebuild the Matrix as avt /= avs
+
+         ! Diagonal, inferior, superior
+         ! (including the bottom boundary condition via avs masked)
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zwi(ji,jk) = - r2dt(jk) * fsavs(ji,jj,jk  )   &
+                  /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) )
+               zws(ji,jk) = - r2dt(jk) * fsavs(ji,jj,jk+1)   &
+                  /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )
+               zwd(ji,jk) = 1. - zwi(ji,jk) - zws(ji,jk)
+            END DO
+         END DO
+
+         ! Surface boudary conditions
+         DO ji = 2, jpim1
+            zwi(ji,1) = 0.e0
+            zwd(ji,1) = 1. - zws(ji,1)
+         END DO
+#endif
+         ! Second member construction
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zwy(ji,jk) = sb(ji,jj,jk) + r2dt(jk) * sa(ji,jj,jk)
+            END DO
+         END DO
+
+         ! Matrix inversion from the first level
+         ikst = 1
+
+#   include "zdf.matrixsolver.h90"
+
+#if defined key_trdtra   ||   defined key_trdmld
+         ! Compute and save the vertical diffusive salinity trends
+         IF( l_traldf_iso ) THEN
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  zsa = ( zwx(ji,jk) - sb(ji,jj,jk) ) / r2dt(jk)
+                  strd(ji,jj,jk,4) = zsa - sa(ji,jj,jk) + strd(ji,jj,jk,4)
+               END DO
+            END DO
+         ELSE
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  zsa = ( zwx(ji,jk) - sb(ji,jj,jk) ) / r2dt(jk)
+                  strd(ji,jj,jk,4) = zsa - sa(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+#endif
+
+         ! Save the masked salinity after in sa
+         ! (c a u t i o n:  salinity not its trend, Leap-frog scheme done
+         !                  it will not be done in tranxt)
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               sa(ji,jj,jk) = zwx(ji,jk)  * tmask(ji,jj,jk)
+            END DO
+         END DO
+
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+   END SUBROUTINE tra_zdf_imp
+
+   !!==============================================================================
+END MODULE trazdf_imp
Index: /branches/nemo/NEMO/OPA_SRC/TRA/trazdf_iso.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/trazdf_iso.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/trazdf_iso.F90	(revision 4)
@@ -0,0 +1,545 @@
+MODULE trazdf_iso
+   !!==============================================================================
+   !!                    ***  MODULE  trazdf_iso  ***
+   !! Ocean active tracers:  vertical component of the tracer mixing trend
+   !!==============================================================================
+#if defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   tra_zdf_iso  : update the tracer trend with the vertical part of 
+   !!                  the isopycnal or geopotential s-coord. operator and
+   !!                  the vertical diffusion
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE ldfslp          ! Make iso-neutral slopes available
+   USE ldftra_oce     ! ocean active tracers: lateral physics
+   USE zdf_oce         ! ocean vertical physics 
+   USE zdfddm          ! ocean vertical physics: double diffusion
+   USE trdtra_oce     ! tracers trends diagnostics variables
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC tra_zdf_iso    ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_zdf_iso( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_zdf_iso  ***
+      !!
+      !! ** Purpose :
+      !!     Compute the trend due to the vertical tracer diffusion inclu-
+      !!     ding the vertical component of lateral mixing (only for second
+      !!     order operator, for fourth order it is already computed and
+      !!     add to the general trend in traldf.F) and add it to the general
+      !!     trend of the tracer equations.
+      !!
+      !! ** Method :
+      !!         The vertical component of the lateral diffusive trends is
+      !!      provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      First part: vertical trends associated with the lateral mixing
+      !!      ==========  (excluding the vertical flux proportional to dk[t] )
+      !!      vertical fluxes associated with the rotated lateral mixing:
+      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(tb)) ]
+      !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  }
+      !!      save avt coef. resulting from vertical physics alone in zavt:
+      !!         zavt = avt
+      !!      update and save in zavt the vertical eddy viscosity coefficient:
+      !!         avt = avt + wslpi^2+wslj^2
+      !!      add vertical Eddy Induced advective fluxes ('lk_traldf_eiv=T):
+      !!         zftw = zftw + { di[aht e2u mi(wslpi)]
+      !!                    +dj[aht e1v mj(wslpj)] } mk(tb)
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ] 
+      !!      Add this trend to the general trend (ta,sa):
+      !!         ta = ta + difft
+      !!
+      !!      Second part: vertical trend associated with the vertical physics
+      !!      ===========  (including the vertical flux proportional to dk[t]
+      !!                  associated with the lateral mixing, through the
+      !!                  update of avt)
+      !!      The vertical diffusion of tracers (t & s) is given by:
+      !!             difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
+      !!      It is computed using a backward time scheme, t=ta.
+      !!      Surface and bottom boundary conditions: no diffusive flux on
+      !!      both tracers (bottom, applied through the masked field avt).
+      !!      Add this trend to the general trend ta,sa :
+      !!         ta = ta + dz( avt dz(t) )
+      !!         (sa = sa + dz( avs dz(t) ) if lk_zdfddm=T )
+      !!
+      !!      Third part: recover avt resulting from the vertical physics
+      !!      ==========  alone, for further diagnostics (for example to
+      !!                  compute the turbocline depth in diamld).
+      !!         avt = zavt
+      !!         (avs = zavs if lk_zdfddm=T )
+      !!
+      !!      'key_trdtra' defined: trend saved for futher diagnostics.
+      !!
+      !!      macro-tasked on vertical slab (jj-loop)
+      !!
+      !! ** Action :
+      !!         Update (ta,sa) arrays with the before vertical diffusion trend
+      !!         Save in (ttrd,strd) arrays the trends if 'key_diatrends' defined
+      !!
+      !! History :
+      !!   7.0  !  91-11  (G. Madec)  Original code
+      !!        !  92-06  (M. Imbard)  correction on tracer trend loops
+      !!        !  96-01  (G. Madec)  statement function for e3
+      !!        !  97-05  (G. Madec)  vertical component of isopycnal
+      !!        !  97-07  (G. Madec)  geopotential diffusion in s-coord
+      !!        !  00-08  (G. Madec)  double diffusive mixing
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+
+      !! * Local save
+      REAL(wp), DIMENSION(jpk), SAVE ::  &
+         z2dt
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk                 ! dummy loop indices
+      INTEGER ::   ikst, ikenm2, ikstp1       ! temporary integers
+#if defined key_partial_steps
+      INTEGER ::   iku, ikv, ikv1             ! temporary integers
+#endif
+      REAL(wp) ::   zta, zsa
+      REAL(wp) ::   &
+         ztavg, zsavg,          &  ! ???
+         zcoef0, zcoef3,        &  ! ???
+         zcoef4, zcoeg3, zavi,  &  ! ???
+         zbtr, zmku, zmkv,      &  !
+         zuwki, zvwki, zuwk,    &  !
+         zvwk, ztav, zsav
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         zwd, zws, zwi,         &  ! ???
+         zwx, zwy, zwz, zwt        ! ???
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         ztfw, zdit, zdjt, zdj1t,   &
+         zsfw, zdis, zdjs, zdj1s,   &
+         zavt, zavs
+#if defined key_traldf_eiv
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         ztfwg, zsfwg
+#endif
+      !!---------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!---------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_zdf_iso : vertical mixing (including isopycnal component)'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+#if defined key_diaeiv
+         w_eiv(:,:,:) = 0.e0
+#endif
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+
+      ztavg = 0.e0
+      zsavg = 0.e0
+      ! time step = 2 rdttra ex
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+         z2dt(:) =  rdttra(:)              ! restarting with Euler time stepping
+      ELSEIF( kt <= nit000 + 1) THEN
+         z2dt(:) = 2. * rdttra(:)          ! leapfrog
+      ENDIF
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+
+         ! I. vertical trends associated with the lateral mixing
+         ! =====================================================
+         !  (excluding the vertical flux proportional to dk[t]
+
+
+         ! I.1 horizontal tracer gradient
+         ! ------------------------------
+
+         DO jk = 1, jpkm1
+            DO ji = 1, jpim1
+               ! i-gradient of T and S at jj
+               zdit (ji,jk) = ( tb(ji+1,jj,jk)-tb(ji,jj,jk) ) * umask(ji,jj,jk)
+               zdis (ji,jk) = ( sb(ji+1,jj,jk)-sb(ji,jj,jk) ) * umask(ji,jj,jk)
+               ! j-gradient of T and S at jj
+               zdjt (ji,jk) = ( tb(ji,jj+1,jk)-tb(ji,jj,jk) ) * vmask(ji,jj,jk)
+               zdjs (ji,jk) = ( sb(ji,jj+1,jk)-sb(ji,jj,jk) ) * vmask(ji,jj,jk)
+               ! j-gradient of T and S at jj+1
+               zdj1t(ji,jk) = ( tb(ji,jj,jk)-tb(ji,jj-1,jk) ) * vmask(ji,jj-1,jk)
+               zdj1s(ji,jk) = ( sb(ji,jj,jk)-sb(ji,jj-1,jk) ) * vmask(ji,jj-1,jk)
+            END DO
+         END DO
+#  if defined key_partial_steps
+         ! partial steps correction at the bottom ocean level 
+         DO ji = 1, jpim1
+            ! last ocean level
+            iku  = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
+            ikv  = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
+            ikv1 = MIN( mbathy(ji,jj), mbathy(ji  ,jj-1) ) - 1
+            ! i-gradient of T and S at jj
+            zdit (ji,iku) = gtu(ji,jj)
+            zdis (ji,iku) = gsu(ji,jj)
+            ! j-gradient of T and S at jj
+            zdjt (ji,ikv) = gtv(ji,jj) 
+            zdjs (ji,ikv) = gsv(ji,jj) 
+            ! j-gradient of T and S at jj+1
+            zdj1t(ji,ikv1)= gtv(ji,jj-1)
+            zdj1s(ji,ikv1)= gsv(ji,jj-1)
+         END DO
+#endif
+
+
+         ! I.2 Vertical fluxes
+         ! -------------------
+
+         ! Surface and bottom vertical fluxes set to zero
+         ztfw(:, 1 ) = 0.e0
+         zsfw(:, 1 ) = 0.e0
+         ztfw(:,jpk) = 0.e0
+         zsfw(:,jpk) = 0.e0
+         IF( lk_traldf_eiv ) THEN
+            ztfwg(:, 1 ) = 0.e0
+            zsfwg(:, 1 ) = 0.e0
+            ztfwg(:,jpk) = 0.e0
+            zsfwg(:,jpk) = 0.e0
+         ENDIF
+
+         ! interior (2=<jk=<jpk-1)
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk)
+
+               zmku = 1./MAX( umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)   &
+                  &          +umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1. )
+
+               zmkv = 1./MAX( vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)   &
+                  &          +vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1. )
+
+               zcoef3 = zcoef0 * e2t(ji,jj) * zmku * wslpi (ji,jj,jk)
+               zcoef4 = zcoef0 * e1t(ji,jj) * zmkv * wslpj (ji,jj,jk)
+
+               ztfw(ji,jk) = zcoef3 * ( zdit (ji  ,jk-1) + zdit (ji-1,jk)     &
+                  &                    +zdit (ji-1,jk-1) + zdit (ji  ,jk) )   &
+                  &        + zcoef4 * ( zdjt (ji  ,jk-1) + zdj1t(ji  ,jk)     &
+                  &                    +zdj1t(ji  ,jk-1) + zdjt (ji  ,jk) )
+
+               zsfw(ji,jk) = zcoef3 * ( zdis (ji  ,jk-1) + zdis (ji-1,jk)     &
+                  &                    +zdis (ji-1,jk-1) + zdis (ji  ,jk) )   &
+                  &        + zcoef4 * ( zdjs (ji  ,jk-1) + zdj1s(ji  ,jk)     &
+                  &                    +zdj1s(ji  ,jk-1) + zdjs (ji  ,jk) )
+            END DO
+         END DO
+
+
+         ! I.3  update and save of avt (and avs if double diffusive mixing)
+         ! ---------------------------
+
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+
+               zavi = fsahtw(ji,jj,jk)*( wslpi(ji,jj,jk)*wslpi(ji,jj,jk)   &
+                  &                     +wslpj(ji,jj,jk)*wslpj(ji,jj,jk) )
+
+               ! save avt in zavt to recover avt for mixed layer depth diag.
+               zavt(ji,jk) = avt(ji,jj,jk)
+               ! add isopycnal vertical coeff. to avt
+               avt(ji,jj,jk) = avt(ji,jj,jk) + zavi
+               ! same procedure on avs if necessary
+#if defined key_zdfddm
+               ! save avs in zavs to recover avs in output files
+               zavs(ji,jk) = fsavs(ji,jj,jk)
+               ! add isopycnal vertical coeff. to avs
+               fsavs(ji,jj,jk) = fsavs(ji,jj,jk) + zavi
+#endif
+            END DO
+         END DO
+
+         !                              ! ---------------------------------------!
+         IF( lk_traldf_eiv ) THEN       ! Eddy induced vertical advective fluxes !
+            !                           ! ---------------------------------------!
+#if defined key_traldf_c2d || defined key_traldf_c3d
+            DO jk = 2, jpkm1
+               DO ji = 2, jpim1
+                  zuwki = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) )   &
+                     &  * fsaeiu(ji-1,jj,jk) * e2u(ji-1,jj)*umask(ji-1,jj,jk)
+                  zuwk  = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) )   &
+                     &  * fsaeiu(ji  ,jj,jk) * e2u(ji  ,jj)*umask(ji  ,jj,jk)
+                  zvwki = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) )   &
+                     &  * fsaeiv(ji,jj-1,jk) * e1v(ji,jj-1)*vmask(ji,jj-1,jk)
+                  zvwk  = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) )   &
+                     &  * fsaeiv(ji,jj  ,jk) * e1v(ji  ,jj)*vmask(ji  ,jj,jk)
+
+                  zcoeg3 = + 0.25 * tmask(ji,jj,jk) * ( zuwk - zuwki + zvwk - zvwki )
+   
+                  ztfwg(ji,jk) = + zcoeg3 * ( tb(ji,jj,jk) + tb(ji,jj,jk-1) )
+                  zsfwg(ji,jk) = + zcoeg3 * ( sb(ji,jj,jk) + sb(ji,jj,jk-1) )
+   
+                  ztfw(ji,jk) = ztfw(ji,jk) + ztfwg(ji,jk)
+                  zsfw(ji,jk) = zsfw(ji,jk) + zsfwg(ji,jk)
+# if defined key_diaeiv
+                  w_eiv(ji,jj,jk) = -2. *  zcoeg3 / ( e1t(ji,jj)*e2t(ji,jj) )
+# endif
+               END DO
+            END DO
+
+#else
+            DO jk = 2, jpkm1
+               DO ji = 2, jpim1
+                  zuwki = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) )   &
+                     &  * e2u(ji-1,jj)*umask(ji-1,jj,jk)
+                  zuwk  = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) )   &
+                     &  * e2u(ji  ,jj)*umask(ji  ,jj,jk)
+                  zvwki = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) )   &
+                     &  * e1v(ji,jj-1)*vmask(ji,jj-1,jk)
+                  zvwk  = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) )   &
+                     &  * e1v(ji  ,jj)*vmask(ji  ,jj,jk)
+   
+                  zcoeg3 = + 0.25 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk)   &
+                     &            * ( zuwk - zuwki + zvwk - zvwki )
+
+                  ztfwg(ji,jk) = + zcoeg3 * ( tb(ji,jj,jk) + tb(ji,jj,jk-1) )
+                  zsfwg(ji,jk) = + zcoeg3 * ( sb(ji,jj,jk) + sb(ji,jj,jk-1) )
+
+                  ztfw(ji,jk) = ztfw(ji,jk) + ztfwg(ji,jk)
+                  zsfw(ji,jk) = zsfw(ji,jk) + zsfwg(ji,jk)
+# if defined key_diaeiv
+                  w_eiv(ji,jj,jk) = -2. *  zcoeg3 / ( e1t(ji,jj)*e2t(ji,jj) )
+# endif
+               END DO
+            END DO
+#endif
+         ENDIF
+
+         ! I.5 Divergence of vertical fluxes added to the general tracer trend
+         ! -------------------------------------------------------------------
+
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zbtr =  1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+               ztav = (  ztfw(ji,jk) - ztfw(ji,jk+1)  ) * zbtr
+               zsav = (  zsfw(ji,jk) - zsfw(ji,jk+1)  ) * zbtr
+               ta(ji,jj,jk) = ta(ji,jj,jk) + ztav
+               sa(ji,jj,jk) = sa(ji,jj,jk) + zsav
+#if defined key_trdtra || defined key_trdmld
+#   if defined key_traldf_eiv
+               ztavg = ( ztfwg(ji,jk) - ztfwg(ji,jk+1) ) * zbtr
+               zsavg = ( zsfwg(ji,jk) - zsfwg(ji,jk+1) ) * zbtr
+               !  WARNING ttrd(ji,jj,jk,6) used for vertical gent velocity trend
+               !                           not for damping !!!
+               ttrd(ji,jj,jk,6) = ztavg
+               strd(ji,jj,jk,6) = zsavg
+#   endif
+               ttrd(ji,jj,jk,4) = ztav - ztavg
+               strd(ji,jj,jk,4) = zsav - zsavg
+#endif
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+
+      IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging)
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' zdf 1- Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+
+         ! II. Vertical trend associated with the vertical physics
+         ! =======================================================
+         !     (including the vertical flux proportional to dk[t] associated
+         !      with the lateral mixing, through the avt update)
+         !     dk[ avt dk[ (t,s) ] ] diffusive trends
+
+
+         ! II.0 Matrix construction
+         ! ------------------------
+
+         ! Diagonal, inferior, superior
+         ! (including the bottom boundary condition via avt masked)
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zwi(ji,jk) = - z2dt(jk) * avt(ji,jj,jk  )   &
+                                       / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) )
+               zws(ji,jk) = - z2dt(jk) * avt(ji,jj,jk+1)   &
+                                       / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )
+               zwd(ji,jk) = 1. - zwi(ji,jk) - zws(ji,jk)
+            END DO
+         END DO
+
+         ! Surface boudary conditions
+         DO ji = 2, jpim1
+            zwi(ji,1) = 0.e0
+            zwd(ji,1) = 1. - zws(ji,1)
+         END DO
+
+
+         ! II.1. Vertical diffusion on t
+         ! ---------------------------
+
+         ! Second member construction
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zwy(ji,jk) = tb(ji,jj,jk) + z2dt(jk) * ta(ji,jj,jk)
+            END DO
+         END DO
+
+         ! Matrix inversion from the first level
+         ikst = 1
+#   include "zdf.matrixsolver.h90"
+
+#if defined key_trdtra   ||   defined key_trdmld
+         ! Compute and save the vertical diffusive temperature trends
+         IF( l_traldf_iso ) THEN
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  zta = ( zwx(ji,jk) - tb(ji,jj,jk) ) / z2dt(jk)
+                  ttrd(ji,jj,jk,4) = zta - ta(ji,jj,jk) + ttrd(ji,jj,jk,4)
+               END DO
+            END DO
+         ELSE
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  zta = ( zwx(ji,jk) - tb(ji,jj,jk) ) / z2dt(jk)
+                  ttrd(ji,jj,jk,4) = zta - ta(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+#endif
+
+         ! Save the masked temperature after in ta
+         ! (c a u t i o n:  temperature not its trend, Leap-frog scheme done
+         !                  it will not be done in tranxt)
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ta(ji,jj,jk) = zwx(ji,jk) * tmask(ji,jj,jk)
+            END DO
+         END DO
+
+
+         ! II.2 Vertical diffusion on s
+         ! ---------------------------
+
+#if defined key_zdfddm
+         ! Rebuild the Matrix as avt /= avs
+
+         ! Diagonal, inferior, superior
+         ! (including the bottom boundary condition via avs masked)
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zwi(ji,jk) = - z2dt(jk) * fsavs(ji,jj,jk  )   &
+                                       /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) )
+               zws(ji,jk) = - z2dt(jk) * fsavs(ji,jj,jk+1)   &
+                                       /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )
+               zwd(ji,jk) = 1. - zwi(ji,jk) - zws(ji,jk)
+            END DO
+         END DO
+
+         ! Surface boudary conditions
+         DO ji = 2, jpim1
+            zwi(ji,1) = 0.e0
+            zwd(ji,1) = 1. - zws(ji,1)
+         END DO
+#endif
+         ! Second member construction
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               zwy(ji,jk) = sb(ji,jj,jk) + z2dt(jk) * sa(ji,jj,jk)
+            END DO
+         END DO
+
+         ! Matrix inversion from the first level
+         ikst = 1
+#   include "zdf.matrixsolver.h90"
+
+#if defined key_trdtra   ||   defined key_trdmld
+         ! Compute and save the vertical diffusive salinity trends
+         IF( l_traldf_iso ) THEN
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  zsa = ( zwx(ji,jk) - sb(ji,jj,jk) ) / z2dt(jk)
+                  strd(ji,jj,jk,4) = zsa - sa(ji,jj,jk) + strd(ji,jj,jk,4)
+               END DO
+            END DO
+         ELSE
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  zsa = ( zwx(ji,jk) - sb(ji,jj,jk) ) / z2dt(jk)
+                  strd(ji,jj,jk,4) = zsa - sa(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+#endif
+
+         ! Save the masked salinity after in sa
+         ! (c a u t i o n:  salinity not its trend, Leap-frog scheme done
+         !                  it will not be done in tranxt)
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               sa(ji,jj,jk) = zwx(ji,jk)  * tmask(ji,jj,jk)
+            END DO
+         END DO
+
+
+         ! III. recover the avt (avs) resulting from vertical physics only
+         ! ===============================================================
+
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               avt(ji,jj,jk) = zavt(ji,jk)
+#if defined key_zdfddm
+               fsavs(ji,jj,jk) = zavs(ji,jk)
+#endif
+            END DO
+         END DO
+
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging)
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' zdf 2- Ta: ', zta, ' Sa: ', zsa
+      ENDIF
+
+   END SUBROUTINE tra_zdf_iso
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module               NO rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE tra_zdf_iso( kt )              ! empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE tra_zdf_iso
+#endif
+
+   !!==============================================================================
+END MODULE trazdf_iso
Index: /branches/nemo/NEMO/OPA_SRC/TRA/trazdf_iso_vopt.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/trazdf_iso_vopt.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/trazdf_iso_vopt.F90	(revision 4)
@@ -0,0 +1,693 @@
+MODULE trazdf_iso_vopt
+   !!==============================================================================
+   !!                 ***  MODULE  trazdf_iso_vopt  ***
+   !! Ocean active tracers:  vertical component of the tracer mixing trend
+   !!==============================================================================
+#if defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   tra_zdf_iso_vopt : Update the tracer trend with the vertical part of 
+   !!                  the isopycnal or geopotential s-coord. operator and
+   !!                  the vertical diffusion. vector optimization, use
+   !!                  k-j-i loops.
+   !!   tra_zdf_iso  :
+   !!   tra_zdf_zdf  :
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE zdf_oce         ! ocean vertical physics variables
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE trdtra_oce      ! tracers trends diagnostics variables
+   USE ldfslp          ! iso-neutral slopes 
+   USE zdfddm          ! ocean vertical physics: double diffusion
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_zdf_iso_vopt   !  routine called by step.F90
+
+   !! * Module variables
+   REAL(wp), DIMENSION(jpk) ::  &
+      r2dt                          ! vertical profile of 2 x time-step
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE tra_zdf_iso_vopt( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_zdf_iso_vopt  ***
+      !!
+      !! ** Purpose :
+      !! ** Method  :
+      !! ** Action  :
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !! * Local variables
+      REAL(wp) :: zta, zsa               ! temporary scalars
+      !!---------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!---------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'tra_zdf_iso_vopt : vertical mixing computation'
+         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~~~~~   is  iso-neutral diffusion : implicit vertical time stepping'
+#if defined key_diaeiv 
+         w_eiv(:,:,:) = 0.e0
+#endif
+      ENDIF
+
+
+      ! I. vertical extra-diagonal part of the rotated tensor
+      ! -----------------------------------------------------
+
+      CALL tra_zdf_iso
+
+      IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging)
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' zdf 1- Ta: ', zta-t_ctl, ' Sa: ', zsa-s_ctl
+         t_ctl = zta   ;   s_ctl = zsa
+      ENDIF
+
+      ! II. vertical diffusion (including the vertical diagonal part of the rotated tensor)
+      ! ----------------------
+
+      CALL tra_zdf_zdf( kt )
+
+      IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging)
+         zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         zsa = SUM( sa(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
+         WRITE(numout,*) ' zdf 1- Ta: ', zta, ' Sa: ', zsa
+      ENDIF
+
+
+
+   END SUBROUTINE tra_zdf_iso_vopt
+
+
+   SUBROUTINE tra_zdf_zdf( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tra_zdf_zdf  ***
+      !!                    
+      !! ** Purpose :   Compute the trend due to the vertical tracer diffusion
+      !!     including the vertical component of lateral mixing (only for 2nd
+      !!     order operator, for fourth order it is already computed and add
+      !!     to the general trend in traldf.F) and add it to the general trend
+      !!     of the tracer equations.
+      !!
+      !! ** Method  :   The vertical component of the lateral diffusive trends
+      !!      is provided by a 2nd order operator rotated along neural or geo-
+      !!      potential surfaces to which an eddy induced advection can be 
+      !!      added. It is computed using before fields (forward in time) and 
+      !!      isopycnal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      Second part: vertical trend associated with the vertical physics
+      !!      ===========  (including the vertical flux proportional to dk[t]
+      !!                  associated with the lateral mixing, through the
+      !!                  update of avt)
+      !!      The vertical diffusion of tracers (t & s) is given by:
+      !!             difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
+      !!      It is computed using a backward time scheme (t=ta).
+      !!      Surface and bottom boundary conditions: no diffusive flux on
+      !!      both tracers (bottom, applied through the masked field avt).
+      !!      Add this trend to the general trend ta,sa :
+      !!         ta = ta + dz( avt dz(t) )
+      !!         (sa = sa + dz( avs dz(t) ) if lk_zdfddm=T )
+      !!
+      !!      Third part: recover avt resulting from the vertical physics
+      !!      ==========  alone, for further diagnostics (for example to
+      !!                  compute the turbocline depth in diamld).
+      !!         avt = zavt
+      !!         (avs = zavs if lk_zdfddm=T )
+      !!
+      !!      'key_trdtra' defined: trend saved for futher diagnostics.
+      !!
+      !!      macro-tasked on vertical slab (jj-loop)
+      !!
+      !! ** Action  : - Update (ta,sa) with before vertical diffusion trend
+      !!              - Save the trend in (ttrd,strd) ('key_diatrends')
+      !!
+      !! History :
+      !!   6.0  !  90-10  (B. Blanke)  Original code
+      !!   7.0  !  91-11 (G. Madec)
+      !!        !  92-06 (M. Imbard) correction on tracer trend loops
+      !!        !  96-01 (G. Madec) statement function for e3
+      !!        !  97-05 (G. Madec) vertical component of isopycnal
+      !!        !  97-07 (G. Madec) geopotential diffusion in s-coord
+      !!        !  00-08 (G. Madec) double diffusive mixing
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Modules used
+      USE oce    , ONLY :   zwd   => ua,  &  ! ua, va used as
+                            zws   => va      ! workspace
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   &
+         zavi, zrhs                          ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zwi, zwt, zavsi                     ! temporary workspace arrays
+#  if defined key_trdtra   ||   defined key_trdmld
+      REAL(wp) ::    zta, zsa                !temporary scalars
+#  endif
+      !!---------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!---------------------------------------------------------------------
+
+
+      ! I. Local constant initialization
+      ! --------------------------------
+      ! ... time step = 2 rdttra ex
+      IF( neuler == 0 .AND. kt == nit000 ) THEN
+         r2dt(:) =  rdttra(:)              ! restarting with Euler time stepping
+      ELSEIF( kt <= nit000 + 1) THEN
+         r2dt(:) = 2. * rdttra(:)          ! leapfrog
+      ENDIF
+
+      zwd( 1 ,:,:)=0.e0     ;     zwd(jpi,:,:)=0.e0
+      zws( 1 ,:,:)=0.e0     ;     zws(jpi,:,:)=0.e0
+      zwi( 1 ,:,:)=0.e0     ;     zwi(jpi,:,:)=0.e0
+      zwt( 1 ,:,:)=0.e0     ;     zwt(jpi,:,:)=0.e0     ;     zwt(:,:,jpk) = 0.e0
+
+      zavsi( 1 ,:,:)=0.e0    ;     zavsi(jpi,:,:)=0.e0     ;     zavsi(:,:,jpk) = 0.e0
+
+      zwt(:,:,1) = 0.e0
+      zavsi(:,:,1) = 0.e0
+
+
+      ! II. Vertical trend associated with the vertical physics
+      ! =======================================================
+      !     (including the vertical flux proportional to dk[t] associated
+      !      with the lateral mixing, through the avt update)
+      !     dk[ avt dk[ (t,s) ] ] diffusive trends
+
+
+      ! II.0 Matrix construction
+      ! ------------------------
+
+      ! update and save of avt (and avs if double diffusive mixing)
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zavi = fsahtw(ji,jj,jk) * (                 &   ! vertical mixing coef. due to lateral mixing
+                    wslpi(ji,jj,jk) * wslpi(ji,jj,jk)      &
+                  + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
+               zwt(ji,jj,jk) = avt(ji,jj,jk) + zavi            ! zwt=avt+zavi (total vertical mixing coef. on temperature)
+#if defined key_zdfddm
+               zavsi(ji,jj,jk) = fsavs(ji,jj,jk) + zavi        ! dd mixing: zavsi = total vertical mixing coef. on salinity
+#endif
+            END DO
+         END DO
+      END DO
+
+      ! Diagonal, inferior, superior  (including the bottom boundary condition via avt masked)
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zwi(ji,jj,jk) = - r2dt(jk) * zwt(ji,jj,jk  ) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) )
+               zws(ji,jj,jk) = - r2dt(jk) * zwt(ji,jj,jk+1) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )
+               zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! Surface boudary conditions
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwi(ji,jj,1) = 0.e0
+            zwd(ji,jj,1) = 1. - zws(ji,jj,1)
+         END DO
+      END DO
+
+
+      ! II.1. Vertical diffusion on t
+      ! ---------------------------
+
+      !! Matrix inversion from the first level
+      !!----------------------------------------------------------------------
+      !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+      !
+      !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+      !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+      !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+      !        (        ...               )( ...  ) ( ...  )
+      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+      !
+      !   m is decomposed in the product of an upper and lower triangular matrix
+      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+      !   The second member is in 2d array zwy
+      !   The solution is in 2d array zwx
+      !   The 3d arry zwt is a work space array
+      !   zwy is used and then used as a work space array : its value is modified!
+
+      ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            zwt(ji,jj,1) = zwd(ji,jj,1)
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1)  /zwt(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            ta(ji,jj,1) = tb(ji,jj,1) + r2dt(1) * ta(ji,jj,1)
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zrhs = tb(ji,jj,jk) + r2dt(jk) * ta(ji,jj,jk)   ! zrhs=right hand side 
+               ta(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *ta(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
+      ! Save the masked temperature after in ta
+      ! (c a u t i o n:  temperature not its trend, Leap-frog scheme done it will not be done in tranxt)
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            ta(ji,jj,jpkm1) = ta(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 1, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               ta(ji,jj,jk) = ( ta(ji,jj,jk) - zws(ji,jj,jk) * ta(ji,jj,jk+1) ) / zwt(ji,jj,jk) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+#if defined key_trdtra   ||   defined key_trdmld
+      ! Compute and save the vertical diffusive temperature trends
+      IF( l_traldf_iso ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zta = ( ta(ji,jj,jk) - tb(ji,jj,jk) ) / r2dt(jk)
+                  ttrd(ji,jj,jk,4) = zta - ta(ji,jj,jk) + ttrd(ji,jj,jk,4)
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zta = ( ta(ji,jj,jk) - tb(ji,jj,jk) ) / r2dt(jk)
+                  ttrd(ji,jj,jk,4) = zta - ta(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ENDIF
+#endif
+
+
+      ! II.2 Vertical diffusion on salinity
+      ! ---------------------------========
+
+#if defined key_zdfddm
+      ! Rebuild the Matrix as avt /= avs
+
+      ! Diagonal, inferior, superior  (including the bottom boundary condition via avs masked)
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zwi(ji,jj,jk) = - r2dt(jk) * zavsi(ji,jj,jk  ) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) )
+               zws(ji,jj,jk) = - r2dt(jk) * zavsi(ji,jj,jk+1) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) )
+               zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! Surface boudary conditions
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwi(ji,jj,1) = 0.e0
+            zwd(ji,jj,1) = 1. - zws(ji,jj,1)
+         END DO
+      END DO
+#endif
+
+
+      !! Matrix inversion from the first level
+      !!----------------------------------------------------------------------
+      !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+      !
+      !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+      !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+      !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+      !        (        ...               )( ...  ) ( ...  )
+      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+      !
+      !   m is decomposed in the product of an upper and lower triangular
+      !   matrix
+      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+      !   The second member is in 2d array zwy
+      !   The solution is in 2d array zwx
+      !   The 3d arry zwt is a work space array
+      !   zwy is used and then used as a work space array : its value is modified!
+
+      ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            zwt(ji,jj,1) = zwd(ji,jj,1)
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1)  /zwt(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            sa(ji,jj,1) = sb(ji,jj,1) + r2dt(1) * sa(ji,jj,1)
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zrhs = sb(ji,jj,jk) + r2dt(jk) * sa(ji,jj,jk)   ! zrhs=right hand side
+               sa(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *sa(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk
+      ! Save the masked temperature after in ta
+      ! (c a u t i o n:  temperature not its trend, Leap-frog scheme done it will not be done in tranxt)
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            sa(ji,jj,jpkm1) = sa(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 1, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               sa(ji,jj,jk) = ( sa(ji,jj,jk) - zws(ji,jj,jk) * sa(ji,jj,jk+1) ) / zwt(ji,jj,jk) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+#if defined key_trdtra   ||   defined key_trdmld
+      ! Compute and save the vertical diffusive temperature trends
+      IF( l_traldf_iso ) THEN
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zsa = ( sa(ji,jj,jk) - sb(ji,jj,jk) ) / r2dt(jk)
+                  strd(ji,jj,jk,4) = zsa - sa(ji,jj,jk) + strd(ji,jj,jk,4)
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zsa = ( sa(ji,jj,jk) - sb(ji,jj,jk) ) / r2dt(jk)
+                  strd(ji,jj,jk,4) = zsa - sa(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ENDIF
+#endif
+
+   END SUBROUTINE tra_zdf_zdf
+
+
+   SUBROUTINE tra_zdf_iso
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_zdf_iso  ***
+      !!
+      !! ** Purpose :
+      !!     Compute the trend due to the vertical tracer diffusion inclu-
+      !!     ding the vertical component of lateral mixing (only for second
+      !!     order operator, for fourth order it is already computed and
+      !!     add to the general trend in traldf.F) and add it to the general
+      !!     trend of the tracer equations.
+      !!
+      !! ** Method :
+      !!         The vertical component of the lateral diffusive trends is
+      !!      provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      First part: vertical trends associated with the lateral mixing
+      !!      ==========  (excluding the vertical flux proportional to dk[t] )
+      !!      vertical fluxes associated with the rotated lateral mixing:
+      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(tb)) ]
+      !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  }
+      !!      save avt coef. resulting from vertical physics alone in zavt:
+      !!         zavt = avt
+      !!      update and save in zavt the vertical eddy viscosity coefficient:
+      !!         avt = avt + wslpi^2+wslj^2
+      !!      add vertical Eddy Induced advective fluxes (lk_traldf_eiv=T):
+      !!         zftw = zftw + { di[aht e2u mi(wslpi)]
+      !!                    +dj[aht e1v mj(wslpj)] } mk(tb)
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ] 
+      !!      Add this trend to the general trend (ta,sa):
+      !!         ta = ta + difft
+      !!
+      !! ** Action :
+      !!         Update (ta,sa) arrays with the before vertical diffusion trend
+      !!         Save in (ttrd,strd) arrays the trends if 'key_diatrends' defined
+      !!
+      !! History :
+      !!   6.0  !  90-10  (B. Blanke)  Original code
+      !!   7.0  !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard) correction on tracer trend loops
+      !!        !  96-01  (G. Madec) statement function for e3
+      !!        !  97-05  (G. Madec) vertical component of isopycnal
+      !!        !  97-07  (G. Madec) geopotential diffusion in s-coord
+      !!        !  00-08  (G. Madec) double diffusive mixing
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Modules used
+      USE oce    , ONLY :   zwx => ua,  &  ! use ua, va as
+                            zwy => va      ! workspace arrays
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk       ! dummy loop indices
+#if defined key_partial_steps
+      INTEGER ::   iku, ikv
+#endif
+      REAL(wp) ::   &
+         ztavg, zsavg,           &  ! temporary scalars
+         zcoef0, zcoef3,         &  !    "         "
+         zcoef4, zcoeg3,         &  !    "         "
+         zbtr, zmku, zmkv  ,     &  !    "         "
+         zuwki, zvwki, zuwk,     &  !    "         "
+         zvwk, ztav, zsav
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zwz, zwt, ztfw, zsfw       ! temporary workspace arrays
+      !!---------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!---------------------------------------------------------------------
+
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      ztavg = 0.e0
+      zsavg = 0.e0
+      zwx( 1 ,:,:)=0.e0     ;     zwx(jpi,:,:)=0.e0
+      zwy( 1 ,:,:)=0.e0     ;     zwy(jpi,:,:)=0.e0
+      zwz( 1 ,:,:)=0.e0     ;     zwz(jpi,:,:)=0.e0
+      zwt( 1 ,:,:)=0.e0     ;     zwt(jpi,:,:)=0.e0
+      ztfw( 1 ,:,:)=0.e0    ;     ztfw(jpi,:,:)=0.e0
+      zsfw( 1 ,:,:)=0.e0    ;     zsfw(jpi,:,:)=0.e0
+
+
+      ! I. Vertical trends associated with lateral mixing
+      ! -------------------------------------------------
+      !    (excluding the vertical flux proportional to dk[t] )
+
+
+      ! I.1 horizontal tracer gradient
+      ! ------------------------------
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               ! i-gradient of T and S at jj
+               zwx (ji,jj,jk) = ( tb(ji+1,jj,jk)-tb(ji,jj,jk) ) * umask(ji,jj,jk)
+               zwy (ji,jj,jk) = ( sb(ji+1,jj,jk)-sb(ji,jj,jk) ) * umask(ji,jj,jk)
+               ! j-gradient of T and S at jj
+               zwz (ji,jj,jk) = ( tb(ji,jj+1,jk)-tb(ji,jj,jk) ) * vmask(ji,jj,jk)
+               zwt (ji,jj,jk) = ( sb(ji,jj+1,jk)-sb(ji,jj,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+#  if defined key_partial_steps
+      ! partial steps correction at the bottom ocean level 
+      DO jj = 1, jpjm1
+         DO ji = 1, fs_jpim1   ! vector opt.
+            ! last ocean level
+            iku  = MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1
+            ikv  = MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1
+            ! i-gradient of T and S
+            zwx (ji,jj,iku) = gtu(ji,jj)
+            zwy (ji,jj,iku) = gsu(ji,jj)
+            ! j-gradient of T and S
+            zwz (ji,jj,ikv) = gtv(ji,jj) 
+            zwt (ji,jj,ikv) = gsv(ji,jj) 
+         END DO
+         END DO
+#endif
+
+
+      ! I.2 Vertical fluxes
+      ! -------------------
+
+      ! Surface and bottom vertical fluxes set to zero
+      ztfw(:,:, 1 ) = 0.e0
+      zsfw(:,:, 1 ) = 0.e0
+      ztfw(:,:,jpk) = 0.e0
+      zsfw(:,:,jpk) = 0.e0
+
+      ! interior (2=<jk=<jpk-1)
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk)
+
+               zmku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      &
+                              + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.  )
+
+               zmkv = 1./MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      &
+                              + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.  )
+
+               zcoef3 = zcoef0 * e2t(ji,jj) * zmku * wslpi (ji,jj,jk)
+               zcoef4 = zcoef0 * e1t(ji,jj) * zmkv * wslpj (ji,jj,jk)
+
+               ztfw(ji,jj,jk) = zcoef3 * (   zwx(ji  ,jj  ,jk-1) + zwx(ji-1,jj  ,jk)      &
+                                           + zwx(ji-1,jj  ,jk-1) + zwx(ji  ,jj  ,jk)  )   &
+                              + zcoef4 * (   zwz(ji  ,jj  ,jk-1) + zwz(ji  ,jj-1,jk)      &
+                                           + zwz(ji  ,jj-1,jk-1) + zwz(ji  ,jj  ,jk)  )
+
+               zsfw(ji,jj,jk) = zcoef3 * (   zwy(ji  ,jj  ,jk-1) + zwy(ji-1,jj  ,jk)      &
+                                           + zwy(ji-1,jj  ,jk-1) + zwy(ji  ,jj  ,jk)  )   &
+                              + zcoef4 * (   zwt(ji  ,jj  ,jk-1) + zwt(ji  ,jj-1,jk)      &
+                                           + zwt(ji  ,jj-1,jk-1) + zwt(ji  ,jj  ,jk)  )
+            END DO
+         END DO
+      END DO
+
+      !                              ! ---------------------------------------!
+      IF( lk_traldf_eiv ) THEN       ! Eddy induced vertical advective fluxes !
+         !                           ! ---------------------------------------!
+         zwx(:,:, 1 ) = 0.e0
+         zwy(:,:, 1 ) = 0.e0
+         zwx(:,:,jpk) = 0.e0
+         zwy(:,:,jpk) = 0.e0
+
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+#   if defined key_traldf_c2d || defined key_traldf_c3d
+                  zuwki = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) )   &
+                     &  * fsaeiu(ji-1,jj,jk) * e2u(ji-1,jj) * umask(ji-1,jj,jk)
+                  zuwk  = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) )   &
+                     &  * fsaeiu(ji  ,jj,jk) * e2u(ji  ,jj) * umask(ji  ,jj,jk)
+                  zvwki = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) )   &
+                     &  * fsaeiv(ji,jj-1,jk) * e1v(ji,jj-1) * vmask(ji,jj-1,jk)
+                  zvwk  = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) )   &
+                     &  * fsaeiv(ji,jj  ,jk) * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
+
+                  zcoeg3 = + 0.25 * tmask(ji,jj,jk) * ( zuwk - zuwki + zvwk - zvwki )
+#   else
+                  zuwki = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) )   &
+                     &  * e2u(ji-1,jj) * umask(ji-1,jj,jk)
+                  zuwk  = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) )   &
+                     &  * e2u(ji  ,jj) * umask(ji  ,jj,jk)
+                  zvwki = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) )   &
+                     &  * e1v(ji,jj-1) * vmask(ji,jj-1,jk)
+                  zvwk  = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) )   &
+                     &  * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
+
+                  zcoeg3 = + 0.25 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk)   &
+                     &            * ( zuwk - zuwki + zvwk - zvwki )
+#   endif
+                  zwx(ji,jj,jk) = + zcoeg3 * ( tb(ji,jj,jk) + tb(ji,jj,jk-1) )
+                  zwy(ji,jj,jk) = + zcoeg3 * ( sb(ji,jj,jk) + sb(ji,jj,jk-1) )
+
+                  ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + zwx(ji,jj,jk)
+                  zsfw(ji,jj,jk) = zsfw(ji,jj,jk) + zwy(ji,jj,jk)
+#   if defined key_diaeiv
+                  w_eiv(ji,jj,jk) = -2. * zcoeg3 / ( e1t(ji,jj)*e2t(ji,jj) )
+#   endif
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! I.5 Divergence of vertical fluxes added to the general tracer trend
+      ! -------------------------------------------------------------------
+
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbtr =  1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+               ztav = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr
+               zsav = (  zsfw(ji,jj,jk) - zsfw(ji,jj,jk+1)  ) * zbtr
+               ta(ji,jj,jk) = ta(ji,jj,jk) + ztav
+               sa(ji,jj,jk) = sa(ji,jj,jk) + zsav
+#if defined key_trdtra || defined key_trdmld
+#   if defined key_traldf_eiv
+               ztavg = ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * zbtr
+               zsavg = ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) * zbtr
+               !  WARNING ttrd(ji,jj,jk,6) used for vertical gent velocity trend  not for damping !!!
+               ttrd(ji,jj,jk,6) = ztavg
+               strd(ji,jj,jk,6) = zsavg
+#   endif
+               ttrd(ji,jj,jk,4) = ztav - ztavg
+               strd(ji,jj,jk,4) = zsav - zsavg
+#endif
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE tra_zdf_iso
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :             NO rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE tra_zdf_iso_vopt( kt )              ! empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE tra_zdf_iso_vopt
+#endif
+
+   !!==============================================================================
+END MODULE trazdf_iso_vopt
Index: /branches/nemo/NEMO/OPA_SRC/TRA/zpshde.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 4)
@@ -0,0 +1,257 @@
+MODULE zpshde
+   !!==============================================================================
+   !!                       ***  MODULE zpshde   ***
+   !! Ocean active tracers: 
+   !!==============================================================================
+#if defined key_partial_steps || defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_partial_steps' :               z-coordinate with partial steps
+   !!----------------------------------------------------------------------
+   !!   zps_hde      :  Horizontal DErivative of T, S and rd at the last
+   !!                   ocean level (Z-coord. with Partial Steps)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space domain variables
+   USE oce             ! ocean dynamics and tracers variables
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE eosbn2          ! ocean equation of state
+   USE lbclnk          ! lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC zps_hde          ! routine called by step.F90
+
+   !! * module variables
+   INTEGER, DIMENSION(jpi,jpj) ::   &
+      mbatu, mbatv      ! bottom ocean level index at U- and V-points
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE zps_hde ( kt, ptem, psal, prd ,   &
+                            pgtu, pgsu, pgru,   &
+                            pgtv, pgsv, pgrv  )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE zps_hde  ***
+      !!                    
+      !! ** Purpose :   Compute the horizontal derivative of T, S and rd
+      !!      at u- and v-points with a linear interpolation for z-coordinate
+      !!      with partial steps.
+      !!
+      !! ** Method  :   In z-coord with partial steps, scale factors on last 
+      !!      levels are different for each grid point, so that T, S and rd 
+      !!      points are not at the same depth as in z-coord. To have horizontal
+      !!      gradients again, we interpolate T and S at the good depth : 
+      !!      Linear interpolation of T, S   
+      !!         Computation of di(tb) and dj(tb) by vertical interpolation:
+      !!          di(t) = t~ - t(i,j,k) or t(i+1,j,k) - t~
+      !!          dj(t) = t~ - t(i,j,k) or t(i,j+1,k) - t~
+      !!         This formulation computes the two cases:
+      !!                 CASE 1                   CASE 2  
+      !!         k-1  ___ ___________   k-1   ___ ___________
+      !!                    Ti  T~                  T~  Ti+1
+      !!                  _____                        _____
+      !!         k        |   |Ti+1     k           Ti |   |
+      !!                  |   |____                ____|   |
+      !!              ___ |   |   |           ___  |   |   |
+      !!                  
+      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
+      !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1)
+      !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  )
+      !!          or
+      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
+      !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i )
+      !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) )
+      !!          Idem for di(s) and dj(s)          
+      !!
+      !!      For rho, we call eos2d.h which will compute rd~(t~,s~) at 
+      !!      the good depth zh from interpolated T and S for the different
+      !!      formulation of the equation of state (eos).
+      !!      Gradient formulation for rho :
+      !!          di(rho) = rd~ - rd(i,j,k) or rd (i+1,j,k) - rd~
+      !!
+      !! ** Action  : - pgtu, pgsu, pgru: horizontal gradient of T, S
+      !!                and rd at U-points 
+      !!              - pgtv, pgsv, pgrv: horizontal gradient of T, S
+      !!                and rd at V-points 
+      !!
+      !! History :
+      !!   8.5  !  02-04  (A. Bozec)  Original code
+      !!   8.5  !  02-08  (G. Madec E. Durand)  Optimization and Free form
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt ! ocean time-step index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
+         ptem, psal, prd            ! 3D T, S and rd fields
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::   &
+         pgtu, pgsu, pgru,       &  ! horizontal grad. of T, S and rd at u- 
+         pgtv, pgsv, pgrv           ! and v-points of the partial step level
+
+      !! * Local declarations
+      INTEGER ::   ji, jj,       &  ! Dummy loop indices
+                   iku,ikv          ! partial step level at u- and v-points
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zti, ztj, zsi, zsj,     &  ! interpolated value of T, S 
+         zri, zrj,               &  ! and rd
+         zhgi, zhgj                 ! depth of interpolation for eos2d
+      REAL(wp) ::   &
+         ze3wu, ze3wv,           &  ! temporary scalars
+         zmaxu1, zmaxu2,         &  !    "         "
+         zmaxv1, zmaxv2             !    "         "
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      ! Initialization (first time-step only): compute mbatu and mbatv
+      IF( kt == nit000 ) THEN
+         mbatu(:,:) = 0
+         mbatv(:,:) = 0
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               mbatu(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1, 2 )
+               mbatv(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1, 2 )
+            END DO
+         END DO
+         zti(:,:) = FLOAT( mbatu(:,:) )
+         ztj(:,:) = FLOAT( mbatv(:,:) )
+         ! lateral boundary conditions: T-point, sign unchanged
+         CALL lbc_lnk( zti , 'U', 1. )
+         CALL lbc_lnk( ztj , 'V', 1. )
+         mbatu(:,:) = MAX( INT( zti(:,:) ), 2 )
+         mbatv(:,:) = MAX( INT( ztj(:,:) ), 2 )
+      ENDIF
+      
+
+      ! Interpolation of T and S at the last ocean level
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            ! last level
+            iku = mbatu(ji,jj)
+            ikv = mbatv(ji,jj)
+
+            ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
+            ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+            zmaxu1 =  ze3wu / fse3w(ji+1,jj  ,iku)
+            zmaxu2 = -ze3wu / fse3w(ji  ,jj  ,iku)
+            zmaxv1 =  ze3wv / fse3w(ji  ,jj+1,ikv)
+            zmaxv2 = -ze3wv / fse3w(ji  ,jj  ,ikv)
+
+            ! i- direction
+
+            IF( ze3wu >= 0. ) THEN      ! case 1
+               ! interpolated values of T and S
+               zti(ji,jj) = ptem(ji+1,jj,iku) + zmaxu1 * ( ptem(ji+1,jj,iku-1) - ptem(ji+1,jj,iku) )
+               zsi(ji,jj) = psal(ji+1,jj,iku) + zmaxu1 * ( psal(ji+1,jj,iku-1) - psal(ji+1,jj,iku) )
+               ! depth of the partial step level
+               zhgi(ji,jj) = fsdept(ji,jj,iku)
+               ! gradient of T and S
+               pgtu(ji,jj) = umask(ji,jj,1) * ( zti(ji,jj) - ptem(ji,jj,iku) )
+               pgsu(ji,jj) = umask(ji,jj,1) * ( zsi(ji,jj) - psal(ji,jj,iku) )
+
+            ELSE                        ! case 2
+               ! interpolated values of T and S
+               zti(ji,jj) = ptem(ji,jj,iku) + zmaxu2 * ( ptem(ji,jj,iku-1) - ptem(ji,jj,iku) )
+               zsi(ji,jj) = psal(ji,jj,iku) + zmaxu2 * ( psal(ji,jj,iku-1) - psal(ji,jj,iku) )
+               ! depth of the partial step level
+               zhgi(ji,jj) = fsdept(ji+1,jj,iku)
+               ! gradient of T and S 
+               pgtu(ji,jj) = umask(ji,jj,1) * ( ptem(ji+1,jj,iku) - zti (ji,jj) )
+               pgsu(ji,jj) = umask(ji,jj,1) * ( psal(ji+1,jj,iku) - zsi (ji,jj) )
+            ENDIF
+
+            ! j- direction
+
+            IF( ze3wv >= 0. ) THEN      ! case 1
+               ! interpolated values of T and S
+               ztj(ji,jj) = ptem(ji,jj+1,ikv) + zmaxv1 * ( ptem(ji,jj+1,ikv-1) - ptem(ji,jj+1,ikv) )
+               zsj(ji,jj) = psal(ji,jj+1,ikv) + zmaxv1 * ( psal(ji,jj+1,ikv-1) - psal(ji,jj+1,ikv) )
+               ! depth of the partial step level
+               zhgj(ji,jj) = fsdept(ji,jj,ikv) 
+               ! gradient of T and S
+               pgtv(ji,jj) = vmask(ji,jj,1) * ( ztj(ji,jj) - ptem(ji,jj,ikv) )
+               pgsv(ji,jj) = vmask(ji,jj,1) * ( zsj(ji,jj) - psal(ji,jj,ikv) )
+
+            ELSE                        ! case 2
+               ! interpolated values of T and S
+               ztj(ji,jj) = ptem(ji,jj,ikv) + zmaxv2 * ( ptem(ji,jj,ikv-1) - ptem(ji,jj,ikv) )
+               zsj(ji,jj) = psal(ji,jj,ikv) + zmaxv2 * ( psal(ji,jj,ikv-1) - psal(ji,jj,ikv) ) 
+               ! depth of the partial step level
+               zhgj(ji,jj) = fsdept(ji,jj+1,ikv) 
+               ! gradient of T and S
+               pgtv(ji,jj) = vmask(ji,jj,1) * ( ptem(ji,jj+1,ikv) - ztj(ji,jj) )
+               pgsv(ji,jj) = vmask(ji,jj,1) * ( psal(ji,jj+1,ikv) - zsj(ji,jj) )
+            ENDIF
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! Compute interpolated rd from zti, zsi, ztj, zsj for the 2 cases at the depth of the partial
+      ! step and store it in  zri, zrj for each  case
+      CALL eos( zti, zsi, zhgi, zri )
+      CALL eos( ztj, zsj, zhgj, zrj )
+
+
+      ! Gradient of density at the last level 
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+# endif
+            iku = mbatu(ji,jj)
+            ikv = mbatv(ji,jj)
+            ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
+            ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+            IF( ze3wu >= 0. ) THEN    ! i-direction: case 1
+               pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji,jj) - prd(ji,jj,iku) )
+            ELSE                      ! i-direction: case 2
+               pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) )
+            ENDIF
+            IF( ze3wv >= 0. ) THEN    ! j-direction: case 1
+               pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj) - prd(ji,jj,ikv) )  
+            ELSE                      ! j-direction: case 2
+               pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )
+            ENDIF
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+         END DO
+# endif
+      END DO
+
+      ! Lateral boundary conditions on each gradient
+      CALL lbc_lnk( pgtu , 'U', -1. )   ;   CALL lbc_lnk( pgtv , 'V', -1. )
+      CALL lbc_lnk( pgsu , 'U', -1. )   ;   CALL lbc_lnk( pgsv , 'V', -1. )
+      CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )
+
+   END SUBROUTINE zps_hde
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+   USE par_kind
+CONTAINS
+   SUBROUTINE zps_hde ( kt, ptem, psal, prd ,   &      ! Empty routine
+                            pgtu, pgsu, pgru,   &
+                            pgtv, pgsv, pgrv  )
+      REAL(wp), DIMENSION(:,:,:) :: ptem, psal, prd
+      REAL(wp) :: pgtu, pgsu, pgru, pgtv, pgsv, pgrv
+      WRITE(*,*) kt, ptem, psal, prd, pgtu, pgsu, pgru, pgtv, pgsv, pgrv
+   END SUBROUTINE zps_hde
+#endif
+
+   !!======================================================================
+END MODULE zpshde
Index: /branches/nemo/NEMO/OPA_SRC/TRD/trddyn.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRD/trddyn.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRD/trddyn.F90	(revision 4)
@@ -0,0 +1,458 @@
+MODULE trddyn
+   !!======================================================================
+   !!                       ***  MODULE  trddyn  ***
+   !! Ocean trends :  ocean momentum trends
+   !!=====================================================================
+#if   defined key_trddyn   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trddyn'                                   momentum trend diag.
+   !!----------------------------------------------------------------------
+   !!   trd_dyn      : verify the basin averaged properties for momentum
+   !!   trd_dyn_init :
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE trdtra_oce      ! ocean active tracer trend 
+   USE trddyn_oce      ! ocean dynamics trend
+   USE zdf_oce         ! ocean vertical physics
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldfdyn_oce      ! ocean dynamics: lateral physics
+   USE sol_oce         ! solver variables
+   USE obc_oce         ! ocean lateral open boundary condition
+   USE eosbn2          ! equation of state (eos routine)
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trd_dyn      ! called by step.F90
+   PUBLIC trd_dyn_init ! called by step.F90
+
+   !! * Shared module vaiables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .TRUE.   ! momentum trend flag
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trd_dyn( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_dyn  ***
+      !!
+      !! ** Purpose :   verify the basin averaged properties of the momentum 
+      !!      equation at every time step frequency ntrd.
+      !!      momentum equation:
+      !!       * non linear momentum trend (relative vorticity trend + hori-
+      !!      zontal kinetic energy gradient trend + vertical advection
+      !!      trend) : 
+      !!      1. conserve the momentum
+      !!      2. conserve the potential relative vorticity (rotn/e3f)
+      !!         (except for the vertical advection)
+      !!      3. conserve the potential enstrophy (except for the
+      !!         vertical advection trend) IF no cpp key activated
+      !!        or #defined key_vorcombined
+      !!      4. conserve the horizontal kinetic energy if #defined
+      !!        key_vorenergy
+      !!
+      !! ** Method :
+      !!      damping trend
+      !!      horizontal pressure gradient trend
+      !!      horizontal kinetic energy gradient trend
+      !!      relative vorticity term trend
+      !!      coriolis trend
+      !!
+      !! History :
+      !!        !  91-12  (G. Madec)  Original code
+      !!        !  92-06  (M. Imbard)  add time step frequency
+      !!        !  96-01  (G. Madec)  Statement function for e3
+      !!                              suppression of common work arrays
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk, jn        ! dummy loop indices
+
+      REAL(wp) ::   ze1e2w,zbe1ru,zbe2rv,zbtr,zth,ztz,zpeke,zcof
+      REAL(wp) ::   zmsku, zmskv
+      REAL(wp) ::   zumo(11),zvmo(11),zhke(10)
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zkepe, zkx, zky, zkz            ! workspace
+      
+      NAMELIST/namtrd/ ntrd, nctls
+      !!----------------------------------------------------------------------
+
+
+      ! 1. forcing trend and mask trends
+      ! --------------------------------
+      
+      IF( MOD(kt,ntrd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN
+
+         ! Mask surface forcing and bottom friction fluxes 
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
+               zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
+               tautrd(ji,jj,1) = tautrd(ji,jj,1) * zmsku
+               tautrd(ji,jj,2) = tautrd(ji,jj,2) * zmskv
+               tautrd(ji,jj,3) = tautrd(ji,jj,3) * zmsku
+               tautrd(ji,jj,4) = tautrd(ji,jj,4) * zmskv
+            END DO
+         END DO
+         tautrd( : ,jpj,1:4) = 0.e0
+         tautrd(jpi, : ,1:4) = 0.e0
+         
+         ! Mask the trends
+         DO jn = 1,9
+            DO jk = 1,jpk
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
+                     zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
+                     utrd(ji,jj,jk,jn) = utrd(ji,jj,jk,jn) * zmsku
+                     vtrd(ji,jj,jk,jn) = vtrd(ji,jj,jk,jn) * zmskv
+                  END DO
+               END DO
+            END DO
+         END DO
+         utrd( : ,jpj,:,1:9) = 0.e0      ;      vtrd( : ,jpj,:,1:9) = 0.e0
+         utrd(jpi, : ,:,1:9) = 0.e0      ;      vtrd(jpi, : ,:,1:9) = 0.e0
+         
+         ! Conversion potential energy - kinetic energy
+         ! c a u t i o n here, trends are computed at kt+1 (now , but after the swap)
+
+         zkx(:,:,:) = 0.e0
+         zky(:,:,:) = 0.e0
+         zkz(:,:,:) = 0.e0
+      
+         CALL eos( tn, sn, rhd, rhop )       ! now potential and in situ densities
+
+         ! Density flux at w-point
+         DO jk = 2, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ze1e2w = 0.5 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) * tmask_i(ji,jj)
+                  zkz(ji,jj,jk) = ze1e2w / rau0 * ( rhop(ji,jj,jk) + rhop(ji,jj,jk-1) )
+               END DO
+            END DO
+         END DO
+         zkz  (:,:, 1 ) = 0.e0
+         
+         ! Density flux at u and v-points
+         DO jk = 1, jpk
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  zcof   = 0.5 / rau0
+                  zbe1ru = zcof * e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk)
+                  zbe2rv = zcof * e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk)
+                  zkx(ji,jj,jk) = zbe1ru * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )
+                  zky(ji,jj,jk) = zbe2rv * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) )
+               END DO
+            END DO
+         END DO
+         
+         ! Density flux divergence at t-point
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  zbtr = 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) )
+                  ztz = - zbtr * (    zkz(ji,jj,jk) - zkz(ji,jj,jk+1) )
+                  zth = - zbtr * (  ( zkx(ji,jj,jk) - zkx(ji-1,jj,jk) )   &
+                                  + ( zky(ji,jj,jk) - zky(ji,jj-1,jk) )  )
+                  zkepe(ji,jj,jk) = (zth + ztz) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+         zkepe( : , : ,jpk) = 0.e0
+         zkepe( : ,jpj, : ) = 0.e0
+         zkepe(jpi, : , : ) = 0.e0
+
+
+         ! 2. Basin averaged momentum trend
+         ! --------------------------------
+         
+         DO jn = 1,9
+            zumo(jn) = 0.
+            zvmo(jn) = 0.
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zumo(jn) = zumo(jn) + utrd(ji,jj,jk,jn) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+                     zvmo(jn) = zvmo(jn) + vtrd(ji,jj,jk,jn) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         END DO
+
+         zumo(10) = 0.
+         zvmo(10) = 0.
+         zumo(11) = 0.
+         zvmo(11) = 0.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zumo(10) = zumo(10) + tautrd(ji,jj,1) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1)
+               zvmo(10) = zvmo(10) + tautrd(ji,jj,2) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1)
+               zumo(11) = zumo(11) + tautrd(ji,jj,3)
+               zvmo(11) = zvmo(11) + tautrd(ji,jj,4)
+            END DO
+         END DO
+         
+         
+         ! 3. Basin averaged kinetic energy trend
+         ! --------------------------------------
+         
+         ! Field before, because after the array swap
+         
+         DO jn = 1,9
+            zhke(jn) = 0.e0
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zhke(jn) = zhke(jn)   &
+                     &   + ub(ji,jj,jk) * utrd(ji,jj,jk,jn) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)   &
+                     &   + vb(ji,jj,jk) * vtrd(ji,jj,jk,jn) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         END DO
+         
+         zhke(10) = 0.e0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zhke(10) = zhke(10)   &
+               &   + ub(ji,jj,1) * tautrd(ji,jj,1) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1)   &
+               &   + vb(ji,jj,1) * tautrd(ji,jj,2) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1)
+            END DO
+         END DO
+         
+         zpeke = 0.e0
+         DO jk = 1,jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zpeke    = zpeke + zkepe(ji,jj,jk) * g * fsdept(ji,jj,jk)   &
+                  &                        * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         
+# if defined key_mpp
+         CALL mpp_sum( zpeke )
+         CALL mpp_sum( zumo , 11 )
+         CALL mpp_sum( zvmo , 11 )
+         CALL mpp_sum( zhke , 10 )
+# endif
+
+
+         ! 4. Print
+         ! --------
+
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9400) kt
+            WRITE (numout,9401) zumo( 1) / tvolu, zvmo( 1) / tvolv
+            WRITE (numout,9402) zumo( 2) / tvolu, zvmo( 2) / tvolv
+            WRITE (numout,9403) zumo( 3) / tvolu, zvmo( 3) / tvolv
+            WRITE (numout,9404) zumo( 4) / tvolu, zvmo( 4) / tvolv
+            WRITE (numout,9405) zumo( 5) / tvolu, zvmo( 5) / tvolv
+            WRITE (numout,9406) zumo( 6) / tvolu, zvmo( 6) / tvolv
+            WRITE (numout,9407) zumo( 7) / tvolu, zvmo( 7) / tvolv
+            WRITE (numout,9408) zumo( 8) / tvolu, zvmo( 8) / tvolv
+            WRITE (numout,9409) zumo(10) / tvolu, zvmo(10) / tvolv
+            WRITE (numout,9410) zumo( 9) / tvolu, zvmo( 9) / tvolv
+            WRITE (numout,9411) zumo(11) / tvolu, zvmo(11) / tvolv
+            WRITE (numout,9412)
+            WRITE (numout,9413)                                                     &
+            &     (  zumo(1) + zumo(2) + zumo(3) + zumo(4) + zumo(5) + zumo(6)      &
+            &      + zumo(7) + zumo(8) + zumo(9) + zumo(10) + zumo(11) ) / tvolu,   &
+            &     (  zvmo(1) + zvmo(2) + zvmo(3) + zvmo(4) + zvmo(5) + zvmo(6)      &
+            &      + zvmo(7) + zvmo(8) + zvmo(9) + zvmo(10) + zvmo(11) ) / tvolv
+         ENDIF
+
+ 9400    FORMAT(' momentum trend at it= ', i6, ' :', /' ==============================')
+ 9401    FORMAT(' pressure gradient          u= ', e20.13, '    v= ', e20.13)
+ 9402    FORMAT(' ke gradient                u= ', e20.13, '    v= ', e20.13)
+ 9403    FORMAT(' relative vorticity term    u= ', e20.13, '    v= ', e20.13)
+ 9404    FORMAT(' coriolis term              u= ', e20.13, '    v= ', e20.13)
+ 9405    FORMAT(' horizontal diffusion       u= ', e20.13, '    v= ', e20.13)
+ 9406    FORMAT(' vertical advection         u= ', e20.13, '    v= ', e20.13)
+ 9407    FORMAT(' vertical diffusion         u= ', e20.13, '    v= ', e20.13)
+ 9408    FORMAT(' surface pressure gradient  u= ', e20.13, '    v= ', e20.13)
+ 9409    FORMAT(' forcing term               u= ', e20.13, '    v= ', e20.13)
+ 9410    FORMAT(' dampimg term               u= ', e20.13, '    v= ', e20.13)
+ 9411    FORMAT(' bottom flux                u= ', e20.13, '    v= ', e20.13)
+ 9412    FORMAT(' -----------------------------------------------------------------------------')
+ 9413    FORMAT(' total trend                u= ', e20.13, '    v= ', e20.13)
+
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9420) kt
+            WRITE (numout,9421) zhke( 1) / tvols
+            WRITE (numout,9422) zhke( 2) / tvols
+            WRITE (numout,9423) zhke( 3) / tvols
+            WRITE (numout,9424) zhke( 4) / tvols
+            WRITE (numout,9425) zhke( 5) / tvols
+            WRITE (numout,9426) zhke( 6) / tvols
+            WRITE (numout,9427) zhke( 7) / tvols
+            WRITE (numout,9428) zhke( 8) / tvols
+            WRITE (numout,9429) zhke(10) / tvols
+            WRITE (numout,9430) zhke( 9) / tvols
+            WRITE (numout,9431)
+            WRITE (numout,9432)   &
+            &     (  zhke(1) + zhke(2) + zhke(3) + zhke(4) + zhke(5) + zhke(6)   &
+            &      + zhke(7) + zhke(8) + zhke(9) + zhke(10) ) / tvols
+         ENDIF
+
+ 9420    FORMAT(' kinetic energy trend at it= ', i6, ' :', /' ====================================')
+ 9421    FORMAT(' pressure gradient         u2= ', e20.13)
+ 9422    FORMAT(' ke gradient               u2= ', e20.13)
+ 9423    FORMAT(' relative vorticity term   u2= ', e20.13)
+ 9424    FORMAT(' coriolis term             u2= ', e20.13)
+ 9425    FORMAT(' horizontal diffusion      u2= ', e20.13)
+ 9426    FORMAT(' vertical advection        u2= ', e20.13)
+ 9427    FORMAT(' vertical diffusion        u2= ', e20.13)
+ 9428    FORMAT(' surface pressure gradient u2= ', e20.13)
+ 9429    FORMAT(' forcing term              u2= ', e20.13)
+ 9430    FORMAT(' dampimg term              u2= ', e20.13)
+ 9431    FORMAT(' --------------------------------------------------')
+ 9432    FORMAT(' total trend               u2= ', e20.13)
+
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9440) kt
+            WRITE (numout,9441) ( zhke(2) + zhke(3) + zhke(6) ) / tvols
+            WRITE (numout,9442) ( zhke(2) + zhke(6) ) / tvols
+            WRITE (numout,9443) ( zhke(4) ) / tvols
+            WRITE (numout,9444) ( zhke(3) ) / tvols
+            WRITE (numout,9445) ( zhke(8) ) / tvols
+            WRITE (numout,9446) ( zhke(5) ) / tvols
+            WRITE (numout,9447) ( zhke(7) ) / tvols
+            WRITE (numout,9448) ( zhke(1) ) / tvols, rpktrd / tvols
+         ENDIF
+
+ 9440    FORMAT(' energetic consistency at it= ', i6, ' :', /' =========================================')
+ 9441    FORMAT(' 0 = non linear term(true if key_vorenergy or key_combined): ', e20.13)
+ 9442    FORMAT(' 0 = ke gradient + vertical advection              : ', e20.13)
+ 9443    FORMAT(' 0 = coriolis term  (true if key_vorenergy or key_combined): ', e20.13)
+ 9444    FORMAT(' 0 = uh.( rot(u) x uh ) (true if enstrophy conser.)    : ', e20.13)
+ 9445    FORMAT(' 0 = surface pressure gradient                     : ', e20.13)
+ 9446    FORMAT(' 0 > horizontal diffusion                          : ', e20.13)
+ 9447    FORMAT(' 0 > vertical diffusion                            : ', e20.13)
+ 9448    FORMAT(' pressure gradient u2 = - 1/rau0 u.dz(rhop)        : ', e20.13, '  u.dz(rhop) =', e20.13)
+
+         ! Save potential to kinetic energy conversion for next time step
+         
+         rpktrd = zpeke
+         
+      ENDIF
+
+   END SUBROUTINE trd_dyn
+
+
+   SUBROUTINE trd_dyn_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_dyn_init  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !! ** Method :
+      !!
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  Original code
+      !!---------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk        ! dummy loop indices
+
+      REAL(wp) ::   zmskt,zmsku,zmskv
+      
+      NAMELIST/namtrd/ ntrd, nctls
+      !!----------------------------------------------------------------------
+
+      ! 0. Initialization
+      ! -----------------
+
+      ! set the trends to zero
+      utrd  (:,:,:,:) = 0.e0
+      vtrd  (:,:,:,:) = 0.e0
+      tautrd(:,:,  :) = 0.e0
+
+      ! namelist namtrd : ocean momentum trend 
+      REWIND( numnam )
+      READ  ( numnam, namtrd )
+
+      IF(lwp) THEN
+         WRITE(numout,*) 'trd_dyn : read namelist namtrd'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) ' time step frequency trend       ntrd  = ', ntrd
+         WRITE(numout,*) ' '
+      ENDIF
+
+#if defined key_s_coord || defined key_partial_steps
+      ! dynamics trend diagnostics not yet implemented
+      IF(lwp) WRITE(numout,*) 'trd_dyn : dynamics trend diagnostics not yet implemented'
+      nstop = nstop + 1
+#endif
+
+      ! total volume at u-, v- and t-points:
+      tvols = 0.
+      tvolu = 0.
+      tvolv = 0.
+
+      DO jk = 1, jpk
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zmskt =                      tmask_i(ji,jj) * tmask(ji,jj,jk)
+               zmsku = tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
+               zmskv = tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
+               tvols = tvols + zmskt * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+               tvolu = tvolu + zmsku * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+               tvolv = tvolv + zmskv * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+# if defined key_mpp
+      CALL mpp_sum( tvols )
+      CALL mpp_sum( tvolu )
+      CALL mpp_sum( tvolv )
+# endif
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trd_dyn : frequency ntrd = ', ntrd
+         WRITE(numout,*) '~~~~~~~   tvols = ', tvols
+         WRITE(numout,*) '          tvolu = ', tvolu,' tvolv = ', tvolv
+      ENDIF
+
+      ! 0.2 Initialization of potential to kinetic energy conversion
+      
+      rpktrd = 0.e0
+
+   END SUBROUTINE trd_dyn_init
+
+#   else 
+   !!----------------------------------------------------------------------
+   !!   Default option :                      NO mementum trend diagnostics
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trddyn = .FALSE.   ! momentum trend flag
+CONTAINS
+   SUBROUTINE trd_dyn( kt )        ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE trd_dyn
+   SUBROUTINE trd_dyn_init         ! Empty routine
+   END SUBROUTINE trd_dyn_init
+#endif
+
+   !!======================================================================
+END MODULE trddyn
Index: /branches/nemo/NEMO/OPA_SRC/TRD/trddyn_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRD/trddyn_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRD/trddyn_oce.F90	(revision 4)
@@ -0,0 +1,35 @@
+MODULE trddyn_oce
+   !!======================================================================
+   !!                      ***  trddyn_oce  ***
+   !! Ocean trends :  dynamical trends arrays defined in memory 
+   !!======================================================================
+#if   defined key_trddyn   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trddyn'                             momentum trend diagnostics
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce      ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC
+   
+   REAL(wp) ::   &
+      tvols,     &  ! volume of the whole ocean computed at t-points
+      tvolu,     &  ! volume of the whole ocean computed at u-points
+      tvolv,     &  ! volume of the whole ocean computed at v-points
+      rpktrd        ! potential to kinetic energy conversion
+   REAL(wp), DIMENSION(jpi,jpj,jpk,9) ::   & 
+      utrd,      &  ! trends of the momentum equation
+      vtrd
+   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
+      utrd2,     &  ! trend with the free surface formulation
+      vtrd2
+   REAL(wp), DIMENSION(jpi,jpj,4) ::    &
+      tautrd        ! momentum forcing trends
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case                          NO momentum trend diagnostics
+   !!----------------------------------------------------------------------
+#endif
+   !!----------------------------------------------------------------------
+END MODULE trddyn_oce
Index: /branches/nemo/NEMO/OPA_SRC/TRD/trdmld.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRD/trdmld.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRD/trdmld.F90	(revision 4)
@@ -0,0 +1,619 @@
+MODULE trdmld
+   !!======================================================================
+   !!                       ***  MODULE  trdmld  ***
+   !! Ocean diagnostics:  mixed layer T-S trends 
+   !!=====================================================================
+#if   defined key_trdmld   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trdmld'                          mixed layer trend diagnostics
+   !!----------------------------------------------------------------------
+   !!   trd_mld      : T and S trends averaged over the mixed layer
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE trdtra_oce      ! ocean active tracer trend variables
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+
+   USE phycst          ! Define parameters for the routines
+   USE daymod          ! calendar
+   USE dianam          ! build the name of file (routine)
+   USE ldfslp	       ! iso-neutral slopes 
+   USE zdfmxl
+   USE zdfddm
+   USE ioipsl
+   USE lbclnk
+#if defined key_dimgout
+   USE diawri, ONLY : dia_wri_dimg
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC trd_mld   ! routine called by step.F90
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trdmld = .TRUE.   ! momentum trend flag
+
+   !! * Module variables
+   INTEGER, DIMENSION(jpi,jpj) ::   &
+      nmld,             &  ! mixed layer depth
+      nbol
+
+   INTEGER ::   &
+      nh_t, nmoymltrd,        &  ! ???
+      nidtrd,nhoridtrd,            &
+      ndextrd1(jpi*jpj),ndimtrd1 
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      rmld   ,          &  ! mld depth (m) corresponding to nmld
+      tml    , sml  ,   &  ! average T and S over mixed layer
+      tmlb   , smlb ,   &  ! before tml and sml (kt-1)
+      tmlbb  , smlbb,   &  ! tml and sml at begining of the nwrite-1 
+      !                    ! timestep averaging period
+      tmlbn  , smlbn,   &  ! after tml and sml at time step after the
+      !                    ! begining of the NWRITE-1 timesteps
+      tmltrdm, smltrdm     !
+
+!  REAL(wp), DIMENSION(jpi,jpj,jpltrd) ::   & ! Must be jpk for mpp lbc_lnk
+!                                             TO BE FIXED ???
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+      tmltrd ,          &  ! total cumulative trends of temperature and 
+      smltrd               ! salinity over nwrite-1 time steps
+
+   INTEGER ::  iyear,imon,iday
+   CHARACTER(LEN=80) :: clname, cltext, clmode
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trd_mld( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mld  ***
+      !! 
+      !! ** Purpose :   computation of vertically integrated T and S budgets
+      !!      from ocean surface down to control surface (NetCDF output)
+      !!
+      !! ** Method/usage :
+      !!      integration done over nwrite-1 time steps 
+      !!      Control surface can be either a mixed layer depth (time varying)
+      !!      or a fixed surface (jk level or bowl). 
+      !!      Choose control surface with nctls in namelist NAMDIA.
+      !!      nctls = 0  : use mixed layer with density criterion 
+      !!      nctls = 1  : read index from file 'ctlsurf_idx'
+      !!      nctls > 1  : use fixed level surface jk = nctls
+      !!      Note: in the remainder of the routine, the volume between the 
+      !!            surface and the control surface is called "mixed-layer"
+      !!      Method check : if the control surface is fixed, the residual dh/dt
+      !!                     entrainment should be zero
+      !!
+      !! ** Action :
+      !!            /commld/   : rmld         mld depth corresponding to nmld
+      !!                         tml          average T over mixed layer
+      !!                         tmlb         tml at kt-1
+      !!                         tmlbb        tml at begining of the NWRITE-1 
+      !!                                      time steps averaging period
+      !!                         tmlbn        tml at time step after the 
+      !!                                      begining of the NWRITE-1 time
+      !!                                      steps averaging period
+      !!
+      !!                  mixed layer trends :
+      !!
+      !!                  tmltrd (,,1) = zonal advection
+      !!                  tmltrd (,,2) = meridional advection
+      !!                  tmltrd (,,3) = vertical advection
+      !!                  tmltrd (,,4) = lateral diffusion (horiz. component+Beckman)
+      !!                  tmltrd (,,5) = forcing
+      !!                  tmltrd (,,6) = entrainment due to vertical diffusion (TKE)
+      !!          if iso  tmltrd (,,7) = lateral diffusion (vertical component)
+      !!                  tmltrd (,,8) = eddy induced zonal advection
+      !!                  tmltrd (,,9) = eddy induced meridional advection
+      !!                  tmltrd (,,10) = eddy induced vertical advection
+      !!
+      !!                  tmltrdm(,) : total cumulative trends over nwrite-1 time steps
+      !!                  ztmltot(,) : dT/dt over the NWRITE-1 time steps 
+      !!                               averaging period (including Asselin 
+      !!                               terms)
+      !!                  ztmlres(,) : residual = dh/dt entrainment
+      !!
+      !!      trends output in netCDF format using ioipsl
+      !!
+      !! History :
+      !!        !  95-04  (J. Vialard)  Original code
+      !!        !  97-02  (E. Guilyardi)  Adaptation global + base cmo
+      !!        !  99-09  (E. Guilyardi)  Re-writing + netCDF output
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER :: ilseq
+      INTEGER :: ji, jj, jk, jl, ik, ikb, idebug, isum, it
+      INTEGER, DIMENSION(jpi,jpj) ::  zvlmsk
+
+      REAL(wp) :: zmean, zavt, zjulian, zsto, zout
+      REAL(wp) ,DIMENSION(jpi,jpj,jpktrd) :: zwkx
+      REAL(wp) ,DIMENSION(jpi,jpj)        ::  &
+           &  ztmltot, ztmlres, z2d, zsmltot, zsmlres
+
+      CHARACTER (len=21) ::   &
+         clold ='OLD'        , & ! open specifier (direct access files)
+         clunf ='UNFORMATTED', & ! open specifier (direct access files)
+         clseq ='SEQUENTIAL'     ! open specifier (direct access files)
+      CHARACTER (len=80) ::   clname
+      CHARACTER (len=40) ::   clhstnam
+      CHARACTER (len=40) ::   clop
+      CHARACTER (len=12) ::   clmxl
+
+      NAMELIST/namtrd/ ntrd, nctls
+      !!----------------------------------------------------------------------
+
+      !  ===================
+      !   0. initialization
+      !  ===================
+
+      ! Open specifier
+      ilseq = 1
+      idebug = 0      ! set it to 1 in case of problem to have more print
+
+      IF( kt == nit000 ) THEN
+         ! namelist namtrd : trend diagnostic
+         REWIND( numnam )
+         READ  ( numnam, namtrd )
+
+         IF(lwp) THEN
+            WRITE(numout,*) 'namtrd'
+            WRITE(numout,*) ' '
+            WRITE(numout,*) ' time step frequency trend       ntrd  = ',ntrd
+            WRITE(numout,*) ' control surface for trends      nctls = ',nctls
+            WRITE(numout,*) ' '
+         ENDIF
+
+         ! cumulated trends array init
+         nmoymltrd = 0
+         tmltrdm(:,:) = 0.
+         smltrdm(:,:) = 0.
+      ENDIF
+
+      ! set before values of vertically average T and S 
+
+      IF( kt > nit000 ) THEN
+         tmlb(:,:) = tml(:,:)
+         smlb(:,:) = sml(:,:)
+      ENDIF
+
+      !  read control surface from file ctlsurf_idx
+
+      IF( kt == nit000 .and. nctls == - 1 ) THEN
+         clname ='ctlsurf_idx'
+         CALL ctlopn(numbol,clname,clold,clunf,clseq,   &
+              ilseq,numout,lwp,1)
+         REWIND (numbol)
+         READ(numbol) nbol
+      ENDIF
+
+      IF( idebug /= 0 ) THEN
+         WRITE(numout,*) ' debuging trd_mld: 0. done '  
+         CALL FLUSH(numout)
+      ENDIF
+
+
+      !  ========================================================
+      !   I. definition of control surface and associated fields
+      !  ========================================================
+
+      !    I.1 set nmld(ji,jj) = index of first T point below control surface
+      !    -------------------                       or outside mixed-layer
+
+      !     clmxl = legend root for netCDF output
+
+      IF( nctls == 0 ) THEN
+         ! control surface = mixed-layer with density criterion 
+         ! (array nmln computed in zdfmxl.F90)
+         nmld(:,:) = nmln(:,:)
+         clmxl = 'Mixed Layer '
+      ELSE IF( nctls == 1 ) THEN
+         ! control surface = read index from file 
+         nmld(:,:) = nbol(:,:)
+         clmxl = '      Bowl '
+      ELSE IF( nctls >= 2 ) THEN
+         ! control surface = model level
+         nctls = MIN( nctls, jpktrd - 1 )
+         nmld(:,:) = nctls + 1
+         WRITE(clmxl,'(A9,I2,1X)') 'Levels 1-', nctls
+      ENDIF
+
+      ! Check of validity : nmld(ji,jj) =< jpktrd
+      isum = 0
+
+      IF( jpktrd < jpk ) THEN 
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( nmld(ji,jj) <= jpktrd ) THEN
+                  zvlmsk(ji,jj) = tmask(ji,jj,1)
+               ELSE
+                  isum = isum + 1
+                  zvlmsk(ji,jj) = 0.
+               ENDIF
+            END DO
+         END DO
+      ENDIF
+      
+      IF( idebug /= 0 ) THEN
+         ! CALL prihre (zvlmsk,jpi,jpj,1,jpi,2,1,jpj,2,3,numout)
+         WRITE(numout,*) ' debuging trd_mld: I.1 done '  
+         CALL FLUSH(numout)
+      ENDIF
+
+
+      ! I.2 probability density function of presence in mixed-layer
+      ! --------------------------------
+      ! (i.e. weight of each grid point in vertical integration : zwkx(ji,jj,jk)
+
+
+      ! initialize zwkx with vertical scale factor in mixed-layer
+
+      zwkx(:,:,:) = 0.e0
+      DO jk = 1, jpktrd
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               IF( jk - nmld(ji,jj) < 0. )   zwkx(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk)
+ 	    END DO
+	 END DO
+      END DO
+      
+      ! compute mixed-layer depth : rmld
+      
+      rmld(:,:) = 0.
+      DO jk = 1, jpktrd
+         rmld(:,:) = rmld(:,:) + zwkx(:,:,jk)
+      END DO
+      
+      ! compute PDF
+
+      DO jk = 1, jpktrd
+         zwkx(:,:,jk) = zwkx(:,:,jk) / MAX( 1., rmld(:,:) )
+      END DO
+
+      IF( idebug /= 0 ) THEN
+         WRITE(numout,*) ' debuging trd_mld: I.2 done '  
+         CALL FLUSH(numout)
+      ENDIF
+
+
+      ! I.3 vertically integrated T and S
+      ! ---------------------------------
+
+      tml(:,:) = 0.
+      sml(:,:) = 0.
+
+      DO jk = 1, jpktrd - 1
+         tml(:,:) = tml(:,:) + zwkx(:,:,jk) * tn(:,:,jk)
+         sml(:,:) = sml(:,:) + zwkx(:,:,jk) * sn(:,:,jk) 
+      END DO
+
+      IF(idebug /= 0) THEN
+         WRITE(numout,*) ' debuging trd_mld: I.3 done'  
+         CALL FLUSH(numout)
+      ENDIF
+
+
+      !  ===================================
+      !   II. netCDF output initialization
+      !  ===================================
+
+#if defined key_dimgout 
+
+#else
+#include "trdmld_ncinit.h90"
+#endif
+
+      IF( idebug /= 0 ) THEN
+         WRITE(numout,*) ' debuging trd_mld: II. done'  
+         CALL FLUSH(numout)
+      ENDIF
+
+      !  ====================================================
+      !   III. vertical integration of trends in mixed-layer
+      !  ====================================================
+
+
+      ! III.0 initializations
+      ! ---------------------
+
+      tmltrd(:,:,:) = 0.e0
+      smltrd(:,:,:) = 0.e0
+
+      IF( idebug /= 0 ) THEN
+         WRITE(numout,*) ' debuging trd_mld: III.0 done'  
+         CALL FLUSH(numout)
+      ENDIF
+
+
+      ! III.1 vertical integration of 3D trends
+      ! ---------------------------------------
+      
+      DO jk = 1,jpktrd
+
+         ! Temperature
+         tmltrd(:,:,1) = tmltrd(:,:,1) + ttrdh(:,:,jk,1) * zwkx(:,:,jk)   ! zonal advection
+         tmltrd(:,:,2) = tmltrd(:,:,2) + ttrdh(:,:,jk,2) * zwkx(:,:,jk)   ! meridional advection
+         tmltrd(:,:,3) = tmltrd(:,:,3) + ttrd (:,:,jk,2) * zwkx(:,:,jk)   ! vertical advection
+         tmltrd(:,:,4) = tmltrd(:,:,4) + ttrd (:,:,jk,3) * zwkx(:,:,jk)   ! lateral diffusion (hor. part)
+         tmltrd(:,:,5) = tmltrd(:,:,5) + ttrd (:,:,jk,7) * zwkx(:,:,jk)   ! forcing (penetrative)
+         IF( l_traldf_iso ) THEN
+            tmltrd(:,:,7) = tmltrd(:,:,7) + ttrd (:,:,jk,4) * zwkx(:,:,jk)   ! lateral diffusion (explicit 
+            !                                                                ! vert. part (isopycnal diff.)
+         ENDIF
+!#if defined key_traldf_eiv
+       ! tmltrd(:,:,8 ) = tmltrdg(:,:,8) + ttrdh(:,:,jk,3) * zwkx(:,:,jk)   ! eddy induced zonal advection
+       ! tmltrd(:,:,9 ) = tmltrdg(:,:,9) + ttrdh(:,:,jk,4) * zwkx(:,:,jk)   ! eddy induced merid. advection
+       ! tmltrd(:,:,10) = tmltrdg(:,:,10) + ttrd(:,:,jk,6) * zwkx(:,:,jk)  ! eddy induced vert. advection
+!#endif
+
+         ! Salinity
+         smltrd(:,:,1) = smltrd(:,:,1) + strdh(:,:,jk,1) * zwkx(:,:,jk)   ! zonal advection
+         smltrd(:,:,2) = smltrd(:,:,2) + strdh(:,:,jk,2) * zwkx(:,:,jk)   ! meridional advection
+         smltrd(:,:,3) = smltrd(:,:,3) + strd (:,:,jk,2) * zwkx(:,:,jk)   ! vertical advection
+         smltrd(:,:,4) = smltrd(:,:,4) + strd (:,:,jk,3) * zwkx(:,:,jk)   ! lateral diffusion (hor. part)
+         IF( l_traldf_iso ) THEN
+            smltrd(:,:,7) = smltrd(:,:,7) + strd (:,:,jk,4) * zwkx(:,:,jk)   ! lateral diffusion (explicit 
+            !                                                                ! vert. part (isopycnal diff.)
+         ENDIF
+!#if defined key_traldf_eiv
+       ! smltrd(:,:,8) = smltrdg(:,:,8) + strdh(:,:,jk,3) * zwkx(:,:,jk)   ! eddy induced zonal advection
+       ! smltrd(:,:,9) = smltrdg(:,:,9) + strdh(:,:,jk,4) * zwkx(:,:,jk)   ! eddy induced merid. advection
+       ! smltrd(:,:,10) = smltrdg(:,:,10) + strd(:,:,jk,6) * zwkx(:,:,jk)   ! eddy induced vert. advection
+!#endif
+
+      END DO
+
+
+      IF( idebug /= 0 ) THEN
+         IF(lwp) WRITE(numout,*) ' debuging trd_mld: III.1 done'  
+         CALL FLUSH(numout)
+      ENDIF
+
+
+      ! III.2 trends terms at upper and lower boundaries of mixed-layer
+      ! ---------------------------------------------------------------
+
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+            
+            ik = nmld(ji,jj)
+            
+            ! Temperature
+            
+            ! forcing (non penetrative)
+            tmltrd(ji,jj,5) = tmltrd(ji,jj,5) + flxtrd(ji,jj,1) * zwkx(ji,jj,1)
+            ! entrainment due to vertical diffusion
+            !       - due to vertical mixing scheme (TKE)
+            zavt = avt(ji,jj,ik)
+            tmltrd(ji,jj,6) = - 1. * zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)   &
+                                   * ( tn(ji,jj,ik-1) - tn(ji,jj,ik) )   &
+                                   / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1)
+
+            ! Salinity
+
+            ! forcing
+            smltrd(ji,jj,5) = flxtrd(ji,jj,2) * zwkx(ji,jj,1)
+            ! entrainment due to vertical diffusion
+            !       - due to vertical mixing scheme (TKE)
+            zavt = fsavs(ji,jj,ik)
+            smltrd(ji,jj,6) = -1. * zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)   &
+               &                  * ( sn(ji,jj,ik-1) - sn(ji,jj,ik) )   &
+               &                  / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1)
+         END DO
+      END DO
+
+      IF( l_traldf_iso ) THEN
+!!Clem On retire de la diffusion verticale TOTALE calculee par tmltrd(:,:,7)
+!!Clem ds trazdf.isopycnal et implicit, la partie verticale due au Kz afin de ne garder
+!!Clem effectivement que la diffusion verticale isopycnale (ie composante de la
+!!Clem diff isopycnale sur la verticale) :
+            tmltrd(:,:,7) = tmltrd(:,:,7) - tmltrd(:,:,6)   ! - due to isopycnal mixing scheme (implicit part)
+            smltrd(:,:,7) = smltrd(:,:,7) - smltrd(:,:,6)   ! - due to isopycnal mixing scheme (implicit part)
+      ENDIF
+
+      ! Boundary conditions
+      DO jk = 1, jpltrd
+         CALL lbc_lnk( tmltrd, 'T', 1. )
+         CALL lbc_lnk( smltrd, 'T', 1. )
+      END DO
+
+      IF( idebug /= 0 ) THEN
+         WRITE(numout,*) ' debuging trd_mld: III.2 done'  
+         CALL FLUSH(numout)
+      ENDIF
+
+#if defined key_trabbl_dif
+      ! III.3 trends terms from beckman over-flow parameterization
+      ! ----------------------------------------------------------
+
+      DO jj = 1,jpj
+         DO ji = 1,jpi
+            ikb = MAX( mbathy(ji,jj)-1, 1 )
+            ! beckmann component -> horiz. part of lateral diffusion
+            tmltrd(ji,jj,4) = tmltrd(ji,jj,4) + bbltrd(ji,jj,1) * zwkx(ji,jj,ikb)
+            smltrd(ji,jj,4) = smltrd(ji,jj,4) + bbltrd(ji,jj,2) * zwkx(ji,jj,ikb)
+         END DO
+      END DO
+      
+#endif
+
+      IF( idebug /= 0 ) THEN
+         WRITE(numout,*) ' debuging trd_mld: III.3 done'  
+         CALL FLUSH(numout)
+      ENDIF
+
+
+      !  =================================
+      !   IV. Cumulated trends
+      !  =================================
+
+
+
+      ! IV.1 set `before' mixed layer values for kt = nit000+1
+      ! --------------------------------------------------------
+
+      IF( kt == nit000+1 ) THEN
+         tmlbb(:,:) = tmlb(:,:)
+         tmlbn(:,:) = tml (:,:)
+         smlbb(:,:) = smlb(:,:)
+         smlbn(:,:) = sml (:,:)
+      ENDIF
+
+      IF( idebug /= 0 ) THEN
+         WRITE(numout,*) ' debuging trd_mld: IV.1 done'  
+         CALL FLUSH(numout)
+      ENDIF
+
+
+      ! IV.2 cumulated trends over analysis period (kt=2 to nwrite)
+      ! ----------------------
+
+      ! trends cumulated over nwrite-2 time steps
+
+      IF( kt >= nit000+2 ) THEN
+         nmoymltrd = nmoymltrd + 1
+         DO jl = 1, jpltrd
+            tmltrdm(:,:) = tmltrdm(:,:) + tmltrd(:,:,jl)
+            smltrdm(:,:) = smltrdm(:,:) + smltrd(:,:,jl)
+         END DO
+      ENDIF
+
+      IF( idebug /= 0 ) THEN
+         WRITE(numout,*) ' debuging trd_mld: IV.2 done'  
+         CALL FLUSH(numout)
+      ENDIF
+
+
+      !  =============================================
+      !   V. Output in netCDF + residual computation
+      !  =============================================
+
+
+      IF( MOD( kt - nit000+1, nwrite ) == 0 ) THEN
+
+         ! V.1 compute total trend 
+         ! ------------------------
+
+         zmean = float(nmoymltrd)
+         
+         ztmltot(:,:) = ( tml(:,:) - tmlbn(:,:) + tmlb(:,:) - tmlbb(:,:) ) /  (zmean * 2. * rdt)
+         zsmltot(:,:) = ( sml(:,:) - smlbn(:,:) + smlb(:,:) - smlbb(:,:) ) /  (zmean * 2. * rdt)
+
+         IF(idebug /= 0) THEN
+            WRITE(numout,*) ' zmean = ',zmean  
+            WRITE(numout,*) ' debuging trd_mld: V.1 done'  
+            CALL FLUSH(numout)
+         ENDIF
+          
+
+         ! V.2 compute residual 
+         ! ---------------------
+
+         ztmlres(:,:) = ztmltot(:,:) - tmltrdm(:,:) / zmean
+         zsmlres(:,:) = zsmltot(:,:) - smltrdm(:,:) / zmean
+
+
+         ! Boundary conditions
+
+         CALL lbc_lnk( ztmltot, 'T', 1. )
+         CALL lbc_lnk( ztmlres, 'T', 1. )
+         CALL lbc_lnk( zsmltot, 'T', 1. )
+         CALL lbc_lnk( zsmlres, 'T', 1. )
+
+         IF( idebug /= 0 ) THEN
+            WRITE(numout,*) ' debuging trd_mld: V.2 done'  
+            CALL FLUSH(numout)
+         ENDIF
+
+
+         ! V.3 time evolution array swap
+         ! ------------------------------
+
+         tmlbb(:,:) = tmlb(:,:)
+         tmlbn(:,:) = tml (:,:)
+         smlbb(:,:) = smlb(:,:)
+         smlbn(:,:) = sml (:,:)
+
+         IF( idebug /= 0 ) THEN
+            WRITE(numout,*) ' debuging trd_mld: V.3 done'  
+            CALL FLUSH(numout)
+         ENDIF
+
+
+         ! V.4 zero cumulative array
+         ! ---------------------------
+
+          nmoymltrd = 0
+
+          tmltrdm(:,:) = 0.
+          smltrdm(:,:) = 0.
+
+          IF(idebug /= 0) THEN
+              WRITE(numout,*) ' debuging trd_mld: IV.4 done'  
+              CALL FLUSH(numout)
+          ENDIF
+          
+      ENDIF
+
+      ! IV.5 write trends to output
+      ! ---------------------------
+
+#if defined key_dimgout
+! code for dimg mpp output
+      IF ( MOD(kt,nwrite) == 0 ) THEN
+         WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average'
+         iyear = ndastp/10000
+         imon = (ndastp-iyear*10000)/100
+         iday = ndastp - imon*100 - iyear*10000
+         WRITE(clname,9000) TRIM(cexper),'MLDiags',iyear,imon,iday
+         cltext=TRIM(cexper)//' mld diags'//TRIM(clmode)
+         CALL dia_wri_dimg (clname, cltext, smltrd, jpltrd, '2')
+  9000   FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
+       END IF
+
+#else
+      IF( kt >=  nit000+1 ) THEN
+
+#include "trdmld_ncwrite.h90"
+
+         IF( idebug /= 0 ) THEN
+            WRITE(numout,*) ' debuging trd_mld: IV.5 done'  
+            CALL FLUSH(numout)
+         ENDIF
+
+      ENDIF
+
+      IF( kt == nitend )   CALL histclo( nidtrd )
+#endif
+
+   END SUBROUTINE trd_mld
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trdmld = .FALSE.   ! momentum trend flag
+CONTAINS
+   SUBROUTINE trd_mld( kt )        ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE trd_mld
+#endif
+
+   !!======================================================================
+END MODULE trdmld
Index: /branches/nemo/NEMO/OPA_SRC/TRD/trdmld_ncinit.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRD/trdmld_ncinit.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRD/trdmld_ncinit.h90	(revision 4)
@@ -0,0 +1,121 @@
+      !-----------------------------------------
+      ! II.1 Define frequency of output and means
+      ! -----------------------------------------
+
+#if defined key_diainstant
+      zsto = nwrite*rdt
+      clop ="inst(only(x))"
+#else
+      zsto = rdt
+      clop ="ave(only(x))"
+#endif
+      zout = nwrite*rdt
+
+      IF( kt == nit000 ) THEN
+
+         IF(lwp) WRITE (numout,*) ' Diamld: netCDF initialization'
+
+         ! II.2 Compute julian date from starting date of the run
+         ! ------------------------
+
+         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian )
+         IF (lwp) WRITE(numout,*)' '  
+         IF (lwp) WRITE(numout,*)' Date 0 used :',nit000   &
+              ,' YEAR ', nyear,' MONTH ', nmonth,' DAY ', nday   &
+              ,'Julian day : ', zjulian
+
+
+         ! II.3 Define the T grid trend file (nidtrd)
+         ! ---------------------------------
+
+         CALL dia_nam( clhstnam, nwrite, 'trends' )                  ! filename
+         IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,1, jpi,   &  ! Horizontal grid : glamt and gphit
+              1, jpj, 0, zjulian, rdt, nh_t, nidtrd)
+         IF( isum > 0 ) THEN                                         ! Index of ocean points (2D only)
+            WRITE(numout,*)' Number of invalid points nmld > jpktrd', isum 
+            CALL wheneq( jpi*jpj, zvlmsk(:,:) , 1, 1., ndextrd1, ndimtrd1 )   ! volume
+         ELSE 
+            CALL wheneq( jpi*jpj, tmask(:,:,1), 1, 1., ndextrd1, ndimtrd1 )    ! surface
+         ENDIF
+         
+
+         ! Declare output fields as netCDF variables
+
+         ! Mixed layer Depth
+         CALL histdef( nidtrd, "somlttml", clmxl//"Depth"              , "m"   ,   &  ! hmlp
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+
+         ! Temperature
+         CALL histdef( nidtrd, "somltemp", clmxl//"Temperature"        , "C"   ,   &  ! ???
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         ! Temperature trends
+         CALL histdef( nidtrd, "somlttto", clmxl//"T Total"             , "C/s",   &  ! total
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlttax", clmxl//"T Zonal Advection", "C/s",       & ! i-adv.
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlttay", clmxl//"T Meridional Advection", "C/s",   & ! j-adv.
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlttaz", clmxl//"T Vertical Advection", "C/s",   & ! vert. adv.
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlttdh", clmxl//"T Horizontal Diffusion ", "C/s",   & ! hor. lateral diff.
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlttfo", clmxl//"T Forcing", "C/s",   & ! forcing
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlbtdz", clmxl//"T Vertical Diffusion", "C/s",   & ! vert. diff.
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlbtdt", clmxl//"T dh/dt Entrainment (Residual)", "C/s",   & ! T * dh/dt 
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         IF( l_traldf_iso ) THEN
+         CALL histdef( nidtrd, "somlbtdv", clmxl//"T Vert. lateral Diffusion","C/s",   & ! vertical diffusion entrainment (ISO)
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         ENDIF
+#if defined key_traldf_eiv
+         CALL histdef( nidtrd, "somlgtax", clmxl//"T Zonal EIV Advection", "C/s",   & ! i-adv. (eiv)
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlgtay", clmxl//"T Meridional EIV Advection", "C/s",   & ! j-adv. (eiv)
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlgtaz", clmxl//"T Vertical EIV Advection", "C/s",   & ! vert. adv. (eiv)
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlgtat", clmxl//"T Total EIV Advection", "C/s",   & ! total advection (eiv)
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#endif
+         ! Salinity
+         CALL histdef( nidtrd, "somlsalt", clmxl//"Salinity", "PSU",   & ! Mixed-layer salinity
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         ! Salinity trends
+         CALL histdef( nidtrd, "somltsto", clmxl//"S Total", "PSU/s",   & ! total 
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somltsax", clmxl//"S Zonal Advection", "PSU/s",   & ! i-advection
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somltsay", clmxl//"S Meridional Advection", "PSU/s",   & ! j-advection
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somltsaz", clmxl//"S Vertical Advection", "PSU/s",   & ! vertical advection
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somltsdh", clmxl//"S Horizontal Diffusion ", "PSU/s",   & ! hor. lat. diff.
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somltsfo", clmxl//"S Forcing", "PSU/s",   & ! forcing
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+
+         CALL histdef( nidtrd, "somlbsdz", clmxl//"S Vertical Diffusion", "PSU/s",   & ! vert. diff.
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlbsdt", clmxl//"S dh/dt Entrainment (Residual)", "PSU/s",   & ! S * dh/dt 
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         IF( l_traldf_iso ) THEN
+         ! vertical diffusion entrainment (ISO)
+         CALL histdef( nidtrd, "somlbsdv", clmxl//"S Vertical lateral Diffusion", "PSU/s",   & ! vert. lat. diff.
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         ENDIF
+#if defined key_traldf_eiv
+         CALL histdef( nidtrd, "somlgsax", clmxl//"S Zonal EIV Advection", "PSU/s",   & ! i-advection (eiv)
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlgsay", clmxl//"S Meridional EIV Advection", "PSU/s",   & ! j-advection (eiv)
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlgsaz", clmxl//"S Vertical EIV Advection", "PSU/s",   & ! vert. adv. (eiv)
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nidtrd, "somlgsat", clmxl//"S Total EIV Advection", "PSU/s",   & ! total adv. (eiv)
+            &          jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#endif
+         CALL histend( nidtrd )
+
+      ENDIF
Index: /branches/nemo/NEMO/OPA_SRC/TRD/trdmld_ncwrite.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRD/trdmld_ncwrite.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRD/trdmld_ncwrite.h90	(revision 4)
@@ -0,0 +1,54 @@
+      ! define time axis
+      it= kt-nit000+1
+      IF( lwp .AND. MOD( kt, nwrite ) == 0 ) THEN
+         WRITE(numout,*) '     diamld : write NetCDF fields'
+      ENDIF
+      
+      CALL histwrite( nidtrd,"somlttml",it,rmld          ,ndimtrd1,ndextrd1) ! Mixed-layer depth
+      CALL histwrite( nidtrd,"somltemp",it,tml           ,ndimtrd1,ndextrd1) ! Mixed-layer temperature
+      
+      
+      ! Temperature trends
+      ! ------------------
+      CALL histwrite( nidtrd,"somlttto",it,ztmltot       ,ndimtrd1,ndextrd1) ! total 
+      CALL histwrite( nidtrd,"somlttax",it,tmltrd(:,:, 1),ndimtrd1,ndextrd1) ! i- adv.
+      CALL histwrite( nidtrd,"somlttay",it,tmltrd(:,:, 2),ndimtrd1,ndextrd1) ! j- adv.
+      CALL histwrite( nidtrd,"somlttaz",it,tmltrd(:,:, 3),ndimtrd1,ndextrd1) ! vertical adv.
+      CALL histwrite( nidtrd,"somlttdh",it,tmltrd(:,:, 4),ndimtrd1,ndextrd1) ! hor. lateral diff.
+      CALL histwrite( nidtrd,"somlttfo",it,tmltrd(:,:, 5),ndimtrd1,ndextrd1) ! forcing
+
+      CALL histwrite( nidtrd,"somlbtdz",it,tmltrd(:,:, 6),ndimtrd1,ndextrd1) ! vert. diffusion 
+      CALL histwrite( nidtrd,"somlbtdt",it,ztmlres       ,ndimtrd1,ndextrd1) ! dh/dt entrainment (residual)
+      IF( l_traldf_iso ) THEN
+         CALL histwrite( nidtrd,"somlbtdv",it,tmltrd(:,:, 7),ndimtrd1,ndextrd1) ! vert. lateral diff.
+      ENDIF
+#if defined key_traldf_eiv
+      CALL histwrite( nidtrd,"somlgtax",it,tmltrd(:,:, 8),ndimtrd1,ndextrd1) ! i- adv. (eiv)
+      CALL histwrite( nidtrd,"somlgtay",it,tmltrd(:,:, 9),ndimtrd1,ndextrd1) ! j- adv. (eiv)
+      CALL histwrite( nidtrd,"somlgtaz",it,tmltrd(:,:,10),ndimtrd1,ndextrd1) ! vert. adv. (eiv)
+      z2d(:,:) = tmltrd(:,:,8) + tmltrd(:,:,9) + tmltrd(:,:,10)
+      CALL histwrite( nidtrd,"somlgtat",it,z2d           ,ndimtrd1,ndextrd1) ! total adv. (eiv)
+#endif
+      CALL histwrite( nidtrd,"somlsalt",it,sml           ,ndimtrd1,ndextrd1) ! Mixed-layer salinity
+
+      ! Salinity trends
+      ! ---------------
+      CALL histwrite( nidtrd,"somltsto",it,zsmltot       ,ndimtrd1,ndextrd1) ! total 
+      CALL histwrite( nidtrd,"somltsax",it,smltrd(:,:, 1),ndimtrd1,ndextrd1) ! i- adv.
+      CALL histwrite( nidtrd,"somltsay",it,smltrd(:,:, 2),ndimtrd1,ndextrd1) ! j- adv.
+      CALL histwrite( nidtrd,"somltsaz",it,smltrd(:,:, 3),ndimtrd1,ndextrd1) ! vert. adv.
+      CALL histwrite( nidtrd,"somltsdh",it,smltrd(:,:, 4),ndimtrd1,ndextrd1) ! hor. lateral diff.
+      CALL histwrite( nidtrd,"somltsfo",it,smltrd(:,:, 5),ndimtrd1,ndextrd1) ! forcing
+      CALL histwrite( nidtrd,"somlbsdz",it,smltrd(:,:, 6),ndimtrd1,ndextrd1) ! vert. diff.
+      CALL histwrite( nidtrd,"somlbsdt",it,zsmlres       ,ndimtrd1,ndextrd1) ! dh/dt entrainment (residual)
+      IF( l_traldf_iso ) THEN
+         CALL histwrite( nidtrd,"somlbsdv",it,smltrd(:,:, 7),ndimtrd1,ndextrd1) ! vert. lateral diff;
+      ENDIF
+#if defined key_traldf_eiv
+      CALL histwrite( nidtrd,"somlgsax",it,smltrd(:,:, 8),ndimtrd1,ndextrd1) ! i-adv. (eiv)
+      CALL histwrite( nidtrd,"somlgsay",it,smltrd(:,:, 9),ndimtrd1,ndextrd1) ! j-adv. (eiv)
+      CALL histwrite( nidtrd,"somlgsaz",it,smltrd(:,:,10),ndimtrd1,ndextrd1) ! vert. adv. (eiv)
+      z2d(:,:) = smltrd(:,:,8) + smltrd(:,:,9) + smltrd(:,:,10)
+      CALL histwrite( nidtrd,"somlgsat",it,z2d           ,ndimtrd1,ndextrd1) ! total adv. (eiv)
+#endif
+
Index: /branches/nemo/NEMO/OPA_SRC/TRD/trdtra.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 4)
@@ -0,0 +1,383 @@
+MODULE trdtra
+   !!======================================================================
+   !!                       ***  MODULE  trdtra  ***
+   !! Ocean diagnostics:  ocean tracer trends
+   !!=====================================================================
+#if  defined key_trdtra   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trdtra'  or                           tracer trend diagnostics
+   !!   'key_trdmld'                          mixed layer trend diagnostics
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   trd_tra      : verify the basin averaged properties for tracers
+   !!   trd_tra_init : ???
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE trdtra_oce      ! ocean active tracer trend variables
+   USE trddyn_oce      ! ocean dynamics trend variables
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldfdyn_oce      ! ocean dynamics: lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distibuted memory computing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC trd_tra      ! called by step.F90
+   PUBLIC trd_tra_init ! called by opa.F90
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .TRUE.   ! momentum trend flag
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trd_tra( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_tra  ***
+      !! 
+      !! ** Purpose :   verify the basin averaged properties of the tracers
+      !!   equations at every time step frequency ntrd.
+      !!
+      !!   Method :
+      !!
+      !! History :
+      !!        !  91-12 (G. Madec)
+      !!        !  92-06 (M. Imbard) add time step frequency
+      !!        !  96-01 (G. Madec) terrain following coordinates
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER :: ji, jj, jk, jn
+      REAL(wp)                ::   zbt 
+      REAL(wp), DIMENSION(10) ::   ztmo, zsmo, zt2, zs2
+
+      NAMELIST/namtrd/ ntrd, nctls
+      !!----------------------------------------------------------------------
+
+      ! 0. Initialization
+      ! -----------------
+
+      IF( kt == nit000 ) THEN
+
+         ! namelist namtrd : trend diagnostic
+         REWIND( numnam )
+         READ  ( numnam, namtrd )
+
+         IF(lwp) THEN
+            WRITE(numout,*) 'trd_tra : read namelist namtrd'
+            WRITE(numout,*) '~~~~~~~'
+            WRITE(numout,*) ' time step frequency trend       ntrd  = ', ntrd
+            WRITE(numout,*) ' '
+         ENDIF
+
+         ! Total volume at t-points:
+         tvolt = 0.
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  tvolt = tvolt + e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk)* tmask(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+#if defined key_mpp
+         CALL mpp_sum( tvolt )
+#endif
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '***trd_tra'
+            WRITE(numout,*) ' frequency ntrd = ',ntrd
+            WRITE(numout,*) ' '
+            WRITE(numout,*) ' tvolt = ',tvolt
+            WRITE(numout,*) ' '
+         ENDIF
+
+      ENDIF
+
+
+      ! 1. Advective trends and forcing trend
+      ! -------------------------------------
+
+      IF( MOD(kt,ntrd) == 0 .OR. kt  == nit000 .OR. kt == nitend ) THEN
+         
+         ! 1.1 Mask the forcing trend and substract it from the vertical diffusion trend
+         flxtrd(:,:,1) = flxtrd(:,:,1) * tmask_i(:,:)
+         flxtrd(:,:,2) = flxtrd(:,:,2) * tmask_i(:,:)
+         
+         ! 1.2 Mask the trends
+         DO jn = 1, 6
+            DO jk = 1, jpk
+               ttrd(:,:,jk,jn) = ttrd(:,:,jk,jn)* tmask(:,:,jk) * tmask_i(:,:)
+               strd(:,:,jk,jn) = strd(:,:,jk,jn)* tmask(:,:,jk) * tmask_i(:,:)
+            END DO
+         END DO
+         
+         DO jk = 1, jpk
+            ttrd(:,:,jk,7) = ttrd(:,:,jk,7) * tmask(:,:,jk) * tmask_i(:,:)
+         END DO
+
+
+         ! 2. Basin averaged tracer trend
+         ! ------------------------------
+         
+         DO jn = 1, 6
+            ztmo(jn) = 0.
+            zsmo(jn) = 0.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
+                     ztmo(jn) =  ztmo(jn) + ttrd(ji,jj,jk,jn) * zbt
+                     zsmo(jn) =  zsmo(jn) + strd(ji,jj,jk,jn) * zbt
+                  END DO
+               END DO
+            END DO
+         END DO
+         
+         ztmo(7) = 0.
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+                  ztmo(7) =  ztmo(7) + ttrd(ji,jj,jk,7) * zbt
+               END DO
+            END DO
+         END DO
+         
+         ztmo(8) = 0.
+         zsmo(8) = 0.
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)
+               ztmo(8) =  ztmo(8) + flxtrd(ji,jj,1) * zbt
+               zsmo(8) =  zsmo(8) + flxtrd(ji,jj,2) * zbt
+            END DO
+         END DO
+         
+         
+         ! 3. Basin averaged tracer square trend
+         ! -------------------------------------
+         ! c a u t i o n: field before, because after the array swap
+         
+         DO jn = 1, 6
+            zt2(jn) = 0.e0
+            zs2(jn) = 0.e0
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+                     zt2(jn) = zt2(jn) + ttrd(ji,jj,jk,jn) * zbt * tb(ji,jj,jk)
+                     zs2(jn) = zs2(jn) + strd(ji,jj,jk,jn) * zbt * sb(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         END DO
+         
+         zt2(7) = 0.e0
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+                  zt2(7) = zt2(7) + ttrd(ji,jj,jk,7) * zbt * tb(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         
+         zt2(8) = 0.e0
+         zs2(8) = 0.e0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)
+               zt2(8) = zt2(8) + flxtrd(ji,jj,1) * zbt * tb(ji,jj,1)
+               zs2(8) = zs2(8) + flxtrd(ji,jj,2) * zbt * sb(ji,jj,1)
+            END DO
+         END DO
+         
+#if defined key_mpp
+         CALL mpp_sum( ztmo, 10 )
+         CALL mpp_sum( zsmo, 10 )
+         CALL mpp_sum( zt2 , 10 )
+         CALL mpp_sum( zs2 , 10 )
+#endif
+         
+         ! 4. Print
+         ! --------
+         
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9400) kt
+            WRITE (numout,9401) ztmo(1) / tvolt, zsmo(1) / tvolt
+            WRITE (numout,9402) ztmo(2) / tvolt, zsmo(2) / tvolt
+            WRITE (numout,9403) ztmo(3) / tvolt, zsmo(3) / tvolt
+            WRITE (numout,9404) ztmo(4) / tvolt, zsmo(4) / tvolt
+            WRITE (numout,9405) ztmo(5) / tvolt, zsmo(5) / tvolt
+            WRITE (numout,9406) ztmo(6) / tvolt, zsmo(6) / tvolt
+            WRITE (numout,9407) ztmo(7) / tvolt
+            WRITE (numout,9408) ztmo(8) / tvolt, zsmo(8) / tvolt
+            WRITE (numout,9409)
+            WRITE (numout,9410) (  ztmo(1) + ztmo(2) + ztmo(3) + ztmo(4)              &
+            &                    + ztmo(5) + ztmo(6) + ztmo(7) + ztmo(8) ) / tvolt,   &
+            &                   (  zsmo(1) + zsmo(2) + zsmo(3) + zsmo(4)              &
+            &                    + zsmo(5) + zsmo(6)           + zsmo(8) ) / tvolt
+         ENDIF
+
+9400     FORMAT(' tracer trend at it= ',i6,' :     temperature',   &
+              '              salinity',/' ============================')
+9401     FORMAT(' horizontal advection        ',e20.13,'     ',e20.13)
+9402     FORMAT(' vertical advection          ',e20.13,'     ',e20.13)
+9403     FORMAT(' horizontal diffusion        ',e20.13,'     ',e20.13)
+9404     FORMAT(' vertical diffusion          ',e20.13,'     ',e20.13)
+9405     FORMAT(' STATIC instability mixing   ',e20.13,'     ',e20.13)
+9406     FORMAT(' damping term                ',e20.13,'     ',e20.13)
+9407     FORMAT(' penetrative qsr             ',e20.13,'     ',e20.13)
+9408     FORMAT(' forcing term                ',e20.13,'     ',e20.13)
+9409     FORMAT(' -------------------------------------------------------------------------')
+9410     FORMAT(' total trend                 ',e20.13,'     ',e20.13)
+
+
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9420) kt
+            WRITE (numout,9421) zt2(1) / tvolt, zs2(1) / tvolt
+            WRITE (numout,9422) zt2(2) / tvolt, zs2(2) / tvolt
+            WRITE (numout,9423) zt2(3) / tvolt, zs2(3) / tvolt
+            WRITE (numout,9424) zt2(4) / tvolt, zs2(4) / tvolt
+            WRITE (numout,9425) zt2(5) / tvolt, zs2(5) / tvolt
+            WRITE (numout,9426) zt2(6) / tvolt, zs2(6) / tvolt
+            WRITE (numout,9427) zt2(7) / tvolt
+            WRITE (numout,9428) zt2(8) / tvolt, zs2(8) / tvolt
+            WRITE (numout,9429)
+            WRITE (numout,9430) (  zt2(1) + zt2(2) + zt2(3) + zt2(4)              &
+            &                    + zt2(5) + zt2(6) + zt2(7) + zt2(8) ) / tvolt,   &
+            &                   (  zs2(1) + zs2(2) + zs2(3) + zs2(4)              &
+            &                    + zs2(5) + zs2(6)          + zs2(8) ) / tvolt
+         ENDIF
+
+9420     FORMAT(' tracer**2 trend at it= ', i6, ' :      temperature',   &
+            '               salinity', /, ' ===============================')
+9421     FORMAT(' horizontal advection      * t   ', e20.13, '     ', e20.13)
+9422     FORMAT(' vertical advection        * t   ', e20.13, '     ', e20.13)
+9423     FORMAT(' horizontal diffusion      * t   ', e20.13, '     ', e20.13)
+9424     FORMAT(' vertical diffusion        * t   ', e20.13, '     ', e20.13)
+9425     FORMAT(' STATIC instability mixing * t   ', e20.13, '     ', e20.13)
+9426     FORMAT(' damping term              * t   ', e20.13, '     ', e20.13)
+9427     FORMAT(' penetrative qsr           * t   ', e20.13, '     ', e20.13)
+9428     FORMAT(' forcing term              * t   ', e20.13, '     ', e20.13)
+9429     FORMAT(' -----------------------------------------------------------------------------')
+9430     FORMAT(' total trend                *t = ', e20.13, '  *s = ', e20.13)
+
+
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9440) kt
+            WRITE (numout,9441) ( ztmo(1)+ztmo(2) )/tvolt, ( zsmo(1)+zsmo(2) )/tvolt
+            WRITE (numout,9442)   ztmo(3)/tvolt,  zsmo(3)/tvolt
+            WRITE (numout,9443)   ztmo(4)/tvolt,  zsmo(4)/tvolt
+            WRITE (numout,9444)   ztmo(5)/tvolt,  zsmo(5)/tvolt
+            WRITE (numout,9445) ( zt2(1)+zt2(2) )/tvolt, ( zs2(1)+zs2(2) )/tvolt
+            WRITE (numout,9446)   zt2(3)/tvolt,   zs2(3)/tvolt
+            WRITE (numout,9447)   zt2(4)/tvolt,   zs2(4)/tvolt
+            WRITE (numout,9448)   zt2(5)/tvolt,   zs2(5)/tvolt
+         ENDIF
+
+9440     FORMAT(' tracer consistency at it= ',i6,   &
+            ' :         temperature','                salinity',/,   &
+            ' ==================================')
+9441     FORMAT(' 0 = horizontal+vertical advection      ',e20.13,'       ',e20.13)
+9442     FORMAT(' 0 = horizontal diffusion               ',e20.13,'       ',e20.13)
+9443     FORMAT(' 0 = vertical diffusion                 ',e20.13,'       ',e20.13)
+9444     FORMAT(' 0 = static instability mixing          ',e20.13,'       ',e20.13)
+9445     FORMAT(' 0 = horizontal+vertical advection * t  ',e20.13,'       ',e20.13)
+9446     FORMAT(' 0 > horizontal diffusion          * t  ',e20.13,'       ',e20.13)
+9447     FORMAT(' 0 > vertical diffusion            * t  ',e20.13,'       ',e20.13)
+9448     FORMAT(' 0 > static instability mixing     * t  ',e20.13,'       ',e20.13)
+      ENDIF
+
+   END SUBROUTINE trd_tra
+
+
+   SUBROUTINE trd_tra_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_tra_init  ***
+      !! 
+      !! ** Purpose :   
+      !!
+      !! ** Method  :
+      !!
+      !! History :
+      !!   9.0  !  03-09  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER :: ji, jj, jk
+
+      NAMELIST/namtrd/ ntrd, nctls
+      !!----------------------------------------------------------------------
+
+      ! set to zero the tracers trends
+      ttrd  (:,:,:,:) = 0.e0
+      strd  (:,:,:,:) = 0.e0
+      ttrdh (:,:,:,:) = 0.e0
+      strdh (:,:,:,:) = 0.e0
+      flxtrd(:,:,  :) = 0.e0
+
+      ! namelist namtrd : trend diagnostic
+      REWIND( numnam )
+      READ  ( numnam, namtrd )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trd_tra : read namelist namtrd'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '          time step frequency trend       ntrd  = ', ntrd
+      ENDIF
+
+      ! Total volume at t-points:
+      tvolt = 0.
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               tvolt = tvolt + e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk)* tmask(ji,jj,jk) * tmask_i(ji,jj)
+            END DO
+         END DO
+      END DO
+#if defined key_mpp
+      CALL mpp_sum( tvolt )
+#endif
+      IF(lwp) THEN
+         WRITE(numout,*) '          total ocean volume at T-point   tvolt = ',tvolt
+      ENDIF
+
+   END SUBROUTINE trd_tra_init
+
+#   else
+   !!----------------------------------------------------------------------
+   !!   Default case :                                         Empty module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trdtra = .FALSE.   ! momentum trend flag
+CONTAINS
+   SUBROUTINE trd_tra( kt )        ! Empty routine
+      WRITE(*,*) kt
+   END SUBROUTINE trd_tra
+   SUBROUTINE trd_tra_init         ! Empty routine
+   END SUBROUTINE trd_tra_init
+#endif
+
+   !!======================================================================
+END MODULE trdtra
Index: /branches/nemo/NEMO/OPA_SRC/TRD/trdtra_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/TRD/trdtra_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/TRD/trdtra_oce.F90	(revision 4)
@@ -0,0 +1,70 @@
+MODULE trdtra_oce
+   !!======================================================================
+   !!                   ***  MODULE trdtra_oce  ***
+   !! Ocean trends :   set tracer trend variables
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce      ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   INTEGER  ::      & !!! namdia :  diagnostics on dynamics and/or tracer trends
+      ntrd  = 10 ,  &  !: time step frequency dynamics and tracers trends
+      nctls =  0       !: control surface type for trends vertical integration
+   !!----------------------------------------------------------------------
+
+#if   defined key_trdtra   ||   defined key_trdmld   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trdtra'   or                         tracer trends diagnostics
+   !!   'key_trdmld'                         mixed layer trends diagnostics
+   !!----------------------------------------------------------------------
+
+   !! Trends diagnostics parameters
+   !!---------------------------------------------------------------------
+   INTEGER, PARAMETER ::            &
+# if defined key_traldf_eiv
+      jptrdh = 4,   &  !: number of 3D horiz trends arrays
+      jpltrd = 10,  &  !: number of mixed-layer trends arrays
+      jpktrd = jpk     !: max level for mixed-layer trends diag.
+# else
+      jptrdh = 2,   &  !: number of 3D horiz trends arrays
+      jpltrd = 7,   &  !: number of mixed-layer trends arrays
+      jpktrd = jpk     !: max level for mixed-layer trends diag.
+# endif
+
+   !! Trends diagnostics variables
+   !!---------------------------------------------------------------------
+   REAL(wp) ::   &
+      tvolt         ! volume of the whole ocean computed at t-points
+   REAL(wp), DIMENSION(jpi,jpj,jpk,7) ::   &
+      ttrd             !: trends of the temperature tracer equations
+      !                !  ttrd(,,,1) : horizontal advection
+      !                !  ttrd(,,,2) : vertical advection
+      !                !  ttrd(,,,3) : horizontal diffusion
+      !                !  ttrd(,,,4) : vertical diffusion
+      !                !  ttrd(,,,5) : static instability
+      !                !  ttrd(,,,6) : damping OR vertical EIV
+      !                !  ttrd(,,,7) : penetrative solar radiation (T only)
+   REAL(wp), DIMENSION(jpi,jpj,jpk,6) ::   &
+      strd             !: trends of the salinity tracer equations
+      !                !  same as ttrd()
+   REAL(wp), DIMENSION(jpi,jpj,jpk,jptrdh) ::   &
+      ttrdh, strdh     !: ttrdh(,,,1) : zonal advection
+      !                !  ttrdh(,,,2) : meridional advection
+      !                !  ttrdh(,,,3) : zonal EIV
+      !                !  ttrdh(,,,4) : meridional EIV
+   REAL(wp), DIMENSION(jpi,jpj,2) ::   &
+      flxtrd,       &  !: tracer forcing trends
+      bbltrd           !: tracer bottom boundary layer trends
+   
+#else
+  !!----------------------------------------------------------------------
+  !!   Default option :                        NO tracer trend diagnostics
+  !!----------------------------------------------------------------------
+#endif
+
+  !!======================================================================
+END MODULE trdtra_oce
Index: /branches/nemo/NEMO/OPA_SRC/ZDF/zdf.matrixsolver.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ZDF/zdf.matrixsolver.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ZDF/zdf.matrixsolver.h90	(revision 4)
@@ -0,0 +1,55 @@
+!! 
+!!         ZDF.MATRIXSOLVER
+!!       ********************
+!! 
+!! Matrix inversion
+!!----------------------------------------------------------------------
+!   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+!
+!        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+!        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+!        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+!        (        ...               )( ...  ) ( ...  )
+!        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+!
+!   m is decomposed in the product of an upper and lower triangular
+!   matrix
+!   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+!   The second member is in 2d array zwy
+!   The solution is in 2d array zwx
+!   The 2d arry zwt and zwz are work space arrays
+!
+!   N.B. the starting vertical index (ikst) is equal to 1 except for
+!   the resolution of tke matrix where surface tke value is prescribed
+!   so that ikstrt=2.
+!!----------------------------------------------------------------------
+!!  OPA 8.5, LODYC-IPSL (2002)
+!!----------------------------------------------------------------------
+
+      ikstp1 = ikst + 1
+      ikenm2 = jpk - 2
+      DO ji = 2, jpim1
+         zwt(ji,ikst) = zwd(ji,ikst)
+      END DO
+      DO jk = ikstp1, jpkm1
+         DO ji = 2, jpim1
+            zwt(ji,jk) = zwd(ji,jk) - zwi(ji,jk) * zws(ji,jk-1) / zwt(ji,jk-1)
+         END DO
+      END DO
+      DO ji = 2, jpim1
+         zwz(ji,ikst) = zwy(ji,ikst)
+      END DO
+      DO jk = ikstp1, jpkm1
+         DO ji = 2, jpim1
+            zwz(ji,jk) = zwy(ji,jk) - zwi(ji,jk) / zwt(ji,jk-1) * zwz(ji,jk-1)
+         END DO
+      END DO
+      DO ji = 2, jpim1
+         zwx(ji,jpkm1) = zwz(ji,jpkm1) / zwt(ji,jpkm1)
+      END DO
+      DO jk = ikenm2, ikst, -1
+         DO ji = 2, jpim1
+            zwx(ji,jk) =( zwz(ji,jk) - zws(ji,jk) * zwx(ji,jk+1) ) / zwt(ji,jk)
+         END DO
+      END DO
+      
Index: /branches/nemo/NEMO/OPA_SRC/ZDF/zdf.matrixsolver.vopt.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ZDF/zdf.matrixsolver.vopt.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ZDF/zdf.matrixsolver.vopt.h90	(revision 4)
@@ -0,0 +1,67 @@
+!! 
+!!         ZDF.MATRIXSOLVER
+!!       ********************
+!! 
+!! Matrix inversion
+!!----------------------------------------------------------------------
+!   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk )
+!
+!        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 )
+!        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 )
+!        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 )
+!        (        ...               )( ...  ) ( ...  )
+!        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk )
+!
+!   m is decomposed in the product of an upper and lower triangular
+!   matrix
+!   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi
+!   The second member is in 2d array zwy
+!   The solution is in 2d array zwx
+!   The 3d arry zwt is a work space array
+!   zwy is used and then used as a work space array : its value is modified!
+!
+!   N.B. the starting vertical index (ikst) is equal to 1 except for
+!   the resolution of tke matrix where surface tke value is prescribed
+!   so that ikstrt=2.
+!!----------------------------------------------------------------------
+!!  OPA 8.5, LODYC-IPSL (2002)
+!!----------------------------------------------------------------------
+
+      ikstp1 = ikst + 1
+      ikenm2 = jpk - 2
+
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            zwt(ji,jj,ikst) = zwd(ji,jj,ikst)
+         END DO
+      END DO
+
+      DO jk = ikstp1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      DO jk = ikstp1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zwy(ji,jj,jk) = zwy(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * zwy(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            zwx(ji,jj,jpkm1) = zwy(ji,jj,jpkm1) / zwt(ji,jj,jpkm1)
+         END DO
+      END DO
+
+      DO jk = ikenm2, ikst, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zwx(ji,jj,jk) = ( zwy(ji,jj,jk) - zws(ji,jj,jk) * zwx(ji,jj,jk+1) ) / zwt(ji,jj,jk)
+            END DO
+         END DO
+      END DO
Index: /branches/nemo/NEMO/OPA_SRC/ZDF/zdf_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 4)
@@ -0,0 +1,52 @@
+MODULE zdf_oce
+   !!======================================================================
+   !!              ***  MODULE  zdf_oce  ***
+   !! Ocean physics : define vertical mixing variables
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   zdf_init    : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce         ! mesh and scale factors
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Share Module variables
+   LOGICAL, PARAMETER, PUBLIC ::    &
+#if defined key_zdfcst   ||   defined key_esopa
+      lk_zdfcst        = .TRUE.         !: constant vertical mixing flag
+#else
+      lk_zdfcst        = .FALSE.        !: constant vertical mixing flag
+#endif
+   LOGICAL, PUBLIC ::    &
+      ln_zdfevd        = .TRUE.  ,   &  !: convection: enhanced vertical diffusion flag
+      ln_zdfnpc        = .FALSE.        !: convection: non-penetrative convection flag
+
+   LOGICAL, PUBLIC ::    &
+      l_trazdf_exp     = .FALSE. ,   &  !: ???
+      l_trazdf_imp     = .FALSE. ,   &  !: 
+      l_dynzdf_exp     = .FALSE. ,   &  !: 
+      l_dynzdf_imp     = .TRUE.  ,   &  !:
+      l_dynzdf_imp_tsk = .FALSE.        !:
+
+   INTEGER, PUBLIC ::    & !!! namzdf:  vertical diffusion
+      n_zdfexp = 3    ,  &  !: number of sub-time step (explicit time stepping)
+      nevdm    = 1          !: =0/1 flag to apply enhanced avm or not
+ 
+   REAL(wp), PUBLIC ::   & !!! namzdf   vertical diffusion
+      avm0  = 1.e-4_wp,  &  !: vertical eddy viscosity (m2/s)
+      avt0  = 1.e-5_wp,  &  !: vertical eddy diffusivity (m2/s)
+      avevd = 1._wp         !: vertical eddy coeff. for enhanced vert. diff. (m2/s)
+
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &
+      avmu,              &  !: vertical viscosity coeff. at uw-, vw-points
+      avmv,              &  !: vertical viscosity coeff. at uw-, vw-points
+      avt                   !: vertical diffusivity coeff. at w-point
+ 
+   REAL(wp), PUBLIC, DIMENSION(jpk) ::   &
+      avmb, avtb            !: background profile of avm and avt
+ 
+   !!======================================================================
+END MODULE zdf_oce
Index: /branches/nemo/NEMO/OPA_SRC/ZDF/zdfbfr.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 4)
@@ -0,0 +1,229 @@
+MODULE zdfbfr
+   !!======================================================================
+   !!                       ***  MODULE  zdfbfr  ***
+   !! Ocean physics: Bottom friction
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   zdf_bfr      : update momentum Kz at the ocean bottom due to the
+   !!                  type of bottom friction chosen
+   !!   zdf_bfr_init : read in namelist and control the bottom friction
+   !!                  parameters.
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE zdf_oce         ! ocean vertical physics variables
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC zdf_bfr    ! called by step.F90
+
+   !! * Module variables
+   INTEGER ::             & !!! ** bottom friction namelist (nambfr) **
+      nbotfr = 0             ! = 0/1/2/3 type of bottom friction 
+   REAL(wp) ::            & !!! ** bottom friction namelist (nambfr) **
+      bfri1 = 4.0e-4_wp,  &  ! bottom drag coefficient (linear case) 
+      bfri2 = 1.0e-3_wp,  &  ! bottom drag coefficient (non linear case)
+      bfeb2 = 2.5e-3_wp      ! background bottom turbulent kinetic energy  (m2/s2)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE zdf_bfr( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zdf_bfr  ***
+      !!                 
+      !! ** Purpose :   Applied the bottom friction through a specification of 
+      !!      Kz at the ocean bottom.
+      !!
+      !! ** Method  :   Update the value of avmu and avmv at the ocean bottom 
+      !!       level following the chosen friction type (no-slip, free-slip, 
+      !!       linear, or quadratic)
+      !!
+      !! History :
+      !!   8.0  !  97-06  (G. Madec, A.-M. Treguier)  Original code
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   &
+         ji, jj,                   &  ! dummy loop indexes
+         ikbu, ikbv,               &  ! temporary integers
+         ikbum1, ikbvm1               !
+      REAL(wp) ::   &
+         zvu, zuv, zecu, zecv         ! temporary scalars
+      !!----------------------------------------------------------------------
+
+
+      IF( kt == nit000 )   CALL zdf_bfr_init
+
+
+      ! Compute avmu, avmv at the ocean bottom
+      ! --------------------------------------
+
+      SELECT CASE (nbotfr)
+
+      CASE( 0 )                 ! no-slip boundary condition
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+         jj = 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+# endif
+               ikbu   = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) )
+               ikbv   = MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) )
+               ikbum1 = MAX( ikbu-1, 1 )
+               ikbvm1 = MAX( ikbv-1, 1 )
+               avmu(ji,jj,ikbu) = 2. * avmu(ji,jj,ikbum1)
+               avmv(ji,jj,ikbv) = 2. * avmv(ji,jj,ikbvm1)
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+            END DO
+# endif
+         END DO
+
+      CASE( 1 )                 ! linear botton friction
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+         jj = 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+# endif
+               ikbu = MIN( mbathy(ji+1,jj), mbathy(ji,jj) )
+               ikbv = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )
+               avmu(ji,jj,ikbu) = bfri1 * fse3uw(ji,jj,ikbu)
+               avmv(ji,jj,ikbv) = bfri1 * fse3vw(ji,jj,ikbv)
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+            END DO
+# endif
+         END DO
+
+      CASE( 2 )                 ! quadratic botton friction
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+         jj = 1
+!CDIR NOVERRCHK
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = 2, jpim1
+# endif
+               ikbu   = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) )
+               ikbv   = MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) )
+               ikbum1 = MAX( ikbu-1, 1 )
+               ikbvm1 = MAX( ikbv-1, 1 )
+               
+               zvu  = 0.25 * (  vn(ji,jj  ,ikbum1) + vn(ji+1,jj  ,ikbum1)     &
+                              + vn(ji,jj-1,ikbum1) + vn(ji+1,jj-1,ikbum1)  )
+               
+               zuv  = 0.25 * (  un(ji,jj  ,ikbvm1) + un(ji-1,jj  ,ikbvm1)     &
+                              + un(ji,jj+1,ikbvm1) + un(ji-1,jj+1,ikbvm1)  )
+               
+               zecu = SQRT(  un(ji,jj,ikbum1) * un(ji,jj,ikbum1) + zvu*zvu + bfeb2  )
+               zecv = SQRT(  vn(ji,jj,ikbvm1) * vn(ji,jj,ikbvm1) + zuv*zuv + bfeb2  )
+               
+               avmu(ji,jj,ikbu) = bfri2 * zecu * fse3uw(ji,jj,ikbu)
+               avmv(ji,jj,ikbv) = bfri2 * zecv * fse3vw(ji,jj,ikbv)
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+            END DO
+# endif
+         END DO
+
+      CASE( 3 )                 ! free-slip boundary condition
+# if defined key_vectopt_loop   &&   ! defined key_autotasking
+         jj = 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+# endif
+               ikbu = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) )
+               ikbv = MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) )
+               avmu(ji,jj,ikbu) = 0.e0
+               avmv(ji,jj,ikbv) = 0.e0
+# if ! defined key_vectopt_loop   ||   defined key_autotasking
+            END DO
+# endif
+         END DO
+
+      END SELECT
+
+      ! Lateral boundary condition on (avmu,avmv)   (unchanged sign)
+      ! ------------------------------===========
+      CALL lbc_lnk( avmu, 'U', 1. )
+      CALL lbc_lnk( avmv, 'V', 1. )
+
+   END SUBROUTINE zdf_bfr
+
+
+   SUBROUTINE zdf_bfr_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_bfr_init  ***
+      !!                    
+      !! ** Purpose :   Initialization of the bottom friction
+      !!
+      !! ** Method  :   Read the nammbf namelist and check their consistency
+      !!      called at the first timestep (nit000)
+      !!
+      !! History :
+      !!   9.0  !  02-06  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      NAMELIST/nambfr/ nbotfr, bfri1, bfri2, bfeb2
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist nambfr : bottom momentum boundary condition
+      ! --------------------
+      REWIND ( numnam )
+      READ   ( numnam, nambfr )
+
+
+      ! Parameter control and print
+      ! ---------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'zdf_bfr : momentum bottom friction'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+      IF(lwp) WRITE(numout,*) '          Namelist nambfr : set bottom friction parameters'
+
+      SELECT CASE (nbotfr)
+
+      CASE( 0 )
+         IF(lwp) WRITE(numout,*) '            no-slip '
+
+      CASE( 1 )
+         IF(lwp) WRITE(numout,*) '            linear botton friction'
+         IF(lwp) WRITE(numout,*) '            friction coef.   bfri1  = ', bfri1
+
+      CASE( 2 )
+         IF(lwp) WRITE(numout,*) '            quadratic botton friction'
+         IF(lwp) WRITE(numout,*) '            friction coef.   bfri2  = ', bfri2
+         IF(lwp) WRITE(numout,*) '            background tke   bfeb2  = ', bfeb2
+
+      CASE( 3 )
+         IF(lwp) WRITE(numout,*) '            free-slip '
+
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '         bad flag value for nbotfr = ', nbotfr
+         nstop = nstop + 1
+
+      END SELECT
+
+   END SUBROUTINE zdf_bfr_init
+
+   !!======================================================================
+END MODULE zdfbfr
Index: /branches/nemo/NEMO/OPA_SRC/ZDF/zdfddm.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 4)
@@ -0,0 +1,252 @@
+MODULE zdfddm
+   !!======================================================================
+   !!                       ***  MODULE  zdfddm  ***
+   !! Ocean physics : double diffusion mixing parameterization
+   !!======================================================================
+#if defined key_zdfddm   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_zdfddm' :                                     double diffusion
+   !!----------------------------------------------------------------------
+   !!   zdf_ddm       : compute the Ks for salinity
+   !!   zdf_ddm_init  : read namelist and control the parameters
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE zdf_oce         ! ocean vertical physics variables
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC zdf_ddm     ! called by step.F90
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC ::   lk_zdfddm = .TRUE.    !: double diffusive mixing flag
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &
+      avs ,               &  !: salinity vertical diffusivity coeff. at w-point
+      rrau                   !: heat/salt buoyancy flux ratio
+
+   !! * Module variables
+   REAL(wp) ::            & !!! * double diffusive mixing namelist *
+      avts  = 1.e-4_wp ,  &  ! maximum value of avs for salt fingering
+      hsbfr = 1.6_wp         ! heat/salt buoyancy flux ratio
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE zdf_ddm( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_ddm  ***
+      !!                    
+      !! ** Purpose :   Add to the vertical eddy diffusivity coefficient the 
+      !!      effect of salt fingering and diffusive convection. 
+      !!
+      !! ** Method  :   Diapycnal mixing is increased in case of double
+      !!      diffusive mixing (i.e. salt fingering and diffusive layering)
+      !!      following Merryfield et al. (1999). The rate of double diffusive 
+      !!      mixing depend on the buoyancy ratio: Rrau=alpha/beta dk[T]/dk[S]
+      !!      which is computed in rn2.F
+      !!         * salt fingering (Schmitt 1981):
+      !!      for Rrau > 1 and rn2 > 0 : zavfs = avts / ( 1 + (Rrau/hsbfr)^6 )
+      !!      for Rrau > 1 and rn2 > 0 : zavfs = O
+      !!      otherwise                : zavft = 0.7 zavs / Rrau
+      !!         * diffusive layering (Federov 1988):
+      !!      for 0< Rrau < 1 and rn2 > 0 : zavdt = 1.3635e-6  
+      !!                                 * exp( 4.6 exp(-0.54 (1/Rrau-1) ) )
+      !!      otherwise                   : zavdt = 0 
+      !!      for .5 < Rrau < 1 and rn2 > 0 : zavds = zavdt (1.885 Rrau -0.85)
+      !!      for  0 < Rrau <.5 and rn2 > 0 : zavds = zavdt 0.15 Rrau      
+      !!      otherwise                     : zavds = 0 
+      !!         * update the eddy diffusivity:
+      !!      avt = avt + zavft + zavdt
+      !!      avs = avs + zavfs + zavds
+      !!      avmu, avmv are required to remain at least above avt and avs.
+      !!      
+      !! ** Action  :   avt, avs : update vertical eddy diffusivity coef.
+      !!                           for temperature and salinity
+      !!
+      !! References :
+      !!      Merryfield et al., JPO, 29, 1124-1142, 1999.
+      !! History :
+      !!        !  00-08  (G. Madec)  double diffusive mixing
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step indexocean time step
+
+      !! * Local declarations
+      INTEGER ::   ji, jj , jk              ! dummy loop indices
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zmsks, zmskf,                    & ! temporary workspace 
+         zmskd1, zmskd2, zmskd3             !    "           "
+      REAL(wp) ::   &
+         zinr, zrr,                       & ! temporary scalars
+         zavft, zavfs,                    & !    "         "
+         zavdt, zavds                       !    "         "
+      !!----------------------------------------------------------------------
+
+
+      IF ( kt == nit000 )   CALL zdf_ddm_init          ! Initialization (first time-step only)
+
+
+      ! Compute avs
+      ! -----------
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! Define the mask 
+         ! ---------------
+         ! only retains positive value of rrau
+         rrau(:,:,jk) = MAX( 1.e-20, rrau(:,:,jk) )
+
+         ! indicators:
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! stability indicator: msks=1 if rn2>0; 0 elsewhere
+               IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN
+                  zmsks(ji,jj) = 0.e0
+               ELSE
+                  zmsks(ji,jj) = 1.e0
+               ENDIF
+               ! salt fingering indicator: msksf=1 if rrau>1; 0 elsewhere            
+               IF( rrau(ji,jj,jk) <= 1. ) THEN
+                  zmskf(ji,jj) = 0.e0
+               ELSE
+                  zmskf(ji,jj) = 1.e0
+               ENDIF
+               ! diffusive layering indicators: 
+               !   mskdl1=1 if 0<rrau<1; 0 elsewhere
+               IF( rrau(ji,jj,jk) >= 1. ) THEN
+                  zmskd1(ji,jj) = 0.e0
+               ELSE
+                  zmskd1(ji,jj) = 1.e0
+               ENDIF
+               !   mskdl2=1 if 0<rrau<0.5; 0 elsewhere
+               IF( rrau(ji,jj,jk) >= 0.5 ) THEN
+                  zmskd2(ji,jj) = 0.e0
+               ELSE
+                  zmskd2(ji,jj) = 1.e0
+               ENDIF
+               !   mskdl3=1 if 0.5<rrau<1; 0 elsewhere
+               IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN
+                  zmskd3(ji,jj) = 0.e0
+               ELSE
+                  zmskd3(ji,jj) = 1.e0
+               ENDIF
+            END DO
+         END DO
+         ! mask zmsk in order to have avt and avs masked
+         zmsks(:,:) = zmsks(:,:) * tmask(:,:,jk)
+
+
+         ! Update avt and avs
+         ! ------------------
+         ! Constant eddy coefficient: reset to the background value
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               zinr = 1./rrau(ji,jj,jk)
+               ! salt fingering
+               zrr = rrau(ji,jj,jk)/hsbfr
+               zrr = zrr * zrr
+               zavfs = avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) *zmskf(ji,jj)
+               zavft = 0.7 * zavfs / rrau(ji,jj,jk)
+               ! diffusive layering
+               zavdt = 1.3635e-6 * EXP(4.6*EXP(-0.54*(zinr-1.) ) )   &
+                                 * zmsks(ji,jj) * zmskd1(ji,jj)
+               zavds = zavdt * zmsks(ji,jj)   &
+                     * ( (1.85 * rrau(ji,jj,jk) - 0.85 ) * zmskd3(ji,jj)   &
+                         + zavdt * 0.15 * rrau(ji,jj,jk) * zmskd2(ji,jj)  )
+               ! add to the eddy viscosity coef. previously computed
+               avs (ji,jj,jk) = avt(ji,jj,jk) + zavfs + zavds
+               avt (ji,jj,jk) = avt(ji,jj,jk) + zavft + zavdt
+            END DO
+         END DO
+
+
+         ! Increase avmu, avmv if necessary
+         ! --------------------------------
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk),    &
+                                     avt(ji,jj,jk), avt(ji+1,jj,jk),   &
+                                     avs(ji,jj,jk), avs(ji+1,jj,jk) )   &
+                              * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk),    &
+                                     avt(ji,jj,jk), avt(ji,jj+1,jk),   &
+                                     avs(ji,jj,jk), avs(ji,jj+1,jk) )   &
+                              * vmask(ji,jj,jk)
+            END DO
+         END DO
+         !                                                ! ===============
+      END DO                                              !   End of slab
+      !                                                   ! ===============
+      
+      ! Lateral boundary conditions on ( avt, avs, avmu, avmv )   (unchanged sign)
+      ! -------------------------------========================
+      CALL lbc_lnk( avt , 'W', 1. )
+      CALL lbc_lnk( avs , 'W', 1. )
+      CALL lbc_lnk( avmu, 'U', 1. ) 
+      CALL lbc_lnk( avmv, 'V', 1. )
+      
+   END SUBROUTINE zdf_ddm
+   
+   
+   SUBROUTINE zdf_ddm_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_ddm_init  ***
+      !!
+      !! ** Purpose :   Initialization of double diffusion mixing scheme
+      !!
+      !! ** Method  :   Read the nammbf namelist and check the parameter values
+      !!      called by zdf_ddm at the first timestep (nit000)
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      NAMELIST/namddm/ avts, hsbfr
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist namddm : double diffusion mixing scheme
+      ! --------------------
+      REWIND ( numnam )
+      READ   ( numnam, namddm )
+
+
+      ! Parameter control and print
+      ! ---------------------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_ddm : double diffusive mixing'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '          Namelist namddm : set dd mixing parameter'
+         WRITE(numout,*)
+         WRITE(numout,*) '             maximum avs for dd mixing      avts   = ', avts
+         WRITE(numout,*) '             heat/salt buoyancy flux ratio  hsbfr  = ', hsbfr
+         WRITE(numout,*)
+      ENDIF
+
+   END SUBROUTINE zdf_ddm_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :          Dummy module          No double diffusion
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC ::   lk_zdfddm = .FALSE.   !: double diffusion flag
+CONTAINS
+   SUBROUTINE zdf_ddm( kt )           ! Dummy routine
+      WRITE(*,*) kt                          ! avoid compil warning
+   END SUBROUTINE zdf_ddm
+#endif
+
+   !!======================================================================
+END MODULE zdfddm
Index: /branches/nemo/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90	(revision 4)
@@ -0,0 +1,13 @@
+   !!----------------------------------------------------------------------
+   !!                    *** zdfddm_substitute.h90  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute fsaht. the eddy diffusivity coeff.
+   !!      with a constant or 1D or 2D or 3D array, using CPP macro.
+   !!----------------------------------------------------------------------
+#if defined key_zdfddm
+!   'key_zdfddm' :                      avs: 3D array defined in zdfddm module
+#   define   fsavs(i,j,k)   avs(i,j,k)
+#else
+!   Defautl option :                     avs = avt
+#   define   fsavs(i,j,k)   avt(i,j,k)
+#endif
Index: /branches/nemo/NEMO/OPA_SRC/ZDF/zdfevd.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 4)
@@ -0,0 +1,131 @@
+MODULE zdfevd
+   !!======================================================================
+   !!                       ***  MODULE  zdfevd  ***
+   !! Ocean physics: parameterization of convection through an enhancement
+   !!                of vertical eddy mixing coefficient
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   zdf_evd      : update momentum and tracer Kz at the location of
+   !!                  statically unstable portion of the water column
+   !!                  (called if ln_zdfevd=T)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics variables
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC zdf_evd      ! called by step.F90
+
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE zdf_evd( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_evd  ***
+      !!                   
+      !! ** Purpose :   Local increased the vertical eddy viscosity and diffu-
+      !!      sivity coefficients when a static instability is encountered.
+      !!
+      !! ** Method  :   avt, and the 4 neighbouring avmu, avmv coefficients
+      !!      are set to avevd (namelist parameter) if the water column is 
+      !!      statically unstable (i.e. if rn2 < -1.e-12 )
+      !!
+      !! ** Action  :   Update avt, avmu, avmv in statically instable cases
+      !!
+      !! References :
+      !!      Lazar, A., these de l'universite Paris VI, France, 1997
+      !! History :
+      !!   7.0  !  97-06  (G. Madec, A. Lazar)  Original code
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step indexocean time step
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk               ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'zdf_evd : Enhanced Vertical Diffusion (evd)'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      SELECT CASE ( nevdm )
+ 
+      CASE ( 1 )           ! enhance vertical eddy viscosity and diffusivity (if rn2<-1.e-12)
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+#   if defined key_vectopt_loop   &&   ! defined key_autotasking
+!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL!
+            jj = 1                     ! big loop forced
+            DO ji = jpj+1, jpij   
+               IF( rn2(ji,jj,jk) <= -1.e-12 ) THEN
+                  avt (ji  ,jj  ,jk) = avevd * tmask(ji  ,jj  ,jk)
+                  avmu(ji  ,jj  ,jk) = avevd * umask(ji  ,jj  ,jk)
+                  avmu(ji-1,jj  ,jk) = avevd * umask(ji-1,jj  ,jk)
+                  avmv(ji  ,jj  ,jk) = avevd * vmask(ji  ,jj  ,jk)
+                  avmv(ji  ,jj-1,jk) = avevd * vmask(ji  ,jj-1,jk)
+               ENDIF
+            END DO
+#   else
+            DO jj = 2, jpj             ! no vector opt.
+               DO ji = 2, jpi
+                  IF( rn2(ji,jj,jk) <= -1.e-12 ) THEN
+                     avt (ji  ,jj  ,jk) = avevd * tmask(ji  ,jj  ,jk)
+                     avmu(ji  ,jj  ,jk) = avevd * umask(ji  ,jj  ,jk)
+                     avmu(ji-1,jj  ,jk) = avevd * umask(ji-1,jj  ,jk)
+                     avmv(ji  ,jj  ,jk) = avevd * vmask(ji  ,jj  ,jk)
+                     avmv(ji  ,jj-1,jk) = avevd * vmask(ji  ,jj-1,jk)
+                  ENDIF
+               END DO
+            END DO
+#   endif
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+         ! Lateral boundary conditions on ( avt, avmu, avmv )   (unchanged sign)
+         ! -------------------------------===================
+         CALL lbc_lnk( avt , 'W', 1. )
+         CALL lbc_lnk( avmu, 'U', 1. )
+         CALL lbc_lnk( avmv, 'V', 1. )
+
+      CASE DEFAULT         ! enhance vertical eddy diffusivity only (if rn2<-1.e-12) 
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL! 
+#   if defined key_vectopt_loop   &&   ! defined key_autotasking
+            jj = 1                     ! big loop forced
+            DO ji = 1, jpij   
+               IF( rn2(ji,jj,jk) <= -1.e-12 )   avt(ji,jj,jk) = avevd * tmask(ji,jj,jk)
+            END DO
+#   else
+            DO jj = 1, jpj             ! loop over the whole domain (no lbc_lnk call)
+               DO ji = 1, jpi
+                  IF( rn2(ji,jj,jk) <= -1.e-12 )   avt(ji,jj,jk) = avevd * tmask(ji,jj,jk)
+               END DO
+            END DO
+#   endif
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+      END SELECT 
+
+   END SUBROUTINE zdf_evd
+
+   !!======================================================================
+END MODULE zdfevd
Index: /branches/nemo/NEMO/OPA_SRC/ZDF/zdfini.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 4)
@@ -0,0 +1,172 @@
+MODULE zdfini
+   !!======================================================================
+   !!              ***  MODULE  zdfini  ***
+   !! Ocean physics : define vertical mixing variables
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   zdf_init    : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce         ! mesh and scale factors
+   USE ldftra_oce      ! ???
+   USE ldfdyn_oce      ! ???
+   USE zdf_oce         ! TKE vertical mixing          
+   USE zdftke          ! TKE vertical mixing          
+   USE zdfddm          ! double diffusion mixing      
+   USE zdfevd          ! enhanced vertical diffusion  
+   USE zdfric          ! Richardson vertical mixing   
+   USE tranpc          ! convection: non penetrative adjustment
+   USE ldfslp          ! ???
+
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! *  Routine accessibility
+   PUBLIC zdf_init          ! routine called by opa.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0   !   LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+   
+CONTAINS
+
+   SUBROUTINE zdf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_init  ***
+      !! 
+      !! ** Purpose :   initializations of the vertical ocean physics
+      !!
+      !! ** Method  :   Read namelist namzdf, control cpp keys
+      !!
+      !! History :
+      !!        !  97-06  (G. Madec)  Original code from inimix
+      !!   8.5  !  02-08  (G. Madec)  F90 : free form
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   ioptio       ! temporary scalar
+      LOGICAL ::           & !!! namzdf: vertical diffusion
+         ln_zdfexp = .FALSE.   ! explicit vertical diffusion scheme flag
+
+      !! * Namelist
+      NAMELIST/namzdf/ ln_zdfevd, ln_zdfnpc,   &
+         &             avm0, avt0, avevd, nevdm, ln_zdfexp, n_zdfexp
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0, LODYC-IPSL (2003)
+      !!----------------------------------------------------------------------
+
+      ! Read namzdf namelist : vertical mixing parameters
+      ! --------------------
+      REWIND( numnam )
+      READ  ( numnam, namzdf )
+
+      ! Parameter print
+      ! ---------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_init: vertical physics'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '          Namelist namzdf : set vertical mixing mixing parameters'
+         WRITE(numout,*) '             enhanced vertical diffusion      ln_zdfevd = ', ln_zdfevd
+         WRITE(numout,*) '             non-penetrative convection       ln_zdfnpc = ', ln_zdfnpc
+         WRITE(numout,*) '             vertical eddy viscosity             avm0   = ', avm0
+         WRITE(numout,*) '             vertical eddy diffusivity           avt0   = ', avt0
+         WRITE(numout,*) '             vertical coefficient for evd        avevd  = ', avevd
+         WRITE(numout,*) '                applied on momentum (=1/0)       nevdm  = ', nevdm
+         WRITE(numout,*) '             time splitting / backward scheme ln_zdfexp = ', ln_zdfexp
+         WRITE(numout,*) '             number of time step               n_zdfexp = ', n_zdfexp
+      ENDIF
+
+      ! Parameter & key controls
+      ! ------------------------
+      ! ... vertical mixing
+      ! time stepping scheme (N.B. TKE scheme => force the use of implicit scheme)
+      IF( ln_zdfexp .AND. .NOT.lk_zdftke ) THEN  
+         l_trazdf_exp = .TRUE.           ! use explicit scheme
+         l_trazdf_imp = .FALSE.
+         l_dynzdf_exp = .TRUE.           ! use explicit scheme
+         l_dynzdf_imp = .FALSE.
+      ELSE
+         l_trazdf_exp = .FALSE.          ! use implicit scheme
+         l_trazdf_imp = .TRUE. 
+         l_dynzdf_exp = .FALSE.          ! use implicit scheme
+         l_dynzdf_imp = .TRUE. 
+      ENDIF
+      IF( l_trazdf_iso .OR. l_trazdf_iso_vo ) THEN  
+         l_trazdf_exp = .FALSE.          ! iso-neutral diffusion : 
+         l_trazdf_imp = .FALSE.          ! implicit scheme included in iso-neutral routine
+      ENDIF
+      IF( l_dynldf_iso ) THEN  
+         l_dynzdf_exp = .FALSE.          ! iso-neutral diffusion :
+         l_dynzdf_imp = .FALSE.          ! implicit scheme included in iso-neutral routine
+      ENDIF
+#if defined key_autotasking
+      IF( l_dynzdf_imp ) THEN
+         l_dynzdf_imp     = .FALSE.
+         l_dynzdf_imp_tsk = .TRUE.
+      ENDIF
+#else
+      l_dynzdf_imp_tsk = .FALSE.
+#endif
+      IF( lk_esopa  ) THEN
+         l_trazdf_exp = .TRUE.           ! esopa: use all options
+         l_trazdf_imp = .TRUE.
+         l_dynzdf_exp     = .TRUE.           ! esopa: use all options
+         l_dynzdf_imp     = .TRUE.
+         l_dynzdf_imp_tsk = .TRUE.
+      ENDIF
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          vertical mixing option :'
+      ioptio = 0
+      IF( lk_zdfcst ) THEN
+         IF(lwp) WRITE(numout,*) '             constant eddy diffusion coef.'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdfric ) THEN
+         IF(lwp) WRITE(numout,*) '             Richardson dependent eddy coef.'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdftke ) THEN
+         IF(lwp) WRITE(numout,*) '             TKE dependent eddy coef.'
+         ioptio = ioptio+1
+      ENDIF
+      IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa ) THEN
+          IF(lwp) WRITE(numout,cform_err)
+          IF(lwp) WRITE(numout,*) ' one and only one vertical diffusion option has to be defined '
+          nstop = nstop + 1
+      ENDIF
+
+      ! ... Convection
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '          convection :'
+      ioptio = 0
+      IF( ln_zdfnpc ) THEN
+         IF(lwp) WRITE(numout,*) '             use non penetrative convective scheme'
+         ioptio = ioptio+1
+      ENDIF
+      IF( ln_zdfevd ) THEN
+         IF(lwp) WRITE(numout,*) '             use enhanced vertical dif. scheme'
+         ioptio = ioptio+1
+      ENDIF
+      IF( lk_zdftke ) THEN
+         IF(lwp) WRITE(numout,*) '             use the 1.5 turbulent closure'
+      ENDIF
+      IF ( ioptio > 1 .AND. .NOT. lk_esopa ) THEN
+          IF(lwp) WRITE(numout,cform_err)
+          IF(lwp) WRITE(numout,*) ' chose between key_convnpc'
+          IF(lwp) WRITE(numout,*) '           and key_convevd'
+          nstop = nstop + 1
+      ENDIF
+      IF( ioptio == 0 .AND. .NOT. lk_zdftke ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' except for TKE scheme, a convection scheme is'
+         IF(lwp) WRITE(numout,*) ' required: convevd or convnpc keys'
+         nstop = nstop + 1
+      ENDIF
+
+   END SUBROUTINE zdf_init
+
+   !!======================================================================
+END MODULE zdfini
Index: /branches/nemo/NEMO/OPA_SRC/ZDF/zdfmxl.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 4)
@@ -0,0 +1,238 @@
+MODULE zdfmxl
+   !!======================================================================
+   !!                       ***  MODULE  zdfmxl  ***
+   !! Ocean physics: mixed layer depth 
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   zdf_mxl      : Compute the turbocline and mixed layer depths.
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC zdf_mxl           ! called by step.F90
+
+   !! * Shared module variables
+   INTEGER, PUBLIC, DIMENSION(jpi,jpj) ::   &
+      nmln                  !: number of level in the mixed layer
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &
+      hmld ,             &  !: mixing layer depth (turbocline) (m)
+      hmlp ,             &  !: mixed layer depth  (rho=rho0+zdcrit) (m)
+      hmlpt                 !: mixed layer depth at t-points (m)
+
+   !! * module variables
+   REAL(wp) ::   &
+      avt_c = 5.e-4_wp,  &  ! Kz criterion for the turbocline depth
+      rho_c = 0.01_wp       ! density criterion for mixed layer depth
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+# if defined key_autotasking
+   !!----------------------------------------------------------------------
+   !!   'key_autotasking'                               j-k-i loop (j-slab)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE zdf_mxl( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zdfmxl  ***
+      !!                   
+      !! ** Purpose :   Compute the turbocline depth and the mixed layer depth
+      !!      with a density criteria.
+      !!
+      !! ** Method  :   The turbocline depth is the depth at which the vertical 
+      !!      eddy diffusivity coefficient (resulting from the vertical physics
+      !!      alone, not the isopycnal part, see trazdf.F) fall below a given
+      !!      value defined locally (avt_c here taken equal to 5 cm/s2)
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!   9.0  !  03-08  (G. Madec)  autotasking optimization
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk     ! dummy loop indices
+      INTEGER ::   ik             ! temporary integer
+      INTEGER, DIMENSION(jpi,jpj) ::   &
+         imld                     ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   auto-tasking case : j-k-i loop'
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      !                                                ! ===============
+      DO jj = 1, jpj                                   !  Vertical slab
+         !                                             ! ===============
+
+         ! 1. Turbocline depth
+         ! -------------------
+         ! last w-level at which avt<avt_c (starting from the bottom jk=jpk)
+         ! (since avt(.,.,jpk)=0, we have jpk=< imld =< 2 )
+         DO jk = jpk, 2, -1
+            DO ji = 1, jpi
+               IF( avt(ji,jj,jk) < avt_c ) imld(ji,jj) = jk 
+            END DO
+         END DO
+
+         ! Turbocline depth and sub-turbocline temperature
+         DO ji = 1, jpi
+            ik = imld(ji,jj)
+            hmld (ji,jj) = fsdepw(ji,jj,ik) * tmask(ji,jj,1)
+         END DO
+
+!!gm idea
+!!   
+!!gm     DO jk = jpk, 2, -1
+!!gm        DO ji = 1, jpi
+!!gm           IF( avt(ji,jj,jk) < avt_c ) hmld(ji,jj) = fsdepw(ji,jj,jk) * tmask(ji,jj,1)
+!!gm        END DO
+!!gm     END DO
+!!gm
+
+         ! 2. Mixed layer depth
+         ! --------------------
+         ! Initialization to the number of w ocean point mbathy
+         nmln(:,jj) = mbathy(:,jj)
+
+         ! Last w-level at which rhop>=rho surf+rho_c (starting from jpk-1)
+         ! (rhop defined at t-point, thus jk-1 for w-level just above)
+         DO jk = jpkm1, 2, -1
+            DO ji = 1, jpi
+               IF( rhop(ji,jj,jk) > rhop(ji,jj,1) + rho_c )   nmln(ji,jj) = jk
+            END DO
+         END DO
+
+         ! Mixed layer depth
+         DO ji = 1, jpi
+            ik = nmln(ji,jj)
+            hmlp (ji,jj) = fsdepw(ji,jj,ik) * tmask(ji,jj,1)
+            hmlpt(ji,jj) = fsdept(ji,jj,ik-1)
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+   END SUBROUTINE zdf_mxl
+
+# else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                         k-j-i loop
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE zdf_mxl( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdfmxl  ***
+      !!                   
+      !! ** Purpose :   Compute the turbocline depth and the mixed layer depth
+      !!      with density criteria.
+      !!
+      !! ** Method  :   The turbocline depth is the depth at which the vertical
+      !!      eddy diffusivity coefficient (resulting from the vertical physics
+      !!      alone, not the isopycnal part, see trazdf.F) fall below a given
+      !!      value defined locally (avt_c here taken equal to 5 cm/s2)
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        !  94-11  (M. Imbard)  Original code
+      !!   8.0  !  96-01  (E. Guilyardi)  sub mixed layer temp.
+      !!   8.1  !  97-07  (G. Madec)  optimization
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk     ! dummy loop indices
+      INTEGER ::   ik             ! temporary integer
+      INTEGER, DIMENSION(jpi,jpj) ::   &
+         imld                     ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+
+      ! 1. Turbocline depth
+      ! -------------------
+      ! last w-level at which avt<avt_c (starting from the bottom jk=jpk)
+      ! (since avt(.,.,jpk)=0, we have jpk=< imld =< 2 )
+      DO jk = jpk, 2, -1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( avt(ji,jj,jk) < avt_c ) imld(ji,jj) = jk 
+            END DO
+         END DO
+      END DO
+
+      ! Turbocline depth and sub-turbocline temperature
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = imld(ji,jj)
+            hmld (ji,jj) = fsdepw(ji,jj,ik) * tmask(ji,jj,1)
+         END DO
+      END DO
+
+!!gm idea
+!!   
+!!gm  DO jk = jpk, 2, -1
+!!gm     DO jj = 1, jpj
+!!gm        DO ji = 1, jpi
+!!gm           IF( avt(ji,jj,jk) < avt_c ) hmld(ji,jj) = fsdepw(ji,jj,jk) * tmask(ji,jj,1)
+!!gm        END DO
+!!gm     END DO
+!!gm  END DO
+!!gm
+
+      ! 2. Mixed layer depth
+      ! --------------------
+      ! Initialization to the number of w ocean point mbathy
+      nmln(:,:) = mbathy(:,:)
+
+      ! Last w-level at which rhop>=rho surf+rho_c (starting from jpk-1)
+      ! (rhop defined at t-point, thus jk-1 for w-level just above)
+      DO jk = jpkm1, 2, -1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( rhop(ji,jj,jk) > rhop(ji,jj,1) + rho_c )   nmln(ji,jj) = jk
+            END DO
+         END DO
+      END DO
+
+      ! Mixed layer depth
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = nmln(ji,jj)
+            hmlp (ji,jj) = fsdepw(ji,jj,ik) * tmask(ji,jj,1)
+            hmlpt(ji,jj) = fsdept(ji,jj,ik-1)
+         END DO
+      END DO
+
+   END SUBROUTINE zdf_mxl
+#endif
+
+   !!======================================================================
+END MODULE zdfmxl
Index: /branches/nemo/NEMO/OPA_SRC/ZDF/zdfric.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 4)
@@ -0,0 +1,263 @@
+MODULE zdfric
+   !!======================================================================
+   !!                       ***  MODULE  zdfric  ***
+   !! Ocean physics:  vertical mixing coefficient compute from the local
+   !!                 Richardson number dependent formulation
+   !!======================================================================
+#if defined key_zdfric   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_zdfric'                                             Kz = f(Ri)
+   !!----------------------------------------------------------------------
+   !!   zdf_ric      : update momentum and tracer Kz from the Richardson
+   !!                  number computation
+   !!   zdf_ric_init : initialization, namelist read, & parameters control
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE zdf_oce         ! ocean vertical physics
+!  USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC zdf_ric   ! called by step.F90
+
+   !! * Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfric = .TRUE.   !: Richardson vertical mixing flag
+
+   !! * Module variables
+   INTEGER ::               & !!! namric   richardson number dependent Kz
+      nric  = 2                ! coefficient of the parameterization
+   REAL(wp) ::              & !!! namric   richardson number dependent Kz
+      avmri = 100.e-4_wp ,  &  ! maximum value of the vertical eddy viscosity
+      alp   =   5._wp          ! coefficient of the parameterization
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+      tmric                    ! coef. for the horizontal mean at t-point
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE zdf_ric( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE zdfric  ***
+      !!                    
+      !! ** Purpose :   Compute the before eddy viscosity and diffusivity as
+      !!      a function of the local richardson number.
+      !!
+      !! ** Method  :   Local richardson number dependent formulation of the 
+      !!      vertical eddy viscosity and diffusivity coefficients. the eddy
+      !!      coefficients are given by:
+      !!              avm = avm0 + avmb
+      !!              avt = avm0 / (1 + alp*ri)
+      !!      with    ri  = N^2 / dz(u)**2
+      !!                  = e3w**2 * rn2/[ mi( dk(ub) )+mj( dk(vb) ) ]
+      !!              avm0= avmri / (1 + alp*ri)**nric
+      !!      Where ri is the before local Richardson number, avmri the maximum
+      !!      value reaches by the vertical eddy coefficients, avmb and avtb
+      !!      the background (or minimum) values of these coefficients for
+      !!      momemtum and tracers, and alp, nric are adjustable parameters.
+      !!      typical values used are : avm0=1.e-2 m2/s, avmb=1.e-6 m2/s
+      !!      avtb=1.e-7 m2/s, alp=5. and nric=2.
+      !!      this formulation needs ri>=0 : ri is set to zero if dz(rau)<0.
+      !!      a numerical threshold is impose on the vertical shear (1.e-20)
+      !!        N.B. the mask are required for implicit scheme, and surface
+      !!      and bottom value already set in inimix.F
+      !!
+      !! References :
+      !!      pacanowski & philander 1981, j. phys. oceanogr., 1441-1451.
+      !! History :
+      !!        !  87-09  (P. Andrich)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  93-03  (M. Guyon)  symetrical conditions
+      !!        !  96-01  (G. Madec)  complet rewriting of multitasking
+      !!                                  suppression of common work arrays
+      !!        !  97-06 (G. Madec)  complete rewriting of zdfmix
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step indexocean time step
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk               ! dummy loop indices
+      REAL(wp) ::   &
+         zcoef, zdku, zdkv, zri, z05alp     ! temporary scalars
+      REAL(wp), DIMENSION(jpi,jpj) ::   zwx ! temporary workspace
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0, LODYC-IPSL (2003)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000  ) CALL zdf_ric_init            ! Initialization (first time-step only)
+
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! Richardson number (put in zwx(ji,jj))
+         ! -----------------
+         ! minimum value set to zero
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               zcoef = 0.5 / fse3w(ji,jj,jk)
+               ! shear of horizontal velocity
+               zdku = zcoef * (  ub(ji-1,jj,jk-1) + ub(ji,jj,jk-1)   &
+                                -ub(ji-1,jj,jk  ) - ub(ji,jj,jk  )  )
+               zdkv = zcoef * (  vb(ji,jj-1,jk-1) + vb(ji,jj,jk-1)   &
+                                -vb(ji,jj-1,jk  ) - vb(ji,jj,jk  )  )
+               ! richardson number (minimum value set to zero)
+               zri = rn2(ji,jj,jk) / ( zdku*zdku + zdkv*zdkv + 1.e-20 )
+               zwx(ji,jj) = MAX( zri, 0.e0 )
+            END DO
+         END DO
+
+         ! Boundary condition on zwx   (sign unchanged)
+         CALL lbc_lnk( zwx, 'W', 1. )
+
+
+         ! Vertical eddy viscosity and diffusivity coefficients
+         ! -------------------------------------------------------
+         ! Eddy viscosity coefficients
+         z05alp = 0.5 * alp
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               avmu(ji,jj,jk) = umask(ji,jj,jk)   &
+                              * avmri / ( 1. + z05alp*( zwx(ji+1,jj)+zwx(ji,jj) ) )**nric
+               avmv(ji,jj,jk) = vmask(ji,jj,jk)   &
+                              * avmri / ( 1. + z05alp*( zwx(ji,jj+1)+zwx(ji,jj) ) )**nric
+            END DO
+         END DO
+
+         ! Eddy diffusivity coefficients
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               avt(ji,jj,jk) = tmric(ji,jj,jk) / ( 1. + alp * zwx(ji,jj) )   &
+                             * (  avmu(ji,jj,jk) + avmu(ji-1, jj ,jk)        &
+                                + avmv(ji,jj,jk) + avmv( ji ,jj-1,jk)  )     &
+                             + avtb(jk) * tmask(ji,jj,jk)
+            END DO
+         END DO
+
+         ! Add the background coefficient on eddy viscosity
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) + avmb(jk) * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + avmb(jk) * vmask(ji,jj,jk)
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      ! Boundary conditions on (avt,avmu,avmv)   (unchanged sign)
+      ! -----------------------===============
+      CALL lbc_lnk( avt , 'W', 1. )
+      CALL lbc_lnk( avmu, 'U', 1. )
+      CALL lbc_lnk( avmv, 'V', 1. )
+
+   END SUBROUTINE zdf_ric
+
+
+   SUBROUTINE zdf_ric_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE zdfbfr_init  ***
+      !!                    
+      !! ** Purpose :   Initialization of the vertical eddy diffusivity and
+      !!      viscosity coef. for the Richardson number dependent formulation.
+      !!
+      !! ** Method  :   Read the namric namelist and check the parameter values
+      !!
+      !! ** input   :   Namelist namric
+      !!
+      !! ** Action  :   increase by 1 the nstop flag is setting problem encounter
+      !!
+      !! history :
+      !!  8.5  !  02-06  (G. Madec)  original code
+      !!----------------------------------------------------------------------
+      !! * local declarations
+      INTEGER :: ji, jj, jk        ! dummy loop indices
+
+      NAMELIST/namric/ avmri, alp, nric
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist namric : richardson number dependent Kz
+      ! --------------------
+      REWIND ( numnam )
+      READ   ( numnam, namric )
+
+
+      ! Parameter control and print
+      ! ---------------------------
+      ! Control print
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'zdf_ric : Ri depend vertical mixing scheme'
+      IF(lwp) WRITE(numout,*) '======='
+      IF(lwp) WRITE(numout,*) '          Namelist namric : set Kz(Ri) parameters'
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '             maximum vertical viscosity     avmri  = ', avmri
+         WRITE(numout,*) '             coefficient                    alp    = ', alp
+         WRITE(numout,*) '             coefficient                    nric   = ', nric
+         WRITE(numout,*)
+      ENDIF
+
+
+      ! Work arrays for Ri number formulation
+      ! -------------------------------------
+
+      ! background eddy viscosity and diffusivity profiles
+      avmb(:) = avm0
+      avtb(:) = avt0
+
+      ! background profile of avm (fit the theoretical/observational
+      !     profile shown by Krauss (1990) and avt
+!!!   avtb(:) = 1.e-5 + 2.8e-8 * gdepw(:) ! m2/s
+
+      ! Increase the background in the surface layers
+      avmb(1) = 10.  * avmb(1)      ;      avtb(1) = 10.  * avtb(1)
+      avmb(2) = 10.  * avmb(2)      ;      avtb(2) = 10.  * avtb(2)
+      avmb(3) =  5.  * avmb(3)      ;      avtb(3) =  5.  * avtb(3)
+      avmb(4) =  2.5 * avmb(4)      ;      avtb(4) =  2.5 * avtb(4)
+
+      ! weighting mean array tmric for 4 T-points which accounts for coastal boundary conditions.
+      DO jk = 1, jpk
+         DO jj = 2, jpj
+            DO ji = 2, jpi
+               tmric(ji,jj,jk) =  tmask(ji,jj,jk)                                  &
+                               / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   &
+                                         + vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)  )
+            END DO
+         END DO
+      END DO
+
+      tmric(:,1,:) = 0.e0
+
+      ! Initialization of vertical eddy coef. to the background value
+      DO jk = 1, jpk
+         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
+         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
+         avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
+      END DO
+
+   END SUBROUTINE zdf_ric_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :              NO Richardson dependent vertical mixing
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfric = .FALSE.   !: Richardson mixing flag
+CONTAINS
+   SUBROUTINE zdf_ric( kt )        ! Dummy routine
+      WRITE(*,*) kt 
+   END SUBROUTINE zdf_ric
+#endif
+
+   !!======================================================================
+END MODULE zdfric
Index: /branches/nemo/NEMO/OPA_SRC/ZDF/zdftke.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 4)
@@ -0,0 +1,801 @@
+MODULE zdftke
+   !!======================================================================
+   !!                       ***  MODULE  zdftke  ***
+   !! Ocean physics:  vertical mixing coefficient compute from the tke 
+   !!                 turbulent closure parameterization
+   !!=====================================================================
+#if defined key_zdftke   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_zdftke'                                             TKE scheme
+   !!----------------------------------------------------------------------
+   !!   zdf_tke      : update momentum and tracer Kz from a tke scheme
+   !!   zdf_tke_init : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE phycst          ! physical constants
+   USE taumod          ! surface stress
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC zdf_tke   ! routine called by step.F90
+
+   !! * Share Module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke = .TRUE.   !: TKE vertical mixing flag
+   LOGICAL, PUBLIC ::         & !!! ** tke namelist (namtke) **
+     ln_rstke = .FALSE.          !: =T restart with tke from a run without tke with 
+     !                           !  a none zero initial value for en
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &
+      en                         !: now turbulent kinetic energy
+
+   !! * Module variables
+   INTEGER ::                 & !!! ** tke namelist (namtke) **
+      nitke = 50 ,            &  ! number of restart iterative loops
+      nmxl  =  2 ,            &  ! = 0/1/2/3 flag for the type of mixing length used
+      npdl  =  1 ,            &  ! = 0/1/2 flag on prandtl number on vert. eddy coeff.
+      nave  =  1 ,            &  ! = 0/1 flag for horizontal average on avt, avmu, avmv
+      navb  =  0                 ! = 0/1 flag for constant or profile background avt
+   REAL(wp) ::                & !!! ** tke namlist (namtke) **
+      ediff = 0.1_wp       ,  &  ! coeff. for vertical eddy coef.; avt=ediff*mxl*sqrt(e)
+      ediss = 0.7_wp       ,  &  ! coef. of the Kolmogoroff dissipation 
+      ebb   = 3.75_wp      ,  &  ! coef. of the surface input of tke
+      efave = 1._wp        ,  &  ! coef. for the tke vert. diff. coeff.; avtke=efave*avm
+      emin  = 0.7071e-6_wp ,  &  ! minimum value of tke (m2/s2)
+      emin0 = 1.e-4_wp     ,  &  ! surface minimum value of tke (m2/s2)
+      ri_c  = 2._wp / 9._wp      ! critic Richardson number
+   REAL(wp) ::   &  
+      eboost        ! multiplicative coeff of the shear product.
+
+   !! caution vectopt_memory change the solution (last digit of the solver stat)
+# if defined key_vectopt_memory
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+      etmean,    &  ! coefficient used for horizontal smoothing
+      eumean,    &  ! at t-, u- and v-points
+      evmean        !
+# endif
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+# if defined key_autotasking
+   !!----------------------------------------------------------------------
+   !!   'key_autotasking' :                             j-k-i loop (j-slab)
+   !!----------------------------------------------------------------------
+#  include "zdftke_atsk.h90"
+
+# else
+   !!----------------------------------------------------------------------
+   !!   default option :                                         k-j-i loop
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE zdf_tke ( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zdf_tke  ***
+      !!
+      !! ** Purpose :   Compute the vertical eddy viscosity and diffusivity
+      !!      coefficients using a 1.5 turbulent closure scheme.
+      !!
+      !! ** Method  :   The time evolution of the turbulent kinetic energy 
+      !!      (tke) is computed from a prognostic equation :
+      !!         d(en)/dt = eboost eav (d(u)/dz)**2       ! shear production
+      !!                  + d( efave eav d(en)/dz )/dz    ! diffusion of tke
+      !!                  + g/rau0 pdl eav d(rau)/dz      ! stratif. destruc.
+      !!                  - ediss / emxl en**(2/3)        ! dissipation
+      !!      with the boundary conditions:
+      !!         surface: en = max( emin0,ebb sqrt(taux^2 + tauy^2) )
+      !!         bottom : en = emin
+      !!      -1- The dissipation and mixing turbulent lengh scales are computed
+      !!      from the usual diagnostic buoyancy length scale:  
+      !!         mxl= 1/(sqrt(en)/N)  WHERE N is the brunt-vaisala frequency
+      !!      Four cases : 
+      !!         nmxl=0 : mxl bounded by the distance to surface and bottom.
+      !!                  zmxld = zmxlm = mxl
+      !!         nmxl=1 : mxl bounded by the vertical scale factor.
+      !!                  zmxld = zmxlm = mxl
+      !!         nmxl=2 : mxl bounded such that the vertical derivative of mxl 
+      !!                  is less than 1 (|d/dz(xml)|<1). 
+      !!                  zmxld = zmxlm = mxl
+      !!         nmxl=3 : lup = mxl bounded using |d/dz(xml)|<1 from the surface 
+      !!                        to the bottom
+      !!                  ldown = mxl bounded using |d/dz(xml)|<1 from the bottom 
+      !!                        to the surface
+      !!                  zmxld = sqrt (lup*ldown) ; zmxlm = min(lup,ldown)
+      !!      -2- Compute the now Turbulent kinetic energy. The time differencing
+      !!      is implicit for vertical diffusion term, linearized for kolmo-
+      !!      goroff dissipation term, and explicit forward for both buoyancy
+      !!      and dynamic production terms. Thus a tridiagonal linear system is
+      !!      solved.
+      !!         Note that - the shear production is multiplied by eboost in order
+      !!      to set the critic richardson number to ri_c (namelist parameter)
+      !!                   - the destruction by stratification term is multiplied
+      !!      by the Prandtl number (defined by an empirical funtion of the local 
+      !!      Richardson number) if npdl=1 (namelist parameter)
+      !!      coefficient (zesh2):
+      !!      -3- Compute the now vertical eddy vicosity and diffusivity
+      !!      coefficients from en (before the time stepping) and zmxlm:
+      !!              avm = max( avtb, ediff*zmxlm*en^1/2 )
+      !!              avt = max( avmb, pdl*avm )  (pdl=1 if npdl=0)
+      !!              eav = max( avmb, avm )
+      !!      avt and avm are horizontally averaged to avoid numerical insta-
+      !!      bilities.
+      !!        N.B. The computation is done from jk=2 to jpkm1 except for
+      !!      en. Surface value of avt avmu avmv are set once a time to
+      !!      their background value in routine zdf_tke_init.
+      !!
+      !! ** Action  :   compute en (now turbulent kinetic energy)
+      !!                update avt, avmu, avmv (before vertical eddy coef.)
+      !!
+      !! References :
+      !!      Gaspar et al., jgr, 95, 1990,
+      !!      Blanke and Delecluse, jpo, 1991
+      !! History :
+      !!   6.0  !  91-03  (b. blanke)  Original code
+      !!   7.0  !  91-11  (G. Madec)   bug fix
+      !!   7.1  !  92-10  (G. Madec)   new mixing length and eav
+      !!   7.2  !  93-03  (M. Guyon)   symetrical conditions
+      !!   7.3  !  94-08  (G. Madec, M. Imbard)   npdl flag
+      !!   7.5  !  96-01  (G. Madec)   s-coordinates
+      !!   8.0  !  97-07  (G. Madec)   lbc
+      !!   8.1  !  99-01  (E. Stretta) new option for the mixing length
+      !!   8.5  !  02-08  (G. Madec)  ri_c and Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce     , zwd   => ua,  &  ! use ua as workspace
+         &          zmxlm => ta,  &  ! use ta as workspace
+         &          zmxld => sa      ! use sa as workspace
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt ! ocean time step
+
+      !! * local declarations
+      INTEGER ::   ji, jj, jk        ! dummy loop arguments
+      REAL(wp) ::   &
+         zmlmin, zbbrau,          &  ! temporary scalars
+         zfact1, zfact2, zfact3,  &  !
+         zrn2, zesurf,            &  !
+         ztx2, zty2, zav,         &  !
+         zcoef, zcof, zsh2,       &  !
+         zdku, zdkv, zpdl, zri,   &  !
+         zsqen, zesh2,            &  !
+         zemxl, zemlm, zemlp
+      !!--------------------------------------------------------------------
+
+      ! Initialization (first time-step only)
+      ! --------------
+      IF( kt == nit000  )   CALL zdf_tke_init
+
+      ! Local constant initialization
+      zmlmin = 1.e-8
+      zbbrau =  .5 * ebb / rau0
+      zfact1 = -.5 * rdt * efave
+      zfact2 = 1.5 * rdt * ediss
+      zfact3 = 0.5 * rdt * ediss
+
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! I.  Mixing length
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+
+      ! Buoyancy length scale: l=sqrt(2*e/n**2)
+      ! ---------------------
+      zmxlm(:,:, 1 ) = zmlmin   ! surface set to the minimum value
+      zmxlm(:,:,jpk) = zmlmin   ! bottom  set to the minimum value
+!CDIR NOVERRCHK
+      DO jk = 2, jpkm1
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zrn2 = MAX( rn2(ji,jj,jk), rsmall )
+               zmxlm(ji,jj,jk) = MAX( SQRT( 2. * en(ji,jj,jk) / zrn2 ), zmlmin  )
+            END DO
+         END DO
+      END DO
+
+
+      ! Physical limits for the mixing length
+      ! -------------------------------------
+      zmxld(:,:, 1 ) = zmlmin   ! surface set to the minimum value
+      zmxld(:,:,jpk) = zmlmin   ! bottom  set to the minimum value
+
+      SELECT CASE ( nmxl )
+
+      CASE ( 0 )           ! bounded by the distance to surface and bottom
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zemxl = MIN( fsdepw(ji,jj,jk), zmxlm(ji,jj,jk),   &
+                  &            fsdepw(ji,jj,mbathy(ji,jj)) - fsdepw(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemxl
+                  zmxld(ji,jj,jk) = zemxl
+               END DO
+            END DO
+         END DO
+
+      CASE ( 1 )           ! bounded by the vertical scale factor
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zemxl = MIN( fse3w(ji,jj,jk), zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemxl
+                  zmxld(ji,jj,jk) = zemxl
+               END DO
+            END DO
+         END DO
+
+      CASE ( 2 )           ! |dk[xml]| bounded by e3t :
+         DO jk = 2, jpkm1         ! from the surface to the bottom :
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         DO jk = jpkm1, 2, -1     ! from the bottom to the surface :
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zemxl = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemxl
+                  zmxld(ji,jj,jk) = zemxl
+               END DO
+            END DO
+         END DO
+
+      CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t :
+         DO jk = 2, jpkm1         ! from the surface to the bottom : lup
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         DO jk = jpkm1, 2, -1     ! from the bottom to the surface : ldown
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+!CDIR NOVERRCHK
+         DO jk = 2, jpkm1
+!CDIR NOVERRCHK
+            DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) )
+                  zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemlm
+                  zmxld(ji,jj,jk) = zemlp
+               END DO
+            END DO
+         END DO
+
+      END SELECT
+
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! II  Tubulent kinetic energy time stepping
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+
+      ! 1. Vertical eddy viscosity on tke (put in zmxlm) and first estimate of avt
+      ! ---------------------------------------------------------------------
+!CDIR NOVERRCHK
+      DO jk = 2, jpkm1
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zsqen = SQRT( en(ji,jj,jk) )
+               zav   = ediff * zmxlm(ji,jj,jk) * zsqen
+               avt  (ji,jj,jk) = MAX( zav, avtb(jk) ) * tmask(ji,jj,jk)
+               zmxlm(ji,jj,jk) = MAX( zav, avmb(jk) ) * tmask(ji,jj,jk)
+               zmxld(ji,jj,jk) = zsqen / zmxld(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! 2. Surface boundary condition on tke and its eddy viscosity (zmxlm)
+      ! -------------------------------------------------
+      ! en(1)   = ebb sqrt(taux^2+tauy^2) / rau0  (min value emin0)
+      ! zmxlm(1) = avmb(1) and zmxlm(jpk) = 0.
+!CDIR NOVERRCHK
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ztx2 = taux(ji-1,jj  ) + taux(ji,jj)
+            zty2 = tauy(ji  ,jj-1) + tauy(ji,jj)
+            zesurf = zbbrau * SQRT( ztx2 * ztx2 + zty2 * zty2 )
+            en (ji,jj,1) = MAX( zesurf, emin0 ) * tmask(ji,jj,1)
+            zmxlm(ji,jj,1  ) = avmb(1) * tmask(ji,jj,1)
+            zmxlm(ji,jj,jpk) = 0.e0
+         END DO
+      END DO
+
+      ! 3. Now Turbulent kinetic energy (output in en)
+      ! -------------------------------
+      ! Resolution of a tridiagonal linear system by a "methode de chasse"
+      ! computation from level 2 to jpkm1  (e(1) already computed and
+      ! e(jpk)=0 ). 
+
+      SELECT CASE ( npdl )
+
+      CASE ( 0 )           ! No Prandtl number
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! zesh2 = eboost * (du/dz)^2 - N^2
+                  zcoef = 0.5 / fse3w(ji,jj,jk)
+                  ! shear
+                  zdku = zcoef * (   ub(ji-1, jj ,jk-1) + ub(ji,jj,jk-1)   &
+                  &                - ub(ji-1, jj ,jk  ) - ub(ji,jj,jk  )  )
+                  zdkv = zcoef * (   vb( ji ,jj-1,jk-1) + vb(ji,jj,jk-1)   &
+                  &                - vb( ji ,jj-1,jk  ) - vb(ji,jj,jk  )  )
+                  ! coefficient (zesh2)
+                  zesh2 =  eboost * ( zdku*zdku + zdkv*zdkv ) - rn2(ji,jj,jk)
+
+                  ! Matrix
+                  zcof = zfact1 * tmask(ji,jj,jk)
+                  ! lower diagonal
+                  avmv(ji,jj,jk) = zcof * ( zmxlm(ji,jj,jk  ) + zmxlm(ji,jj,jk-1) )   &
+                  &                    / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+                  ! upper diagonal
+                  avmu(ji,jj,jk) = zcof * ( zmxlm(ji,jj,jk+1) + zmxlm(ji,jj,jk  ) )   &
+                  &                    / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
+                  ! diagonal
+                  zwd(ji,jj,jk) = 1. - avmv(ji,jj,jk) - avmu(ji,jj,jk) + zfact2 * zmxld(ji,jj,jk)
+                  ! right hand side in en 
+                  en(ji,jj,jk) = en(ji,jj,jk) + zfact3 * zmxld(ji,jj,jk) * en   (ji,jj,jk)   &
+                  &                           +   rdt  * zmxlm(ji,jj,jk) * zesh2
+               END DO
+            END DO
+         END DO
+
+      CASE ( 1 )           ! Prandtl number
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! zesh2 =  eboost * (du/dz)^2 - pdl * N^2
+                  zcoef = 0.5 / fse3w(ji,jj,jk)
+                  ! shear
+                  zdku = zcoef * (   ub(ji-1,jj  ,jk-1) + ub(ji,jj,jk-1) &
+                  &                - ub(ji-1,jj  ,jk  ) - ub(ji,jj,jk  )   )
+                  zdkv = zcoef * (   vb(ji  ,jj-1,jk-1) + vb(ji,jj,jk-1) &
+                  &                - vb(ji  ,jj-1,jk  ) - vb(ji,jj,jk  )   )
+                  ! square of vertical shear
+                  zsh2 = zdku * zdku + zdkv * zdkv
+                  ! Prandtl number
+                  zri  = MAX( rn2(ji,jj,jk), 0. ) / ( zsh2 + 1.e-20 )
+                  zpdl = 1.0
+                  IF( zri >= 0.2 ) zpdl = 0.2 / zri
+                  zpdl = MAX( 0.1, zpdl )
+                  ! coefficient (esh2)
+                  zesh2 = eboost * zsh2 - zpdl * rn2(ji,jj,jk)
+
+                  ! Matrix
+                  zcof = zfact1 * tmask(ji,jj,jk)
+                  ! lower diagonal
+                  avmv(ji,jj,jk) = zcof * ( zmxlm(ji,jj,jk  ) + zmxlm(ji,jj,jk-1) )   &
+                  &                     / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+                  ! upper diagonal
+                  avmu(ji,jj,jk) = zcof * ( zmxlm(ji,jj,jk+1) + zmxlm(ji,jj,jk  ) )   &
+                  &                     / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
+                  ! diagonal
+                  zwd(ji,jj,jk) = 1. - avmv(ji,jj,jk) - avmu(ji,jj,jk) + zfact2 * zmxld(ji,jj,jk)
+                  ! right hand side in en 
+                  en(ji,jj,jk) = en(ji,jj,jk) + zfact3 * zmxld(ji,jj,jk) * en   (ji,jj,jk)   &
+                  &                           +   rdt  * zmxlm(ji,jj,jk) * zesh2
+                  ! save masked Prandlt number in zmxlm array
+                  zmxld(ji,jj,jk) = zpdl * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+      END SELECT
+
+      ! 4. Matrix inversion from level 2 (tke prescribed at level 1)
+      !!--------------------------------
+      ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+      DO jk = 3, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               zwd(ji,jj,jk) = zwd(ji,jj,jk) - avmv(ji,jj,jk) * avmu(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1    ! vector opt.
+            avmv(ji,jj,2) = en(ji,jj,2) - avmv(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke
+         END DO
+      END DO
+      DO jk = 3, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               avmv(ji,jj,jk) = en(ji,jj,jk) - avmv(ji,jj,jk) / zwd(ji,jj,jk-1) *avmv(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+
+      ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1    ! vector opt.
+            en(ji,jj,jpkm1) = avmv(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 2, -1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               en(ji,jj,jk) = ( avmv(ji,jj,jk) - avmu(ji,jj,jk) * en(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! Save the result in en and set minimum value of tke : emin
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               en(ji,jj,jk) = MAX( en(ji,jj,jk), emin ) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! Lateral boundary conditions on ( avt, en )   (sign unchanged)
+      CALL lbc_lnk( en , 'W', 1. )   ;   CALL lbc_lnk( avt, 'W', 1. )
+
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! III.  Before vertical eddy vicosity and diffusivity coefficients
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! =============== 
+         SELECT CASE ( nave )
+            
+         CASE ( 0 )                ! no horizontal average
+
+            ! Vertical eddy viscosity
+
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avmu(ji,jj,jk) = ( avt  (ji,jj,jk) + avt  (ji+1,jj  ,jk) ) * umask(ji,jj,jk)   &
+                  &     / MAX( 1.,   tmask(ji,jj,jk) + tmask(ji+1,jj  ,jk) )
+                  avmv(ji,jj,jk) = ( avt  (ji,jj,jk) + avt  (ji  ,jj+1,jk) ) * vmask(ji,jj,jk)   &
+                  &     / MAX( 1.,   tmask(ji,jj,jk) + tmask(ji  ,jj+1,jk) )
+               END DO
+            END DO
+
+            ! Lateral boundary conditions (avmu,avmv) (U- and V- points, sign unchanged)
+            CALL lbc_lnk( avmu(:,:,jk), 'U', 1. )   ;    CALL lbc_lnk( avmv(:,:,jk), 'V', 1. )
+            
+         CASE ( 1 )                ! horizontal average
+
+            !                                                ( 1/2  1/2 )
+            ! Eddy viscosity: horizontal average: avmu = 1/4 ( 1    1   )
+            !                      ( 1/2  1 1/2 )            ( 1/2  1/2 )
+            !           avmv = 1/4 ( 1/2  1 1/2 )      
+            
+!! caution vectopt_memory change the solution (last digit of the solver stat)
+#  if defined key_vectopt_memory
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avmu(ji,jj,jk) = (      avt(ji,jj  ,jk) + avt(ji+1,jj  ,jk)   &
+                  &                 +.5*( avt(ji,jj-1,jk) + avt(ji+1,jj-1,jk)   &
+                  &                      +avt(ji,jj+1,jk) + avt(ji+1,jj+1,jk) ) ) * eumean(ji,jj,jk)
+
+                  avmv(ji,jj,jk) = (      avt(ji  ,jj,jk) + avt(ji  ,jj+1,jk)   &
+                  &                 +.5*( avt(ji-1,jj,jk) + avt(ji-1,jj+1,jk)   &
+                  &                      +avt(ji+1,jj,jk) + avt(ji+1,jj+1,jk) ) ) * evmean(ji,jj,jk)
+               END DO
+            END DO
+#  else
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avmu(ji,jj,jk) = (   avt  (ji,jj  ,jk) + avt  (ji+1,jj  ,jk)   &
+                  &              +.5*( avt  (ji,jj-1,jk) + avt  (ji+1,jj-1,jk)   &
+                  &                   +avt  (ji,jj+1,jk) + avt  (ji+1,jj+1,jk) ) ) * umask(ji,jj,jk)  &
+                  &       / MAX( 1.,   tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk)   &
+                  &              +.5*( tmask(ji,jj-1,jk) + tmask(ji+1,jj-1,jk)   &
+                  &                   +tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) )  )
+
+                  avmv(ji,jj,jk) = (   avt  (ji  ,jj,jk) + avt  (ji  ,jj+1,jk)   &
+                  &              +.5*( avt  (ji-1,jj,jk) + avt  (ji-1,jj+1,jk)   &
+                  &                   +avt  (ji+1,jj,jk) + avt  (ji+1,jj+1,jk) ) ) * vmask(ji,jj,jk)  &
+                  &      /  MAX( 1.,   tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   &
+                  &              +.5*( tmask(ji-1,jj,jk) + tmask(ji-1,jj+1,jk)   &
+                  &                   +tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk) )  )
+               END DO
+            END DO
+#  endif
+
+            ! Lateral boundary conditions (avmu,avmv) (sign unchanged)
+            CALL lbc_lnk( avmu(:,:,jk), 'U', 1. )   ;    CALL lbc_lnk( avmv(:,:,jk), 'V', 1. )
+
+            ! Vertical eddy diffusivity
+            ! ------------------------------
+            !                                (1 2 1)
+            ! horizontal average  avt = 1/16 (2 4 2)
+            !                                (1 2 1)
+#  if defined key_vectopt_memory
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avt(ji,jj,jk) = ( avmu(ji,jj,jk) + avmu(ji-1,jj  ,jk)    &
+                  &               + avmv(ji,jj,jk) + avmv(ji  ,jj-1,jk)  ) * etmean(ji,jj,jk)
+               END DO
+            END DO
+#  else
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avt(ji,jj,jk) = ( avmu (ji,jj,jk) + avmu (ji-1,jj  ,jk)   &
+                  &               + avmv (ji,jj,jk) + avmv (ji  ,jj-1,jk)  ) * tmask(ji,jj,jk)   &
+                  &     / MAX( 1.,  umask(ji,jj,jk) + umask(ji-1,jj  ,jk)   &
+                  &               + vmask(ji,jj,jk) + vmask(ji  ,jj-1,jk)  )
+               END DO
+            END DO
+#  endif
+         END SELECT
+
+         ! multiplied by the Prandtl number (npdl>1)
+         ! ----------------------------------------
+         IF( npdl == 1 ) THEN
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zpdl = zmxld(ji,jj,jk)
+                  avt(ji,jj,jk) = MAX( zpdl * avt(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+
+         ! Minimum value on the eddy viscosity
+         ! ----------------------------------------
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), avmb(jk) ) * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), avmb(jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      ! Lateral boundary conditions on avt  (sign unchanged)
+      ! ------------------------------=====
+      CALL lbc_lnk( avt, 'W', 1. )
+
+   END SUBROUTINE zdf_tke
+
+# endif
+
+   SUBROUTINE zdf_tke_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_tke_init  ***
+      !!                     
+      !! ** Purpose :   Initialization of the vertical eddy diffivity and 
+      !!      viscosity when using a tke turbulent closure scheme
+      !!
+      !! ** Method  :   Read the namtke namelist and check the parameters
+      !!      called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namlist namtke
+      !!
+      !! ** Action  :   Increase by 1 the nstop flag is setting problem encounter
+      !!
+      !! history :
+      !!  8.5  ! 02-06 (G. Madec) original code
+      !!----------------------------------------------------------------------
+      !! * Module used
+      USE dynzdf_exp
+      USE trazdf_exp
+
+      !! * local declarations
+      !! caution vectopt_memory change the solution (last digit of the solver stat)
+# if defined key_vectopt_memory
+      INTEGER ::   ji, jj, jk, jit   ! dummy loop indices
+# else
+      INTEGER ::           jk, jit   ! dummy loop indices
+# endif
+
+      NAMELIST/namtke/ ln_rstke, ediff, ediss, ebb, efave, emin, emin0,   &
+         ri_c, nitke, nmxl, npdl, nave, navb
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist namtke : Turbulente Kinetic Energy
+      ! --------------------
+      REWIND ( numnam )
+      READ   ( numnam, namtke )
+
+      ! Compute boost associated with the Richardson critic
+      !     (control values: ri_c = 0.3   ==> eboost=1.25 for npdl=1 or 2)
+      !     (                ri_c = 0.222 ==> eboost=1.                  )
+      eboost = ri_c * ( 2. + ediss / ediff ) / 2.
+
+
+      ! Parameter control and print
+      ! ---------------------------
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_tke_init : tke turbulent closure scheme'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '          Namelist namtke : set tke mixing parameters'
+         WRITE(numout,*)
+         WRITE(numout,*) '             restart with tke from no tke ln_rstke = ', ln_rstke
+         WRITE(numout,*) '             coef. to compute avt           ediff  = ', ediff
+         WRITE(numout,*) '             Kolmogoroff dissipation coef.  ediss  = ', ediss
+         WRITE(numout,*) '             tke surface input coef.        ebb    = ', ebb
+         WRITE(numout,*) '             tke diffusion coef.            efave  = ', efave
+         WRITE(numout,*) '             minimum value of tke           emin   = ', emin
+         WRITE(numout,*) '             surface minimum value of tke   emin0  = ', emin0
+         WRITE(numout,*) '             number of restart iter loops   nitke  = ', nitke
+         WRITE(numout,*) '             mixing length type             nmxl   = ', nmxl
+         WRITE(numout,*) '             prandl number flag             npdl   = ', npdl
+         WRITE(numout,*) '             horizontal average flag        nave   = ', nave
+         WRITE(numout,*) '             critic Richardson nb           ri_c   = ', ri_c
+         WRITE(numout,*) '                and its associated coeff.   eboost = ', eboost
+         WRITE(numout,*) '             constant background or profile navb   = ', navb
+         WRITE(numout,*)
+      ENDIF
+
+      ! Check nmxl and npdl values
+      IF( nmxl < 0 .OR. nmxl > 3 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag: nmxl is < 0 or > 3 '
+         nstop = nstop + 1
+      ENDIF
+      IF ( npdl < 0 .OR. npdl > 1 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag: npdl is < 0 or > 1 '
+         nstop = nstop + 1
+      ENDIF
+
+
+      ! Horizontal average : initialization of weighting arrays 
+      ! -------------------
+      
+      SELECT CASE ( nave )
+
+      CASE ( 0 )                ! no horizontal average
+         IF(lwp) WRITE(numout,*) '          no horizontal average on avt, avmu, avmv'
+         IF(lwp) WRITE(numout,*) '          only in very high horizontal resolution !'
+!! caution vectopt_memory change the solution (last digit of the solver stat)
+# if defined key_vectopt_memory
+         ! weighting mean arrays etmean, eumean and evmean
+         !           ( 1  1 )                                          ( 1 )
+         ! avt = 1/4 ( 1  1 )     avmu = 1/2 ( 1  1 )       avmv=  1/2 ( 1 )
+         !                          
+         etmean(:,:,:) = 0.e0
+         eumean(:,:,:) = 0.e0
+         evmean(:,:,:) = 0.e0
+         
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  etmean(ji,jj,jk) = tmask(ji,jj,jk)                     &
+                  &  / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   &
+                  &            + vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)  )
+                  
+                  eumean(ji,jj,jk) = umask(ji,jj,jk)                     &
+                  &  / MAX( 1.,  tmask(ji,jj,jk) + tmask(ji+1,jj  ,jk)  )
+
+                  evmean(ji,jj,jk) = vmask(ji,jj,jk)                     &
+                  &  / MAX( 1.,  tmask(ji,jj,jk) + tmask(ji  ,jj+1,jk)  )
+               END DO
+            END DO
+         END DO
+# endif
+
+      CASE ( 1 )                ! horizontal average 
+         IF(lwp) WRITE(numout,*) '          horizontal average on avt, avmu, avmv'
+!! caution vectopt_memory change the solution (last digit of the solver stat)
+# if defined key_vectopt_memory
+         ! weighting mean arrays etmean, eumean and evmean
+         !           ( 1  1 )              ( 1/2  1/2 )             ( 1/2  1  1/2 )
+         ! avt = 1/4 ( 1  1 )   avmu = 1/4 ( 1    1   )   avmv= 1/4 ( 1/2  1  1/2 )
+         !                                 ( 1/2  1/2 )
+         etmean(:,:,:) = 0.e0
+         eumean(:,:,:) = 0.e0
+         evmean(:,:,:) = 0.e0
+         
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  etmean(ji,jj,jk) = tmask(ji,jj,jk)                     &
+                  &  / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   &
+                  &            + vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)  )
+                  
+                  eumean(ji,jj,jk) = umask(ji,jj,jk)                        &
+                  &  / MAX( 1.,   tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk)   &
+                  &       +.5 * ( tmask(ji,jj-1,jk) + tmask(ji+1,jj-1,jk)   &
+                  &              +tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) )  )
+
+                  evmean(ji,jj,jk) = vmask(ji,jj,jk)                        &
+                  &  / MAX( 1.,   tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   &
+                  &       +.5 * ( tmask(ji-1,jj,jk) + tmask(ji-1,jj+1,jk)   &
+                  &              +tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk) )  )
+               END DO
+            END DO
+         END DO
+# endif
+
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for nave = ', nave
+         nstop = nstop + 1
+
+      END SELECT
+
+
+      ! Background eddy viscosity and diffusivity profil
+      ! ------------------------------------------------
+      IF( navb == 0 ) THEN
+         !   Define avmb, avtb from namelist parameter
+         avmb(:) = avm0
+         avtb(:) = avt0
+      ELSE
+         !   Background profile of avt (fit a theoretical/observational profile (Krauss 1990) 
+         avmb(:) = avm0
+         avtb(:) = 1.e-5 + 2.8e-8 * gdepw(:)   ! m2/s
+      ENDIF
+
+      !   Increase the background in the surface layers
+      avmb(1) = 10.  * avmb(1)      ;      avtb(1) = 10.  * avtb(1)
+      avmb(2) = 10.  * avmb(2)      ;      avtb(2) = 10.  * avtb(2)
+      avmb(3) =  5.  * avmb(3)      ;      avtb(3) =  5.  * avtb(3)
+      avmb(4) =  2.5 * avmb(4)      ;      avtb(4) =  2.5 * avtb(4)
+
+
+      ! Initialization of vertical eddy coef. to the background value
+      ! -------------------------------------------------------------
+      DO jk = 1, jpk
+         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
+         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
+         avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
+      END DO
+
+
+      ! Initialization of turbulent kinetic energy ( en )
+      ! -------------------------------------------------
+      IF( ln_rstart ) THEN
+         ! no en field in the restart file, en set by iterative loop
+         IF( ln_rstke ) THEN
+            en (:,:,:) = emin * tmask(:,:,:)
+            DO jit = 2, nitke+1
+               CALL zdf_tke( jit )
+            END DO
+         ENDIF
+         ! otherwise en is already read in dtrlec called by inidtr
+      ELSE
+         ! no restart: en set to emin
+         en(:,:,:) = emin * tmask(:,:,:)
+      ENDIF
+
+   END SUBROUTINE zdf_tke_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                        NO TKE scheme
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke = .FALSE.   ! TKE flag
+CONTAINS
+   SUBROUTINE zdf_tke( kt )          ! Empty routine
+      WRITE(*,*) kt                     ! no compilation warning
+   END SUBROUTINE zdf_tke
+#endif
+
+   !!======================================================================
+END MODULE zdftke
Index: /branches/nemo/NEMO/OPA_SRC/ZDF/zdftke_atsk.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ZDF/zdftke_atsk.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ZDF/zdftke_atsk.h90	(revision 4)
@@ -0,0 +1,478 @@
+   SUBROUTINE zdf_tke( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zdf_tke  ***
+      !!                     
+      !! ** Purpose :   Compute the vertical eddy viscosity and diffusivity
+      !!      coefficients using a 1.5 turbulent closure scheme.
+      !!
+      !! ** Method  :   The time evolution of the turbulent kinetic energy 
+      !!      (tke) is computed from a prognostic equation :
+      !!         d(en)/dt = eboost eav (d(u)/dz)**2       ! shear production
+      !!                  + d( efave eav d(en)/dz )/dz    ! diffusion of tke
+      !!                  + g/rau0 pdl eav d(rau)/dz      ! stratif. destruc.
+      !!                  - ediss / emxl en**(2/3)        ! dissipation
+      !!      with the boundary conditions:
+      !!         surface: en = max( emin0,ebb sqrt(taux^2 + tauy^2) )
+      !!         bottom : en = emin
+      !!      -1- The dissipation and mixing turbulent lengh scales are computed
+      !!      from the usual diagnostic buoyancy length scale:  
+      !!         mxl= 1/(sqrt(en)/N)  WHERE N is the brunt-vaisala frequency
+      !!      Four cases : 
+      !!         nmxl=0 : mxl bounded by the distance to surface and bottom.
+      !!                  zmxld = zmxlm = mxl
+      !!         nmxl=1 : mxl bounded by the vertical scale factor.
+      !!                  zmxld = zmxlm = mxl
+      !!         nmxl=2 : mxl bounded such that the vertical derivative of mxl 
+      !!                  is less than 1 (|d/dz(xml)|<1). 
+      !!                  zmxld = zmxlm = mxl
+      !!         nmxl=3 : lup = mxl bounded using |d/dz(xml)|<1 from the surface 
+      !!                        to the bottom
+      !!                  ldown = mxl bounded using |d/dz(xml)|<1 from the bottom 
+      !!                        to the surface
+      !!                  zmxld = sqrt (lup*ldown) ; zmxlm = min(lup,ldown)
+      !!      -2- Compute the now Turbulent kinetic energy. The time differencing
+      !!      is implicit for vertical diffusion term, linearized for kolmo-
+      !!      goroff dissipation term, and explicit forward for both buoyancy
+      !!      and dynamic production terms. Thus a tridiagonal linear system is
+      !!      solved.
+      !!         Note that - the shear production is multiplied by eboost in order
+      !!      to set the critic richardson number to ri_c (namelist parameter)
+      !!                   - the destruction by stratification term is multiplied
+      !!      by the Prandtl number (defined by an empirical funtion of the local 
+      !!      Richardson number) if npdl=1 (namelist parameter)
+      !!      coefficient (zesh2):
+      !!      -3- Compute the now vertical eddy vicosity and diffusivity
+      !!      coefficients from en (before the time stepping) and zmxlm:
+      !!              avm = max( avtb, ediff*zmxlm*en^1/2 )
+      !!              avt = max( avmb, pdl*avm )  (pdl=1 if npdl=0)
+      !!              eav = max( avmb, avm )
+      !!      avt and avm are horizontally averaged to avoid numerical insta-
+      !!      bilities.
+      !!        N.B. The computation is done from jk=2 to jpkm1 except for
+      !!      en. Surface value of avt avmu avmv are set once a time to
+      !!      their background value in routine zdftke_init.
+      !!
+      !! ** Action :   compute en (now turbulent kinetic energy)
+      !!               update avt, avmu, avmv (before vertical eddy coeff.)
+      !!
+      !! References :
+      !!      Gaspar et al., jgr, 95, 1990,
+      !!      Blanke and Delecluse, jpo, 1991
+      !! History :
+      !!   9.0  !  02-08  (G. Madec)  autotasking optimization
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE oce       , zwd   => ua,  &  ! use ua as workspace
+                      zmxlm => ta,  &  ! use ta as workspace
+                      zmxld => sa      ! use sa as workspace
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+
+      !! * local declarations
+      INTEGER ::   ji, jj, jk          ! dummy loop arguments
+      REAL(wp) ::                   &
+         zmlmin, zbbrau,            &  ! temporary scalars
+         zfact1, zfact2, zfact3,    &  !
+         zrn2, zesurf,              &  !
+         ztx2, zty2, zav,           &  !
+         zcoef, zcof, zsh2,         &  !
+         zdku, zdkv, zpdl, zri,     &  !
+         zsqen, zesh2,              &  !
+         zemxl, zemlm, zemlp
+      !!--------------------------------------------------------------------
+      !!  OPA8.5, LODYC-IPSL (2002)
+      !!--------------------------------------------------------------------
+
+
+      ! 0. Initialization
+      !    --------------
+      IF( kt == nit000  )   CALL zdf_tke_init
+
+      ! Local constant 
+      zmlmin = 1.e-8
+      zbbrau =  .5 * ebb / rau0
+      zfact1 = -.5 * rdt * efave
+      zfact2 = 1.5 * rdt * ediss
+      zfact3 = 0.5 * rdt * ediss
+
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! I.  Mixing length
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+      !                                                ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! =============== 
+         ! Buoyancy length scale: l=sqrt(2*e/n**2)
+         ! ---------------------
+         zmxlm(:,jj, 1 ) = zmlmin   ! surface set to the minimum value
+         zmxlm(:,jj,jpk) = zmlmin   ! bottom  set to the minimum value
+!CDIR NOVERRCHK
+         DO jk = 2, jpkm1
+!CDIR NOVERRCHK
+            DO ji = 2, jpim1
+               zrn2 = MAX( rn2(ji,jj,jk), rsmall )
+               zmxlm(ji,jj,jk) = MAX( SQRT( 2. * en(ji,jj,jk) / zrn2 ), zmlmin  )
+            END DO
+         END DO
+
+
+         ! Physical limits for the mixing length
+         ! -------------------------------------
+         zmxld(:,jj, 1 ) = zmlmin   ! surface set to the minimum value
+         zmxld(:,jj,jpk) = zmlmin   ! bottom  set to the minimum value
+
+         SELECT CASE ( nmxl )
+
+         CASE ( 0 )           ! bounded by the distance to surface and bottom
+
+            DO jk = 2, jpkm1
+               DO ji = 2, jpim1
+                  zemxl = MIN( fsdepw(ji,jj,jk), zmxlm(ji,jj,jk),   &
+                  &            fsdepw(ji,jj,mbathy(ji,jj)) - fsdepw(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemxl
+                  zmxld(ji,jj,jk) = zemxl
+               END DO
+            END DO
+
+         CASE ( 1 )           ! bounded by the vertical scale factor
+
+            DO jk = 2, jpkm1
+               DO ji = 2, jpim1
+                  zemxl = MIN( fse3w(ji,jj,jk), zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemxl
+                  zmxld(ji,jj,jk) = zemxl
+               END DO
+            END DO
+
+         CASE ( 2 )           ! |dk[xml]| bounded by e3t :
+
+            DO jk = 2, jpk           ! from the surface to the bottom :
+               DO ji = 2, jpim1
+                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+               END DO
+            END DO
+            DO jk = jpkm1, 2, -1     ! from the bottom to the surface :
+               DO ji = 2, jpim1
+                  zemxl = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemxl
+                  zmxld(ji,jj,jk) = zemxl
+               END DO
+            END DO
+
+         CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t :
+
+            DO jk = 2, jpk           ! from the surface to the bottom : lup
+               DO ji = 2, jpim1
+                  zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+               END DO
+            END DO
+            DO jk = jpkm1, 1, -1     ! from the bottom to the surface : ldown
+               DO ji = 2, jpim1
+                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+               END DO
+            END DO
+!CDIR NOVERRCHK
+            DO jk = 1, jpk
+!CDIR NOVERRCHK
+               DO ji = 2, jpim1
+                  zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) )
+                  zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemlm
+                  zmxld(ji,jj,jk) = zemlp
+               END DO
+            END DO
+
+         END SELECT
+
+
+         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+         ! II  Tubulent kinetic energy time stepping
+         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+
+         ! 1. Vertical eddy viscosity on tke (put in zmxlm) and first estimate of avt
+         ! ---------------------------------------------------------------------
+!CDIR NOVERRCHK
+         DO jk = 2, jpkm1
+!CDIR NOVERRCHK
+            DO ji = 2, jpim1
+               zsqen = SQRT( en(ji,jj,jk) )
+               zav   = ediff * zmxlm(ji,jj,jk) * zsqen
+               avt  (ji,jj,jk) = MAX( zav, avtb(jk) ) * tmask(ji,jj,jk)
+               zmxlm(ji,jj,jk) = MAX( zav, avmb(jk) ) * tmask(ji,jj,jk)
+               zmxld(ji,jj,jk) = zsqen / zmxld(ji,jj,jk)
+            END DO
+         END DO
+
+
+         ! 2. Surface boundary condition on tke and its eddy viscosity (zmxlm)
+         ! -------------------------------------------------
+         ! en(1)   = ebb sqrt(taux^2+tauy^2) / rau0  (min value emin0)
+         ! zmxlm(1) = avmb(1) and zmxlm(jpk) = 0.
+!CDIR NOVERRCHK
+         DO ji = 2, jpim1
+            ztx2 = taux(ji-1,jj  ) + taux(ji,jj)
+            zty2 = tauy(ji  ,jj-1) + tauy(ji,jj)
+            zesurf = zbbrau * SQRT( ztx2 * ztx2 + zty2 * zty2 )
+            en (ji,jj,1) = MAX( zesurf, emin0 ) * tmask(ji,jj,1)
+            zmxlm(ji,jj,1  ) = avmb(1) * tmask(ji,jj,1)
+            zmxlm(ji,jj,jpk) = 0.e0
+         END DO
+
+
+         ! 3. Now Turbulent kinetic energy (output in en)
+         ! -------------------------------
+         ! Resolution of a tridiagonal linear system by a "methode de chasse"
+         ! computation from level 2 to jpkm1  (e(1) already computed and
+         ! e(jpk)=0 ). 
+
+         SELECT CASE ( npdl )
+
+         CASE ( 0 )           ! No Prandtl number
+            DO jk = 2, jpkm1
+               DO ji = 2, jpim1
+                  ! zesh2 = eboost * (du/dz)^2 - N^2
+                  zcoef = 0.5 / fse3w(ji,jj,jk)
+                  ! shear
+                  zdku = zcoef * (   ub(ji-1, jj ,jk-1) + ub(ji,jj,jk-1)   &
+                  &                - ub(ji-1, jj ,jk  ) - ub(ji,jj,jk  )  )
+                  zdkv = zcoef * (   vb( ji ,jj-1,jk-1) + vb(ji,jj,jk-1)   &
+                  &                - vb( ji ,jj-1,jk  ) - vb(ji,jj,jk  )  )
+                  ! coefficient (zesh2)
+                  zesh2 =  eboost * ( zdku*zdku + zdkv*zdkv ) - rn2(ji,jj,jk)
+
+                  ! Matrix
+                  zcof = zfact1 * tmask(ji,jj,jk)
+                  ! lower diagonal
+                  avmv(ji,jj,jk) = zcof * ( zmxlm(ji,jj,jk  ) + zmxlm(ji,jj,jk-1) )   &
+                  &                    / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+                  ! upper diagonal
+                  avmu(ji,jj,jk) = zcof * ( zmxlm(ji,jj,jk+1) + zmxlm(ji,jj,jk  ) )   &
+                  &                    / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
+                  ! diagonal
+                  zwd(ji,jj,jk) = 1. - avmv(ji,jj,jk) - avmu(ji,jj,jk) + zfact2 * zmxld(ji,jj,jk)
+                  ! right hand side in en 
+                  en(ji,jj,jk) = en(ji,jj,jk) + zfact3 * zmxld(ji,jj,jk) * en   (ji,jj,jk)   &
+                  &                           +   rdt  * zmxlm(ji,jj,jk) * zesh2
+               END DO
+            END DO
+
+         CASE ( 1 )           ! Prandtl number
+            DO jk = 2, jpkm1
+               DO ji = 2, jpim1
+                  ! zesh2 =  eboost * (du/dz)^2 - pdl * N^2
+                  zcoef = 0.5 / fse3w(ji,jj,jk)
+                  ! shear
+                  zdku = zcoef * (   ub(ji-1,jj  ,jk-1) + ub(ji,jj,jk-1) &
+                  &                - ub(ji-1,jj  ,jk  ) - ub(ji,jj,jk  )   )
+                  zdkv = zcoef * (   vb(ji  ,jj-1,jk-1) + vb(ji,jj,jk-1) &
+                  &                - vb(ji  ,jj-1,jk  ) - vb(ji,jj,jk  )   )
+                  ! square of vertical shear
+                  zsh2 = zdku * zdku + zdkv * zdkv
+                  ! Prandtl number
+                  zri  = MAX( rn2(ji,jj,jk), 0. ) / ( zsh2 + 1.e-20 )
+                  zpdl = 1.0
+                  IF( zri >= 0.2 ) zpdl = 0.2 / zri
+                  zpdl = MAX( 0.1, zpdl )
+                  ! coefficient (esh2)
+                  zesh2 = eboost * zsh2 - zpdl * rn2(ji,jj,jk)
+
+                  ! Matrix
+                  zcof = zfact1 * tmask(ji,jj,jk)
+                  ! lower diagonal
+                  avmv(ji,jj,jk) = zcof * ( zmxlm(ji,jj,jk  ) + zmxlm(ji,jj,jk-1) )   &
+                  &                     / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+                  ! upper diagonal
+                  avmu(ji,jj,jk) = zcof * ( zmxlm(ji,jj,jk+1) + zmxlm(ji,jj,jk  ) )   &
+                  &                     / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
+                  ! diagonal
+                  zwd(ji,jj,jk) = 1. - avmv(ji,jj,jk) - avmu(ji,jj,jk) + zfact2 * zmxld(ji,jj,jk)
+                  ! right hand side in en 
+                  en(ji,jj,jk) = en(ji,jj,jk) + zfact3 * zmxld(ji,jj,jk) * en   (ji,jj,jk)   &
+                  &                           +   rdt  * zmxlm(ji,jj,jk) * zesh2
+                  ! save masked Prandlt number in zmxlm array
+                  zmxld(ji,jj,jk) = zpdl * tmask(ji,jj,jk)
+               END DO
+            END DO
+
+         END SELECT
+
+
+         ! 4. Matrix inversion from level 2 (tke prescribed at level 1)
+         !---------------------------------
+
+         ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+         DO jk = 3, jpkm1
+            DO ji = 2, jpim1
+               zwd(ji,jj,jk) = zwd(ji,jj,jk) - avmv(ji,jj,jk) * avmu(ji,jj,jk-1) / zwd(ji,jj,jk-1)
+            END DO
+         END DO
+
+         ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+         DO ji = 2, jpim1
+            avmv(ji,jj,2) = en(ji,jj,2) - avmv(ji,jj,2) * en(ji,jj,1)    ! Surface boudary conditions on tke
+         END DO
+         DO jk = 3, jpkm1
+            DO ji = 2, jpim1
+               avmv(ji,jj,jk) = en(ji,jj,jk) - avmv(ji,jj,jk) / zwd(ji,jj,jk-1) *avmv(ji,jj,jk-1)
+            END DO
+         END DO
+
+         ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+         DO ji = 2, jpim1
+            en(ji,jj,jpkm1) = avmv(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
+         END DO
+         DO jk = jpk-2, 2, -1
+            DO ji = 2, jpim1
+               en(ji,jj,jk) = ( avmv(ji,jj,jk) - avmu(ji,jj,jk) * en(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+            END DO
+         END DO
+
+         ! Save the result in en and set minimum value of tke : emin
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               en(ji,jj,jk) = MAX( en(ji,jj,jk), emin ) * tmask(ji,jj,jk)
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      ! Lateral boundary conditions on ( avt, en )  (sign unchanged)
+      ! --------------------------------=========
+      CALL lbc_lnk( avt, 'W', 1. )   ;   CALL lbc_lnk( en , 'W', 1. )
+
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! III.  Before vertical eddy vicosity and diffusivity coefficients
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! =============== 
+         SELECT CASE ( nave )
+            
+         CASE ( 0 )                ! no horizontal average
+
+            ! Vertical eddy viscosity
+
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avmu(ji,jj,jk) = ( avt  (ji,jj,jk) + avt  (ji+1,jj  ,jk) ) * umask(ji,jj,jk)   &
+                  &     / MAX( 1.,   tmask(ji,jj,jk) + tmask(ji+1,jj  ,jk) )
+                  avmv(ji,jj,jk) = ( avt  (ji,jj,jk) + avt  (ji  ,jj+1,jk) ) * vmask(ji,jj,jk)   &
+                  &     / MAX( 1.,   tmask(ji,jj,jk) + tmask(ji  ,jj+1,jk) )
+               END DO
+            END DO
+
+            
+         CASE ( 1 )                ! horizontal average
+
+            !                                                ( 1/2  1/2 )
+            ! Eddy viscosity: horizontal average: avmu = 1/4 ( 1    1   )
+            !                      ( 1/2  1 1/2 )            ( 1/2  1/2 )
+            !           avmv = 1/4 ( 1/2  1 1/2 )      
+            
+!! caution vectopt_memory change the solution (last digit of the solver stat)
+#  if defined key_vectopt_memory
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avmu(ji,jj,jk) = (      avt(ji,jj  ,jk) + avt(ji+1,jj  ,jk)   &
+                  &                 +.5*( avt(ji,jj-1,jk) + avt(ji+1,jj-1,jk)   &
+                  &                      +avt(ji,jj+1,jk) + avt(ji+1,jj+1,jk) ) ) * eumean(ji,jj,jk)
+
+                  avmv(ji,jj,jk) = (      avt(ji  ,jj,jk) + avt(ji  ,jj+1,jk)   &
+                  &                 +.5*( avt(ji-1,jj,jk) + avt(ji-1,jj+1,jk)   &
+                  &                      +avt(ji+1,jj,jk) + avt(ji+1,jj+1,jk) ) ) * evmean(ji,jj,jk)
+               END DO
+            END DO
+#  else
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avmu(ji,jj,jk) = (   avt  (ji,jj  ,jk) + avt  (ji+1,jj  ,jk)   &
+                  &              +.5*( avt  (ji,jj-1,jk) + avt  (ji+1,jj-1,jk)   &
+                  &                   +avt  (ji,jj+1,jk) + avt  (ji+1,jj+1,jk) ) ) * umask(ji,jj,jk)  &
+                  &       / MAX( 1.,   tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk)   &
+                  &              +.5*( tmask(ji,jj-1,jk) + tmask(ji+1,jj-1,jk)   &
+                  &                   +tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) )  )
+
+                  avmv(ji,jj,jk) = (   avt  (ji  ,jj,jk) + avt  (ji  ,jj+1,jk)   &
+                  &              +.5*( avt  (ji-1,jj,jk) + avt  (ji-1,jj+1,jk)   &
+                  &                   +avt  (ji+1,jj,jk) + avt  (ji+1,jj+1,jk) ) ) * vmask(ji,jj,jk)  &
+                  &      /  MAX( 1.,   tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   &
+                  &              +.5*( tmask(ji-1,jj,jk) + tmask(ji-1,jj+1,jk)   &
+                  &                   +tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk) )  )
+               END DO
+            END DO
+#  endif
+         END SELECT
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      ! Lateral boundary conditions (avmu,avmv)  (sign unchanged)
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )
+
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! =============== 
+         SELECT CASE ( nave )
+            
+         CASE ( 1 )                ! horizontal average
+
+            ! Vertical eddy diffusivity
+            ! ------------------------------
+            !                                (1 2 1)
+            ! horizontal average  avt = 1/16 (2 4 2)
+            !                                (1 2 1)
+!! caution vectopt_memory change the solution (last digit of the solver stat)
+#  if defined key_vectopt_memory
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avt(ji,jj,jk) = ( avmu(ji,jj,jk) + avmu(ji-1,jj  ,jk)    &
+                  &               + avmv(ji,jj,jk) + avmv(ji  ,jj-1,jk)  ) * etmean(ji,jj,jk)
+               END DO
+            END DO
+#  else
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avt(ji,jj,jk) = ( avmu (ji,jj,jk) + avmu (ji-1,jj  ,jk)   &
+                  &               + avmv (ji,jj,jk) + avmv (ji  ,jj-1,jk)  ) * tmask(ji,jj,jk)   &
+                  &     / MAX( 1.,  umask(ji,jj,jk) + umask(ji-1,jj  ,jk)   &
+                  &               + vmask(ji,jj,jk) + vmask(ji  ,jj-1,jk)  )
+               END DO
+            END DO
+#  endif
+         END SELECT
+
+
+         ! multiplied by the Prandtl number (npdl>1)
+         ! ----------------------------------------
+         IF( npdl == 1 ) THEN
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zpdl = zmxld(ji,jj,jk)
+                  avt(ji,jj,jk) = MAX( zpdl * avt(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+
+         ! Minimum value on the eddy viscosity
+         ! ----------------------------------------
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), avmb(jk) ) * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), avmb(jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+
+      ! Lateral boundary conditions on avt   (W-point (=T), sign unchanged)
+      ! ------------------------------=====
+      CALL lbc_lnk( avt, 'W', 1. )
+
+   END SUBROUTINE zdf_tke
Index: /branches/nemo/NEMO/OPA_SRC/cla.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/cla.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/cla.F90	(revision 4)
@@ -0,0 +1,786 @@
+MODULE cla
+   !!==============================================================================
+   !!                         ***  MODULE  cla  ***
+   !! Cross Land Advection : parameterize ocean exchanges through straits by a
+   !!                        specified advection across land.
+   !!==============================================================================
+#if defined key_orca_r2
+   !!----------------------------------------------------------------------
+   !!   'key_orca_r2'   :                             ORCA R2 configuration
+   !!----------------------------------------------------------------------
+   !!   tra_cla           : update the tracer trend with the horizontal 
+   !!                       and vertical advection trends at straits
+   !!   tra_bab_el_mandeb : 
+   !!   tra_gibraltar     :
+   !!   tra_hormuz        :
+   !!   tra_cla_init      :
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE ocesbc          ! ocean surface boundary condition (fluxes)
+   USE lib_mpp         ! distributed memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC tra_cla        ! routine called by step.F90
+
+   !! * Modules variables   
+   REAL(wp) :: zempmed, zempred
+
+   REAL(wp) :: zisw_rs, zurw_rs, zbrw_rs          ! Imposed transport Red Sea 
+   REAL(wp) :: zisw_ms, zmrw_ms, zurw_ms, zbrw_ms ! Imposed transport Med Sea 
+   REAL(wp) :: zisw_pg, zbrw_pg                   ! Imposed transport Persic Gulf 
+
+   REAL(wp), DIMENSION(jpk) ::   &
+      zu1_rs_i, zu2_rs_i, zu3_rs_i,              &  ! Red Sea velocities
+      zu1_ms_i, zu2_ms_i, zu3_ms_i,              &  ! Mediterranean Sea velocities
+      zu_pg                                         ! Persic Gulf velocities
+   REAL(wp), DIMENSION (jpk) :: zthor, zshor        ! Temperature, salinity Hormuz 
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE tra_cla( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tra_cla  ***
+      !!                   
+      !! ** Purpose :   Update the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations
+      !!      at some straits ( Bab el Mandeb, Gibraltar, Hormuz ).
+      !!
+      !! ** Method  :   ...
+      !!         Add this trend now to the general trend of tracer (ta,sa):
+      !!            (ta,sa) = (ta,sa) + ( zta , zsa )
+      !!
+      !! ** Action  :   update (ta,sa) with the now advective tracer trends
+      !!
+      !! History :
+      !!        !         (A. Bozec)  original code  
+      !!   8.5  !  02-11  (A. Bozec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+      !!----------------------------------------------------------------------
+ 
+      ! cross land advection for straits
+
+      ! Initialization
+      IF( kt == nit000 )   CALL tra_cla_init
+
+
+      ! Bab el Mandeb strait horizontal advection
+
+      CALL tra_bab_el_mandeb 
+
+      ! Gibraltar strait horizontal advection
+
+      CALL tra_gibraltar
+
+      ! Hormuz Strait ( persian Gulf) horizontal advection
+
+      CALL tra_hormuz 
+
+   END SUBROUTINE tra_cla
+
+
+   SUBROUTINE tra_bab_el_mandeb
+      !!---------------------------------------------------------------------
+      !!             ***  ROUTINE tra_bab_el_mandeb  ***
+      !!
+      !! ** Purpose :   Update the horizontal advective trend of tracers
+      !!      correction in Bab el Mandeb strait and
+      !!      add it to the general trend of tracer equations.
+      !!
+      !! ** Method :
+      !!     We impose transport at Bab el Mandeb and knowing T and S in
+      !!     surface and depth at each side of the  strait, we deduce T and S
+      !!     of the deep outflow of the Red Sea in the Indian ocean . 
+      !!                                          |
+      !!            |/ \|            N          |\ /|
+      !!            |_|_|______      |          |___|______
+      !!        88  |   |<-       W - - E    88 |   |<-
+      !!        87  |___|______      |       87 |___|->____
+      !!             160 161         S           160 161 
+      !!       horizontal view                horizontal view
+      !!          surface                        depth
+      !!    
+      !!     The horizontal advection is evaluated by a second order cen-
+      !!     tered scheme using now fields (leap-frog scheme). In specific
+      !!     areas (vicinity of major river mouths, some straits, or tn
+      !!     approaching the freezing point) it is mixed with an upstream 
+      !!     scheme for stability reasons. 
+      !!
+      !!         C A U T I O N : the trend saved is the centered trend only.
+      !!      It doesn't take into account the upstream part of the scheme.
+      !!
+      !! ** history :
+      !!           !  02-11  (A. Bozec) Original code 
+      !!      8.5  !  02-11  (A. Bozec) F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::  ji, jj, jk               ! dummy loop indices
+      REAL(wp) :: zsu, zvt
+      REAL(wp) :: zsumt, zsumt1, zsumt2, zsumt3, zsumt4
+      REAL(wp) :: zsums, zsums1, zsums2, zsums3, zsums4
+      REAL(wp) :: zt, zs
+      REAL(wp) :: zwei
+      REAL(wp), DIMENSION (jpk) ::  zu1_rs, zu2_rs, zu3_rs
+      !!---------------------------------------------------------------------
+
+      ! Initialization of vertical sum for T and S transport
+      ! ----------------------------------------------------
+
+      zsumt  = 0.e0       ! East  Bab el Mandeb surface north point (T)
+      zsums  = 0.e0       ! East  Bab el Mandeb surface north point (S)
+      zsumt1 = 0.e0       ! East  Bab el Mandeb depth   south point (T)
+      zsums1 = 0.e0       ! East  Bab el Mandeb depth   south point (S)
+      zsumt2 = 0.e0       ! West  Bab el Mandeb surface             (T)
+      zsums2 = 0.e0       ! West  Bab el Mandeb surface             (S)
+      zsumt3 = 0.e0       ! West  Bab el Mandeb depth               (T)
+      zsums3 = 0.e0       ! West  Bab el Mandeb depth               (S)
+      zsumt4 = 0.e0       ! East  Bab el Mandeb depth   north point (T) 
+      zsums4 = 0.e0       ! East  Bab el Mandeb depth   north point (S) 
+      
+      ! EMP of the Red Sea 
+      ! ------------------
+
+      zempred = 0.e0
+      zwei = 0.e0
+      DO jj = mj0(87), mj1(96)
+         DO ji = mi0(148), mi1(160)
+            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
+            zempred = zempred + emp(ji,jj) * zwei
+         END DO
+      END DO
+
+      ! mpp
+# if defined key_mpp
+      CALL mpp_sum( zempred )
+# endif
+
+      ! convert in m3
+      zempred = zempred * 1.e-3
+
+      ! Velocity profile at each point
+      ! ------------------------------
+
+      zu1_rs(:) = zu1_rs_i(:)
+      zu2_rs(:) = zu2_rs_i(:)
+      zu3_rs(:) = zu3_rs_i(:)
+
+      ! velocity profile at 161,88 East Bab el Mandeb North point 
+      ! we imposed zisw_rs + EMP above the Red Sea 
+      DO jk = 1, 8                                      
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(160), mi1(160) 
+               zu1_rs(jk) = zu1_rs(jk) - ( zempred / 8. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )     
+            END DO
+         END DO
+      END DO
+
+      ! velocity profile at 161, 88 West Bab el Mandeb 
+      ! we imposed zisw_rs + EMP above the Red Sea 
+      DO jk = 1,  10                                     
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(160), mi1(160) 
+               zu3_rs(jk) = zu3_rs(jk) + ( zempred / 10. ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      
+      ! Balance of temperature and salinity
+      ! -----------------------------------
+
+      ! east Bab el Mandeb surface vertical sum of transport* S,T
+      DO jk =  1, 19
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(161), mi1(161) 
+               zsumt  = zsumt  + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)  
+               zsums  = zsums  + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk) 
+            END DO
+         END DO
+      END DO
+
+      ! west Bab el Mandeb surface vertical sum of transport* S,T
+      DO jk =  1, 10
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(161), mi1(161) 
+               zsumt2 = zsumt2 + tn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk)
+               zsums2 = zsums2 + sn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk)
+            END DO
+         END DO
+      END DO
+
+      ! west Bab el Mandeb deeper
+      DO jj = mj0(89), mj1(89) 
+         DO ji = mi0(160), mi1(160) 
+            zsumt3 = tn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16)
+            zsums3 = sn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16)
+         END DO
+      END DO
+
+      ! east  Bab el Mandeb deeper  
+      DO jk =  20, 21
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(161), mi1(161) 
+               zsumt4 =  zsumt4 + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)
+               zsums4 =  zsums4 + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk) 
+            END DO
+         END DO
+      END DO
+
+      ! Total transport  
+      zsumt1 = -( zsumt3 + zsumt2 + zsumt + zsumt4 )
+      zsums1 = -( zsums3 + zsums2 + zsums + zsums4 )
+
+      ! Temperature and Salinity at East Bab el Mandeb, Level 21
+      DO jj = mj0(88), mj1(88) 
+         DO ji = mi0(160), mi1(160) 
+            zt = zsumt1 / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) )
+            zs = zsums1 / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) )
+         END DO
+      END DO
+      
+      ! New Temperature and Salinity at East Bab el Mandeb
+      ! --------------------------------------------------
+
+      ! north point 	
+      DO jk = 1, jpk
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(161), mi1(161) 
+               zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+               zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
+               ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu1_rs(jk) * tn(ji,jj,jk)
+               sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu1_rs(jk) * sn(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! south point
+      jk =  21
+      DO jj = mj0(87), mj1(87) 
+         DO ji = mi0(161), mi1(161) 
+            zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+            zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
+            ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu2_rs(jk) * zt
+            sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu2_rs(jk) * zs
+         END DO
+      END DO
+
+
+      ! New Temperature and Salinity at West Bab el Mandeb 
+      ! --------------------------------------------------
+
+      ! surface	
+      DO jk = 1, 10
+         DO jj = mj0(89), mj1(89) 
+            DO ji = mi0(160), mi1(160) 
+               zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+               zsu = e1v(ji,jj-1) * fse3v(ji,jj-1,jk)
+               ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * tn(ji+1,jj-1,jk)
+               sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * sn(ji+1,jj-1,jk)
+            END DO
+         END DO
+      END DO
+      ! deeper
+      jk =  16
+      DO jj = mj0(89), mj1(89) 
+         DO ji = mi0(160), mi1(160) 
+            zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+            zsu = e1v(ji,jj-1) * fse3v(ji,jj-1,jk)
+            ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * tn(ji,jj,jk)
+            sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * sn(ji,jj,jk)
+         END DO
+      END DO
+
+   END SUBROUTINE tra_bab_el_mandeb
+
+
+   SUBROUTINE tra_gibraltar
+      !!---------------------------------------------------------------------
+      !!               ***  ROUTINE tra_gibraltar  ***
+      !!
+      !! ** Purpose :
+      !!        Update the horizontal advective trend of tracers (t & s)
+      !!        correction in Gibraltar  and
+      !!        add it to the general trend of tracer equations.
+      !!
+      !! ** Method :
+      !!      We impose transport at Gibraltar and knowing T and S in
+      !!      surface and deeper at each side of the strait, we deduce T and S
+      !!      of the outflow of the Mediterranean Sea in the Atlantic ocean .
+      !!                                
+      !!          ________________      N        ________________
+      !! 102           |    |->         |           <-|    |<-
+      !! 101      ___->|____|_____   W - - E     ___->|____|_____
+      !!           139   140  141       |         139   140  141
+      !!          horizontal view       S        horizontal view
+      !!            surface                          depth
+      !!         C A U T I O N : the trend saved is the centered trend only.
+      !!      It doesn't take into account the upstream part of the scheme.
+      !!
+      !! ** history :
+      !!           !  02-06  (A. Bozec) Original code 
+      !!      8.5  !  02-11  (A. Bozec) F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::  ji, jj, jk               ! dummy loop indices
+      REAL(wp) :: zsu, zvt
+      REAL(wp) :: zsumt, zsumt1, zsumt2, zsumt3, zsumt4
+      REAL(wp) :: zsums, zsums1, zsums2, zsums3, zsums4
+      REAL(wp) :: zt, zs
+      REAL(wp) :: zwei
+      REAL(wp), DIMENSION (jpk) ::  zu1_ms, zu2_ms, zu3_ms
+      !!---------------------------------------------------------------------
+      
+      ! Initialization of vertical sum for T and S transport
+      ! ----------------------------------------------------
+
+      zsumt  = 0.e0        ! West Gib. surface south point ( T )
+      zsums  = 0.e0        ! West Gib. surface south point ( S )
+      zsumt1 = 0.e0        ! East Gib. surface north point ( T )
+      zsums1 = 0.e0        ! East Gib. surface north point ( S )
+      zsumt2 = 0.e0        ! East Gib. depth   north point ( T )
+      zsums2 = 0.e0        ! East Gib. depth   north point ( S )
+      zsumt3 = 0.e0        ! West Gib. depth   south point ( T ) 
+      zsums3 = 0.e0        ! West Gib. depth   south point ( S ) 
+      zsumt4 = 0.e0        ! West Gib. depth   north point ( T ) 
+      zsums4 = 0.e0        ! West Gib. depth   north point ( S ) 
+      
+      ! EMP of Mediterranean Sea 
+      ! ------------------------
+ 
+      zempmed = 0.e0
+      zwei = 0.e0
+      DO jj = mj0(96),mj1(110)
+         DO ji = mi0(141),mi1(181)
+            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
+            zempmed = zempmed + emp(ji,jj) * zwei
+         END DO
+      END DO
+
+      ! mpp
+# if defined key_mpp
+      CALL mpp_sum( zempmed )
+# endif
+
+      ! minus 2 points in Red Sea and 3 in Atlantic ocean
+      DO jj = mj0(96),mj1(96)
+         DO ji = mi0(148),mi1(148)
+            zempmed = zempmed  -  emp(ji  ,jj) * tmask(ji  ,jj,1) * e1t(ji  ,jj) * e2t(ji  ,jj)   &
+                               -  emp(ji+1,jj) * tmask(ji+1,jj,1) * e1t(ji+1,jj) * e2t(ji+1,jj)   
+         END DO
+      END DO
+
+      ! convert in m3
+      zempmed = zempmed * 1.e-3
+
+      ! Velocity profile at each point
+      ! ------------------------------
+
+      zu1_ms(:) = zu1_ms_i(:)
+      zu2_ms(:) = zu2_ms_i(:)
+      zu3_ms(:) = zu3_ms_i(:)
+
+      ! velocity profile at 139,101  South point + emp on surface 
+      DO jk = 1, 14                      
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(140), mi1(140) 
+               zu1_ms(jk) = zu1_ms(jk) + ( zempmed / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
+            END DO
+         END DO
+      END DO
+
+      ! profile at East Gibraltar    
+      ! velocity profile at 141,102  + emp on surface 
+      DO  jk = 1, 14                     
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(140), mi1(140) 
+               zu3_ms(jk) = zu3_ms(jk) +  ( zempmed / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 
+            END DO
+         END DO
+      END DO
+     
+      ! Balance of temperature and salinity
+      ! -----------------------------------
+
+      ! west gibraltar surface vertical sum of transport* S,T
+      DO  jk =  1, 14 
+         DO jj = mj0(101), mj1(101) 
+            DO ji = mi0(139), mi1(139) 
+               zsumt  = zsumt + tn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk)  
+               zsums  = zsums + sn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk) 
+            END DO
+         END DO
+      END DO
+
+      ! east Gibraltar surface  vertical sum of transport* S,T
+      DO  jk =  1, 14 
+         DO jj = mj0(101), mj1(101) 
+            DO ji = mi0(139), mi1(139) 
+               zsumt1 = zsumt1 + tn(ji, jj,jk) * e2u(ji+1, jj+1) * fse3u(ji+1, jj+1,jk) * zu3_ms(jk)
+               zsums1 = zsums1 + sn(ji, jj,jk) * e2u(ji+1, jj+1) * fse3u(ji+1, jj+1,jk) * zu3_ms(jk)
+            END DO
+         END DO
+      END DO
+
+      ! east Gibraltar deeper  vertical sum of transport* S,T
+      DO jj = mj0(102), mj1(102) 
+         DO ji = mi0(141), mi1(141) 
+            zsumt2 = tn(ji, jj,21) * e2u(ji-1, jj) * fse3u(ji-1, jj,21) * zu3_ms(21)
+            zsums2 = sn(ji, jj,21) * e2u(ji-1, jj) * fse3u(ji-1, jj,21) * zu3_ms(21)
+         END DO
+      END DO
+      
+      ! west Gibraltar deeper vertical sum of transport* S,T
+      DO  jk =  21, 22 
+         DO jj = mj0(101), mj1(101) 
+            DO ji = mi0(139), mi1(139) 
+               zsumt3 = zsumt3 + tn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk)
+               zsums3 = zsums3 + sn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk)
+            END DO
+         END DO
+      END DO
+
+      ! Total transport = 0.
+      zsumt4 = zsumt2 + zsumt1 - zsumt - zsumt3
+      zsums4 = zsums2 + zsums1 - zsums - zsums3
+
+      ! Temperature and Salinity at West gibraltar , Level 22
+      DO jj = mj0(102), mj1(102) 
+         DO ji = mi0(140), mi1(140) 
+            zt = zsumt4 / ( zu2_ms(22) * e2u(ji-1, jj) * fse3u(ji-1, jj, 22) )
+            zs = zsums4 / ( zu2_ms(22) * e2u(ji-1, jj) * fse3u(ji-1, jj, 22) )
+         END DO
+      END DO
+      
+      ! New Temperature and Salinity trend at West Gibraltar
+      ! ----------------------------------------------------
+
+      ! south point 	
+      DO jk = 1, 22
+         DO jj = mj0(101), mj1(101) 
+            DO ji = mi0(139), mi1(139) 
+               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
+               zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
+               ta(ji, jj,jk) = ta(ji, jj,jk) - ( 1. / zvt ) * zsu * zu1_ms(jk) * tn(ji, jj,jk)
+               sa(ji, jj,jk) = sa(ji, jj,jk) - ( 1. / zvt ) * zsu * zu1_ms(jk) * sn(ji, jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! north point 
+      DO jk = 15, 20
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(139), mi1(139) 
+               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
+               zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
+               ta(ji, jj,jk) = ta(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * tn(ji, jj-1,jk)
+               sa(ji, jj,jk) = sa(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * sn(ji, jj-1,jk)
+            END DO
+         END DO
+      END DO
+
+      ! Gibraltar outflow, north point deeper
+      jk =  22
+      DO jj = mj0(102), mj1(102) 
+         DO ji = mi0(139), mi1(139) 
+            zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
+            zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
+            ta(ji, jj,jk) = ta(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * zt
+            sa(ji, jj,jk) = sa(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * zs
+         END DO
+      END DO
+
+
+      ! New Temperature and Salinity at East Gibraltar 
+      ! ----------------------------------------------
+
+      ! surface	
+      DO jk = 1, 14
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(141), mi1(141) 
+               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
+               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
+               ta(ji, jj,jk) = ta(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * tn(ji-2, jj-1,jk)
+               sa(ji, jj,jk) = sa(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * sn(ji-2, jj-1,jk)
+            END DO
+         END DO
+      END DO
+      ! deeper
+      jk =  21
+      DO jj = mj0(102), mj1(102) 
+         DO ji = mi0(141), mi1(141) 
+            zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
+            zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
+            ta(ji, jj,jk) = ta(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * tn(ji, jj,jk)
+            sa(ji, jj,jk) = sa(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * sn(ji, jj,jk)
+         END DO
+      END DO
+
+   END SUBROUTINE tra_gibraltar
+
+
+   SUBROUTINE tra_hormuz
+      !!---------------------------------------------------------------------
+      !!               ***  ROUTINE tra_hormuz  ***
+      !!
+      !! ** Purpose :   Update the horizontal advective trend of tracers
+      !!        correction in Hormuz.
+      !!
+      !! ** Method :   We impose transport at Hormuz .
+      !!                                
+      !! ** history :
+      !!           !  02-11  (A. Bozec) Original code 
+      !!      8.5  !  02-11  (A. Bozec) F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::  ji, jj, jk              ! dummy loop indices
+      REAL(wp) :: zsu, zvt
+      !!---------------------------------------------------------------------
+      
+      ! New trend at Hormuz strait
+      ! --------------------------
+      DO jk = 1, 8   
+         DO jj = mj0(94), mj1(94) 
+            DO ji = mi0(172), mi1(172) 
+               zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+               zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
+               ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * tn(ji,jj,jk) 
+               sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * sn(ji,jj,jk) 
+            END DO
+         END DO
+      END DO
+      DO jk = 16, 18
+         DO jj = mj0(94), mj1(94) 
+            DO ji = mi0(172), mi1(172) 
+               zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+               zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
+               ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * zthor(jk)
+               sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * zshor(jk)
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE tra_hormuz
+
+
+   SUBROUTINE tra_cla_init
+      !!---------------------------------------------------------------------
+      !!               ***  ROUTINE tra_cla_init  ***
+      !!
+      !! ** Purpose :   Initialization of variables
+      !!
+      !! ** history :
+      !!      9.0  !  02-11  (A. Bozec) Original code
+      !!---------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::  ji, jj, jk              ! dummy loop indices
+      !!---------------------------------------------------------------------
+
+      ! Control print
+      ! -------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'tra_cla_init : cross land advection on tracer '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+
+      ! Initialization at Bab el Mandeb
+      ! -------------------------------
+
+      ! imposed transport
+      zisw_rs = 0.4e6        ! inflow surface water
+      zurw_rs = 0.2e6        ! upper recirculation water
+!!Alex      zbrw_rs = 1.2e6        ! bottom  recirculation water
+      zbrw_rs = 0.5e6        ! bottom  recirculation water
+
+      ! initialization of the velocity at Bab el Mandeb
+      zu1_rs_i(:) = 0.e0      ! velocity profile at 161,88 South point
+      zu2_rs_i(:) = 0.e0      ! velocity profile at 161,87 North point
+      zu3_rs_i(:) = 0.e0      ! velocity profile at 160,88 East  point
+
+      ! velocity profile at 161,88 East Bab el Mandeb North point 
+      ! we imposed zisw_rs + EMP above the Red Sea 
+      DO jk = 1, 8                                      
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(160), mi1(160) 
+               zu1_rs_i(jk) = -( zisw_rs / 8. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )     
+            END DO
+         END DO
+      END DO
+
+      ! recirculation water 
+      DO jj = mj0(88), mj1(88) 
+         DO ji = mi0(160), mi1(160) 
+            zu1_rs_i(20) = -(           zurw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,20) )
+            zu1_rs_i(21) = -( zbrw_rs - zurw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,21) )
+         END DO
+      END DO
+      
+      ! velocity profile at 161,87 East Bab el Mandeb South point
+      DO jj = mj0(87), mj1(87) 
+         DO ji = mi0(160), mi1(160) 
+            zu2_rs_i(21) =  ( zbrw_rs + zisw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,21) )
+         END DO
+      END DO
+
+      ! velocity profile at 161, 88 West Bab el Mandeb 
+      ! we imposed zisw_rs + EMP above the Red Sea 
+      DO jk = 1,  10                                     
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(160), mi1(160) 
+               zu3_rs_i(jk) =  ( zisw_rs / 10. ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+
+      ! deeper
+      DO jj = mj0(88), mj1(88) 
+         DO ji = mi0(160), mi1(160) 
+            zu3_rs_i(16)  = - zisw_rs /( e1v(ji,jj) * fse3v(ji,jj,16) )
+         END DO
+      END DO
+
+
+      ! Initialization at Gibraltar
+      ! ---------------------------
+
+      ! imposed transport
+      zisw_ms = 0.8e6         ! atlantic-mediterranean  water
+      zmrw_ms = 0.7e6         ! middle recirculation water
+      zurw_ms = 2.5e6         ! upper  recirculation water 
+      zbrw_ms = 3.5e6         ! bottom recirculation water 
+
+      ! initialization of the velocity
+      zu1_ms_i(:) = 0.e0       ! velocity profile at 139,101 South point
+      zu2_ms_i(:) = 0.e0       ! velocity profile at 139,102 North point
+      zu3_ms_i(:) = 0.e0       ! velocity profile at 141,102 East  point
+
+      ! velocity profile at 139,101  South point
+      DO jk = 1, 14                      
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(140), mi1(140) 
+               zu1_ms_i(jk) = ( zisw_ms / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk)) 
+            END DO
+         END DO
+      END DO
+
+      ! middle recirculation ( uncounting in the balance )
+      DO jk = 15, 20                      
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(140), mi1(140) 
+               zu1_ms_i(jk) = ( zmrw_ms / 6. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
+            END DO
+         END DO
+      END DO
+
+      DO jj = mj0(102), mj1(102) 
+         DO ji = mi0(140), mi1(140) 
+            zu1_ms_i(21) =  (           zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,21) )
+            zu1_ms_i(22) =  ( zbrw_ms - zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,22) )
+         END DO
+      END DO
+
+      ! velocity profile at 139,102  North point
+      ! middle recirculation ( uncounting in the balance )
+      DO jk = 15, 20                      
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(140), mi1(140) 
+               zu2_ms_i(jk) = -( zmrw_ms / 6. ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,jk) ) 
+            END DO
+         END DO
+      END DO 
+
+      DO jj = mj0(102), mj1(102) 
+         DO ji = mi0(140), mi1(140) 
+            zu2_ms_i(22) = -( zisw_ms + zbrw_ms ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,22) )
+         END DO
+      END DO 
+
+      ! profile at East Gibraltar   
+      ! velocity profile at 141,102 
+      DO  jk = 1, 14                     
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(140), mi1(140) 
+               zu3_ms_i(jk) =  ( zisw_ms / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 
+            END DO
+         END DO
+      END DO
+
+      ! deeper 
+      DO jj = mj0(102), mj1(102) 
+         DO ji = mi0(140), mi1(140) 
+            zu3_ms_i(21) = -zisw_ms / ( e2u(ji, jj) * fse3u(ji, jj,21) )
+         END DO
+      END DO
+
+
+      ! Initialization at Hormuz
+      ! ------------------------
+
+      ! imposed transport
+      zisw_pg = 4. * 0.25e6      ! surface and bottom  water
+
+      ! initialization of the velocity
+      zu_pg(:) = 0.e0       ! velocity profile at 139,101 South point
+
+      ! Velocity profile 
+      DO jk = 1, 8 
+         DO jj = mj0(94), mj1(94) 
+            DO ji = mi0(172), mi1(172) 
+               zu_pg(jk) = -( zisw_pg / 8. ) /  ( e2u(ji-1,jj) * fse3u(ji-1,jj,jk) )
+            END DO
+         END DO
+      END DO
+     DO jk = 16, 18
+         DO jj = mj0(94), mj1(94) 
+            DO ji = mi0(172), mi1(172) 
+               zu_pg(jk) =  ( zisw_pg / 3. )  / ( e2u(ji-1,jj) * fse3u(ji-1,jj,jk) )
+            END DO
+         END DO
+      END DO
+
+      ! Temperature and Salinity at Hormuz
+      zthor(:) = 0.e0
+      zshor(:) = 0.e0
+
+      zthor(16) = 18.4
+      zshor(16) = 36.27
+      !
+      zthor(17) = 17.8
+      zshor(17) = 36.4
+      !
+      zthor(18) = 16.
+      zshor(18) = 36.27
+ 
+   END SUBROUTINE tra_cla_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                              NO cross land advection
+   !!----------------------------------------------------------------------
+   USE in_out_manager  ! I/O manager
+CONTAINS
+   SUBROUTINE tra_cla( kt ) 
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step indice
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_cla : No use of cross land advection'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+   END SUBROUTINE tra_cla
+#endif
+
+   !!======================================================================
+END MODULE cla
Index: /branches/nemo/NEMO/OPA_SRC/cla_div.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/cla_div.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/cla_div.F90	(revision 4)
@@ -0,0 +1,547 @@
+MODULE cla_div
+   !!==============================================================================
+   !!                    ***  MODULE  cla_div  ***
+   !! Ocean diagnostic variable : specific update of the horizontal divergence
+   !!                             CAUTION: Specific to ORCA_R2
+   !!==============================================================================
+#if defined key_orca_r2
+   !!----------------------------------------------------------------------
+   !!   'key_orca_r2'                                 global ocean model R2
+   !!----------------------------------------------------------------------
+   !!   div_cla      : 
+   !!   div_bab_el_mandeb
+   !!   div_gibraltar
+   !!   div_hormuz
+   !!   div_cla_init :
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE ocesbc          ! ocean surface boundary condition (fluxes)
+   USE lib_mpp         ! distributed memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Module variables
+   REAL(wp) :: zempmed, zempred       ! EMP of Mediterranean and Red Sea 
+
+   REAL(wp) :: zisw_rs, zbrw_rs, zurw_rs          ! imposed transport at Red Sea
+   REAL(wp) :: zisw_ms, zbrw_ms, zurw_ms, zmrw_ms ! imposed transport at Mediterranean Sea
+   REAL(wp) :: zisw_pg, zbrw_pg                   ! imposed transport at Persic Gulf
+
+   REAL(wp), DIMENSION (jpk) ::   &
+      zu1_rs_i, zu2_rs_i, zu3_rs_i,                   & ! Red Sea velocities
+      zu1_ms_i, zu2_ms_i, zu3_ms_i,                   & ! Mediterranean Sea velocities
+      zu_pg                                             ! Persic Gulf velocities
+   
+   !! * Routine accessibility
+   PUBLIC div_cla     ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE div_cla ( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE div_cla  ***
+      !!
+      !! ** Purpose :   update the horizontal divergence of the velocity field
+      !!      for at some straits ( Gibraltar, Bab el Mandeb and Hormuz ).
+      !!
+      !! ** Method  :   With imposed transport at each strait, we compute 
+      !!      corresponding velocities and update horizontal divergence.
+      !!        Apply lateral boundary conditions on hdivn through a call
+      !!      to routine lbc_lnk.
+      !!
+      !! ** Action  :   update hdivn array : the now horizontal divergence
+      !!
+      !! History :
+      !!   8.5  !  02-11 (A. Bozec)  Free form, F90
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!----------------------------------------------------------------------
+
+      ! Correction of the Divergence at some straits
+            
+      IF( kt == nit000 )     CALL div_cla_init    ! Initialization
+
+      CALL div_bab_el_mandeb                        ! New divergence at Bab el Mandeb 
+
+      CALL div_gibraltar                            ! New divergence at Gibraltar
+
+      CALL div_hormuz                               ! Hormuz Strait ( persian Gulf)
+
+      ! Lateral boundary conditions on hdivn
+      CALL lbc_lnk( hdivn, 'T', 1. )
+
+   END SUBROUTINE div_cla
+
+   SUBROUTINE div_bab_el_mandeb
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE div_bab_el_mandeb  ***
+      !!       
+      !! ** Purpose :   Update  the now horizontal divergence of the velocity 
+      !!     field in Bab el Mandeb ( Red Sea strait ).
+      !!
+      !! ** Method  :   Set the velocity field at each side of the strait :
+      !!                                          |
+      !!            |/ \|            N          |\ /|
+      !!            |_|_|______      |          |___|______
+      !!        88  |   |<-       W - - E    88 |   |<-
+      !!        87  |___|______      |       87 |___|->____
+      !!             160 161         S           160 161 
+      !!       horizontal view                horizontal view
+      !!          surface                        depth
+      !!      The now divergence is given by :
+      !!       * z-coordinate (default key) and partial steps (key_partial_steps)
+      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
+      !!
+      !! ** History :
+      !!           !         (A. Bozec) Original code 
+      !!      8.5  !  02-11  (A. Bozec) F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER  :: ji, jj, jk   ! dummy loop indices
+      REAL(wp) :: zsu, zvt, zwei   ! temporary scalar
+      REAL(wp), DIMENSION (jpk) ::  zu1_rs, zu2_rs, zu3_rs
+      !!---------------------------------------------------------------------
+      
+      ! EMP on the Red Sea 
+      ! ------------------
+
+      zempred = 0.e0
+      zwei = 0.e0
+      DO jj = mj0(87), mj1(96)
+         DO ji = mi0(148), mi1(160) 
+            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
+            zempred = zempred + emp(ji,jj) * zwei
+         END DO
+      END DO
+
+      ! mpp
+# if defined key_mpp
+      CALL mpp_sum( zempred )
+# endif
+
+      ! convert in m3
+      zempred = zempred * 1.e-3         
+
+      ! Velocity profile at each point
+      ! ------------------------------
+
+      zu1_rs(:) = zu1_rs_i(:)
+      zu2_rs(:) = zu2_rs_i(:)
+      zu3_rs(:) = zu3_rs_i(:)
+
+      ! velocity profile at 161,88 North point 
+      ! we imposed zisw_rs + EMP above the Red Sea 
+      DO jk = 1,  8                                      
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(160), mi1(160) 
+               zu1_rs(jk) = zu1_rs(jk) - ( zempred / 8. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) )
+            END DO
+         END DO
+      END DO
+
+      ! velocity profile at 160,88 North  point
+      ! we imposed zisw_rs + EMP above the Red Sea 
+      DO jk = 1,  10                                     
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(160), mi1(160) 
+               zu3_rs(jk) = zu3_rs(jk) + ( zempred / 10. ) / ( e1v(ji, jj) * fse3v(ji, jj,jk) )
+            END DO
+         END DO
+      END DO
+       
+      ! Divergence at each point of the straits
+      ! ---------------------------------------
+
+      ! compute the new divergence at 161,88 
+      DO jk = 1, 21
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(161), mi1(161) 
+               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
+               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
+               hdivn(ji, jj  ,jk) = hdivn(ji, jj  ,jk) - ( 1. / zvt ) * zsu * zu1_rs(jk)
+            END DO
+         END DO
+      END DO
+
+      ! compute the new divergence at 161,87 
+      DO jk = 1, 21
+         DO jj = mj0(87), mj1(87) 
+            DO ji = mi0(161), mi1(161) 
+               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
+               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
+               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_rs(jk)
+            END DO
+         END DO
+      END DO
+
+      ! compute the divergence at 160,89 
+      DO jk = 1, 18
+         DO jj = mj0(89), mj1(89) 
+            DO ji = mi0(160), mi1(160) 
+               zvt = e1t(ji, jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+               zsu = e1v(ji, jj-1) * fse3v(ji, jj-1,jk)
+               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) - ( 1. / zvt ) * zsu * zu3_rs(jk)
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE div_bab_el_mandeb
+
+   SUBROUTINE div_gibraltar
+      !! -------------------------------------------------------------------
+      !!                 ***  ROUTINE div_gibraltar  ***
+      !!        
+      !! ** Purpose :   update the now horizontal divergence of the velocity 
+      !!     field in Gibraltar.
+      !!
+      !! ** Method :
+      !!          ________________      N        ________________
+      !! 102           |    |->         |           <-|    |<-
+      !! 101      ___->|____|_____   W - - E     ___->|____|_____
+      !!           139   140  141       |         139   140  141
+      !!          horizontal view       S        horizontal view
+      !!            surface                          depth
+      !!      The now divergence is given by :
+      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
+      !!
+      !! ** History :
+      !!           !         (A. Bozec) Original code 
+      !!      8.5  !  02-10  (A. Bozec) F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER  :: ji, jj, jk   ! dummy loop indices
+      REAL(wp) :: zsu, zvt
+      REAL(wp) :: zwei
+      REAL(wp), DIMENSION (jpk) ::  zu1_ms, zu2_ms, zu3_ms
+      !!---------------------------------------------------------------------
+      
+      ! EMP on the Mediterranean Sea 
+      ! ----------------------------
+
+      zempmed = 0.e0
+      zwei = 0.e0
+      DO jj = mj0(96), mj1(110)
+         DO ji = mi0(141),mi1(181)
+            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
+            zempmed = zempmed + emp(ji,jj) * zwei
+         END DO
+      END DO
+
+      ! mpp
+# if defined key_mpp
+      CALL mpp_sum( zempmed )
+# endif
+
+      ! minus 2 points in Red Sea and 3 in Atlantic 
+      DO jj = mj0(96), mj1(96)
+         DO ji = mi0(148),mi1(148)
+            zempmed = zempmed -  emp(ji  , jj) * tmask(ji  , jj,1) * e1t(ji  , jj) * e2t(ji  , jj)   &
+                              -  emp(ji+1, jj) * tmask(ji+1, jj,1) * e1t(ji+1, jj) * e2t(ji+1, jj)   
+         END DO
+      END DO
+
+      ! convert in m3
+      zempmed = zempmed * 1.e-3
+
+      ! Velocity profile at each point
+      ! ------------------------------
+
+      zu1_ms(:) = zu1_ms_i(:)
+      zu2_ms(:) = zu2_ms_i(:)
+      zu3_ms(:) = zu3_ms_i(:)
+
+      ! velocity profile at 139,101 South point 
+      ! we imposed zisw + EMP above the Mediterranean Sea 
+      DO jk = 1, 14                      
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(140), mi1(140) 
+               zu1_ms(jk) =  zu1_ms(jk) + ( zempmed / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
+            END DO
+         END DO
+      END DO
+      
+      ! velocity profile at 141,102  East point
+      ! flux in surface inflow of the Atlantic ocean + EMP   
+      DO  jk = 1, 14                     
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(140), mi1(140) 
+               zu3_ms(jk) = zu3_ms(jk) +  ( zempmed / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 
+            END DO
+         END DO
+      END DO
+     
+      ! Divergence at each point of the straits
+      ! ---------------------------------------
+
+      ! compute the new divergence at 139,101 South point  
+      DO jk = 1, jpk
+         DO jj = mj0(101), mj1(101) 
+            DO ji = mi0(139), mi1(139) 
+               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
+               zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
+               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) + ( 1. / zvt ) * zsu * zu1_ms(jk) 
+            END DO
+         END DO
+      END DO
+
+      ! compute the new divergence at 139,102 deep North point
+      DO jk = 1, jpk
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(139), mi1(139) 
+               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
+               zsu = e2u(ji, jj) * fse3u(ji, jj,jk)
+               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) + ( 1. / zvt ) * zsu * zu2_ms(jk) 
+            END DO
+         END DO
+      END DO
+
+      ! compute the divergence at 141,102 East point
+      DO jk = 1, jpk
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(141), mi1(141) 
+               zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk)
+               zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk)
+               hdivn(ji, jj,jk) = hdivn(ji, jj,jk) - ( 1. / zvt ) * zsu * zu3_ms(jk)
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE div_gibraltar
+
+   SUBROUTINE div_hormuz
+      !! -------------------------------------------------------------------
+      !!                   ***  ROUTINE div_hormuz  ***
+      !!              
+      !! ** Purpose :   update the now horizontal divergence of the velocity 
+      !!     field in Hormuz ( Persic Gulf strait ) .
+      !!
+      !! ** Method :
+      !!      The now divergence is given by :
+      !!         hdivn = 1/(e1t*e2t) [ di(e2u  un) + dj(e1v  vn) ]
+      !!
+      !! ** History :
+      !!           !         (A. Bozec) Original code 
+      !!      8.5  !  02-10  (A. Bozec) F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER  :: ji, jj, jk   ! dummy loop indices
+      REAL(wp) :: zsu, zvt     ! temporary scalars
+      !!---------------------------------------------------------------------
+
+      ! New divergence at Hormuz 
+      ! ------------------------
+      DO jk = 1, jpk
+         DO jj = mj0(94), mj1(94) 
+            DO ji = mi0(172), mi1(172) 
+               zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+               zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk)
+               hdivn(ji,jj,jk) = hdivn(ji,jj,jk) - ( 1. / zvt ) * zsu * zu_pg(jk)
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE div_hormuz
+
+
+   SUBROUTINE div_cla_init
+      !! -------------------------------------------------------------------
+      !!                   ***  ROUTINE div_cla_init  ***
+      !!           
+      !! ** Purpose :   Initialization of variables at all straits  
+      !!
+      !! ** History :
+      !!           !         (A. Bozec) Original code 
+      !!      8.5  !  02-10  (A. Bozec) F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER  :: ji, jj, jk   ! dummy loop indices
+      !!---------------------------------------------------------------------
+
+      ! Control print
+      ! -------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'divmod_cross_land : cross land advection on divergence '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*) ' '
+
+      ! Initialization at Bab el Mandeb
+      ! -------------------------------
+
+      ! imposed transport
+      zisw_rs = 0.4e6             ! inflow surface water
+      zurw_rs = 0.2e6             ! upper recirculation water
+!Alex      zbrw = 1.2e6        ! bottom  recirculation water
+      zbrw_rs = 0.5e6             ! bottom  recirculation water
+
+      ! initialization of the velocity
+      zu1_rs_i(:) = 0.e0          ! velocity profile at 161,88 South point
+      zu2_rs_i(:) = 0.e0          ! velocity profile at 161,87 North point
+      zu3_rs_i(:) = 0.e0          ! velocity profile at 160,88 East  point
+
+      ! velocity profile at 161,88 North point 
+      ! we imposed zisw_rs + EMP above the Red Sea 
+      DO jk = 1,  8                                      
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(160), mi1(160) 
+               zu1_rs_i(jk) = -( zisw_rs / 8. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) )
+            END DO
+         END DO
+      END DO
+
+      ! recirculation water 
+      DO jj = mj0(88), mj1(88) 
+         DO ji = mi0(160), mi1(160) 
+            zu1_rs_i(20) =            - zurw_rs   / ( e2u(ji, jj) * fse3u(ji, jj,20) )
+            zu1_rs_i(21) = -( zbrw_rs - zurw_rs ) / ( e2u(ji, jj) * fse3u(ji, jj,21) )
+         END DO
+      END DO
+      
+      ! velocity profile at 161,87 South point
+      DO jj = mj0(88), mj1(88) 
+         DO ji = mi0(160), mi1(160) 
+            zu2_rs_i(21) =  ( zbrw_rs + zisw_rs ) / ( e2u(ji, jj-1 ) * fse3u(ji, jj-1,21) )
+         END DO
+      END DO
+
+      ! velocity profile at 160,88 North  point
+      ! we imposed zisw_rs + EMP above the Red Sea 
+      DO jk = 1,  10                                     
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(160), mi1(160) 
+               zu3_rs_i(jk) = ( zisw_rs / 10. ) / ( e1v(ji, jj) * fse3v(ji, jj,jk) )
+            END DO
+         END DO
+      END DO
+
+      ! deeper
+      DO jj = mj0(88), mj1(88) 
+         DO ji = mi0(160), mi1(160) 
+            zu3_rs_i(16)  = - zisw_rs / ( e1v(ji, jj) * fse3v(ji, jj,16) )
+         END DO
+      END DO
+      
+
+      ! Initialization at Gibraltar
+      ! ---------------------------
+
+      ! imposed transport
+      zisw_ms = 0.8e6             ! inflow surface  water
+      zmrw_ms = 0.7e6             ! middle recirculation water
+      zurw_ms = 2.5e6             ! upper  recirculation water
+      zbrw_ms = 3.5e6             ! bottom recirculation water
+
+      ! initialization of the velocity
+      zu1_ms_i(:) = 0.e0          ! velocity profile at 139,101 South point
+      zu2_ms_i(:) = 0.e0          ! velocity profile at 139,102 North point
+      zu3_ms_i(:) = 0.e0          ! velocity profile at 141,102 East  point
+
+      ! velocity profile at 139,101 South point 
+      DO jk = 1, 14                      
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(140), mi1(140) 
+               zu1_ms_i(jk) =  ( zisw_ms / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
+            END DO
+         END DO
+      END DO
+
+      ! recirculation water 
+      DO jk = 15, 20                      
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(140), mi1(140) 
+               zu1_ms_i(jk) =  ( zmrw_ms / 6. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) ) 
+            END DO
+         END DO
+      END DO
+
+      DO jj = mj0(102), mj1(102) 
+         DO ji = mi0(140), mi1(140) 
+            zu1_ms_i(21) =  (           zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,21) )
+            zu1_ms_i(22) =  ( zbrw_ms - zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,22) )
+         END DO
+      END DO
+      
+      ! velocity profile at 139,102 North point
+      DO jk = 15, 20                      
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(140), mi1(140) 
+               zu2_ms_i(jk) = -( zmrw_ms / 6. ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,jk) ) 
+            END DO
+         END DO
+      END DO
+
+      ! outflow of Mediterranean sea + recirculation
+      DO jj = mj0(102), mj1(102) 
+         DO ji = mi0(140), mi1(140) 
+            zu2_ms_i(22) = -( zisw_ms + zbrw_ms ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,22) )
+         END DO
+      END DO
+      
+      ! velocity profile at 141,102  East point
+      ! flux in surface inflow of the Atlantic ocean    
+      DO  jk = 1, 14                     
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(140), mi1(140) 
+               zu3_ms_i(jk) =  ( zisw_ms / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) ) 
+            END DO
+         END DO
+      END DO
+
+      ! deeper 
+      DO jj = mj0(102), mj1(102) 
+         DO ji = mi0(140), mi1(140) 
+            zu3_ms_i(21) = - zisw_ms / ( e2u(ji, jj) * fse3u(ji, jj,21) )
+         END DO
+      END DO
+
+      ! Initialization at Hormuz
+      ! ------------------------
+
+      ! imposed transport
+      zisw_pg = 4. * 0.25e6       ! inflow surface  water
+      zbrw_pg = 4. * 0.25e6       ! bottom recirculation water
+
+      ! initialization of the velocity
+      zu_pg(:) = 0.e0           ! velocity profile at 172,94 
+
+      ! velocity profile 
+      DO jk = 1, 8 
+         DO jj = mj0(94), mj1(94) 
+            DO ji = mi0(172), mi1(172) 
+               zu_pg(jk) = -( zisw_pg / 8. ) / ( e2u(ji-1,jj) * fse3u(ji-1,jj, jk) )
+            END DO
+         END DO
+      END DO
+
+      DO jk = 16, 18
+         DO jj = mj0(94), mj1(94) 
+            DO ji = mi0(172), mi1(172) 
+               zu_pg(jk) =  ( zbrw_pg / 3. ) / ( e2u(ji-1,jj) * fse3u(ji-1,jj, jk) )
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE div_cla_init
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                            Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE div_cla( kt )
+      WRITE(*,*) kt                         ! suppress compilation warning
+   END SUBROUTINE div_cla
+#endif
+   
+   !!======================================================================
+END MODULE cla_div
Index: /branches/nemo/NEMO/OPA_SRC/cla_dynspg.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/cla_dynspg.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/cla_dynspg.F90	(revision 4)
@@ -0,0 +1,231 @@
+MODULE cla_dynspg
+   !!----------------------------------------------------------------------
+   !!                 ***  dynspg_freesurf_cstvol.h90  ***
+   !!----------------------------------------------------------------------
+   !!   dyn_spg      : update the momentum trend with the surface pressure
+   !!                  gradient in the free surface constant volume case
+   !!                  with vector optimization
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain 
+   USE trdtra_oce     ! ocean active tracer   trend
+   USE trddyn_oce     ! ocean active dynamics trend
+   USE zdf_oce         ! ocean vertical physics
+   USE obc_oce         ! Lateral open boundary condition
+   USE sol_oce         ! solver variables
+   USE phycst          ! physical constants
+   USE ocesbc          ! ocean surface boundary condition (fluxes)
+   USE flxrnf          ! ???
+   USE solpcg          ! preconditionned conjugate gradient solver
+   USE solsor          ! Successive Over-relaxation solver
+   USE solfet          ! FETI solver
+   USE obcdyn          ! ocean open boundary condition (obc_dyn routines)
+   USE obcvol          ! ocean open boundary condition (obc_vol routines)
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! ???
+   USE lbclnk          ! ???
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC dyn_spg_cla   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dyn_spg_cla( kt ) 
+      !!----------------------------------------------------------------------
+      !!              ***  routine dyn_spg_cross_land  ***
+      !!
+      !! ** Purpose :
+      !!
+      !! ** Method :
+      !!
+      !! ** Action :
+      !!
+      !! History :
+      !!        !         (A. Bozec)  Original code
+      !!   8.5  !  02-11  (A. Bozec)  F90: Free form and module
+      !!---------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk                 ! dummy loop indices
+      REAL(wp) ::    &    
+         zempmed, zempred,   &                ! EMP on Med Sea ans Red Sea
+         zwei,   &                            !              
+         zisw_rs, zurw_rs, zbrw_rs,      &    ! imposed transport Red sea
+         zisw_ms, zurw_ms, zbrw_ms, zmrw_ms   ! imposed transport Med Sea
+      !!----------------------------------------------------------------------
+
+      ! Different velocities for straits ( Gibraltar, Bab el Mandeb...)
+         
+      ! Control print
+      ! -------------
+      IF( kt == nit000 ) THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dynspg_cross_land : cross land advection on surface '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~   pressure '
+         IF(lwp) WRITE(numout,*) ' '
+      ENDIF
+
+      ! EMP on Mediterranean Sea and Red Sea 
+      ! ------------------------------------
+      ! compute the emp in Mediterranean Sea
+      zempmed = 0.e0
+      zwei = 0.e0
+      DO jj = mj0(96), mj1(110)
+         DO ji = mi0(141),mi1(181)
+            zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
+            zempmed = zempmed + emp(ji,jj) * zwei
+         END DO
+      END DO
+
+      ! mpp
+# if defined key_mpp
+      CALL mpp_sum( zempmed )
+# endif
+
+      ! minus 2 points in Red Sea and 3 in Atlantic 
+      DO jj = mj0(96), mj1(96)
+         DO ji = mi0(148),mi1(148)
+            zempmed = zempmed - emp(ji  ,jj) * tmask(ji  ,jj,1) * e1t(ji  ,jj) * e2t(ji  ,jj)   &
+               &              - emp(ji+1,jj) * tmask(ji+1,jj,1) * e1t(ji+1,jj) * e2t(ji+1,jj)   
+         END DO
+      END DO
+      ! we convert in m3
+      zempmed = zempmed * 1.e-3
+
+      ! compute the emp in Red Sea   
+      zempred = 0.e0
+      zwei = 0.e0
+      DO jj = mj0(87), mj1(96)
+         DO ji = mi0(148), mi1(160) 
+            zwei      = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj)
+            zempred   = zempred + emp(ji,jj) * zwei
+         END DO
+      END DO
+
+      ! mpp
+# if defined key_mpp
+      CALL mpp_sum( zempred )
+# endif
+
+      ! we convert in m3
+      zempred = zempred * 1.e-3
+
+      ! New Transport at Bab el Mandeb and Gibraltar
+      ! --------------------------------------------
+
+      ! imposed transport at Bab el Mandeb
+      zisw_rs = 0.4e6        ! inflow surface water
+      zurw_rs = 0.2e6        ! upper recirculation water
+!!Alex      zbrw_rs = 1.2e6        ! bottom  recirculation water
+      zbrw_rs = 0.5e6        ! bottom  recirculation water
+
+      ! imposed transport at Gibraltar
+      zisw_ms  = 0.8e6          ! atlantic-mediterranean  water
+      zmrw_ms  = 0.7e6          ! middle recirculation water
+      zurw_ms  = 2.5e6          ! upper  recirculation water 
+      zbrw_ms  = 3.5e6          ! bottom recirculation water 
+
+      ! Different velocities for straits ( Gibraltar, Bab el Mandeb )
+      ! -------------------------------------------------------------
+
+      ! Bab el Mandeb
+      ! -------------
+      DO jj = mj0(88), mj1(88) 
+         DO ji = mi0(160), mi1(160) 
+            ua(ji,jj  ,: ) = 0.e0  !  North East Bab el Mandeb 
+            ua(ji,jj-1,: ) = 0.e0  !  South East Bab el Mandeb
+         END DO
+      END DO
+ 
+      ! 160,87 north point Bab el Mandeb
+      ! surface
+      DO jk = 1,  8                                      
+         DO jj = mj0(88), mj1(88) 
+            DO ji = mi0(160), mi1(160) 
+               ua(ji, jj,jk) = -( ( zisw_rs + zempred ) / 8. ) / ( e2u(ji, jj) * fse3t(ji, jj,jk) )     
+            END DO
+         END DO
+      END DO
+
+      ! deeper
+      DO jj = mj0(88), mj1(88) 
+         DO ji = mi0(160), mi1(160) 
+            ua(ji, jj,21) = - zbrw_rs / ( e2u(ji, jj) * fse3t(ji, jj,21) )
+         END DO
+      END DO
+
+      ! 160,87 south point Bab el Mandeb
+      DO jj = mj0(87), mj1(87) 
+         DO ji = mi0(160), mi1(160) 
+            ua(ji, jj,21) =  ( zisw_rs + zbrw_rs ) / ( e2u(ji,jj )*fse3t(ji, jj,21) )      
+         END DO
+      END DO
+
+      ! Gibraltar
+      ! ---------
+
+      ! initialisation of velocity at concerned points 
+      DO jj = mj0(101), mj1(101) 
+         DO ji = mi0(139), mi1(139) 
+            ua(ji,jj  ,: ) = 0.e0  !  South West Gibraltar
+            ua(ji,jj+1,: ) = 0.e0  !  North West Gibraltar
+         END DO
+      END DO
+
+      ! 139, 101 south point in Gibraltar 
+      ! surface
+      DO jk = 1, 14                      
+         DO jj = mj0(101), mj1(101) 
+            DO ji = mi0(139), mi1(139) 
+               ua(ji,jj,jk) =  ( ( zisw_ms + zempmed ) / 14. ) / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) 
+            END DO
+         END DO
+      END DO
+
+      ! middle circulation
+      DO jk = 15, 20                      
+         DO jj = mj0(101), mj1(101) 
+            DO ji = mi0(139), mi1(139) 
+               ua(ji,jj,jk) =  ( zmrw_ms / 6. ) / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) 
+            END DO
+         END DO
+      END DO
+
+      ! deeper 
+      DO jj = mj0(101), mj1(101) 
+         DO ji = mi0(139), mi1(139) 
+            ua(ji,jj,21) =             zurw_ms   / ( e2u(ji,jj) * fse3t(ji,jj,21) )
+            ua(ji,jj,22) = ( zbrw_ms - zurw_ms ) / ( e2u(ji,jj) * fse3t(ji,jj,22) )
+         END DO
+      END DO
+
+      ! 139,102 north point in Gibraltar
+      DO jk = 15, 20                      
+         DO jj = mj0(102), mj1(102) 
+            DO ji = mi0(139), mi1(139) 
+               ua(ji,jj,jk) = -( zmrw_ms / 6. ) / ( e2u(ji,jj) * fse3t(ji,jj,jk) ) 
+            END DO
+         END DO
+      END DO
+
+      ! deeper
+      DO jj = mj0(102), mj1(102) 
+         DO ji = mi0(139), mi1(139) 
+            ua(ji,jj,22) = -( zisw_ms + zbrw_ms ) / ( e2u(ji,jj) * fse3t(ji,jj,22) )
+         END DO
+      END DO
+
+   END SUBROUTINE dyn_spg_cla
+END MODULE cla_dynspg
Index: /branches/nemo/NEMO/OPA_SRC/cpl.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/cpl.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/cpl.F90	(revision 4)
@@ -0,0 +1,780 @@
+MODULE cpl
+   !!======================================================================
+   !!                       ***  MODULE cpl  ***
+   !! Coupled O/A : coupled ocean-atmosphere case using OASIS
+   !!=====================================================================
+#if defined key_coupled
+   !!----------------------------------------------------------------------
+   !!   'key_coupled'                              coupled Ocean/Atmosphere
+   !!----------------------------------------------------------------------
+   !!   cpl_init     : initialization of coupled mode communication
+   !!   cpl_read     : read the coupled namelist
+   !!   cpl_step     : exchange fields in coupled mode
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE cpl_oce         ! coupled exchange variables (???)
+   USE flx_oce         ! in case of ice 
+   USE ocfzpt          ! ocean freezing point
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! Routine accessibility
+   PUBLIC cpl_init
+   PUBLIC cpl_step  ! routine called by step.F90
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE cpl_init( kastp, kexch, kstep )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE cpl_init  ***
+      !!
+      !! ** Purpose :   Initialize coupled mode communication for ocean
+      !!    exchange process identifiers and timestep information
+      !!    between AGCM, OGCM and COUPLER. (OASIS software)
+      !!
+      !! ** Method  :  3 types :
+      !!      a) Use named pipes(FIFO) to exchange process identifiers
+      !!          between the 3 programs
+      !!      b) USE a messag passing method with PVM language (CLIM)
+      !!      c) USE SVIPC method
+      !!
+      !! ** Input   :   npiat     : agcm process identifier
+      !!                npicp     : coupler process identifier
+      !!                npioc     : ogcm process identifier
+      !!
+      !! Reference  :   see Epicoa 0803 (1992)
+      !!
+      !! History :
+      !!        !  92-09  (L. Terray)  Original code
+      !!        !  96-07  (L. Terray)  OASIS version 2
+      !!        !  96-11  (E. Guilyardi)  run-off + Taux,Tauy x2
+      !!        !  98-04  (M.A Foujols, S. Valcke, M. Imbard)  OASIS2.2
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(in ) ::   &
+         kastp,      &  ! total number of timesteps in oceanic model
+         kexch,      &  ! frequency of exchange for the fluxes (in time steps)
+         kstep          ! timestep value (in seconds)
+
+      !! * Local declarations
+      INTEGER,DIMENSION(3)  :: iparal
+      INTEGER               :: ifcpl, idt, info, imxtag, istep
+
+      CHARACTER (len=9) ::   clpoolnam 
+      INTEGER           :: ipoolhandle, ipoolsize, index, jf
+      CHARACTER (len=3) ::   cljobnam      ! experiment name
+      INTEGER           :: ierror
+      INTEGER,DIMENSION(4) ::  imess, imesso
+      INTEGER           :: getpid, mknod     ! system functions
+      !!----------------------------------------------------------------------
+     
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cpl_init : initialization in coupled ocean/atmosphere case'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+      IF(lwp) WRITE(numout,*)
+     
+#if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_forced_daily
+      IF(lwp)WRITE(numout,cform_err)
+      IF(lwp)WRITE(numout,*) ' key_coupled and key_flx_bulk_... are incompatible'
+      nstop = nstop + 1
+#endif
+ 
+      IF(lwp)WRITE(numout,*)'     coupled simulation'
+      IF(lwp)WRITE(numout,*)'        unit ',numlhf,' receive atm fluxes'
+      IF(lwp)WRITE(numout,*)'        unit ',numlws,' receive windstress'
+      IF(lwp)WRITE(numout,*)'        unit ',numlts,' transfer sst'
+      IF(lwp)WRITE(numout,*)'        unit ',numlic,' transfer ice cover'
+
+
+      CALL cpl_read           ! read the coupled mode information in namelist
+
+      CALL flush(numout)
+
+      ! I- PIPE
+      ! --------
+      ! W A R N I N G : PIPE technique is temporary diseable (nov. 2000)
+
+      IF( cchan == 'PIPE' ) THEN 
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'Making pipes for fields to receive from CPL'
+         IF(lwp) WRITE(numout,*)
+         CALL flush(numout)
+         ierror = 0
+
+         ! loop to define pipes (CPL=atmos to ocean)
+
+         DO jf = 1, nflxc2o  
+            ! CALL PIPE_Model_Define(numout,cpl_readflx(jf),jpread,info)
+            IF( info /= 0 ) ierror = ierror + 1
+         END DO
+         DO jf = 1, ntauc2o
+            ! CALL PIPE_Model_Define(numout,cpl_readtau(jf),jpread,info)
+            IF( info /= 0 ) ierror = ierror + 1
+         END DO
+         
+         IF(lwp) WRITE(numout,*) ' '
+         IF(lwp) WRITE(numout,*) 'Making pipes for fields to send to CPL'
+         IF(lwp) WRITE(numout,*) ' '
+         
+         ! loop to define pipes (ocean to atmos=CPL)
+
+         DO jf = 1, nfldo2c
+            ! CALL PIPE_Model_Define(numout, cpl_writ(jf), jpwrit, info)
+            IF( info /= 0 ) ierror = ierror + 1
+         END DO
+
+         IF( ierror /= 0 ) THEN
+            IF(lwp) WRITE(numout,*) 'Error in pipes definitions'
+            IF(lwp) WRITE(numout,*) 'STOP cpl_init'
+            CALL abort
+         END IF
+         
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'All pipes have been made'
+         IF(lwp) WRITE(numout,*)
+         
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'Communication test between OCE and CPL'
+         IF(lwp) WRITE(numout,*)
+         CALL flush(numout)
+         
+         ! CALL PIPE_Model_Stepi(numout, imess, nmodcpl, imesso, ierror)
+         
+         IF( ierror /= 0 ) THEN
+            IF(lwp) WRITE(numout,*) 'Error in exchange first informations with Oasis' 
+            IF(lwp) WRITE(numout,*) 'STOP cpl_init'
+            CALL abort
+         END IF
+         
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'Communication test between OCE and CPL is OK'
+         IF(lwp) WRITE(numout,*) ' total simulation time in oasis = ',imesso(1)
+         IF(lwp) WRITE(numout,*) ' total number of iterations is  = ',imesso(2)
+         IF(lwp) WRITE(numout,*) ' value of oasis timestep  is    = ',imesso(3)
+         IF(lwp) WRITE(numout,*) ' process id for oasis  is       = ',imesso(4)
+         IF(lwp) WRITE(numout,*)
+         CALL flush(numout)
+         
+         ! II SVIPC
+         ! ---------
+         ! W A R N I N G : SVIPC technique is temporary diseable (nov. 2000)
+         
+         
+      ELSE IF( cchan == 'SIPC' ) THEN
+
+         ! debug for more information
+
+         ! CALL SVIPC_debug(1)
+
+
+         ! 1.1-Define the experiment name :
+
+          cljobnam = 'IPC'      ! as $JOBNAM in namcouple
+
+          ! 3-Attach to shared memory pool used to exchange initial infos 
+
+          info = 0
+          ! CALL SIPC_Init_Model (cljobnam, cplmodnam, 1, info)
+          IF( info /= 0 ) THEN 
+             IF(lwp) WRITE(numout,*)
+             IF(lwp) WRITE(numout,*)'WARNING: Problem with attachement to',info 
+             IF(lwp) WRITE(numout,*)'         initial memory pool(s) in ocean'
+             IF(lwp) WRITE(numout,*)
+             CALL abort('STOP in ocean')
+          ENDIF
+
+          ! 4-Attach to pools used to exchange fields from ocean to coupler
+
+          DO jf = 1, nfldo2c
+             ! Pool name:
+             clpoolnam = 'P'//cpl_writ(jf)
+             ! CALL SIPC_Attach(clpoolnam, ipoolhandle)
+             ! Resulting pool handle:
+             mpoolwrit(jf) = ipoolhandle  
+          END DO
+
+          ! 5-Attach to pools used to exchange fields from coupler to ocean
+          
+          DO jf = 1, nflxc2o
+             ! Pool name:
+             clpoolnam = 'P'//cpl_readflx(jf)
+             ! CALL SIPC_Attach(clpoolnam, ipoolhandle)
+             ! Resulting pool handle:
+             mpoolread(jf) = ipoolhandle  
+          END DO  
+
+          DO jf = 1, ntauc2o
+             ! Pool name:
+             clpoolnam = 'P'//cpl_readtau(jf)
+             ! CALL SIPC_Attach(clpoolnam, ipoolhandle)
+             ! Resulting pool handle:
+             mpoolread(jf+nflxc2o) = ipoolhandle  
+          END DO 
+
+          ! 6-Exchange of initial infos
+
+          ! Write data array isend to pool READ by Oasis
+
+          info = 0
+          ipoolsize = 4*jpbyteint
+          ! CALL SVIPC_write(mpoolinitr, imess, ipoolsize, info)
+
+          ! Find error if any
+
+          IF( info < 0 ) THEN
+             IF(lwp) WRITE(numout,*)
+             IF(lwp) WRITE(numout,*) 'Problem in ocean in writing initial' 
+             IF(lwp) WRITE(numout,*) 'infos to the shared memory segment(s)'
+             IF(lwp) WRITE(numout,*)
+          ELSE
+             IF(lwp) WRITE(numout,*)
+             IF(lwp) WRITE(numout,*) 'Initial infos written in ocean'            
+             IF(lwp) WRITE(numout,*) 'to the shared memory segment(s)'
+             IF(lwp) WRITE(numout,*)
+          ENDIF
+
+          ! Read data array irecv from pool written by Oasis
+
+          info = 0
+          ipoolsize = 4 * jpbyteint
+          CALL svipc_read(mpoolinitw, imesso, ipoolsize, info)
+
+          ! Find error if any
+
+          IF( info < 0 ) THEN
+             IF(lwp) WRITE(numout,*) '   '
+             IF(lwp) WRITE(numout,*) 'Problem in ocean in reading initial' 
+             IF(lwp) WRITE(numout,*) 'infos from the shared memory segment(s)'
+             IF(lwp) WRITE(numout,*) '   '
+          ELSE
+             IF(lwp) WRITE(numout,*) '   '
+             IF(lwp) WRITE(numout,*) 'Initial infos read by ocean'                
+             IF(lwp) WRITE(numout,*) 'from the shared memory segment(s)'
+             IF(lwp) WRITE(numout,*) '   '
+             IF(lwp) WRITE(numout,*) ' ntime, niter, nstep, Oasis pid:'
+             IF(lwp) WRITE(numout,*) imesso(1), imesso(2), imesso(3), imesso(4) 
+          ENDIF
+
+          ! Detach from shared memory segment(s)
+
+          info = 0
+          ! CALL SVIPC_close(mpoolinitw, 0, info)
+          
+          ! Find error if any
+
+          IF( info < 0 ) THEN
+             IF(lwp) WRITE(numout,*) 'Problem in detaching from shared memory segment(s)'
+             IF(lwp) WRITE(numout,*) 'used by ocean to read initial infos' 
+          ENDIF
+
+          ! III CLIM
+          ! --------
+
+      ELSE IF( cchan == 'CLIM' ) THEN
+
+         ! Define the number of processors involved in the coupling for
+         ! Oasis (=1) and each model (as last two INTEGER on $CHATYPE line
+         ! in the namcouple); they will be stored in a COMMON in mpiclim.h
+         ! (used for CLIM/MPI2 only)
+         mpi_nproc(0)=1
+         mpi_nproc(1)=1
+         mpi_nproc(2)=1 
+
+         ! Define the number of processors used by each model as in
+         ! $CHATYPE line of namcouple (used for CLIM/MPI2 only)
+         mpi_totproc(1)=1
+         mpi_totproc(2)=1
+         
+         ! Define names of each model as in $NBMODEL line of namcouple
+         ! (used for CLIM/MPI2 only)
+         cmpi_modnam(1)='lmdz.x'
+         cmpi_modnam(2)=cplmodnam
+         !  
+         ! 1.1-Define the experiment name :
+         
+         cljobnam = 'CLI'      ! as $JOBNAM in namcouple
+         
+         OPEN ( UNIT = 7, FILE = 'trace', STATUS = 'unknown', FORM = 'formatted')
+         CALL clim_init ( cljobnam, cplmodnam, 3, 7,   &
+                          kastp, kexch, kstep,   &
+                          5, 3600, 3600, info )
+
+         IF( info /= clim_ok ) THEN
+            IF(lwp) WRITE( numout, *) ' cpl_init : pb init clim '
+            IF(lwp) WRITE( numout, *) ' error code is = ', info
+            CALL abort('STOP in cpl_init')
+         ELSE
+            IF(lwp) WRITE(numout,*) 'cpl_init : init clim ok '
+         ENDIF
+         
+         iparal ( clim_strategy ) = clim_serial
+         iparal ( clim_length   ) = jpiglo*jpjglo
+         iparal ( clim_offset   ) = 0
+         
+         ! loop to define messages (CPL=atmos to ocean)
+         DO jf = 1, nflxc2o
+            CALL CLIM_Define ( cpl_readflx(jf), clim_in, clim_double, iparal, info )  
+         END DO
+         DO jf = 1, ntauc2o
+            CALL CLIM_Define ( cpl_readtau(jf), clim_in, clim_double, iparal, info )  
+         END DO
+         
+         ! loop to define messages (ocean to CPL=atmos)
+         DO jf = 1, nfldo2c
+            CALL CLIM_Define ( cpl_writ(jf), clim_out, clim_double, iparal, info )   
+         END DO
+         
+         IF(lwp) WRITE(numout,*) 'cpl_init : clim_define ok '
+         
+         CALL CLIM_Start ( imxtag, info )
+         
+         IF( info /= clim_ok ) THEN
+            IF(lwp) WRITE(numout,*) 'cpl_init : pb start clim '
+            IF(lwp) WRITE(numout,*) ' error code is = ', info
+            CALL abort('stop in cpl_init')
+         ELSE
+            IF(lwp) WRITE(numout,*) 'cpl_init : start clim ok '
+         ENDIF
+         
+         CALL CLIM_Stepi ( cploasis, istep, ifcpl, idt, info )
+
+         IF( info /= clim_ok ) THEN
+            IF(lwp) WRITE(numout,*) ' warning : problem in getting step info from oasis '
+            IF(lwp) WRITE(numout,*) ' =======   error code number = ', info
+         ELSE
+            IF(lwp) WRITE(numout,*) ' got step information from oasis '
+         ENDIF
+         IF(lwp) WRITE(numout,*) ' number of tstep in oasis ', istep
+         IF(lwp) WRITE(numout,*) ' exchange frequency in oasis ', ifcpl
+         IF(lwp) WRITE(numout,*) ' length of tstep in oasis ', idt
+      ENDIF
+
+   END SUBROUTINE cpl_init
+
+
+   SUBROUTINE cpl_read
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE cpl_read  ***
+      !!                    
+      !! ** Purpose :
+      !!     Read and print options for the coupled run (namelist)
+      !!
+      !! ** Method :                   : no
+      !!
+      !! History :
+      !!   8.5  !  02-12  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER :: jf
+
+      CHARACTER (len=21) ::   clold, clfor, clseq
+      CHARACTER (len=32) ::   clname
+
+      NAMELIST/namcpl/ nexco, cchan, nmodcpl, cplmodnam, cploasis   &
+          , nfldo2c, nflxc2o, ntauc2o, cpl_f_readflx, cpl_f_readtau   &
+          , cpl_f_writ, cpl_readflx, cpl_readtau, cpl_writ
+      !!----------------------------------------------------------------------
+      
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' cpl_read : read the coupled parameters in namelist'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~'
+      IF(lwp) WRITE(numout,*)
+
+      ! Default values
+      
+      nexco = 24
+      cchan='PIPE'              ! echange TYPE
+      nmodcpl = 2
+      cplmodnam = 'opa.xx'      ! model name : as $NBMODEL in namcouple
+      cploasis = 'Oasis'        ! coupler name : as in coupler
+
+      ! -Define symbolic name for fields exchanged from ocean to coupler,
+      ! must be the same as (1) of the field  definition in namcouple:
+      nfldo2c=2
+      cpl_writ(1)='SOSSTSST'
+      cpl_writ(2)='SOICECOV'
+
+      ! -Define files name for fields exchanged from ocean to coupler,
+      ! must be the same as (6) of the field  definition in namcouple:
+      nflxc2o=6
+      cpl_readflx(1)='SONSFLDO' ! non solar heat flux (positif vers l'ocean)
+      cpl_readflx(2)='SOSHFLDO' ! solar flux
+      cpl_readflx(3)='SOTOPRSU' ! precip
+      cpl_readflx(4)='SOTFSHSU' ! evaporation
+      cpl_readflx(5)='SORUNCOA' ! coastal run-off
+      cpl_readflx(6)='SORIVFLU' ! river run-off
+      ntauc2o=2
+      cpl_readtau(1)='SOZOTAUX' ! first zonal wind stress
+      cpl_readtau(2)='SOZOTAU2' ! second zonal wind stress
+      cpl_readtau(3)='SOMETAUY' ! first meridien wind stress
+      cpl_readtau(4)='SOMETAU2' ! second meridien wind stress
+
+      ! -Define files name for fields exchanged from ocean to coupler,
+      ! must be the same as (6) of the field  definition in namcouple:
+      cpl_f_writ(1)='ocesst'
+      cpl_f_writ(2)='oceice'
+
+      ! -Define files name for fields exchanged from coupler to ocean
+      ! must be the same as (7) of the field  definition in namcouple:
+      cpl_f_readflx(1)='oceflx'
+      cpl_f_readflx(2)='oceflx'
+      cpl_f_readflx(3)='oceflx'
+      cpl_f_readflx(4)='oceflx'
+      cpl_f_readflx(5)='oceflx'
+      cpl_f_readflx(6)='oceflx'
+      cpl_f_readtau(1)='ocetau'
+      cpl_f_readtau(2)='ocetau'
+      cpl_f_readtau(3)='ocetau'
+      cpl_f_readtau(4)='ocetau'
+
+      ! Namelist namcpl : coupling mode and frequency
+      REWIND( numnam )
+      READ  ( numnam, namcpl )
+
+      IF(lwp) THEN
+         WRITE(numout,*) 'namcpl'
+         WRITE(numout,*) 
+         WRITE(numout,*) ' Coupling exchange frequency    nexco  = ',nexco
+         WRITE(numout,*) ' Coupling exchange technique    cchan  = ',cchan
+         WRITE(numout,*) ' Mode Coupling technique      nmodcpl  = ',nmodcpl
+         WRITE(numout,*) ' Define the model name      cplmodnam  = ',cplmodnam
+         WRITE(numout,*) ' Define the coupler name      cploasis = ',cploasis
+         WRITE(numout,*) ' Fields number ocean to coupler nfldo2c= ',nfldo2c
+         WRITE(numout,*) ' Flux fields coupler to ocean nflxc2o  = ',nflxc2o
+         WRITE(numout,*) ' Stress fields coupler to ocean ntauc2o= ',ntauc2o
+         IF ( cchan == 'PIPE' .OR.  cchan == 'pipe' ) THEN
+            cchan='PIPE'
+            WRITE(numout,*)'(communication between models made by pipes)'
+         ELSEIF( cchan == 'CLIM' .OR. cchan == 'clim' ) THEN
+            cchan='CLIM'
+            WRITE(numout,*)'(communication between models made by CLIM-PVM)'
+         ELSEIF( cchan == 'SIPC' .OR. cchan == 'sipc' ) THEN
+            cchan='SIPC'
+            WRITE(numout,*)'(communication between models made by the',  &
+               'Share Memory Segment and Semaphore)'
+         ELSE
+            WRITE(numout,*) 'technic not yet implemented ',cchan
+            STOP 'in cpl_read'
+         ENDIF
+         DO jf = 1, nflxc2o
+            WRITE(numout,*) 'file to receive field number = ',jf,'  ',cpl_f_readflx(jf) 
+         END DO
+         DO jf = 1, ntauc2o
+            WRITE(numout,*) 'file to receive field number = ',jf,'  ',cpl_f_readtau(jf) 
+         END DO
+         DO jf = 1, nfldo2c
+            WRITE(numout,*) 'file to send field number = ',jf,'  ',cpl_f_writ(jf)
+         END DO
+         WRITE(numout,*) ' fields received from coupler'
+         DO jf = 1, nflxc2o
+            WRITE(numout,*) 'symbolic name for field number = ',jf,'  ',cpl_readflx(jf) 
+         END DO
+         DO jf = 1, ntauc2o
+            WRITE(numout,*) 'symbolic name for field number = ',jf,'  ',cpl_readtau(jf) 
+         END DO
+         WRITE(numout,*) ' fields send to coupler'
+         DO jf = 1, nfldo2c
+            WRITE(numout,*) 'symbolic name for field number = ',jf,'  ',cpl_writ(jf)
+         END DO
+      ENDIF
+
+   END SUBROUTINE cpl_read
+
+
+   SUBROUTINE cpl_step( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE cpl_step  ***
+      !!                      *****************
+      !!                      * OASIS routine *
+      !!                      *****************
+      !! ** Purpose : - At each coupling time-step,this routine sends fields
+      !!      like sst or ice cover to the coupler.
+      !!              - At each time-step computes time average values 
+      !!              - Specific treatment for the last time-step
+      !!
+      !! ** Method  :   3 types available:
+      !!      a) Use named pipes(FIFO) to exchange process identifiers
+      !!         between the 3 programs
+      !!      b) USE a messag passing method with PVM language (CLIM)
+      !!      c) USE SVIPC method
+      !!
+      !! History :
+      !!        !  92-09 (L. Terray)  Original code
+      !!        !  96-07 (L. Terray)  OASIS version 2
+      !!        !  96-11 (E. Guilyardi)  run-off + Taux,Tauy x2
+      !!        !  98-04 (M.A Foujols, S. Valcke, M. Imbard)  OASIS2.2
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * modules used
+      USE ioipsl
+
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt    ! ocean time-step
+
+      !! * Local declarations
+      INTEGER :: ji, jj, jn, jf           ! dummy loop indexes
+      INTEGER :: icstep, info, ierror, isize
+      INTEGER :: iflmax, iunmax
+      INTEGER :: ifile(jpmaxfld), ifield(jpmaxfld)
+      CHARACTER (len=8) ::  clfile(jpmaxfld) 
+      LOGICAL :: llfind
+      REAL(wp), DIMENSION(jpiglo,jpjglo) ::    &
+         zstoc, zieoc, zalboc, zticoc
+      
+      ! netcdf outputs
+       
+      CHARACTER (len=80) ::  clcplsnam
+      INTEGER, SAVE ::  nhoridcs, nidcs, ndexcs(1)
+      LOGICAL, SAVE :: lfirsts = .TRUE.
+      REAL(wp) ::    zjulian
+      
+      ! Additions for SVIPC
+      
+      INTEGER  :: index
+      INTEGER, DIMENSION(3) :: infos
+      CHARACTER (len=3) ::  clmodinf       ! Header or not
+      CHARACTER (len=3) ::  cljobnam      ! experiment name
+      !!----------------------------------------------------------------------
+
+      ! coupled mode Ocean/Atmosphere
+
+      ! 0. Initialization
+      ! -----------------
+
+      isize = jpiglo * jpjglo
+
+      ! First time step: ocean sst and ice sea-ice extend set to zero
+      IF( kt == nit000 ) THEN
+         sstoc(:,:) = 0.e0
+         sieoc(:,:) = 0.e0
+         alboc(:,:) = 0.e0
+         ticoc(:,:) = 0.e0
+
+         ! initialisation for netcdf outputs
+         ! 
+         ndexcs(:) = 0
+         clcplsnam = "cpl_oce_sst"
+
+         ! Compute julian date from starting date of the run
+         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zjulian )
+         CALL histbeg(clcplsnam, jpiglo, glamt, jpjglo, gphit,   &
+            1, jpiglo, 1, jpjglo, 0,   &
+            zjulian, rdt, nhoridcs, nidcs)
+         ! no vertical axis
+         DO jf = 1, nfldo2c
+            CALL histdef(nidcs, cpl_writ(jf),cpl_writ(jf),"-",jpi,    &
+               jpj, nhoridcs, 1, 1, 1, -99, 32, "inst", rdt, rdt)
+         END DO
+         CALL histend(nidcs)
+      ENDIF
+
+      ! 1. Cumulated sst and sea-ice extend
+      !------------------------------------
+
+      sstoc(:,:) = sstoc(:,:) + ( 1.0 - freeze(:,:) ) * ( tn(:,:,1) + rt0 )
+      sieoc(:,:) = sieoc(:,:) + freeze(:,:)
+
+#if defined key_ice_lim
+      alboc(:,:) = alboc(:,:) + freeze(:,:) * alb_ice(:,:)
+      ticoc(:,:) = ticoc(:,:) + freeze(:,:) * tn_ice(:,:) 
+#else
+      alboc(:,:) = alboc(:,:) + freeze(:,:) * 0.8
+      ticoc(:,:) = ticoc(:,:) + freeze(:,:) * ( -10.0 + rt0 )
+#endif
+
+
+      ! 2. Send coupling fields to OASIS
+      !---------------------------------
+
+      IF( MOD(kt,nexco) == 0 ) THEN
+
+         ! 2.1 Average : mean coupling fields
+         DO jj = 1, jpjglo
+            DO ji = 1, jpiglo
+               zstoc (ji,jj) = 0.e0
+               zieoc (ji,jj) = 0.e0
+               zalboc(ji,jj) = 0.e0
+               zticoc(ji,jj) = 0.e0
+            END DO
+         END DO
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               zstoc (mig(ji),mjg(jj)) = sstoc(ji,jj) / FLOAT( nexco )
+               zieoc (mig(ji),mjg(jj)) = sieoc(ji,jj) / FLOAT( nexco )
+               zalboc(mig(ji),mjg(jj)) = alboc(ji,jj) / FLOAT( nexco )
+               zticoc(mig(ji),mjg(jj)) = ticoc(ji,jj) / FLOAT( nexco )
+            END DO
+         END DO
+         icstep = kt - nit000 + 1
+
+         WRITE(numout,*) ' '
+         WRITE(numout,*) 'STEP: Send fields to CPL with kt= ', kt
+         WRITE(numout,*) ' '
+
+         ! outputs
+
+         CALL histwrite( nidcs, cpl_writ(1), kt, zstoc , jpi*jpj, ndexcs )
+         CALL histwrite( nidcs, cpl_writ(2), kt, zieoc , jpi*jpj, ndexcs )
+         CALL histwrite( nidcs, cpl_writ(3), kt, zalboc, jpi*jpj, ndexcs )
+         CALL histwrite( nidcs, cpl_writ(4), kt, zticoc, jpi*jpj, ndexcs )
+         CALL histsync ( nidcs )
+
+         ! 2.2 Last time step (clim or pipe) or pipe mode
+         ! 
+         IF( kt == nitend .OR. cchan == 'PIPE' ) THEN 
+
+            ! finalize outputs
+
+            CALL histclo(nidcs)
+
+            ! WRITE fields for coupler with pipe technique or for last time step
+
+            ! initialisation
+
+            iflmax =  1
+            iunmax = 99
+            
+            clfile(iflmax) = cpl_f_writ(iflmax)     ! keeps first file name
+            ifile(iflmax) = iunmax                  ! keeps first file unit
+            iunmax = iunmax - 1                     ! decrements file unit maximum
+            ifield(1) = ifile(iflmax)               ! keeps file unit for field
+
+            ! different files names counter
+            DO jf = 2, nfldo2c
+               llfind = .FALSE.
+               DO jn = 1, iflmax
+                  IF( .NOT. llfind ) THEN
+                     IF( cpl_f_writ(jf) == clfile(jn) ) THEN
+                        ifield(jf) = ifile(jn)      ! keep file unit for field
+                        llfind = .TRUE.
+                     ENDIF
+                  END IF
+               END DO
+               IF( .NOT. llfind) THEN
+                  iflmax = iflmax + 1               ! increment the number of different files
+                  clfile(iflmax) = cpl_f_writ(jf)   ! keep file name
+                  ifile(iflmax) = iunmax            ! keep file unit for file
+                  ifield(jf) = ifile(iflmax)        ! keep file unit for field
+                  iunmax = iunmax-1                 ! decrement unit maximum number from 99 to 98...
+               ENDIF
+            END DO
+            !          
+            DO jn = 1, iflmax 
+               OPEN (ifile(jn), FILE=clfile(jn), FORM='UNFORMATTED')
+            END DO
+            !              
+            DO jf = 1, nfldo2c
+               IF(jf == 1) CALL locwrite(cpl_writ(jf),zstoc , isize, ifield(jf), ierror, numout) 
+               IF(jf == 2) CALL locwrite(cpl_writ(jf),zieoc , isize, ifield(jf), ierror, numout) 
+               IF(jf == 3) CALL locwrite(cpl_writ(jf),zalboc, isize, ifield(jf), ierror, numout) 
+               IF(jf == 4) CALL locwrite(cpl_writ(jf),zticoc, isize, ifield(jf), ierror, numout) 
+            END DO
+
+            ! simulate a FLUSH
+
+            DO jn = 1, iflmax 
+               CLOSE (ifile(jn))
+            END DO
+
+            ! Clim mode
+            IF( cchan == 'CLIM' ) THEN  ! inform PVM daemon, I have finished
+               CALL CLIM_Quit (CLIM_ContPvm, info)
+               IF(info /= CLIM_Ok) THEN
+                  WRITE (6, *) 'An error occured while leaving CLIM. Error = ',info
+               ENDIF
+            ENDIF
+
+         ENDIF
+
+         ! IF last we have finished
+
+         IF (kt == nitend ) RETURN 
+
+         ! 2.3 normal exchange
+
+         ! PIPE mode      
+         IF( cchan == 'PIPE' ) THEN 
+
+            ! Send message to pipes for CPL=atmosphere
+
+            ! DO jf = 1, nfldo2c
+            !    CALL PIPE_Model_Send(cpl_writ(jf), icstep, numout)
+            ! END DO 
+
+            ! SIPC mode
+         ELSE IF( cchan == 'SIPC' ) THEN
+
+            ! Define IF a header must be encapsulated within the field brick :
+            clmodinf = 'NOT'  ! as $MODINFO in namcouple  
+
+            ! IF clmodinf = 'YES', define encapsulated infos to be exchanged
+            !    infos(1) = initial date
+            !    infos(2) = timestep
+            !    infos(3) = actual time
+            !
+            ! Writing of output field SST SOSSTSST
+            !
+            ! Index of SST in total number of fields jpfldo2a: 
+            index = 1
+            !
+            ! CALL SIPC_Write_Model(index, isize, clmodinf, cljobnam, infos, zstoc)
+            !
+            ! Writing of output field Sea-Ice SOICECOV 
+            !
+            ! Index of sea-ice in total number of fields jpfldo2a: 
+            index = 2
+            !
+            ! CALL SIPC_Write_Model(index, isize, clmodinf, cljobnam, infos, zieoc)
+
+            ! CLIM mode
+         ELSE IF( cchan == 'CLIM' ) THEN
+
+            DO jn = 1, nfldo2c
+
+               IF (jn == 1) CALL CLIM_Export(cpl_writ(jn), icstep, zstoc , info)
+               IF (jn == 2) CALL CLIM_Export(cpl_writ(jn), icstep, zieoc , info)
+               IF (jn == 3) CALL CLIM_Export(cpl_writ(jn), icstep, zalboc, info)
+               IF (jn == 4) CALL CLIM_Export(cpl_writ(jn), icstep, zticoc, info)
+
+               IF (info /= CLIM_Ok) THEN
+                  WRITE (numout,*) 'STEP : Pb giving', cpl_writ(jn), ':', jn
+                  WRITE (numout,*) ' at timestep = ', icstep, 'kt = ', kt
+                  WRITE (numout,*) 'Clim error code is = ',info
+                  WRITE (numout,*) 'STOP in stpcpl '
+                  CALL abort(' stpcpl ')
+               ENDIF
+            END DO
+         ENDIF
+
+         ! reset cumulative sst and sea-ice extend to zero
+         sstoc(:,:) = 0.0
+         sieoc(:,:) = 0.0
+         alboc(:,:) = 0.0
+         ticoc(:,:) = 0.0
+      ENDIF
+
+   END SUBROUTINE cpl_step
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case           Dummy module         forced Ocean/Atmosphere
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE cpl_init       ! Dummy routine
+   END SUBROUTINE cpl_init
+   SUBROUTINE cpl_step( kt )       ! Dummy routine
+      WRITE(*,*) kt
+   END SUBROUTINE cpl_step
+#endif
+
+   !!======================================================================
+END MODULE cpl
Index: /branches/nemo/NEMO/OPA_SRC/cpl_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/cpl_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/cpl_oce.F90	(revision 4)
@@ -0,0 +1,276 @@
+MODULE cpl_oce
+   !!======================================================================
+   !!                   ***  MODULE  cpl_oce  ***
+   !! Ocean coupling:  ocean-atmosphere-sea ice coupled exchanges 
+   !!=====================================================================
+#if defined key_coupled
+   !!----------------------------------------------------------------------
+   !!   'key_coupled'                              Coupled Ocean/Atmosphere
+   !!----------------------------------------------------------------------
+   !! ** Purpose :   Atmosphere/Ice/Ocean Coupling
+   !!      GASTON TEAM (CERFACS, Meteo-France, LMD, LSCE, IPSL, LODYC)
+   !!
+   !! history :
+   !!  8.0   ! 08-98  (M.A. Foujols, M. Imbard)  Original code
+   !!  8.5   ! 06/02  (G. Madec)  modules
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce          ! ocean parameters
+
+   IMPLICIT NONE
+
+   !! ---------------------------------------------------------------------
+   !! Ocean/Ice/Atmosphere Coupling
+   !! -----------------------------
+   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.   !: coupled flag
+
+   INTEGER, PARAMETER ::   &
+      jpmaxfld = 40        &  !: Number of maximum fields exchange betwwen
+      !                       ! the ocean and the coupler
+
+   !!---------------------------------------------------------------------
+   !! SIPC Method   (L. Terray, S. Valcke, CERFACS)
+   !! -----------
+
+   INTEGER, PARAMETER ::   &
+      jpbyteint = 4,       &  !: number of bytes per integer
+      jpbyterea = 8,       &  !: number of bytes per real
+      jpbytecha = 1           !: number of bytes per character  
+
+   INTEGER, PARAMETER ::   &
+      jptest = 100         &  !: The models will test during 2*jptest 
+      !                       ! seconds if the file DUMMY_SIPC has been
+      !                       ! created by OASIS, signaling that the
+      !                       ! SHM pools are opened. After, it aborts.
+
+   !!---------------------------------------------------------------------
+   !! PIPE Method   (L. Terray, CERFACS)
+   !! -----------
+
+   INTEGER, PARAMETER ::   &
+      jpread = 0,          &  !: 
+      jpwrit = 1              !: 
+
+   !!---------------------------------------------------------------------
+   !! Messag Passing Method (CLIM)
+   !! ----------------------------
+!!!INCLUDE '../../CPL/include/clim.h'
+! -- clim.h   18-08-95   Version 2.0   Author: Laurent Terray
+!    ******
+!             26-10-99   Version 2.4   Jean Latour (F.S.E.) MPI-2 support
+!!
+!!  Contents : variables related to the CLIM library
+!!  --------
+!! For complete definition, see the CLIM manual
+!!
+      INTEGER*4 CLIM_MaxMod,    CLIM_MaxPort,  CLIM_MaxSegments,
+     *          CLIM_MaxTag,
+     *          CLIM_MaxLink,
+     *          CLIM_ParSize,
+     *          CLIM_Clength,
+     *          CLIM_MaxCodes
+
+      INTEGER*4 CLIM_Void
+
+      INTEGER*4 CLIM_In,        CLIM_Out,       CLIM_InOut
+
+      INTEGER*4 CLIM_Strategy,  CLIM_Segments,  
+     *          CLIM_Serial,    CLIM_Length,    CLIM_Orange,
+     *          CLIM_Apple,     CLIM_Offset,
+     *          CLIM_Box,       CLIM_SizeX,     CLIM_SizeY,
+     *          CLIM_LdX
+
+      INTEGER*4 CLIM_Integer,   CLIM_Real,      CLIM_Double
+
+      INTEGER*4 CLIM_StopPvm,   CLIM_ContPvm
+
+      INTEGER*4 CLIM_Ok
+      INTEGER*4 CLIM_FastExit,  CLIM_BadName,   CLIM_BadPort,
+     *          CLIM_BadType,   CLIM_DoubleDef, CLIM_NotStep,
+     *          CLIM_IncStep,   CLIM_IncSize,   CLIM_NotClim,
+     *          CLIM_TimeOut,
+     *          CLIM_Pvm,       CLIM_FirstCall, CLIM_PbRoute,
+     *          CLIM_Group,     CLIM_BadTaskId, CLIM_NoTask,
+     *          CLIM_InitBuff,  CLIM_Pack,      CLIM_Unpack,
+     *          CLIM_Down,      CLIM_PvmExit
+
+      INTEGER*4 CLIM_jpmax,     CLIM_jpmx8,     CLIM_Mpi
+
+!-----Parameter sizes
+
+      PARAMETER ( CLIM_Void    = 0  )
+      PARAMETER ( CLIM_MaxMod  = 8 )
+      PARAMETER ( CLIM_MaxPort = 50 )
+      PARAMETER ( CLIM_MaxSegments = 50 )
+      PARAMETER ( CLIM_MaxLink = CLIM_MaxMod * CLIM_MaxPort )
+      PARAMETER ( CLIM_ParSize = 2*CLIM_MaxSegments+2 )
+      PARAMETER ( CLIM_MaxTag  = 16777215 )
+      PARAMETER ( CLIM_Clength = 32 )
+
+!-----Dimension of buffer for packing / unpacking messages with MPI
+!     (must be equal to jpmax of Oasis)
+
+      PARAMETER ( CLIM_jpmax = 400000 )
+      PARAMETER ( CLIM_jpmx8 = CLIM_jpmax*8 )
+
+!-----Ports status
+
+      PARAMETER ( CLIM_In      = 1 )
+      PARAMETER ( CLIM_Out     = 0 )
+      PARAMETER ( CLIM_InOut   = 2 )
+
+!-----Parallel distribution
+
+      PARAMETER ( CLIM_Strategy = 1 )
+      PARAMETER ( CLIM_Segments = 2 )
+      PARAMETER ( CLIM_Serial   = 0 )
+      PARAMETER ( CLIM_Apple    = 1 )
+      PARAMETER ( CLIM_Box      = 2 )
+      PARAMETER ( CLIM_Orange   = 3 )
+      PARAMETER ( CLIM_Offset   = 2 )
+      PARAMETER ( CLIM_Length   = 3 )
+      PARAMETER ( CLIM_SizeX    = 3 )
+      PARAMETER ( CLIM_SizeY    = 4 )
+      PARAMETER ( CLIM_LdX      = 5 )
+
+!-----Datatypes
+
+      PARAMETER ( CLIM_Integer = 1 )
+      PARAMETER ( CLIM_Real    = 4 ) 
+      PARAMETER ( CLIM_Double  = 8 )
+
+!-----Quit parameters
+
+      PARAMETER ( CLIM_ContPvm = 0 )
+      PARAMETER ( CLIM_StopPvm = 1 )
+
+!-----Error Codes
+
+      PARAMETER ( CLIM_MaxCodes  = -22 )
+
+      PARAMETER ( CLIM_Ok        = 0 )
+      PARAMETER ( CLIM_FastExit  = -1 )
+      PARAMETER ( CLIM_BadName   = -2 )
+      PARAMETER ( CLIM_BadPort   = -3 )
+      PARAMETER ( CLIM_BadType   = -4 )
+      PARAMETER ( CLIM_DoubleDef = -5 )
+      PARAMETER ( CLIM_NotStep   = -6 )
+      PARAMETER ( CLIM_IncStep   = -7 )
+      PARAMETER ( CLIM_IncSize   = -8 )
+      PARAMETER ( CLIM_NotClim   = -9 )
+      PARAMETER ( CLIM_TimeOut   = -10 )
+      PARAMETER ( CLIM_Pvm       = -11 )
+      PARAMETER ( CLIM_FirstCall = -12 )
+      PARAMETER ( CLIM_PbRoute   = -13 )
+      PARAMETER ( CLIM_Group     = -14 )
+      PARAMETER ( CLIM_BadTaskId = -15 )
+      PARAMETER ( CLIM_NoTask    = -16 )
+      PARAMETER ( CLIM_InitBuff  = -17 )
+      PARAMETER ( CLIM_Pack      = -18 )
+      PARAMETER ( CLIM_Unpack    = -19 )
+      PARAMETER ( CLIM_Down      = -20 )
+      PARAMETER ( CLIM_PvmExit   = -21 )
+      PARAMETER ( CLIM_Mpi       = -22 )
+
+!     --- end of clim.h
+!!!END-----------------------------------------------------------------
+
+!!!INCLUDE '../../CPL/include/mpiclim.h'
+!!-- mpiclim.h  26-10-99   Version 2.4   Author: Jean Latour (F.S.E.)
+!!   *********
+!!
+!!  Contents : variables related to MPI-2 message passing
+!!  --------
+!!
+!! -- mpi_totproc: number of processors on which to launch each model
+!!
+!! -- mpi_nproc: number of processors involved in the coupling for
+!!               each model
+!! -- cmpi_modnam: models name
+!     -----------------------------------------------------------------
+
+      INTEGER*4 mpi_totproc(1:CLIM_MaxMod-1),mpi_nproc(0:CLIM_MaxMod-1)
+
+      CHARACTER*6 cmpi_modnam(1:CLIM_MaxMod-1)
+
+!!!END-----------------------------------------------------------------
+
+
+   !!----------------------------------------------------------------------
+   !!  Atmosphere/Ice/Ocean Coupling
+   !!---------------------------------
+
+   REAL(wp), DIMENSION(jpi,jpj) ::   &   !: data from an atmospheric model
+      qc  ,       &  !: total surf. total heat flux (wm-2)
+      ec  ,       &  !: surface water flux (kg m-2s-1)
+      qsrc           !: solar radiation (w m-2)
+
+#  if defined key_ice_lim
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      watm        ,    &  !:
+      tatm        ,    &  !:
+      hatm        ,    &  !:
+      vatm        ,    &  !:
+      catm                !:
+#  endif
+
+   !! Coupling
+
+   INTEGER ::
+      npioc       ,    &  ! process-id of ocean PROGRAM
+      nexco       ,    &  ! exchange frequency for fluxes
+      nmodcpl     ,    &  ! coupling mode
+      nflxc2o     ,    &  ! fluxes field number coupler to ocean
+      ntauc2o     ,    &  ! stress field number coupler to ocean
+      nfldo2c             ! surface field number ocean to coupler
+   INTEGER ::
+      numlhf = 31 ,    &  ! unit to transfer fluxes
+      numlws = 32 ,    &  ! unit to transfer stress
+      numlts = 34 ,    &  ! unit to transfer sst
+      numlic = 35         ! unit to transfer ice cover
+
+   CHARACTER(len=4) ::   cchan       ! type of message passing (pipe or clim) 
+   CHARACTER(len=6) ::   cplmodnam   ! model name
+   CHARACTER(len=5) ::   cploasis    ! coupler name
+
+   CHARACTER(len=8), DIMENSION(jpmaxfld) ::   
+      cpl_f_readflx,   &  ! coupler to ocean file name for flx.coupled
+      cpl_f_readtau,   &  ! coupler to ocean file name for tau.coupled
+      cpl_f_writ   ,   &  ! ocean to coupler file name for stp_cmo
+      cpl_readflx  ,   &  ! coupler to ocean field name for flx.coupled
+      cpl_readtau  ,   &  ! coupler to ocean field name for tau.coupled
+      cpl_writ            ! ocean to coupler field name for stp_cmo
+
+  REAL(wp), DIMENSION(jpi,jpj) ::   &
+      sstoc,     &  ! work array to average sst
+      sieoc,     &  ! work array to average Ice index
+      alboc,     &  ! work array to average Ice Albedo
+      ticoc         ! work array to average Ice temperature
+
+
+   !! -- inc_sipc.h   97-08-11   Version 2.0   Author: S&A
+   !!    **********
+   !! variables describing pools formed of shared memory segments 
+
+   INTEGER ::   &
+      mpoolinitr,  &  ! handles associated to model pools for passing
+      mpoolinitw      ! initial info (r=read, w=write)
+
+   INTEGER, DIMENSION(jpmaxfld) ::
+      mpoolwrit,   &  ! handles associated to pools used to pass fields
+      !               ! exchanged from model to coupler 
+      !               ! (see libsipc/SIPC_Write_Model.f)
+      mpoolread       ! handles associated to pools used to pass fields
+      !               ! exchanged from model to coupler
+      !               ! (see libsipc/SIPC_Read_Model.f)
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case                                Forced Ocean/Atmosphere
+   !!----------------------------------------------------------------------
+   !!   Empty module
+   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE.
+#endif
+   !!----------------------------------------------------------------------
+END MODULE cpl_oce
Index: /branches/nemo/NEMO/OPA_SRC/ctlopn.f90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ctlopn.f90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ctlopn.f90	(revision 4)
@@ -0,0 +1,151 @@
+   SUBROUTINE ctlopn ( knum, cdfile, cdstat, cdform, cdacce,   &
+                       klengh, kout, ldwp, krequ )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ctlopn  ***
+      !!
+      !! ** Purpose :   Open file and check if required file is available.
+      !!
+      !! ** Method  :   Fortan open
+      !!
+      !! History :
+      !!        !  95-12  (G. Madec)  Original code
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      IMPLICIT NONE
+
+      INTEGER, INTENT( in ) ::   &
+         knum,     & ! logical unit to open
+         krequ,    & ! =1 file required (stop if not exist)
+         !           ! =0 file not required (create the file if does not exist)
+         kout,     & ! number of logical units for write
+         klengh      ! record length
+
+      INTEGER ::   iost
+      CHARACTER (len=* ), INTENT( in ) ::   &
+         cdacce,   & ! access specifier
+         cdform,   & ! formatting specifier
+         cdstat      ! disposition specifier
+      CHARACTER (len=* ), INTENT( in ) ::   &
+         cdfile      ! file name to open
+
+      LOGICAL ::  ldwp   ! boolean term for print
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+
+      ! 1. Required file
+      ! ----------------
+
+      IF( krequ == 1 ) THEN
+
+         iost=0
+         IF( cdacce(1:6) == 'DIRECT' )  THEN
+            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
+               STATUS=cdstat, RECL=klengh, ERR=100, IOSTAT=iost )
+         ELSE
+            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
+               STATUS=cdstat, ERR=100, IOSTAT=iost)
+         ENDIF
+         IF( iost == 0 ) THEN
+            IF(ldwp) THEN
+               WRITE(kout,*) '     file   : ', cdfile,' open ok'
+               WRITE(kout,*) '     unit   = ', knum
+               WRITE(kout,*) '     status = ', cdstat
+               WRITE(kout,*) '     form   = ', cdform
+               WRITE(kout,*) '     access = ', cdacce
+               WRITE(kout,*)
+            ENDIF
+         ENDIF
+100      CONTINUE
+         IF( iost /= 0 ) THEN
+            IF(ldwp) THEN
+               WRITE(kout,*)
+               WRITE(kout,*) ' ===>>>> : bad opening file: ', cdfile
+               WRITE(kout,*) ' =======   ===  '
+               WRITE(kout,*) '           unit   = ', knum
+               WRITE(kout,*) '           status = ', cdstat
+               WRITE(kout,*) '           form   = ', cdform
+               WRITE(kout,*) '           access = ', cdacce
+               WRITE(kout,*) '           iostat = ', iost
+               WRITE(kout,*) '           we stop. verify the file '
+               WRITE(kout,*)
+            ENDIF
+            STOP 'ctlopn bad opening'
+         ENDIF
+         
+         
+         ! 2. Not required, file create if not exist
+         ! -----------------------------------------
+         
+      ELSEIF( krequ == 0 ) THEN
+
+         iost = 0
+         IF( cdacce(1:6) == 'DIRECT' ) THEN
+            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
+               STATUS=cdstat, RECL=klengh, ERR=200, IOSTAT=iost )
+         ELSE
+            OPEN( UNIT=knum, FILE=cdfile, FORM=cdform, ACCESS=cdacce,   &
+               STATUS=cdstat, ERR=200, IOSTAT=iost )
+         ENDIF
+         IF(iost == 0) THEN
+            IF(ldwp) THEN
+               WRITE(kout,*) '     file   : ', cdfile,' open ok'
+               WRITE(kout,*) '     unit   = ', knum
+               WRITE(kout,*) '     status = ', cdstat
+               WRITE(kout,*) '     form   = ', cdform
+               WRITE(kout,*) '     access = ', cdacce
+               WRITE(kout,*)
+            ENDIF
+         ENDIF
+200      CONTINUE
+         IF( iost /= 0 ) THEN
+            iost = 0
+            IF(ldwp) THEN
+               WRITE(kout,*)
+               WRITE(kout,*) '     ===>>>> : file ', cdfile,   &
+                  ' does not exist: it is created'
+               WRITE(kout,*) ' =======   ===  '
+            ENDIF
+            IF( cdacce(1:6) == 'DIRECT' ) THEN
+               OPEN( UNIT=knum, FILE=cdfile, FORM=cdform,   &
+                  ACCESS=cdacce, STATUS=cdstat,   &
+                  RECL=klengh, ERR=210, IOSTAT=iost )
+            ELSE
+               OPEN( UNIT=knum, FILE=cdfile, FORM=cdform,   &
+                  ACCESS=cdacce, STATUS=cdstat, ERR=210,   &
+                  IOSTAT=iost )
+            ENDIF
+            IF(ldwp) THEN
+               WRITE(kout,*) '     file   : ', cdfile,' open ok'
+               WRITE(kout,*) '     unit   = ', knum
+               WRITE(kout,*) '     status = ', cdstat
+               WRITE(kout,*) '     form   = ', cdform
+               WRITE(kout,*) '     access = ', cdacce
+               WRITE(kout,*)
+            ENDIF
+210         CONTINUE
+            IF( iost /= 0 ) THEN
+               IF(ldwp) THEN
+                  WRITE(kout,*) ' logical unit ',knum,' iostat = ', iost
+                  WRITE(kout,*) ' we stop. verify the file ', cdfile
+                  WRITE(kout,*)
+               ENDIF
+               STOP '001'
+            ENDIF
+         ENDIF
+         
+      ELSE
+         
+         IF(ldwp) THEN
+            WRITE(kout,*)
+            WRITE(kout,*) ' ctlopn : invalid option, krequ = ', krequ
+            WRITE(kout,*) ' ~~~~~~   call for file ', cdfile
+            WRITE(kout,*)
+         ENDIF
+
+
+         STOP 'ctlopn invalid option'
+      ENDIF
+      
+   END SUBROUTINE ctlopn
Index: /branches/nemo/NEMO/OPA_SRC/daymod.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/daymod.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/daymod.F90	(revision 4)
@@ -0,0 +1,161 @@
+MODULE daymod
+   !!======================================================================
+   !!                       ***  MODULE  daymod  ***
+   !! Ocean        :  calendar 
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   day        : calendar
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC day        ! called by step.F90
+
+   !! * Shared module variables
+   INTEGER, PUBLIC ::         &
+      nyear   ,               &  ! current year
+      nmonth  ,               &  ! current month
+      nday    ,               &  ! current day of the month
+      nday_year ,             &  ! curent day counted from jan 1st of the current year
+      ndastp                     ! time step date in year/month/day aammjj
+
+    REAL(wp), PUBLIC ::     &
+          adatrj ,          &   ! (non integer) number of elapsed days since the begining of the experiment
+          adatrj0               !  value of adatrj at nit000-1 (before the present run).
+                                ! it is the accumulated duration of previous runs
+                                ! that may have been run with different time steps.
+
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE day ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE day  ***
+      !! 
+      !! ** Purpose :   Compute the date with a day iteration IF necessary.
+      !!
+      !! ** Method  : - ???
+      !!
+      !! ** Action  : - nyear     : current year
+      !!              - nmonth    : current month of the year nyear
+      !!              - nday      : current day of the month nmonth
+      !!              - nday_year : current day of the year nyear
+      !!              - ndastp    : =nyear*10000+nmonth*100+nday
+      !!              - adatrj    : date in days since the beginning
+      !!                            of the experiment
+      !!
+      !! History :
+      !!        !  94-09  (M. Pontaud M. Imbard)  Original code
+      !!        !  97-03  (O. Marti)
+      !!        !  97-05  (G. Madec) 
+      !!        !  97-08  (M. Imbard)
+      !!   9.0  !  03-09  (G. Madec)  F90 + nyear, nmonth, nday
+      !!        !  04-01  (A.M. Treguier) new calculation based on adatrj
+      !!----------------------------------------------------------------------      
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step indices
+
+      !! * Local declarations
+      INTEGER  ::   js                   ! dummy loop indice
+      INTEGER  ::   iend, iday0, iday1   ! temporary integers
+      REAL(wp) :: zadatrjn, zadatrjb     ! adatrj at timestep kt-1 and kt-2 
+      !!----------------------------------------------------------------------
+      !!  OPA 9, LODYC-IPSL (2004)
+      !!----------------------------------------------------------------------
+
+      ! 0.  initialization of adatrj0 and nday, nmonth,nyear, nday_year.
+      !     ndastp has been initialized in domain.F90 or restart.F90
+      !-----------------------------------------------------------------
+
+      IF (  kt == nit000 ) THEN
+
+         IF ( .NOT.ln_rstart )   adatrj0 = 0.e0      ! adatrj0 initialized in rst_read when restart 
+
+         adatrj  = adatrj0
+         nyear   =   ndastp / 10000
+         nmonth  = ( ndastp - (nyear * 10000) ) / 100
+         nday    =   ndastp - (nyear * 10000) - ( nmonth * 100 ) 
+
+         ! Calculates nday_year, day since january 1st (useful to read  daily forcing fields)
+         nday_year =  nday
+         !                               ! accumulates days of previous months of this year
+         DO js = 1, nmonth-1
+            IF( MOD( nyear, 4 ) == 0 ) THEN
+               nday_year = nday_year + nbiss(js)
+            ELSE
+               nday_year = nday_year + nobis(js)
+            ENDIF
+         END DO
+
+      ENDIF
+
+      ! I.  calculates adatrj, zadatrjn, zadatrjb.
+      ! ------------------------------------------------------------------
+
+      adatrj    = adatrj0 + ( kt - nit000 + 1 ) * rdttra(1) / rday
+      zadatrjn  = adatrj0 + ( kt - nit000     ) * rdttra(1) / rday
+      zadatrjb  = adatrj0 + ( kt - nit000 - 1 ) * rdttra(1) / rday
+
+
+      ! II.  increment the date.  The date corresponds to 'now' variables (kt-1),
+      !      which is the time step of forcing fields. 
+      !      Do not do this at nit000  unless nrstdt= 2
+      !      In that case ndastp (read in restart) was for step nit000-2
+      ! -------------------------------------------------------------------
+
+      iday0 = INT( zadatrjb )
+      iday1 = INT( zadatrjn )
+
+      if ( iday1 - iday0 >= 1 .AND. ( kt /= nit000 .OR. nrstdt == 2 ) ) THEN
+
+         ! increase calendar
+         nyear  =   ndastp / 10000
+         nmonth = ( ndastp - (nyear * 10000) ) / 100
+         nday   =   ndastp - (nyear * 10000) - ( nmonth * 100 ) 
+         nday = nday + 1
+         IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN
+            iend = nbiss(nmonth)
+         ELSEIF( nleapy > 1 ) THEN 
+            iend = nleapy
+         ELSE 
+            iend = nobis(nmonth)
+         ENDIF
+         IF( nday == iend + 1 ) THEN
+            nday  = 1
+            nmonth = nmonth + 1
+            IF( nmonth == 13 ) THEN
+               nmonth  = 1
+               nyear = nyear + 1
+            ENDIF
+         ENDIF
+         ndastp = nyear * 10000 + nmonth * 100 + nday
+
+         ! Calculates nday_year, day since january 1st (useful to read  daily forcing fields)
+         nday_year =  nday
+         !                                ! accumulates days of previous months of this year
+         DO js = 1, nmonth-1
+            IF( MOD( nyear, 4 ) == 0 ) THEN
+               nday_year = nday_year + nbiss(js)
+            ELSE
+               nday_year = nday_year + nobis(js)
+            ENDIF
+         END DO
+
+         IF(lwp) WRITE(numout,*)' ==============>> time-step =', kt, ' New day, DATE= ',   &
+            &                   nyear, '/', nmonth, '/', nday, 'nday_year:', nday_year
+      ENDIF
+
+      IF(l_ctl) WRITE(numout,*)' kt =', kt, 'd/m/y =', nday, nmonth, nyear
+
+   END SUBROUTINE day
+
+   !!======================================================================
+END MODULE daymod
Index: /branches/nemo/NEMO/OPA_SRC/eosbn2.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/eosbn2.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/eosbn2.F90	(revision 4)
@@ -0,0 +1,832 @@
+MODULE eosbn2
+   !!==============================================================================
+   !!                       ***  MODULE  eosbn2  ***
+   !! Ocean diagnostic variable : equation of state - in situ and potential density
+   !!                                               - Brunt-Vaisala frequency 
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   eos            : generic interface of the equation of state
+   !!   eos_insitu     : Compute the in situ density
+   !!   eos_insitu_pot : Compute the insitu and surface referenced potential
+   !!                    volumic mass
+   !!   eos_insitu_2d  : Compute the in situ density for 2d fields
+   !!   eos_bn2        : Compute the Brunt-Vaisala frequency
+   !!   eos_init       : set eos parameters (namelist)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE zdfddm          ! vertical physics: double diffusion
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Interface 
+   INTERFACE eos
+      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d
+   END INTERFACE 
+   INTERFACE bn2
+      MODULE PROCEDURE eos_bn2
+   END INTERFACE 
+
+   !! * Routine accessibility
+   PUBLIC eos        ! called by step.F90, inidtr.F90, tranpc.F90 and intgrd.F90
+   PUBLIC bn2        ! called by step.F90
+
+   !! * Share module variables
+   INTEGER, PUBLIC ::   & !!! nameos : ocean physical parameters
+      neos     ,        &  ! = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
+      neos_init = 0        ! control flag for initialization
+
+   REAL(wp), PUBLIC ::   & !!! nameos : ocean physical parameters
+      ralpha,            &  ! thermal expension coeff. (linear equation of state)
+      rbeta                 ! saline  expension coeff. (linear equation of state)
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE eos_insitu ( ptem, psal, prd )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE eos_insitu  ***
+      !! 
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from 
+      !!       potential temperature and salinity using an equation of state
+      !!       defined through the namelist parameter neos.
+      !!
+      !! ** Method  :   3 cases:
+      !!      neos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!      neos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = 0.0285 - ralpha * t
+      !!      neos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = rbeta * s - ralpha * tn - 1.
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as (ptem,psal) are defined over the whole domain.
+      !!
+      !! ** Action  :   compute prd , the in situ density (no units)
+      !!
+      !! References :
+      !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994
+      !!
+      !! History :
+      !!        !  89-03 (o. Marti)  Original code
+      !!        ! 94-08 (G. Madec)
+      !!        !  96-01 (G. Madec) statement function for e3
+      !!        !  97-07 (G. Madec) introduction of neos, OPA8.1
+      !!        !  97-07 (G. Madec) density instead of volumic mass
+      !!        !  99-02 (G. Madec, N. Grima) semi-implicit pressure gradient
+      !!        !  01-09 (M. Ben Jelloul) bugfix   
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
+         ptem,                 &  ! potential temperature
+         psal                     ! salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   &
+         prd                      ! potential density (surface referenced)
+
+      !! * Local declarations
+      INTEGER ::  ji, jj, jk      ! dummy loop indices
+      REAL(wp) ::   &          
+         zt , zs , zh , zsr,   &  ! temporary scalars
+         zr1, zr2, zr3, zr4,   &  !    "         " 
+         zrhop, ze, zbw, zb,   &  !    "         "
+         zd , zc , zaw, za ,   &  !    "         "
+         zb1, za1, zkw, zk0       !    "         "
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+         zws                      ! temporary workspace
+      !!----------------------------------------------------------------------
+
+
+      ! initialization (in not already done)
+      IF( neos_init == 0 ) CALL eos_init
+
+
+      SELECT CASE ( neos )
+
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+
+!CDIR NOVERRCHK
+         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) )
+
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = ptem(ji,jj,jk)
+                  zs = psal(ji,jj,jk)
+                  ! depth
+                  zh = fsdept(ji,jj,jk)
+                  ! square root salinity
+                  zsr= zws(ji,jj,jk)
+                  ! compute volumic mass pure water at atm pressure
+                  zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   &
+                     -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
+                  ! seawater volumic mass atm pressure
+                  zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt   &
+                     -4.0899e-3 ) *zt+0.824493
+                  zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
+                  zr4= 4.8314e-4
+
+                  ! potential volumic mass (reference to the surface)
+                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+
+                  ! add the compression terms
+                  ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
+                  zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
+                  zb = zbw + ze * zs
+
+                  zd = -2.042967e-2
+                  zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
+                  zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
+                  za = ( zd*zsr + zc ) *zs + zaw
+
+                  zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
+                  za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
+                  zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
+                  zk0= ( zb1*zsr + za1 )*zs + zkw
+
+                  ! masked in situ density anomaly
+                  prd(ji,jj,jk) = (  zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                     - rau0 ) / rau0 * tmask(ji,jj,jk)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 1 )               ! Linear formulation function of temperature only
+
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = ptem(ji,jj,jk)
+                  zs = psal(ji,jj,jk)
+                  !   ... density and potential volumic mass
+                  prd(ji,jj,jk) = ( 0.0285 - ralpha * zt ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 2 )               ! Linear formulation function of temperature and salinity
+
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = ptem(ji,jj,jk)
+                  zs = psal(ji,jj,jk)
+                  !   ... density and potential volumic mass
+                  prd(ji,jj,jk) = (   rbeta  * zs - ralpha * zt - 1. ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+      CASE DEFAULT
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+
+      END SELECT
+
+   END SUBROUTINE eos_insitu
+
+
+   SUBROUTINE eos_insitu_pot ( ptem, psal, prd, prhop)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_insitu_pot  ***
+      !!           
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) and the
+      !!      potential volumic mass (Kg/m3) from potential temperature and
+      !!      salinity fields using an equation of state defined through the 
+      !!     namelist parameter neos.
+      !!
+      !! ** Method  :
+      !!      neos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!              rhop(t,s)  = rho(t,s,0)
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!
+      !!      neos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - ralpha * t
+      !!              rhop(t,s)  = rho(t,s)
+      !!
+      !!      neos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0 
+      !!                       = rbeta * s - ralpha * tn - 1.
+      !!              rhop(t,s)  = rho(t,s)
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as (tn,sn) or (ta,sa) are defined over the whole domain.
+      !!
+      !! ** Action  : - prd  , the in situ density (no units)
+      !!              - prhop, the potential volumic mass (Kg/m3)
+      !!
+      !! References :
+      !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994
+      !!      Brown, J. A. and K. A. Campana. Mon. Weather Rev., 1978
+      !!
+      !! History :
+      !!   4.0  !  89-03  (O. Marti)
+      !!        !  94-08  (G. Madec)
+      !!        !  96-01  (G. Madec) statement function for e3
+      !!        !  97-07  (G. Madec) introduction of neos, OPA8.1
+      !!        !  97-07  (G. Madec) density instead of volumic mass
+      !!        !  99-02  (G. Madec, N. Grima) semi-implicit pressure gradient
+      !!        !  01-09  (M. Ben Jelloul) bugfix   
+      !!   9.0  !  03-08  (G. Madec)  F90, free form
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
+         ptem,   &  ! potential temperature
+         psal       ! salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   &
+         prd,    &  ! potential density (surface referenced)
+         prhop      ! potential density (surface referenced)
+
+      !! * Local declarations
+      INTEGER  ::  ji, jj, jk                ! dummy loop indices
+      REAL(wp) ::   &             ! temporary scalars
+         zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw,   &
+         zb, zd, zc, zaw, za, zb1, za1, zkw, zk0
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zws
+      !!----------------------------------------------------------------------
+
+      ! initialization (in not already done)
+      IF( neos_init == 0 ) CALL eos_init
+
+
+      SELECT CASE ( neos )
+
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+
+!CDIR NOVERRCHK
+         zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) )
+
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = ptem(ji,jj,jk)
+                  zs = psal(ji,jj,jk)
+                  ! depth
+                  zh = fsdept(ji,jj,jk)
+                  ! square root salinity
+!!Edmee           zsr= SQRT( ABS( zs ) )
+                  zsr= zws(ji,jj,jk)
+                  ! compute volumic mass pure water at atm pressure
+                  zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   &
+                     -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
+                  ! seawater volumic mass atm pressure
+                  zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt   &
+                     -4.0899e-3 ) *zt+0.824493
+                  zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
+                  zr4= 4.8314e-4
+
+                  ! potential volumic mass (reference to the surface)
+                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+
+                  ! save potential volumic mass
+                  prhop(ji,jj,jk) = zrhop * tmask(ji,jj,jk)
+
+                  ! add the compression terms
+                  ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
+                  zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
+                  zb = zbw + ze * zs
+
+                  zd = -2.042967e-2
+                  zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
+                  zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
+                  za = ( zd*zsr + zc ) *zs + zaw
+
+                  zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
+                  za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
+                  zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
+                  zk0= ( zb1*zsr + za1 )*zs + zkw
+
+                  ! masked in situ density anomaly
+                  prd(ji,jj,jk) = (  zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                     - rau0 ) / rau0 * tmask(ji,jj,jk)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 1 )               ! Linear formulation function of temperature only
+
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = ptem(ji,jj,jk)
+                  zs = psal(ji,jj,jk)
+                  !   ... density and potential volumic mass
+                  prd(ji,jj,jk) = ( 0.0285 - ralpha * zt ) * tmask(ji,jj,jk)
+                  prhop(ji,jj,jk) = ( rau0 * prd(ji,jj,jk) + rau0 ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 2 )               ! Linear formulation function of temperature and salinity
+
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = ptem(ji,jj,jk)
+                  zs = psal(ji,jj,jk)
+                  !   ... density and potential volumic mass
+                  prd(ji,jj,jk) = (   rbeta  * zs - ralpha * zt - 1. ) * tmask(ji,jj,jk)
+                  prhop(ji,jj,jk) = ( rau0 * prd(ji,jj,jk) + rau0 ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+      CASE DEFAULT
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+
+      END SELECT
+
+   END SUBROUTINE eos_insitu_pot
+
+   SUBROUTINE eos_insitu_2d ( ptem, psal, pdep, prd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_insitu_2d  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from 
+      !!      potential temperature and salinity using an equation of state
+      !!      defined through the namelist parameter neos. * 2D field case
+      !!
+      !! ** Method :
+      !!      neos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!      neos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = 0.0285 - ralpha * t
+      !!      neos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = rbeta * s - ralpha * tn - 1.
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as (ptem,psal) are defined over the whole domain.
+      !!
+      !! ** Action  : - prd , the in situ density (no units)
+      !!
+      !! References :
+      !!      Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994
+      !!
+      !! History :
+      !!   8.5  !  02-11  (G. Madec, A. Bozec)  partial step
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( in ) ::   &
+         ptem,                           &  ! potential temperature
+         psal,                           &  ! salinity
+         pdep                               ! depth
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::   &
+         prd                                ! potential density (surface referenced)
+
+      !! * Local declarations
+      INTEGER ::  ji, jj                    ! dummy loop indices
+      REAL(wp) ::   &             ! temporary scalars
+         zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw,   &
+         zb, zd, zc, zaw, za, zb1, za1, zkw, zk0,               &
+         zmask
+      REAL(wp), DIMENSION(jpi,jpj) :: zws
+      !!----------------------------------------------------------------------
+
+
+      ! initialization (in not already done)
+      IF( neos_init == 0 ) CALL eos_init
+
+
+      SELECT CASE ( neos )
+
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+
+!CDIR NOVERRCHK
+         DO jj = 1, jpjm1
+!CDIR NOVERRCHK
+#if defined key_autotasking
+            DO ji = 1, jpim1
+#else
+            DO ji = 1, fs_jpim1   ! vector opt.
+#endif
+               zws(ji,jj) = SQRT( ABS( psal(ji,jj) ) )
+            END DO
+         END DO
+
+         !                                                ! ===============
+         DO jj = 1, jpjm1                                 ! Horizontal slab
+            !                                             ! ===============
+#if defined key_autotasking
+            DO ji = 1, jpim1
+#else
+            DO ji = 1, fs_jpim1   ! vector opt.
+#endif
+
+               zmask = tmask(ji,jj,1)      ! land/sea bottom mask = surf. mask
+
+               zt = ptem (ji,jj)            ! interpolated T
+               zs = psal (ji,jj)            ! interpolated S
+               zsr= zws(ji,jj)            ! square root of interpolated S
+               zh = pdep(ji,jj)            ! depth at the partial step level
+
+               ! compute volumic mass pure water at atm pressure
+               zr1 = ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   &
+                         -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
+               ! seawater volumic mass atm pressure
+               zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 )*zt+7.6438e-5 ) *zt   &
+                         -4.0899e-3 ) *zt+0.824493
+               zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
+               zr4= 4.8314e-4
+
+               ! potential volumic mass (reference to the surface)
+               zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+
+               ! add the compression terms
+               ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
+               zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
+               zb = zbw + ze * zs
+
+               zd = -2.042967e-2
+               zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
+               zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt -4.721788
+               za = ( zd*zsr + zc ) *zs + zaw
+
+               zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
+               za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
+               zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt   &
+                         +2098.925 ) *zt+190925.6
+               zk0= ( zb1*zsr + za1 )*zs + zkw
+
+               ! masked in situ density anomaly
+               prd(ji,jj) = ( zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 )   &
+                          / rau0 * zmask
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 1 )               ! Linear formulation function of temperature only
+
+         !                                                ! ===============
+         DO jj = 1, jpjm1                                 ! Horizontal slab
+            !                                             ! ===============
+#if defined key_autotasking
+            DO ji = 1, jpim1
+#else
+            DO ji = 1, fs_jpim1   ! vector opt.
+#endif
+               prd(ji,jj) = ( 0.0285 - ralpha * ptem(ji,jj) ) * tmask(ji,jj,1)
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 2 )               ! Linear formulation function of temperature and salinity
+
+         !                                                ! ===============
+         DO jj = 1, jpjm1                                 ! Horizontal slab
+            !                                             ! ===============
+#if defined key_autotasking
+            DO ji = 1, jpim1
+#else
+            DO ji = 1, fs_jpim1   ! vector opt.
+#endif
+               prd(ji,jj) = ( rbeta * psal(ji,jj) - ralpha * ptem(ji,jj) - 1. ) * tmask(ji,jj,1) 
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+      CASE DEFAULT
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+
+      END SELECT
+
+   END SUBROUTINE eos_insitu_2d
+
+
+   SUBROUTINE eos_bn2( ptem, psal, pn2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_bn2  ***
+      !!
+      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the time-
+      !!      step of the input arguments
+      !!      
+      !! ** Method :
+      !!       * neos = 0  : UNESCO sea water properties
+      !!         The brunt-vaisala frequency is computed using the polynomial
+      !!      polynomial expression of McDougall (1987):
+      !!            N^2 = g * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
+      !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is
+      !!      computed and used in zdfddm module :
+      !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] )
+      !!       * neos = 1  : linear equation of state (temperature only)
+      !!            N^2 = g * ralpha * dk[ t ]/e3w
+      !!       * neos = 2  : linear equation of state (temperature & salinity)
+      !!            N^2 = g * (ralpha * dk[ t ] - rbeta * dk[ s ] ) / e3w
+      !!      The use of potential density to compute N^2 introduces e r r o r
+      !!      in the sign of N^2 at great depths. We recommand the use of 
+      !!      neos = 0, except for academical studies.
+      !!        Macro-tasked on horizontal slab (jk-loop)
+      !!      N.B. N^2 is set to zero at the first level (JK=1) in inidtr
+      !!      and is never used at this level.
+      !!
+      !! ** Action  : - pn2 : the brunt-vaisala frequency
+      !!
+      !! References :
+      !!      McDougall, T. J., J. Phys. Oceanogr., 17, 1950-1964, 1987.
+      !!
+      !! History :
+      !!   6.0  !  94-07  (G. Madec, M. Imbard)  Original code
+      !!   8.0  !  97-07  (G. Madec) introduction of statement functions
+      !!   8.5  !  02-07  (G. Madec) Free form, F90
+      !!   8.5  !  02-08  (G. Madec) introduction of arguments
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   &
+         ptem,                           &  ! potential temperature
+         psal                               ! salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   &
+         pn2                               ! Brunt-Vaisala frequency
+
+      !! * Local declarations
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   &
+         zgde3w, zt, zs, zh,  &  ! temporary scalars 
+         zalbet, zbeta, zds      !    "         "
+      !!----------------------------------------------------------------------
+      !!  OPA8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      ! pn2 : first and last levels
+      ! ---------------------------
+      ! bn^2=0. at jk=1 and jpk set in inidtr.F : no computation
+
+
+      ! pn2 : interior points only (2=< jk =< jpkm1 )
+      ! -------------------------- 
+
+      SELECT CASE ( neos )
+
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+
+         !                                                ! ===============
+         DO jk = 2, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zgde3w = g/fse3w(ji,jj,jk)
+                  zt = 0.5*( ptem(ji,jj,jk) + ptem(ji,jj,jk-1) )          ! potential temperature at w-point
+                  zs = 0.5*( psal(ji,jj,jk) + psal(ji,jj,jk-1) ) - 35.0   ! salinity anomaly (s-35) at w-point
+                  zh = fsdepw(ji,jj,jk)                                   ! depth in meters  at w-point
+
+                  zalbet = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt   &   ! ratio alpha/beta
+                     &                               - 0.203814e-03 ) * zt   &
+                     &                               + 0.170907e-01 ) * zt   &
+                     &   + 0.665157e-01                                      &
+                     &   +     ( - 0.678662e-05 * zs                         &
+                     &           - 0.846960e-04 * zt + 0.378110e-02 ) * zs   &
+                     &   +   ( ( - 0.302285e-13 * zh                         &
+                     &           - 0.251520e-11 * zs                         &
+                     &           + 0.512857e-12 * zt * zt           ) * zh   &
+                     &           - 0.164759e-06 * zs                         &
+                     &        +(   0.791325e-08 * zt - 0.933746e-06 ) * zt   &
+                     &                               + 0.380374e-04 ) * zh
+
+                  zbeta  = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt      &   ! beta
+                     &                            - 0.301985e-05 ) * zt      &
+                     &   + 0.785567e-03                                      &
+                     &   + (     0.515032e-08 * zs                           &
+                     &         + 0.788212e-08 * zt - 0.356603e-06 ) * zs     &
+                     &   +(  (   0.121551e-17 * zh                           &
+                     &         - 0.602281e-15 * zs                           &
+                     &         - 0.175379e-14 * zt + 0.176621e-12 ) * zh     &
+                     &                             + 0.408195e-10   * zs     &
+                     &     + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt     &
+                     &                             - 0.121555e-07 ) * zh
+
+                  pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk)           &   ! N^2 
+                     &          * ( zalbet * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) )   &
+                     &                     - ( psal(ji,jj,jk-1) - psal(ji,jj,jk) ) )
+#if defined key_zdfddm
+                  !                                                         !!bug **** caution a traiter zds=dk[S]= 0 !!!!
+                  zds = ( psal(ji,jj,jk-1) - psal(ji,jj,jk) )                    ! Rrau = (alpha / beta) (dk[t] / dk[s])
+                  IF ( ABS( zds) <= 1.e-20 ) zds = 1.e-20
+                  rrau(ji,jj,jk) = zalbet * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) ) / zds
+#endif
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 1 )               ! Linear formulation function of temperature only
+
+         !                                                ! ===============
+         DO jk = 2, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zgde3w = g/fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                  pn2(ji,jj,jk) = zgde3w * ralpha * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) )
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+
+      CASE ( 2 )               ! Linear formulation function of temperature and salinity
+
+         !                                                ! ===============
+         DO jk = 2, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zgde3w = g/fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                  pn2(ji,jj,jk) = zgde3w * (  ralpha * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) )   &
+                     &                      - rbeta  * ( psal(ji,jj,jk-1) - psal(ji,jj,jk) )  )
+               END DO
+            END DO
+#if defined key_zdfddm
+            !                                                ! Rrau = (alpha / beta) (dk[t] / dk[s])
+            zalbet = ralpha / rbeta
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zds = ( psal(ji,jj,jk-1) - psal(ji,jj,jk) )
+                  IF ( ABS( zds ) <= 1.e-20 ) zds = 1.e-20
+                  rrau(ji,jj,jk) = zalbet * ( ptem(ji,jj,jk-1) - ptem(ji,jj,jk) ) / zds
+               END DO
+            END DO
+#endif
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+
+      CASE DEFAULT
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+
+      END SELECT
+
+   END SUBROUTINE eos_bn2
+
+
+   SUBROUTINE eos_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   initializations for the equation of state
+      !!
+      !! ** Method  :   Read the namelist nameos
+      !!
+      !! ** Action  :   blahblah....
+      !!
+      !! History :
+      !!   8.5  !  02-10  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      NAMELIST/nameos/ neos, ralpha, rbeta
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      ! set the initialization flag to 1
+      neos_init = 1           ! indicate that the initialization has been done
+
+      ! namelist nameos : ocean physical parameters
+
+      ! Default values
+      neos   =      0         ! flag of eos used
+      ralpha =     2.e-4_wp   ! thermal exp. coef. (linear eos)
+      rbeta  =     0.029_wp   ! haline  exp. coef. (linear eos)
+
+      ! Read Namelist nameos : equation of state
+      REWIND( numnam )
+      READ  ( numnam, nameos )
+
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'eos_init : equation of state'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '          Namelist nameos : set eos parameters'
+         WRITE(numout,*)
+         WRITE(numout,*) '             flag for eq. of state and N^2  neos   = ', neos
+         WRITE(numout,*) '             thermal exp. coef. (linear)    ralpha = ', ralpha
+         WRITE(numout,*) '             saline  exp. coef. (linear)    rbeta  = ', rbeta
+         WRITE(numout,*)
+      ENDIF
+
+      SELECT CASE ( neos )
+
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+
+         IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and'
+         IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency'
+
+      CASE ( 1 )               ! Linear formulation function of temperature only
+
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - ralpha * T )'
+         IF( lk_zdfddm ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          double diffusive mixing parameterization requires',   &
+                                             ' that T and S are used as state variables'
+            nstop = nstop + 1
+         ENDIF
+
+      CASE ( 2 )               ! Linear formulation function of temperature and salinity
+
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )'
+
+      CASE DEFAULT
+
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for neos = ', neos
+         nstop = nstop + 1
+
+      END SELECT
+
+   END SUBROUTINE eos_init
+
+   !!======================================================================
+END MODULE eosbn2  
Index: /branches/nemo/NEMO/OPA_SRC/geo2ocean.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/geo2ocean.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/geo2ocean.F90	(revision 4)
@@ -0,0 +1,441 @@
+MODULE geo2ocean
+   !!======================================================================
+   !!                     ***  MODULE  geo2ocean  ***
+   !! Ocean mesh    :  vertical mixing coefficient compute from the tke 
+   !!                 turbulent closure parameterization
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   repcmo      : 
+   !!   angle       :
+   !!   geo2oce     :
+   !!   repere      :   old routine suppress it ???
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! mesh and scale factors
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+
+   !! * Accessibility
+   PRIVATE
+   PUBLIC repcmo   ! routine called by ???.F90
+   PUBLIC geo2oce  ! routine called by ???.F90
+   PUBLIC repere   ! routine called by ???.F90
+
+   !! * Module variables
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      gsinu , gcosu ,   &  ! matrix element for change grid u (repcmo.F)
+      gsinv , gcosv ,   &  ! matrix element for change grid v (repcmo.F)
+      gsinus, gcosin      ! matrix element for change grid (repere.F)
+
+  !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1,   &
+                       px2 , py2 , kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE repcmo  ***
+      !!
+      !! ** Purpose :   Change vector componantes from a geographic grid to a
+      !!      stretched coordinates grid.
+      !!
+      !! ** Method  :   Initialization of arrays at the first call.
+      !!
+      !! ** Action  : - px2 : first componante (defined at u point)
+      !!              - py2 : second componante (defined at v point)
+      !!
+      !! History :
+      !!   7.0  !  07-96  (O. Marti)  Original code
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Arguments 
+      INTEGER,  INTENT( in ) ::   &
+         kt                ! ocean time-step
+      REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) ::   & 
+         pxu1, pyu1,     & ! geographic vector componantes at u-point
+         pxv1, pyv1        ! geographic vector componantes at v-point
+      REAL(wp), INTENT( out ), DIMENSION(jpi,jpj) ::   & 
+         px2,            & ! i-componante (defined at u-point)
+         py2               ! j-componante (defined at v-point)
+      !!----------------------------------------------------------------------
+
+
+      ! Initialization of gsin* and gcos* at first call
+      ! -----------------------------------------------
+
+      IF( kt <= nit000 + 1 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'repcmo : use the geographic to stretched'
+         IF(lwp) WRITE(numout,*) ' ~~~~~   coordinate transformation'
+
+         CALL angle       ! initialization of the transformation
+      ENDIF
+      
+      ! Change from geographic to stretched coordinate
+      ! ----------------------------------------------
+      
+      px2(:,:) = pxu1(:,:) * gcosu(:,:) + pyu1(:,:) * gsinu(:,:)
+      py2(:,:) = pyv1(:,:) * gcosv(:,:) - pxv1(:,:) * gsinv(:,:)   
+      
+   END SUBROUTINE repcmo
+
+
+   SUBROUTINE angle
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE angle  ***
+      !! 
+      !! ** Purpose :   Compute angles between model grid lines and the 
+      !!      direction of the North
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  :   Compute (gsinu, gcosu, gsinv, gcosv) arrays: sinus and 
+      !!      cosinus of the angle between the north-south axe and the 
+      !!      j-direction at u and v-points
+      !!
+      !! History :
+      !!   7.0  !  96-07  (O. Marti)  Original code
+      !!   8.0  !  98-06  (G. Madec)
+      !!   8.5  !  98-06  (G. Madec)  Free form, F90 + opt.
+      !!----------------------------------------------------------------------
+      !! * local declarations
+      INTEGER ::   ji, jj      ! dummy loop indices
+
+      REAL(wp) ::   &
+         zlam, zphi,             &  ! temporary scalars
+         zlan, zphh,             &  !    "         "
+         zxnpu, zxnpv , znnpu,   &  !    "         "
+         zynpu, zynpv , znnpv,   &  !    "         "
+         zxffu, zmnpfu, zxffv,   &  !    "         "
+         zyffu, zmnpfv, zyffv       !    "         "
+      !!----------------------------------------------------------------------
+
+      ! ============================= !
+      ! Compute the cosinus and sinus !
+      ! ============================= !
+      ! (computation done on the north stereographic polar plane)
+
+      DO jj = 2, jpj
+!CDIR NOVERRCHK
+         DO ji = fs_2, jpi   ! vector opt.
+
+            ! north pole direction & modulous (at u-point)
+            zlam = glamu(ji,jj)
+            zphi = gphiu(ji,jj)
+            zxnpu = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+            zynpu = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+            znnpu = zxnpu*zxnpu + zynpu*zynpu
+
+            ! north pole direction & modulous (at v-point)
+            zlam = glamv(ji,jj)
+            zphi = gphiv(ji,jj)
+            zxnpv = 0. - 2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+            zynpv = 0. - 2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )
+            znnpv = zxnpv*zxnpv + zynpv*zynpv
+
+            ! j-direction: f-point segment direction (u-point)
+            zlam = glamf(ji,jj  )
+            zphi = gphif(ji,jj  )
+            zlan = glamf(ji,jj-1)
+            zphh = gphif(ji,jj-1)
+            zxffu =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+               &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+            zyffu =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+               &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+            zmnpfu = SQRT ( znnpu * ( zxffu*zxffu + zyffu*zyffu )  )
+            zmnpfu = MAX( zmnpfu, 1.e-14 )
+
+            ! i-direction: f-point segment direction (v-point)
+            zlam = glamf(ji  ,jj)
+            zphi = gphif(ji  ,jj)
+            zlan = glamf(ji-1,jj)
+            zphh = gphif(ji-1,jj)
+            zxffv =  2. * COS( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+               &  -  2. * COS( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+            zyffv =  2. * SIN( rad*zlam ) * TAN( rpi/4. - rad*zphi/2. )   &
+               &  -  2. * SIN( rad*zlan ) * TAN( rpi/4. - rad*zphh/2. )
+            zmnpfv = SQRT ( znnpv * ( zxffv*zxffv + zyffv*zyffv )  )
+            zmnpfv = MAX( zmnpfv, 1.e-14 )
+
+            ! cosinus and sinus using scalar and vectorial products
+            gsinu(ji,jj) = ( zxnpu*zyffu - zynpu*zxffu ) / zmnpfu
+            gcosu(ji,jj) = ( zxnpu*zxffu + zynpu*zyffu ) / zmnpfu
+
+            ! cosinus and sinus using scalar and vectorial products
+            ! (caution, rotation of 90 degres)
+            gsinv(ji,jj) = ( zxnpv*zxffv + zynpv*zyffv ) / zmnpfv
+            gcosv(ji,jj) =-( zxnpv*zyffv - zynpv*zxffv ) / zmnpfv
+
+         END DO
+      END DO
+
+      ! =============== !
+      ! Geographic mesh !
+      ! =============== !
+
+      DO jj = 2, jpj
+         DO ji = fs_2, jpi   ! vector opt.
+            IF( ABS( glamf(ji,jj) - glamf(ji,jj-1) ) < 1.e-8 ) THEN
+               gsinu(ji,jj) = 0.
+               gcosu(ji,jj) = 1.
+            ENDIF
+            IF( ABS( gphif(ji,jj) - gphif(ji-1,jj) ) < 1.e-8 ) THEN
+               gsinv(ji,jj) = 0.
+               gcosv(ji,jj) = 1.
+            ENDIF
+         END DO
+      END DO
+
+      ! =========================== !
+      ! Lateral boundary conditions !
+      ! =========================== !
+
+      ! lateral boundary cond.: U-, V-pts, sgn
+      CALL lbc_lnk ( gsinu, 'U', -1. )   ;   CALL lbc_lnk( gsinv, 'V', -1. )
+      CALL lbc_lnk ( gcosu, 'U', -1. )   ;   CALL lbc_lnk( gcosv, 'V', -1. )
+
+   END SUBROUTINE angle
+
+
+   SUBROUTINE geo2oce ( pxx , pyy , pzz, cgrid,     &
+                        plon, plat, pte, ptn  , ptv )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE geo2oce  ***
+      !!      
+      !! ** Purpose :
+      !!
+      !! ** Method  :   Change wind stress from geocentric to east/north
+      !!
+      !! History :
+      !!        !         (O. Marti)  Original code
+      !!        !  91-03  (G. Madec)
+      !!        !  92-07  (M. Imbard)
+      !!        !  99-11  (M. Imbard) NetCDF format with IOIPSL
+      !!        !  00-08  (D. Ludicone) Reduced section at Bab el Mandeb
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) ::   &
+         pxx, pyy, pzz
+      CHARACTER (len=1), INTENT( in) ::   &
+         cgrid
+      REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) ::   &
+         plon, plat
+      REAL(wp), INTENT(out), DIMENSION(jpi,jpj) ::    &
+         pte, ptn, ptv
+      REAL(wp), PARAMETER :: rpi = 3.141592653E0
+      REAL(wp), PARAMETER :: rad = rpi / 180.0E0
+
+      !! * Local variables
+      INTEGER ::   ig     !
+
+      !! * Local save
+      REAL(wp), SAVE, DIMENSION(jpi,jpj,4) ::   &
+         zsinlon, zcoslon,   &
+         zsinlat, zcoslat
+      LOGICAL, SAVE, DIMENSION (4) ::   &
+         linit = .FALSE.
+      !!----------------------------------------------------------------------
+
+      SELECT CASE( cgrid)
+
+         CASE ( 't' ) ;; ig = 1
+         CASE ( 'u' ) ;; ig = 2
+         CASE ( 'v' ) ;; ig = 3
+         CASE ( 'f' ) ;; ig = 4
+
+         CASE default
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) 'geo2oce : bad grid argument : ', cgrid
+            nstop = nstop + 1
+       END SELECT
+      
+      IF( .NOT. linit(ig) ) THEN 
+         zsinlon (:,:,ig) = SIN (rad * plon)
+         zcoslon (:,:,ig) = COS (rad * plon)
+         zsinlat (:,:,ig) = SIN (rad * plat)
+         zcoslat (:,:,ig) = COS (rad * plat)
+         linit (ig) = .TRUE.
+      ENDIF
+      
+      pte = - zsinlon (:,:,ig) * pxx + zcoslon (:,:,ig) * pyy
+      ptn = - zcoslon (:,:,ig) * zsinlat (:,:,ig) * pxx    &
+            - zsinlon (:,:,ig) * zsinlat (:,:,ig) * pyy    &
+            + zcoslat (:,:,ig) * pzz
+      ptv =   zcoslon (:,:,ig) * zcoslat (:,:,ig) * pxx    &
+            + zsinlon (:,:,ig) * zcoslat (:,:,ig) * pyy    &
+            + zsinlat (:,:,ig) * pzz
+
+   END SUBROUTINE geo2oce
+
+
+   SUBROUTINE repere ( px1, py1, px2, py2, kchoix )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE repere  ***
+      !!        
+      !! ** Purpose :   Change vector componantes between a geopgraphic grid 
+      !!      and a stretched coordinates grid.
+      !!
+      !! ** Method  :   initialization of arrays at the first call.
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        !  89-03  (O. Marti)  original code
+      !!        !  92-02  (M. Imbard)
+      !!        !  93-03  (M. Guyon)  symetrical conditions
+      !!        !  98-05  (B. Blanke)
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(wp), INTENT( in   ), DIMENSION(jpi,jpj) ::   &
+         px1, py1          ! two horizontal components to be rotated
+      REAL(wp), INTENT( out  ), DIMENSION(jpi,jpj) ::   &
+         px2, py2          ! the two horizontal components in the model repere
+      INTEGER, INTENT( inout ) ::   &
+         kchoix   ! type of transformation
+                  ! = 1 change from geographic to model grid.
+                  ! =-1 change from model to geographic grid
+                  ! = 0 same as the previous call
+      !! * Local declarations
+      INTEGER, SAVE :: nmem
+
+      INTEGER ::   ji, jj                    ! dummy loop indices
+
+      REAL(wp) :: zxx, zcof1, zcof2,    &
+         ze1t, ze2t
+      REAL(wp), DIMENSION(jpi,jpj) ::   &
+         zlamdu, zphiu,   &
+         zlamdv, zphiv
+      !!----------------------------------------------------------------------
+
+
+      ! 0. Initialization of gsinus and gcosin IF first call
+      ! ----------------------------------------------------
+      
+      ! 0.1 control argument
+      
+      IF( kchoix == 0 ) THEN
+         IF( nmem == 0 ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) 'repere : e r r o r  in kchoix : ', kchoix
+            IF(lwp) WRITE(numout,*) ' for the first call , you must indicate '
+            IF(lwp) WRITE(numout,*) ' the direction of change '
+            IF(lwp) WRITE(numout,*) ' kchoix = 1 geo       --> stretched '
+            IF(lwp) WRITE(numout,*) ' kchoix =-1 stretched --> geo '
+            nstop = nstop + 1
+         ELSE
+            kchoix = nmem
+         ENDIF
+      ELSEIF( kchoix == 1 .OR. kchoix == -1 ) THEN
+         nmem = kchoix
+      ELSE
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) 'repere : e r r o r  in kchoix : ', kchoix
+         IF(lwp) WRITE(numout,*) ' kchoix must be equal to -1, 0 or 1 '
+         nstop = nstop + 1
+      ENDIF
+
+      ! 0.2 Initialization
+
+      zxx = gsinus(jpi/2,jpj/2)**2+gcosin(jpi/2,jpj/2)**2
+      IF( zxx <= 0.1 ) THEN
+         IF(lwp) WRITE(numout,*) 'repere : initialization '
+         DO jj = 1, jpj
+            DO ji = 2, jpi
+               zlamdu(ji,jj) = glamu(ji,jj) - glamu(ji-1,jj)
+               zlamdu(ji,jj) = ASIN( SIN( rad*zlamdu(ji,jj) ) )/rad
+               zphiu (ji,jj) = gphiu(ji,jj) - gphiu(ji-1,jj)
+            END DO
+         END DO
+         DO jj = 2, jpj
+            zlamdv(:,jj) = glamv(:,jj)-glamv(:,jj-1)
+            zlamdv(:,jj) = ASIN(SIN(rad*zlamdv(:,jj)))/rad
+            zphiv (:,jj) = gphiv(:,jj)-gphiv(:,jj-1)
+         END DO
+         
+         ! 0.3 Boudary conditions and periodicity
+         
+         IF( nperio == 1 .OR.nperio == 4.OR.nperio == 6 ) THEN
+            DO jj = 1, jpj
+               zlamdu(1,jj) = zlamdu(jpim1,jj)
+               zphiu (1,jj) = zphiu (jpim1,jj)
+            END DO
+         ELSE
+            DO jj = 1, jpj
+               zlamdu(1,jj) = zlamdu(2,jj)
+               zphiu (1,jj) = zphiu (2,jj)
+            END DO
+         ENDIF
+         
+         DO ji = 1, jpi
+            zlamdv(ji,1) = zlamdv(ji,2)
+            zphiv (ji,1) = zphiv (ji,2)
+         END DO
+         
+         IF( nperio == 2 ) THEN
+            DO ji = 1, jpi
+               zphiv (ji,1) = zphiv (ji,3)
+            END DO
+         ENDIF
+         
+         ! 0.4 gsinus gcosin
+         
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               zcof1 = rad * ra * COS( rad * gphit(ji,jj) )
+               zcof2 = rad * ra
+               zlamdu(ji,jj) = zlamdu(ji,jj) * zcof1
+               zlamdv(ji,jj) = zlamdv(ji,jj) * zcof1
+               zphiu (ji,jj) = zphiu (ji,jj) * zcof2
+               zphiv (ji,jj) = zphiv (ji,jj) * zcof2
+            END DO
+         END DO
+
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               ze1t = SQRT( zlamdu(ji,jj)*zlamdu(ji,jj) + zphiu(ji,jj)*zphiu(ji,jj) )
+               ze2t = SQRT( zlamdv(ji,jj)*zlamdv(ji,jj) + zphiv(ji,jj)*zphiv(ji,jj) )
+               gsinus(ji,jj) = 0.5*( zphiu(ji,jj)/ze1t - zlamdv(ji,jj)/ze2t )
+               gcosin(ji,jj) = 0.5*( zphiv(ji,jj)/ze2t + zlamdu(ji,jj)/ze1t )
+            END DO
+         END DO
+         CALL lbc_lnk( gsinus, 'T', -1. )
+         CALL lbc_lnk( gcosin, 'T', -1. )
+         
+      ENDIF
+
+
+      ! 1. Change from geographic to tretched
+      ! -------------------------------------
+      
+      IF( kchoix == 1 ) THEN
+          px2(:,:) =  px1(:,:) * gcosin(:,:) + py1(:,:) * gsinus(:,:)
+          py2(:,:) = -px1(:,:) * gsinus(:,:) + py1(:,:) * gcosin(:,:)
+      ENDIF
+      
+
+      ! 2. Change from tretched to geographic
+      ! -------------------------------------
+      
+      IF( kchoix == -1 ) THEN
+          px2(:,:) =  px1(:,:) * gcosin(:,:) - py1(:,:) * gsinus(:,:)
+          py2(:,:) =  px1(:,:) * gsinus(:,:) + py1(:,:) * gcosin(:,:)
+      ENDIF
+      
+   END SUBROUTINE repere
+
+  !!======================================================================
+END MODULE geo2ocean
Index: /branches/nemo/NEMO/OPA_SRC/ice_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ice_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ice_oce.F90	(revision 4)
@@ -0,0 +1,70 @@
+MODULE ice_oce
+   !!======================================================================
+   !!                 ***  MODULE  ice_oce  ***
+   !! Ocean - ice  :  ice variables defined in memory 
+   !!======================================================================
+   !! History :
+   !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LODYC-IPSL   (2003)
+   !!----------------------------------------------------------------------
+#if defined key_ice_lim
+   !!----------------------------------------------------------------------
+   !!   'key_ice_lim'   :                                     LIM ice model
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce         ! ocean parameters
+   USE blk_oce         ! bulk parameters
+
+
+   IMPLICIT NONE
+ 
+   !! Shared module variables
+   LOGICAL, PUBLIC, PARAMETER ::   lk_ice_lim = .TRUE.    ! LIM ice model
+
+   !!----------------------------------------------------------------------
+   !! ice-ocean common variables
+   !!----------------------------------------------------------------------
+# if defined key_coupled
+   REAL(wp), DIMENSION(jpiglo,jpjglo)    ::   & ! cumulated fields
+      fqsr_oce ,     &   ! Net short wave heat flux on free ocean 
+      fqsr_ice ,     &   ! Net short wave het flux on sea ice 
+      fqnsr_oce,     &   ! Net longwave heat flux on free ocean
+      fqnsr_ice,     &   ! Net longwave heat flux on sea ice
+      fdqns_ice,     &   ! Derivative of non solar heat flux on sea ice
+      ftprecip ,     &   ! Water flux (liquid precipitation - evaporation) 
+      fsprecip ,     &   ! Solid (snow) precipitation
+      frunoff  ,     &   ! runoff
+      fcalving           ! Iceberg calving 
+# endif
+
+   REAL(wp), DIMENSION(jpi,jpj)    ::   & ! field exchanges with ice model to ocean
+      sst_io  ,      &   ! sea surface temperature
+      sss_io  ,      &   ! sea surface salinity
+      u_io    ,      &   ! i-horizontal velocity at ice surface
+      v_io    ,      &   ! j-horizontal velocity at ice surface
+      fsolar  ,      &   ! solar heat flux
+      fnsolar ,      &   ! total non-solar heat flux
+      fsalt   ,      &   ! salt flux
+      fmass   ,      &   ! freshwater flux
+      ftaux   ,      &   ! i-horizontal wind stress 
+      ftauy   ,      &   ! j-horizontal wind stress 
+      gtaux   ,      &   ! i-horizontal wind stress 
+      gtauy              ! i-horizontal wind stress 
+   
+   REAL(wp) ::       &
+      rdt_ice,       &  ! ice time step
+      dtsd2              ! ice time step divide by 2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                 NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_ice_lim = .FALSE.        ! No LIM ice model
+#endif
+
+   INTEGER ::         & !!! namdom : space/time domain (namlist)
+      nfice =  5         ! coupling frequency OPA ICELLN  nfice 
+
+   !!----------------------------------------------------------------------
+END MODULE ice_oce
Index: /branches/nemo/NEMO/OPA_SRC/in_out_manager.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/in_out_manager.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/in_out_manager.F90	(revision 4)
@@ -0,0 +1,81 @@
+MODULE in_out_manager   
+
+   USE lib_print         ! formated print library
+   USE par_kind
+
+   !!----------------------------------------------------------------------
+   !! namelist parameters
+   !! -------------------------------------
+   ! namrun:  parameters of the run
+   CHARACTER (len=16) ::    &
+      cexper = "exp0"          ! experiment name used for output filename
+   
+   LOGICAL ::   &              !!! * namelist namrun *
+      ln_rstart = .FALSE. ,  &  ! start from (F) rest or (T) a restart file
+      ln_ctl    = .FALSE.       ! run control for debugging
+   
+   INTEGER ::                & !!! * namelist namrun *
+      no     = 0        ,    &  ! job number
+      nrstdt = 0        ,    &  ! control of the time step (0, 1 or 2)
+      nit000 = 1        ,    &  ! index of the first time step
+      nitend = 10       ,    &  ! index of the last time step
+      ndate0 = 961115   ,    &  ! initial calendar date aammjj
+      nleapy = 0        ,    &  ! Leap year calendar flag (0/1 or 30)
+      ninist = 0                ! initial state output flag (0/1)
+   !!----------------------------------------------------------------------
+   !!                          Run control  
+   !!----------------------------------------------------------------------
+   
+   INTEGER ::                &  !
+      nstop = 0 ,            &  ! e r r o r  flag (=number of reason for a
+      !                         !                  prematurely stop the run)
+      nwarn = 0                 ! w a r n i n g  flag (=number of warning
+      !                         !                      found during the run)
+
+   
+   CHARACTER (len=64) ::        &
+      cform_err="(/,' ===>>> : E R R O R',     /,'         ===========',/)"    ,   &
+      cform_war="(/,' ===>>> : W A R N I N G', /,'         ===============',/)"
+   !!----------------------------------------------------------------------
+   !! output monitoring
+   !! -----------------------------------
+
+   LOGICAL ::   &
+      lwp                ,   &  ! boolean : true on the 1st processor only
+      l_ctl                     ! = ln_ctl.AND.lwp (print control on the 1st proc)
+
+   INTEGER ::                &
+      nstock = 10 ,          &  ! restart file frequency
+      nprint =  0 ,          &  ! level of print (0 no print)
+      nwrite = 10               ! restart file frequency
+   !!----------------------------------------------------------------------
+   !! logical units
+   !! ------------------------------
+   INTEGER ::                &
+      numstp     =  1 ,      &  ! logical unit for time step
+      numout     =  2 ,      &  ! logical unit for output print
+      numnam     =  3 ,      &  ! logical unit for namelist
+      numnam_ice =  4 ,      &  ! logical unit for ice namelist
+      nummpp     =  8 ,      &  ! logical unit for mpp test print
+      numevo_ice = 17 ,      &  ! logical unit for ice variables (temp. evolution)
+      numsol     = 25 ,      &  ! logical unit for solver statistics
+      numwri     = 40 ,      &  ! logical unit for output write
+      numisp     = 41 ,      &  ! logical unit for island statistics
+      numwrs     = 46 ,      &  ! logical unit for output restart
+      numtdt     = 62 ,      &  ! logical unit for data temperature
+      numsdt     = 63 ,      &  ! logical unit for data salinity
+      numwso     = 71 ,      &  ! logical unit for 2d output write
+      numwvo     = 72 ,      &  ! logical unit for 3d output write
+      numsst     = 65 ,      &  ! logical unit for surface temperature data
+      numgap     = 45 ,      &  ! logical unit for differences diagnostic
+      numbol     = 67 ,      &  ! logical unit for "bol" diagnostics
+      numptr     = 68 ,      &  ! logical unit for Poleward TRansports
+      numflo     = 69           ! logical unit for drifting floats
+
+   !! Contral/debugging
+   !! -----------------
+   REAL(wp) ::               &
+      u_ctl, v_ctl,          &  ! sum of ua and va trend
+      t_ctl, s_ctl              ! sum of ta and sa trend
+
+END MODULE in_out_manager
Index: /branches/nemo/NEMO/OPA_SRC/istate.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/istate.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/istate.F90	(revision 4)
@@ -0,0 +1,511 @@
+MODULE istate
+   !!======================================================================
+   !!                     ***  MODULE  istate  ***
+   !! Ocean state   :  initial state setting
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   istate_init   : initial state setting
+   !!   istate_tem    : analytical profile for initial Temperature
+   !!   istate_sal    : analytical profile for initial Salinity
+   !!   istate_eel    : initial state setting of EEL R5 configuration
+   !!   istate_uvg    : initial velocity in geostropic balance
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and active tracers 
+   USE dom_oce         ! ocean space and time domain 
+   USE daymod          ! 
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE phycst          ! physical constants
+   USE wzvmod          ! verctical velocity               (wzv     routine)
+   USE dtatem          ! temperature data                 (dta_tem routine)
+   USE dtasal          ! salinity data                    (dta_sal routine)
+   USE restart         ! ocean restart                   (rst_read routine)
+   USE solisl          ! ???
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC istate_init   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE istate_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_init  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers.
+      !!
+      !! ** Method  :
+      !!
+      !! History :
+      !!   4.0  !  91-03  ()  Original code
+      !!        !  91-11  (G. Madec)
+      !!   9.0  !  03-09  (G. Madec)  F90: Free form, modules, orthogonality
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      !!----------------------------------------------------------------------
+
+
+      ! Initialization to zero
+      ! ----------------------
+
+      !     before fields       !       now fields        !      after fields       !
+      ;   ub   (:,:,:) = 0.e0   ;   un   (:,:,:) = 0.e0   ;   ua   (:,:,:) = 0.e0
+      ;   vb   (:,:,:) = 0.e0   ;   vn   (:,:,:) = 0.e0   ;   va   (:,:,:) = 0.e0
+      ;                         ;   wn   (:,:,:) = 0.e0   ;
+      ;   rotb (:,:,:) = 0.e0   ;   rotn (:,:,:) = 0.e0   ;
+      ;   hdivb(:,:,:) = 0.e0   ;   hdivn(:,:,:) = 0.e0   ;
+
+      ;   tb   (:,:,:) = 0.e0   ;   tn   (:,:,:) = 0.e0   ;   ta   (:,:,:) = 0.e0
+      ;   sb   (:,:,:) = 0.e0   ;   sn   (:,:,:) = 0.e0   ;   sa   (:,:,:) = 0.e0
+
+      rhd  (:,:,:) = 0.e0
+      rhop (:,:,:) = 0.e0
+      rn2  (:,:,:) = 0.e0 
+  
+
+
+      IF( ln_rstart ) THEN                       ! Restart from a file
+         !                                    ! -------------------
+         neuler = 1                              ! Set time-step indicator at nit000 (leap-frog)
+         CALL rst_read                           ! Read the restart file
+      ELSE
+         !                                    ! Start from rest
+         !                                    ! ---------------
+         neuler = 0                              ! Set time-step indicator at nit000 (euler forward)
+         adatrj = 0._wp
+         IF( cp_cfg == 'eel' ) THEN
+            CALL istate_eel                      ! EEL configuration : start from pre-defined
+            !                                    !                     velocity and thermohaline fields
+         ELSE
+         !                                       ! Initial temperature and salinity fields
+#if defined key_dtatem
+            CALL dta_tem( nit000 )                  ! read 3D temperature data
+            tb(:,:,:) = t_dta(:,:,:)                ! use temperature data read
+            tn(:,:,:) = t_dta(:,:,:)
+#else
+            IF(lwp) WRITE(numout,*)                 ! analytical temperature profile
+            IF(lwp) WRITE(numout,*)' Temperature initialization using an analytic profile'
+            CALL istate_tem
+#endif
+#if defined key_dtasal
+            CALL dta_sal( nit000 )                  ! read 3D salinity data
+            sb(:,:,:) = s_dta(:,:,:)                ! use salinity data read
+            sn(:,:,:) = s_dta(:,:,:)
+#else
+            ! No salinity data
+            IF(lwp)WRITE(numout,*)                  ! analytical salinity profile
+            IF(lwp)WRITE(numout,*)' Salinity initialisation using a constant value'
+            CALL istate_sal
+#endif
+         ENDIF
+
+      ENDIF
+      !                                       ! Vertical velocity
+      !                                       ! -----------------
+      CALL wzv( nit000 )                         ! from horizontal divergence
+
+   END SUBROUTINE istate_init
+
+
+   SUBROUTINE istate_tem
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE istate_tem  ***
+      !!   
+      !! ** Purpose :   Intialization of the temperature field with an 
+      !!      analytical profile or a file (i.e. in EEL configuration)
+      !!
+      !! ** Method  :   Use Philander analytic profile of temperature
+      !!
+      !! References :  Philander ???
+      !!
+      !! History :
+      !!   4.0  !  89-12  (P. Andrich)  Original code
+      !!   6.0  !  96-01  (G. Madec)  terrain following coordinates
+      !!   9.0  !  02-09  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER :: ji, jj, jk
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'istate_tem : initial temperature profile'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               tn(ji,jj,jk) = (  ( ( 7.5 - 0.*ABS(gphit(ji,jj))/30. )   &
+                                  *( 1.-TANH((fsdept(ji,jj,jk)-80.)/30.) )   &
+                               + 10.*(5000.-fsdept(ji,jj,jk))/5000.)  ) * tmask(ji,jj,jk)
+               tb(ji,jj,jk) = tn(ji,jj,jk)
+          END DO
+        END DO
+      END DO
+
+      ! Print
+      IF(lwp) CALL prizre(tn,jpi,jpj,jpk,jpj/2,1,jpi,5,1,jpk,1,1.,numout)
+
+   END SUBROUTINE istate_tem
+
+
+   SUBROUTINE istate_sal
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE istate_sal  ***
+      !!
+      !! ** Purpose :   Intialize the salinity field with an analytic profile
+      !!
+      !! ** Method  :   Use to a constant value 35.5
+      !!              
+      !! ** Action  :   Initialize sn and sb
+      !!
+      !! History :
+      !!   4.0  !  89-12  (P. Andrich)  Original code
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      REAL(wp) ::   zsal = 35.50_wp
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'istate_sal : initial salinity : ', zsal
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+      sn(:,:,:) = zsal * tmask(:,:,:)
+      sb(:,:,:) = sn(:,:,:)
+      
+   END SUBROUTINE istate_sal
+
+
+   SUBROUTINE istate_eel
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_eel  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracers for EEL R5
+      !!      configuration (channel with or without a topographic bump)
+      !!
+      !! ** Method  : - set temprature field
+      !!              - set salinity field
+      !!              - set velocity field including horizontal divergence
+      !!                and relative vorticity fields
+      !!
+      !! History :
+      !!   8.0  !  01-09  (M. Levy, M. Ben Jelloul)  read file for EEL 2 & 6
+      !!   9.0  !  03-09  (G. Madec, C. Talandier)  EEL 5
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE eosbn2     ! eq. of state, Brunt Vaisala frequency (eos     routine)
+      USE divcur     ! hor. divergence & rel. vorticity      (div_cur routine)
+#if ! defined key_fdir
+      USE ioipsl
+#endif
+ 
+      !! * Local declarations
+      LOGICAL :: llog
+      CHARACTER (len=21) ::   &
+         clname = 'eel.initemp',   &  ! filename (for EEL R2 or R6)
+         clvar  = 'initemp'           ! variable name
+      INTEGER  ::   inum              ! temporary logical unit
+      INTEGER  ::   ji, jj, jk        ! dummy loop indices
+      INTEGER  ::   ilev, itime       ! temporary integers
+      REAL(wp) ::   &
+         zh1, zh2, zslope, zcst       ! temporary scalars
+      REAL(wp) ::   &
+         zt1  = 12.e0,             &  ! surface temperature value (EEL R5)
+         zt2  =  2.e0,             &  ! bottom  temperature value (EEL R5)
+         zsal = 35.5                  ! constant salinity (EEL R2, R5 and R6)
+      REAL(wp) ::   &
+         zdt,  zdate0                 ! temporary scalars
+      REAL(wp), DIMENSION(jpk) ::  &
+         zdept                        ! temporary workspace
+      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
+         zlamt, zphit                 ! temporary workspace
+# if defined key_dynspg_fsc
+      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
+         zssh                         ! initial ssh over the global domain
+# endif
+      !!----------------------------------------------------------------------
+
+      SELECT CASE ( jp_cfg ) 
+         !                                              ! ====================
+         CASE ( 5 )                                     ! EEL R5 configuration
+            !                                           ! ====================
+
+            ! set temperature field with a linear profile
+            ! -------------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: linear temperature profile'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+            zh1 = gdept(  1  )
+            zh2 = gdept(jpkm1)
+
+            zslope = ( zt1 - zt2 ) / ( zh1 - zh2 )
+            zcst   = ( zt1 * ( zh1 - zh2) - ( zt1 - zt2 ) * zh1 ) / ( zh1 - zh2 )
+
+            DO jk = 1, jpk
+               tn(:,:,jk) = ( zslope * fsdept(:,:,jk) + zcst  ) * tmask(:,:,jk)
+               tb(:,:,jk) = tn(:,:,jk)
+            END DO
+
+            IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
+               &                 1     , jpi   , 5     , 1     , jpk   ,   &
+               &                 1     , 1.    , numout                  )
+
+            ! set salinity field to a constant value
+            ! --------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+            sn(:,:,:) = zsal * tmask(:,:,:)
+            sb(:,:,:) = sn(:,:,:)
+      
+
+# if defined key_dynspg_fsc
+            ! set the dynamics: U,V, hdiv, rot (and ssh if necessary)
+            ! ----------------
+            ! Start EEL5 configuration with barotropic geostrophic velocities 
+            ! according the sshb and sshn SSH imposed.
+            ub(:,:,:) = 0.1 * umask(:,:,:)
+            un(:,:,:) = ub(:,:,:)
+
+            DO jj = 1, jpjglo
+               zssh(:,jj) = ( .22 - ( float(jj-3) * (0.44) ) / 99. )
+            END DO
+            DO jj = 1, nlcj
+               DO ji = 1, nlci
+                  sshb(ji,jj) = zssh( mig(ji) , mjg(jj) ) * tmask(ji,jj,1)
+               END DO
+            END DO
+            sshb(nlci+1:jpi,      :   ) = 0.e0      ! set to zero extra mpp columns
+            sshb(      :   ,nlcj+1:jpj) = 0.e0      ! set to zero extra mpp rows
+
+            sshn(:,:) = sshb(:,:)                   ! set now ssh to the before value
+
+            ! horizontal divergence and relative vorticity (curl)
+            CALL div_cur( nit000 )
+
+            ! N.B. the vertical velocity will be computed from the horizontal divergence field
+            ! in istate by a call to wzv routine
+# endif
+
+
+            !                                     ! ==========================
+         CASE ( 2 , 6 )                           ! EEL R2 or R6 configuration
+            !                                     ! ==========================
+ 
+            ! set temperature field with a NetCDF file
+            ! ----------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R2 or R6: read initial temperature in a NetCDF file'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+            itime  = 0
+            clname = 'eel.initemp'
+            llog   = .FALSE.
+            ilev   = jpk
+            zlamt(:,:) = 0.e0
+            zphit(:,:) = 0.e0
+            CALL restini( clname, jpidta, jpjdta, zlamt , zphit ,   &
+               &          ilev  , zdept , clname, itime , zdate0,   &
+               &          zdt   , inum                            )
+            CALL restget( inum  , 'initemp', jpi, jpj, jpk,   &
+               &          0     , llog     , tb             )     ! read before temprature (tb)
+            CALL restclo( inum )
+ 
+            tn(:,:,:) = tb(:,:,:)                                 ! set nox temperature to tb
+
+            IF(lwp) WRITE(numout,*) '               file name : ', clname
+            IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   &
+               &                 1     , jpi   , 5     , 1     , jpk   ,   &
+               &                 1     , 1.    , numout                  )
+
+
+            ! set salinity field to a constant value
+            ! --------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+ 
+            sn(:,:,:) = zsal * tmask(:,:,:)
+            sb(:,:,:) = sn(:,:,:)
+
+
+            IF( l_isl ) THEN
+               ! Horizontal velocity : start from geostrophy (EEL config)
+               CALL eos( tn, sn, rhd )     ! now in situ density
+               CALL istate_uvg             ! compute geostrophic velocity
+
+               ! N.B. the vertical velocity will be computed from the horizontal divergence field
+               ! in istate by a call to wzv routine
+            ENDIF
+            !                                    ! ===========================
+         CASE DEFAULT                            ! NONE existing configuration
+            !                                    ! ===========================
+            IF(lwp) WRITE(numout,cform_err) 
+            IF(lwp) WRITE(numout,*) 'EEL with a ', jp_cfg,' km resolution is not coded'
+            nstop = nstop +1
+      END SELECT
+
+   END SUBROUTINE istate_eel
+
+
+   SUBROUTINE istate_uvg
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE istate_uvg  ***
+      !!
+      !! ** Purpose :   Compute the geostrophic velocities from (tn,sn) fields
+      !!
+      !! ** Method  :   Using the hydrostatic hypothesis the now hydrostatic 
+      !!      pressure is computed by integrating the in-situ density from the
+      !!      surface to the bottom.
+      !!                 p=integral [ rau*g dz ]
+      !!
+      !! History :
+      !!   8.1  !  01-09  (M. Levy, M. Ben Jelloul)  Original code
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine)
+      USE dynspg_fsc      ! surface pressure gradient         (dyn_spg_fsc routine)
+      USE dynspg_fsc_atsk ! surface pressure gradient    (dyn_spg_fsc_atsk routine)
+      USE dynspg_rl       ! surface pressure gradient          (dyn_spg_rl routine)
+      USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine)
+      USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk        ! dummy loop indices
+      INTEGER ::   indic             ! ???
+      REAL(wp) ::   &
+         zmsv, zphv, zmsu, zphu,  &  ! temporary scalars
+         zalfg
+      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   &
+         zprn                        ! workspace
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*) 
+      IF(lwp) WRITE(numout,*) 'istate_uvg : Start from Geostrophy'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+      ! Compute the now hydrostatic pressure
+      ! ------------------------------------
+
+      zalfg = 0.5 * g * rau0
+      ! Surface value
+      zprn(:,:,1) = zalfg * fse3w(:,:,1) * ( 1 + rhd(:,:,1) )
+
+      ! Vertical integration from the surface
+      DO jk = 2, jpkm1
+         zprn(:,:,jk) = zprn(:,:,jk-1)   &
+                      + zalfg * fse3w(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) )
+      END DO  
+
+      ! Compute geostrophic balance
+      ! ---------------------------
+
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vertor opt.
+               zmsv = 1. / MAX(  umask(ji-1,jj+1,jk) + umask(ji  ,jj+1,jk)   &
+                               + umask(ji-1,jj  ,jk) + umask(ji  ,jj  ,jk) , 1.  )
+               zphv = ( zprn(ji  ,jj+1,jk) - zprn(ji-1,jj+1,jk) ) * umask(ji-1,jj+1,jk) / e1u(ji-1,jj+1)   &
+                    + ( zprn(ji+1,jj+1,jk) - zprn(ji  ,jj+1,jk) ) * umask(ji  ,jj+1,jk) / e1u(ji  ,jj+1)   &
+                    + ( zprn(ji  ,jj  ,jk) - zprn(ji-1,jj  ,jk) ) * umask(ji-1,jj  ,jk) / e1u(ji-1,jj  )   &
+                    + ( zprn(ji+1,jj  ,jk) - zprn(ji  ,jj  ,jk) ) * umask(ji  ,jj  ,jk) / e1u(ji  ,jj  )
+               zphv = 1. / rau0 * zphv * zmsv * vmask(ji,jj,jk)
+
+               zmsu = 1. / MAX(  vmask(ji+1,jj  ,jk) + vmask(ji  ,jj  ,jk)   &
+                               + vmask(ji+1,jj-1,jk) + vmask(ji  ,jj-1,jk) , 1.  )
+               zphu = ( zprn(ji+1,jj+1,jk) - zprn(ji+1,jj  ,jk) ) * vmask(ji+1,jj  ,jk) / e2v(ji+1,jj  )   &
+                    + ( zprn(ji  ,jj+1,jk) - zprn(ji  ,jj  ,jk) ) * vmask(ji  ,jj  ,jk) / e2v(ji  ,jj  )   &
+                    + ( zprn(ji+1,jj  ,jk) - zprn(ji+1,jj-1,jk) ) * vmask(ji+1,jj-1,jk) / e2v(ji+1,jj-1)   &
+                    + ( zprn(ji  ,jj  ,jk) - zprn(ji  ,jj-1,jk) ) * vmask(ji  ,jj-1,jk) / e2v(ji  ,jj-1)
+               zphu = 1. / rau0 * zphu * zmsu * umask(ji,jj,jk)
+
+               ! Compute the geostrophic velocities
+               un(ji,jj,jk) = -2. * zphu / ( ff(ji,jj) + ff(ji  ,jj-1) )
+               vn(ji,jj,jk) =  2. * zphv / ( ff(ji,jj) + ff(ji-1,jj  ) )
+            END DO
+         END DO
+      END DO
+
+      IF(lwp) WRITE(numout,*) '         we force to zero bottom velocity'
+
+      ! Susbtract the bottom velocity (level jpk-1 for flat bottom case)
+      ! to have a zero bottom velocity
+
+      DO jk = 1, jpkm1
+         un(:,:,jk) = ( un(:,:,jk) - un(:,:,jpkm1) ) * umask(:,:,jk)
+         vn(:,:,jk) = ( vn(:,:,jk) - vn(:,:,jpkm1) ) * vmask(:,:,jk)
+      END DO
+
+      CALL lbc_lnk( un, 'U', -1. )
+      CALL lbc_lnk( vn, 'V', -1. )
+      
+      ub(:,:,:) = un(:,:,:)
+      vb(:,:,:) = vn(:,:,:)
+      
+      ! WARNING !!!!!
+      ! after initializing u and v, we need to calculate the initial streamfunction bsf.
+      ! Otherwise, only the trend will be computed and the model will blow up (inconsistency).
+      
+      ! to do that, we call dyn_spg with a special trick:
+      ! we fill ua and va with the velocities divided by dt,
+      ! and the streamfunction will be brought to the right
+      ! value assuming the velocities have been set up in
+      ! one time step.
+      ! we then set bsfd to zero (first guess for next step
+      ! is d(psi)/dt = 0.)
+
+      !  sets up s false trend to calculate the barotropic
+      !  streamfunction.
+
+      ua(:,:,:) = ub(:,:,:) / rdt
+      va(:,:,:) = vb(:,:,:) / rdt
+
+      ! calls dyn_spg. we assume euler time step, strating from rest.
+      indic = 0
+      !                                                     ! surface pressure gradient
+      IF( lk_dynspg_fsc     )   CALL dyn_spg_fsc     ( nit000, indic )  ! free surface constant volume case
+      IF( lk_dynspg_fsc_tsk )   CALL dyn_spg_fsc_atsk( nit000, indic )  ! autotask free surface constant volume case
+      IF( lk_dynspg_rl      )   CALL dyn_spg_rl      ( nit000, indic )  ! rigid-lid case
+
+      ! the new velocity is ua*rdt
+
+      CALL lbc_lnk( ua, 'U', -1. )
+      CALL lbc_lnk( va, 'V', -1. )
+
+      ub(:,:,:) = ua(:,:,:) * rdt
+      vb(:,:,:) = va(:,:,:) * rdt
+      ua(:,:,:) = 0.e0
+      va(:,:,:) = 0.e0
+      un(:,:,:) = ub(:,:,:)
+      vn(:,:,:) = vb(:,:,:)
+       
+#if ! defined key_dynspg_fsc
+      IF( l_isl )   bsfb(:,:) = bsfn(:,:)          ! Put bsfb to zero
+#endif
+
+      ! Compute the divergence and curl
+
+      CALL div_cur( nit000 )            ! now horizontal divergence and curl
+
+      hdivb(:,:,:) = hdivn(:,:,:)       ! set the before to the now value
+      rotb (:,:,:) = rotn (:,:,:)       ! set the before to the now value
+
+   END SUBROUTINE istate_uvg
+
+   !!=====================================================================
+END MODULE istate
Index: /branches/nemo/NEMO/OPA_SRC/lbclnk.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/lbclnk.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/lbclnk.F90	(revision 4)
@@ -0,0 +1,440 @@
+MODULE lbclnk
+   !!======================================================================
+   !!                       ***  MODULE  zdftke  ***
+   !! Ocean        : lateral boundary conditions
+   !!=====================================================================
+#if defined key_mpp
+   !!----------------------------------------------------------------------
+   !!   'key_mpp'  :                           distributed memory computing
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d
+   !!                  routines defined in lib_mpp
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE lib_mpp          ! distributed memory computing library
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE mpp_lnk_3d, mpp_lnk_2d
+   END INTERFACE
+
+   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
+   !!----------------------------------------------------------------------
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                              shared memory computing
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
+   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable
+   !!                  on OPA ocean mesh
+   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable
+   !!                  on OPA ocean mesh
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers   
+   USE dom_oce         ! ocean space and time domain 
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE lbc_lnk_3d, lbc_lnk_2d
+   END INTERFACE
+
+   PUBLIC lbc_lnk       ! ocean/ice  lateral boundary conditions
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_lnk_3d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions (non mpp case)
+      !!
+      !! ** Method  :
+      !!
+      !! History :
+      !!        !  97-06  (G. Madec)  Original code
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=1), INTENT( in ) ::   &
+         cd_type       ! nature of pt3d grid-points
+         !             !   = T ,  U , V , F or W  gridpoints
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
+         pt3d          ! 3D array on which the boundary condition is applied
+      REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+         !             !   =-1 , the sign is changed if north fold boundary
+         !             !   = 1 , no sign change
+
+      !! * Local declarations
+      INTEGER  ::   ji, jk
+      INTEGER  ::   ijt, iju
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+      
+      !                                                      ! ===============
+      DO jk = 1, jpk                                         ! Horizontal slab
+         !                                                   ! ===============
+
+         !                                     ! East-West boundaries
+         !                                     ! ====================
+         SELECT CASE ( nperio )
+
+         CASE ( 1 , 4 , 6 )                    ! * cyclic east-west
+
+            pt3d( 1 ,:,jk) = pt3d(jpim1,:,jk)          ! all points
+            pt3d(jpi,:,jk) = pt3d(  2  ,:,jk)
+
+         CASE DEFAULT                          ! * closed
+
+            SELECT CASE ( cd_type )
+
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt3d( 1 ,:,jk) = 0.e0
+               pt3d(jpi,:,jk) = 0.e0
+
+            CASE ( 'F' )                               ! F-point
+               pt3d(jpi,:,jk) = 0.e0
+
+            END SELECT
+
+         END SELECT
+
+         !                                     ! North-South boundaries
+         !                                     ! ======================
+         SELECT CASE ( nperio )
+
+         CASE ( 2 )                            ! *  south symmetric
+
+            SELECT CASE ( cd_type )
+
+            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+               pt3d(:, 1 ,jk) = pt3d(:,3,jk)
+               pt3d(:,jpj,jk) = 0.e0
+
+            CASE ( 'V' , 'F' )                         ! V-, F-points
+               pt3d(:, 1 ,jk) = psgn * pt3d(:,2,jk)
+               pt3d(:,jpj,jk) = 0.e0
+
+            END SELECT
+
+         CASE ( 3 , 4 )                            ! *  North fold  T-point pivot
+
+            pt3d( 1 ,jpj,jk) = 0.e0
+            pt3d(jpi,jpj,jk) = 0.e0
+
+            SELECT CASE ( cd_type )
+
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 2, jpi
+                  ijt = jpi-ji+2
+                  pt3d(ji, 1 ,jk) = 0.e0
+                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk)
+               END DO
+               DO ji = jpi/2+1, jpi
+                  ijt = jpi-ji+2
+                  pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk)
+               END DO
+
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpi-1
+                  iju = jpi-ji+1
+                  pt3d(ji, 1 ,jk) = 0.e0
+                  pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-2,jk)
+               END DO
+               DO ji = jpi/2, jpi-1
+                  iju = jpi-ji+1
+                  pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk)
+               END DO
+
+            CASE ( 'V' )                               ! V-point
+                  DO ji = 2, jpi
+                     ijt = jpi-ji+2
+                     pt3d(ji,  1  ,jk) = 0.e0
+                     pt3d(ji,jpj-1,jk) = psgn * pt3d(ijt,jpj-2,jk)
+                     pt3d(ji,jpj  ,jk) = psgn * pt3d(ijt,jpj-3,jk)
+                  END DO
+
+            CASE ( 'F' )                               ! F-point
+                  DO ji = 1, jpi-1
+                     iju = jpi-ji+1
+                     pt3d(ji,jpj-1,jk) = pt3d(iju,jpj-2,jk)
+                     pt3d(ji,jpj  ,jk) = pt3d(iju,jpj-3,jk)
+                  END DO
+
+            END SELECT
+
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+
+            pt3d( 1 ,jpj,jk) = 0.e0
+            pt3d(jpi,jpj,jk) = 0.e0
+
+            SELECT CASE ( cd_type )
+
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 1, jpi
+                  ijt = jpi-ji+1
+                  pt3d(ji, 1 ,jk) = 0.e0
+                  pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-1,jk)
+               END DO
+
+            CASE ( 'U' )                               ! U-point
+                  DO ji = 1, jpi-1
+                     iju = jpi-ji
+                     pt3d(ji, 1 ,jk) = 0.e0
+                     pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-1,jk)
+                  END DO
+
+            CASE ( 'V' )                               ! V-point
+                  DO ji = 1, jpi
+                     ijt = jpi-ji+1
+                     pt3d(ji, 1 ,jk) = 0.e0
+                     pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk)
+                  END DO
+                  DO ji = jpi/2+1, jpi
+                     ijt = jpi-ji+1
+                     pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk)
+                  END DO
+
+            CASE ( 'F' )                               ! F-point
+                  DO ji = 1, jpi-1
+                     iju = jpi-ji
+                     pt3d(ji,jpj  ,jk) = pt3d(iju,jpj-2,jk)
+                  END DO
+                  DO ji = jpi/2+1, jpi-1
+                     iju = jpi-ji
+                     pt3d(ji,jpjm1,jk) = pt3d(iju,jpjm1,jk)
+                  END DO
+            END SELECT
+
+         CASE DEFAULT                           ! *  closed
+
+            SELECT CASE ( cd_type )
+
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt3d(:, 1 ,jk) = 0.e0
+               pt3d(:,jpj,jk) = 0.e0
+
+            CASE ( 'F' )                               ! F-point
+               pt3d(:,jpj,jk) = 0.e0
+
+            END SELECT
+
+         END SELECT
+         !                                                   ! ===============
+      END DO                                                 !   End of slab
+      !                                                      ! ===============
+   END SUBROUTINE lbc_lnk_3d
+
+
+   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE lbc_lnk_2d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions (non mpp case)
+      !!
+      !! ** Method  :
+      !!
+      !! History :
+      !!        !  97-06  (G. Madec)  Original code
+      !!        !  01-05  (E. Durand)  correction
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=1), INTENT( in ) ::   &
+         cd_type       ! nature of pt2d grid-point
+         !             !   = T , U , V , F or W  gridpoints
+         !             !   = I sea-ice U-V gridpoint (= F ocean grid point with indice shift)
+      REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+         !             !   =-1 , the sign is modified following the type of b.c. used
+         !             !   = 1 , no sign change
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
+         pt2d          ! 2D array on which the boundary condition is applied
+
+      !! * Local declarations
+      INTEGER  ::   ji
+      INTEGER  ::   ijt, iju
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+      
+      
+      !                                        ! East-West boundaries
+      !                                        ! ====================
+      SELECT CASE ( nperio )
+
+      CASE ( 1 , 4 , 6 )                       ! * cyclic east-west
+
+         pt2d( 1 ,:) = pt2d(jpim1,:)
+         pt2d(jpi,:) = pt2d(  2  ,:)
+
+      CASE DEFAULT                             ! * closed 
+
+         SELECT CASE ( cd_type )
+
+         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points
+            pt2d( 1 ,:) = 0.e0
+            pt2d(jpi,:) = 0.e0
+
+         CASE ( 'F' , 'I' )                            ! F-point, ice U-V point
+            pt2d(jpi,:) = 0.e0 
+
+         END SELECT
+
+      END SELECT
+
+      !                                        ! North-South boundaries
+      !                                        ! ======================
+      SELECT CASE ( nperio )
+
+      CASE ( 2 )                               ! * South symmetric
+
+         SELECT CASE ( cd_type )
+
+         CASE ( 'T' , 'U' , 'W' )                      ! T-, U-, W-points
+            pt2d(:, 1 ) = pt2d(:,3)
+            pt2d(:,jpj) = 0.e0
+
+         CASE ( 'V' , 'F' )                            ! V-, F-points, ice U-V point
+            pt2d(:, 1 ) = psgn * pt2d(:,2)
+            pt2d(:,jpj) = 0.e0
+
+         END SELECT
+
+      CASE ( 3 , 4 )                           ! * North fold  T-point pivot
+
+         pt2d( 1 , 1 ) = 0.e0        !!!!!  bug gm ??? !Edmee
+         pt2d( 1 ,jpj) = 0.e0
+         pt2d(jpi,jpj) = 0.e0
+
+         SELECT CASE ( cd_type )
+
+         CASE ( 'T' , 'W' )                            ! T-, W-point
+            DO ji = 2, jpi
+               ijt = jpi-ji+2
+               pt2d(ji, 1 ) = 0.e0
+               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)
+            END DO
+            DO ji = jpi/2+1, jpi
+               ijt = jpi-ji+2
+               pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)
+            END DO
+
+         CASE ( 'U' )                                  ! U-point
+            DO ji = 1, jpi-1
+               iju = jpi-ji+1
+               pt2d(ji, 1 ) = 0.e0
+               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-2)
+            END DO
+            DO ji = jpi/2, jpi-1
+               iju = jpi-ji+1
+               pt2d(ji,jpjm1) = psgn * pt2d(iju,jpjm1)
+            END DO
+
+         CASE ( 'V' )                                  ! V-point
+            DO ji = 2, jpi
+               ijt = jpi-ji+2
+               pt2d(ji, 1   ) = 0.e0
+               pt2d(ji,jpj-1) = psgn * pt2d(ijt,jpj-2)
+               pt2d(ji,jpj  ) = psgn * pt2d(ijt,jpj-3)
+            END DO
+
+         CASE ( 'F' )                                  ! F-point
+            DO ji = 1, jpi-1
+               iju = jpi - ji + 1
+               pt2d(ji,jpj-1) = pt2d(iju,jpj-2)
+               pt2d(ji,jpj  ) = pt2d(iju,jpj-3)
+            END DO
+
+         CASE ( 'I' )                                  ! ice U-V point
+            pt2d(2,jpj) = psgn * pt2d(3,jpj-1)
+            DO ji = 3, jpi
+               iju = jpi - ji + 3
+               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)
+            END DO
+
+         END SELECT
+
+      CASE ( 5 , 6 )                           ! * North fold  F-point pivot
+
+         pt2d( 1 , 1 ) = 0.e0           !!bug  ???
+         pt2d( 1 ,jpj) = 0.e0
+         pt2d(jpi,jpj) = 0.e0
+
+         SELECT CASE ( cd_type )
+
+         CASE ( 'T' , 'W' )                            ! T-, W-point
+            DO ji = 1, jpi
+               ijt = jpi-ji+1
+               pt2d(ji, 1 ) = 0.e0
+               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-1)
+            END DO
+
+         CASE ( 'U' )                                  ! U-point
+            DO ji = 1, jpi-1
+               iju = jpi-ji
+               pt2d(ji, 1 ) = 0.e0
+               pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)
+            END DO
+
+         CASE ( 'V' )                                  ! V-point
+            DO ji = 1, jpi
+               ijt = jpi-ji+1
+               pt2d(ji, 1 ) = 0.e0
+               pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)
+            END DO
+            DO ji = jpi/2+1, jpi
+               ijt = jpi-ji+1
+               pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)
+            END DO
+
+         CASE ( 'F' )                                  ! F-point
+            DO ji = 1, jpi-1
+               iju = jpi-ji
+               pt2d(ji,jpj  ) = pt2d(iju,jpj-2)
+            END DO
+            DO ji = jpi/2+1, jpi-1
+               iju = jpi-ji
+               pt2d(ji,jpjm1) = pt2d(iju,jpjm1)
+            END DO
+
+         CASE ( 'I' )                                  ! ice U-V point
+            pt2d( 2 ,jpj) = 0.e0           !!bug  ???
+            DO ji = 1 , jpim1            !!bug rob= 2,jpim1
+               ijt = jpi - ji            !!bug rob= ijt=jpi-ji+2   ???
+               pt2d(ji,jpj)= 0.5 * ( pt2d(ji,jpjm1) + psgn * pt2d(ijt,jpjm1) )
+            END DO
+
+         END SELECT
+
+      CASE DEFAULT                             ! * closed
+
+         SELECT CASE ( cd_type )
+
+         CASE ( 'T' , 'U' , 'V' , 'W' )                ! T-, U-, V-, W-points
+            pt2d(:, 1 ) = 0.e0
+            pt2d(:,jpj) = 0.e0
+
+         CASE ( 'F' )                                  ! F-point
+            pt2d(:,jpj) = 0.e0
+
+         CASE ( 'I' )                                  ! ice U-V point
+            pt2d(:, 1 ) = 0.e0
+            pt2d(:,jpj) = 0.e0
+
+         END SELECT
+
+      END SELECT
+
+   END SUBROUTINE lbc_lnk_2d
+
+#endif
+
+   !!======================================================================
+END MODULE lbclnk
Index: /branches/nemo/NEMO/OPA_SRC/lib_cray.f90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/lib_cray.f90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/lib_cray.f90	(revision 4)
@@ -0,0 +1,58 @@
+!  Cray subroutines or functions used by OPA model and possibly 
+!  not found on other platforms.
+!
+!  check their existence
+!  
+!  sdot
+!  wheneq
+!  saxpy
+!  isrchne
+!---------------------------------------------------------
+        FUNCTION sdot( I, X, J, Y, K )
+        DIMENSION X(1), Y(1)
+        SDOT = 0.
+        DO N = 1, I
+        SDOT = SDOT + X(1+(N-1)*J) * Y(1+(N-1)*K)
+        END DO
+        END FUNCTION sdot
+!---------------------------------------------------------
+        SUBROUTINE wheneq ( i, x, j, t, ind, nn )
+        IMPLICIT NONE
+
+        INTEGER , INTENT (  in ) :: i, j
+        INTEGER , INTENT ( out ) :: nn
+        REAL    , INTENT (  in ), DIMENSION (1+(i-1)*j) :: x
+        REAL    , INTENT (  in ) :: t
+        INTEGER , INTENT ( out ), DIMENSION (1+(i-1)*j) :: ind
+        INTEGER :: n, k
+        nn = 0
+        DO n = 1, i
+          k = 1 + (n-1) * j
+          IF ( x ( k) == t ) THEN 
+              nn = nn + 1
+              ind (nn) = k
+          ENDIF
+        END DO 
+
+        END SUBROUTINE wheneq
+!---------------------------------------------------------
+        SUBROUTINE SAXPY(I,A,X,J,Y,K)
+        DIMENSION X(1),Y(1)
+        DO 1 N=1,I
+        Y(1+(N-1)*K)=A*X(1+(N-1)*J)+Y(1+(N-1)*K)
+  1     CONTINUE
+        RETURN
+        END
+!---------------------------------------------------------
+        FUNCTION ISRCHNE(K,X,I,B)
+        DIMENSION X(1)
+        DO 1 N=1,K
+        IF(X(1+(N-1)*I) /= B)THEN
+         ISRCHNE=N
+        RETURN
+        ELSE
+          ISRCHNE=N+1
+        ENDIF
+ 1      CONTINUE
+        RETURN
+        END
Index: /branches/nemo/NEMO/OPA_SRC/lib_feti.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/lib_feti.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/lib_feti.F90	(revision 4)
@@ -0,0 +1,2313 @@
+MODULE lib_feti
+   !!==============================================================================
+   !!                       ***  MODULE lib_feti   ***
+   !! Ocean solver : FETI library
+   !!==============================================================================
+
+#if defined key_feti
+   !!  feti_creadr
+   !!  feti_prext
+   !!  feti_init
+   !!  feti_iclr
+   !!  feti_vclr
+   !!  feti_vmov
+   !!  feti_vneg    (used in lib_feti)
+   !!  feti_vsub
+   !!  feti_vadd    (used in lib_feti)
+   !!  feti_ldlt    (used in lib_feti)
+   !!  feti_desremo (used in lib_feti)
+   !!  feti_mxv     (used in lib_feti)
+   !!  feti_mxvadd  (used in lib_feti)
+   !!  feti_saut    (used in lib_feti)
+   !!  feti_moyen   (used in lib_feti)
+   !!  feti_assemb  (used in lib_feti)
+   !!  feti_poids
+   !!  feti_probit  (used in lib_feti)
+   !!  feti_inisub
+   !!  feti_subound
+   !!  feti_subdir
+   !!  feti_listdir
+   !!  feti_blodir
+   !!  feti_numblo
+   !!  feti_blomat
+   !!  feti_blomat1
+   !!  feti_nullsp
+   !!  feti_project (used in lib_feti)
+   !!  feti_etesolv (used in lib_feti)
+   !!  feti_osaxpy  (used in lib_feti) 
+   !!  feti_proe    (used in lib_feti)
+   !!  feti_proet   (used in lib_feti)
+   !!  feti_consrhs (used in lib_feti)
+   !!  feti_dualschur
+   !!  feti_extend  (used in lib_feti)
+   !!  feti_restri  (used in lib_feti)
+   !!  feti_halfint
+   !!  feti_front
+   !!  feti_calinv  (used in lib_feti)
+   !!  feti_nbdia   (used in lib_feti)
+   !!  feti_liblod  (used in lib_feti)
+   !!  feti_liblos  (used in lib_feti)
+   !!  feti_resloc
+   !!  feti_pblos   (used in lib_feti)
+   !!  feti_pbloi   (used in lib_feti) 
+   !!  feti_proax
+   !!
+   !!  EXTERNAL used (BLAS): sgemv, strsv, saxpy, irecv
+   !!
+   !! References :
+   !!      Guyon, M, Roux, F-X, Chartier, M and Fraunie, P, 1994 :
+   !!      A domain decomposition solver to compute the barotropic 
+   !!      component of an OGCM in the parallel processing field.
+   !!      Ocean Modelling, issue 105, december 94.
+   !!
+   !! Modifications :
+   !!      original :  98-02 (M. Guyon)
+   !!------------------------------------------------------------------------
+   !! * Modules used
+   USE lib_mpp                 ! distribued memory computing
+
+CONTAINS
+
+      subroutine feti_creadr(ial,ialmax,lmax,ltab,iatab,chtab)
+!  ial = derniere adresse libre dans le super-tableau de longueur lmax .
+!  ltab = taille de la structure de donnee tab , d'adresse iatab .
+      implicit none
+      external mynode
+
+      integer ial,ialmax,lmax,ltab,iatab
+      integer iialmax,iibidon,mynode
+      character(len=12) chtab
+
+      iatab=ial
+      ial=iatab+ltab
+      ialmax=max0(ial,ialmax)
+      if(ial > lmax) then 
+          write(0,*)'  creation de la structure de donnee ',chtab
+          write(0,*)'  depassement taille super-tableau :'
+          write(0,*)'  taille maximale , taille demandee :',lmax,ial
+          stop
+      endif
+
+!... test de la memoire
+
+      iialmax=-ialmax
+      call mpp_min(iialmax,1,iibidon)
+      iialmax=-iialmax
+!     if(mynode() == 0)then
+!         write(0,*)'  creation de la structure de donnee ',chtab
+!         write(0,*)'taille max vaut : ',iialmax
+!     endif
+
+      end subroutine feti_creadr
+!***********************************************************************
+      subroutine feti_prext(n,x)
+      implicit none
+      integer n
+      REAL(kind=8)  x(n)
+      REAL(kind=8)   xmin,xmax
+      integer i
+
+      xmin=x(1)
+      xmax=x(1)
+      do i=2,n
+        xmin=min(xmin,x(i))
+        xmax=max(xmax,x(i))
+      end do
+!     write(0,100)xmin,xmax
+ 100  format(8d10.3)
+
+      end subroutine feti_prext
+!*********************************************************************
+      subroutine feti_init(noeuds,x)
+      implicit none
+      integer noeuds
+      REAL(kind=8)  x(noeuds)
+      integer ji
+
+      do ji=1,noeuds
+        x(ji)=1.
+      end do
+
+      end subroutine feti_init
+!***********************************************************************
+      subroutine feti_iclr(n,x)
+      implicit none
+      integer n
+      integer x(n)
+      integer i
+
+      do i=1,n
+        x(i)=0
+      end do
+
+      end subroutine feti_iclr
+!***********************************************************************
+      subroutine feti_vclr(n,x)
+      implicit none
+      integer n
+      REAL(kind=8)  x(n)
+      integer i
+
+      do i=1,n
+        x(i)=0.e0
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_vmov(n,x,y)
+      implicit none
+      integer n
+      REAL(kind=8)  x(n),y(n)
+      integer i
+      do i=1,n
+        y(i)=x(i)
+      end do
+      return
+      end
+!***********************************************************************
+      subroutine feti_vneg(n,x,y)
+      implicit none
+      integer n
+      REAL(kind=8)  x(n),y(n)
+      integer i
+
+      do i=1,n
+        y(i)=-x(i)
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_vsub(n,x,y,z)
+      implicit none
+      integer n
+      REAL(kind=8)  x(n),y(n),z(n)
+      integer i
+      do i=1,n
+        z(i)=x(i)-y(i)
+      end do
+      return
+      end
+!***********************************************************************
+      subroutine feti_vadd(n,x,y,z)
+      implicit none
+      integer n
+      REAL(kind=8)  x(n),y(n),z(n)
+      integer i
+
+      do i=1,n
+        z(i)=y(i)+x(i)
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_ldlt(n,a,d,v,ndlblo,lisblo,nmdlblo,j0)
+
+!...ndlblo nombre de liberte bloques = nombre de pivots nuls = dim(Ker(Ep))
+
+!...nmdlblo = Max (ndlblo(Ep)) <= superstructure management in f77 context
+!            p=1,Np
+
+      implicit none
+      integer n,ndlblo,nmdlblo
+      integer j0
+      REAL(kind=8)  a(n,n),v(n),d(n)
+      integer lisblo(nmdlblo)
+      integer i,j,k
+      REAL(kind=8)  piv,epsilo
+
+!  pivot de reference .
+      piv=a(1,1)
+!  epsilon .
+      epsilo=1.e-10
+!  factorisation de Crout d'une matrice pleine .
+      do j = 1 , n
+!  calcul du produit de la ligne numero j par la diagonale .
+        do k = 1 , j - 1
+          v(k) = a(j,k) * a(k,k)
+        end do
+!  calcul des termes de la partie inferieure de la colonne .
+        call sgemv('N',n-j+1,j-1,-1.e0,a(j,1),n,v,1,1.e0,a(j,j),1)
+!  detection des pivots nuls .
+        if(a(j,j) < (piv*epsilo)) then
+            ndlblo=ndlblo+1
+            lisblo(ndlblo)=j0+j
+            do i=1,j-1
+              a(i,j)=0.e0
+            end do
+            do i=j+1,n
+              a(j,i)=0.e0
+            end do
+            a(j,j)=0.e0
+            d(j)=0.e0
+        else
+            piv=a(j,j)
+            d(j)=1.e0/a(j,j)
+            do i = j+1 , n
+              a(i,j) = a(i,j) * d(j)
+            end do
+        endif
+      end do
+!  recopie de la partie triangulaire superieure .
+      do i = 1, n
+        do j = i+1, n
+          a(i,j)=a(j,i)
+        end do
+      end do
+      do i=1,n
+        a(i,i)=d(i)
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_desremo(n,j0,a,y,x) 
+      implicit none
+      integer n,i,j,j0
+      REAL(kind=8)  a(n,n),x(n),y(n)
+
+!  descente remontee du systeme .
+!  initialisation du vecteur resultat .
+      do i=1,n
+        x(i)=y(i)
+      end do
+!  descente du systeme L x = x , L est a diagonale unitaire .
+      call strsv('L','N','U',n-j0,a(j0+1,j0+1),n,x(j0+1),1)
+!  division par la diagonale .
+      do j=j0+1,n
+        x(j)=x(j)*a(j,j)
+      end do          
+!  remontee du systeme U x = x , U est a diagonale unitaire . 
+      call strsv('U','N','U',n-j0,a(j0+1,j0+1),n,x(j0+1),1)
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_mxv(n,m,a,x,y) 
+!  calcul du produit matrice-vecteur :  y = A x
+      implicit none
+      integer n,m
+      REAL(kind=8)  a(n,m),x(m),y(n)
+      REAL(kind=8)  alpha,beta
+!  initialisation du vecteur y .
+      alpha=1.e0
+      beta=0.e0
+      call sgemv('N',n,m,alpha,a,n,x,1,beta,y,1)
+      return
+      end
+!**********************************************************************c
+      subroutine feti_mxvadd(n,m,a,x,y) 
+!  calcul du produit matrice-vecteur :  y = y + A x
+      implicit none
+      integer n,m
+      REAL(kind=8)  a(n,m),x(m),y(n)
+      REAL(kind=8)  alpha,beta
+!  initialisation du vecteur y .
+
+      alpha=1.e0
+      beta=1.e0
+      if((n > 0).and.(m > 0))then
+          call sgemv('N',n,m,alpha,a,n,x,1,beta,y,1)
+      endif
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_saut(numnes,listnes,    &
+          plistin,numins,listin,              &
+                numnos,v,w,bufin,bufout)
+!!        narea,numnos,v,w,bufin,bufout)
+
+!  computation of the jump of a field on the interfaces, in the case 
+!  where subdomain number i is allocated to processor number i-1 .
+
+!     INPUTS : numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               lint    =  list of inner interfaces
+!               lext    =  list of extern interfaces
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               narea     =  subdomain number
+!               numnos  =  number of nodes in the subdomain
+!               v       =  local field
+
+!     OUTPUTS : w  =  jump of v
+
+!     WORKSPACE : bufin   =  contributions of local field on interface
+!                 bufout  =  contributions of outer fields on interface
+!                 work
+      implicit none 
+!      external irecv
+!!    integer irecv, work(100)
+!!    integer numnes,numins,numnos,narea
+      integer numnes,numins,numnos
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  v(numnos),w(numins)
+      REAL(kind=8)  bufin(numins),bufout(numins)
+      integer i,j,l
+      integer mesg
+
+      mesg=128
+!  receiving the values of the outer fields on the interface
+!     do i=1,numnes
+!       l=(plistin(i+1)-plistin(i))*8
+!       work(i)=irecv(mesg+listnes(i)-1,bufout(plistin(i)+1),l)
+!     end do
+!  gathering the values of the local field on the interface
+      do i=1,numnes
+        do j=plistin(i)+1,plistin(i+1)
+          bufin(j)=v(listin(j))
+        end do
+      end do
+!  sending the values of the local field on the interface
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))*8
+!       call mppsend(mesg+narea-1,bufin(plistin(i)+1),l,listnes(i)-1,0)
+        call mppsend(mesg+listnes(i,3)-1,bufin(plistin(i)+1),l,   &
+            listnes(i,1)-1,0)
+      end do
+!  computing the jump on each interface 
+      do i=1,numnes
+!       call msgwait(work(i))
+        l=(plistin(i+1)-plistin(i))*8
+!       call mpprecv(mesg+listnes(i)-1,bufout(plistin(i)+1),l)
+        call mpprecv(mesg+listnes(i,2)-1,bufout(plistin(i)+1),l)
+      end do
+      do j=1,numins
+        w(j)=bufin(j)-bufout(j)
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_moyen(numnes,listnes,   &
+          plistin,numins,listin,              &
+          narea,numnos,weight,v,w,bufin,bufout)
+
+!  averaging a field on the interfaces, in the case where subdomain
+!  number i is allocated to processor number i-1 .
+
+!     INPUTS : numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               lint    =  list of inner interfaces
+!               lext    =  list of extern interfaces
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               narea    =  subdomain number
+!               numnos  =  number of nodes in the subdomain
+!               weight  =  weighting vector
+!               v       =  local field
+
+!     OUTPUTS :      w  =  averaged field
+
+!     WORKSPACE : bufin   =  contributions of local field on interface
+!                 bufout  =  contributions of outer fields on interface
+!                 work
+      implicit none 
+!     external irecv
+!!    integer irecv, work(100)
+      integer numnes,numins,numnos,narea
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  weight(numnos),v(numnos),w(numnos)
+      REAL(kind=8)  bufin(numins),bufout(numins)
+      integer i,j,l,n
+      integer mesg
+
+      mesg=128*2
+!  initialization
+      call feti_vmov(numnos,v,w)
+!  receiving the values of the outer fields on the interface
+!     do i=1,numnes
+!       l=(plistin(i+1)-plistin(i))*8
+!       work(i)=irecv(mesg+listnes(i)-1,bufout(plistin(i)+1),l)
+!     end do
+!  gathering the values of the local field on the interface
+      do i=1,numnes
+        do j=plistin(i)+1,plistin(i+1)
+          bufin(j)=v(listin(j))
+        end do
+      end do
+!  sending the values of the local field on the interface
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))*8
+!       call mppsend(mesg+narea-1,bufin(plistin(i)+1),l,listnes(i)-1,0)
+        call mppsend(mesg+listnes(i,3)-1,bufin(plistin(i)+1),l,   &
+            listnes(i,1)-1,0)
+      end do
+!  computing the jump on each interface 
+      do i=1,numnes
+!       call msgwait(work(i))
+        l=(plistin(i+1)-plistin(i))*8
+!       call mpprecv(mesg+listnes(i)-1,bufout(plistin(i)+1),l)
+        call mpprecv(mesg+listnes(i,2)-1,bufout(plistin(i)+1),l)
+      end do
+      do j=1,numins
+        n=listin(j)
+        w(n)=w(n)+bufout(j)
+      end do
+      do n=1,numnos
+        w(n)=w(n)*weight(n)
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_assemb(numnes,listnes,   &
+          plistin,numins,listin,               &
+          narea,numnos,v,w,bufin,bufout)
+
+!  assembling a field on the interfaces, in the case where subdomain
+!  number i is allocated to processor number i-1 .
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               lint    =  list of inner interfaces
+!               lext    =  list of extern interfaces
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               narea     =  subdomain number
+!               numnos  =  number of nodes in the subdomain
+!               v       =  unassembled field
+
+!     OUTPUTS :      w  =  assembled field
+
+!     WORKSPACE : bufin   =  contributions of local field on interface
+!                 bufout  =  contributions of outer fields on interface
+!                 work
+      implicit none 
+!      external irecv
+!!    integer irecv, work(100)
+      integer numnes,numins,numnos,narea
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  v(numnos),w(numnos)
+      REAL(kind=8)  bufin(numins),bufout(numins)
+      integer i,j,l,n
+      integer mesg
+
+      mesg=128*3
+!  initialization
+      call feti_vmov(numnos,v,w)
+!  receiving the values of the outer fields on the interface
+!     do i=1,numnes
+!       l=(plistin(i+1)-plistin(i))*8
+!       work(i)=irecv(mesg+listnes(i)-1,bufout(plistin(i)+1),l)
+!     end do
+!  gathering the values of the local field on the interface
+      do i=1,numnes
+        do j=plistin(i)+1,plistin(i+1)
+          bufin(j)=v(listin(j))
+        end do
+      end do
+!  sending the values of the local field on the interface
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))*8
+!       write(90,*)'envoie a ',listnes(i),'de ',l,'octets'
+!       write(90,*)'tag est : ',listnes(i,3)
+!       call mppsend(mesg+narea-1,bufin(plistin(i)+1),l,listnes(i)-1,0)
+        call mppsend(mesg+listnes(i,3)-1,bufin(plistin(i)+1),l,   &
+            listnes(i,1)-1,0)
+      end do
+!  computing the jump on each interface 
+      do i=1,numnes
+!       call msgwait(work(i))
+        l=(plistin(i+1)-plistin(i))*8
+!       write(90,*)'recoie de ',listnes(i),'de ',l,'octets'
+!       write(90,*)'recois avec tag :',listnes(i,2)
+!       call mpprecv(mesg+listnes(i)-1,bufout(plistin(i)+1),l)
+        call mpprecv(mesg+listnes(i,2)-1,bufout(plistin(i)+1),l)
+      end do
+      do j=1,numins
+        n=listin(j)
+        w(n)=w(n)+bufout(j)
+      end do
+
+      return
+      end
+!**********************************************************************c
+!!    subroutine feti_poids(numnes,listnes,plistin,numins,listin,   &
+!!        narea,numnos,w,bufin,bufout)
+      subroutine feti_poids(numnes,                numins,listin,   &
+                numnos,w             )
+
+!  computation of the subdomain weighting vector, in the case where 
+!  subdomain number i is allocated to processor number i-1 .
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               narea     =  subdomain number
+!               numnos  =  number of nodes in the subdomain
+
+!     OUTPUTS :      w  =  weighting vector
+
+!     WORKSPACE : bufin   =  contributions of local field on interface
+!                 bufout  =  contributions of outer fields on interface
+!                 work
+      implicit none 
+!!    integer numnes,numins,numnos,narea
+      integer numnes,numins,numnos
+!!    integer listnes(numnes), plistin(numnes+1), listin(numins)
+      integer                                     listin(numins)
+      REAL(kind=8)  w(numnos)
+!!    REAL(kind=8)  bufin(numins),bufout(numins)
+      integer j,n
+
+!  initialization
+      do n=1,numnos
+        w(n)=1.e0
+      end do
+!  computing the weight on each interface 
+      do j=1,numins
+        n=listin(j)
+        w(n)=w(n)+1.e0
+      end do
+      do n=1,numnos
+        w(n)=1.e0/w(n)
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_probit(numnes,listnes,plistin,numins,listin,   &
+          numnos,w,bitw)
+
+!  computing the local right-hand-side associated with a field
+!  on the interface .
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               numnos  =  number of nodes in the subdomain
+!               w       =  interface field
+
+!     OUTPUTS :      bitw  =  local right-hand side
+
+      implicit none 
+      integer numnes,numins,numnos
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  w(numins)
+      REAL(kind=8)  bitw(numnos)
+      integer i,j,n
+
+!  initialization
+      do n=1,numnos
+        bitw(n)=0.e0
+      end do
+!  assembling the values on the interfaces 
+      do i=1,numnes
+        do j=plistin(i)+1,plistin(i+1)
+          n=listin(j)
+          bitw(n)=bitw(n)+w(j)
+        end do
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_inisub(ni,nj,ibondi,ibondj,iperio,   &
+          ibsw,ibnw,ibse,ibne,                             &
+          ninterf,ninterfc,nni,nnic)
+      implicit none
+      integer ni,nj,ibondi,ibondj,iperio
+      integer ibsw,ibnw,ibse,ibne
+      integer ibsw2,ibnw2,ibse2,ibne2
+      integer ninterf,ninterfc,nni,nnic
+!     integer i,j
+
+!  determination de la position du sous-domaine dans la grille
+!  cela depnd de ibondi et ibondj
+
+!  nombre de sous-domaines voisins et de la longueur du tableau des
+!  noeuds voisins
+
+!  initialisation
+
+      ninterf=0
+      nni=0
+
+!...first, the "segment-points"
+
+      if((ibondi == 2).AND.(iperio /= 1))then
+
+!  la periodicite : pas d'interface east / west si nbondi = 2
+!  ET nperio != 1
+
+!      elseif(iperio == 1) then
+
+!...ca doit marcher!?
+
+      else
+
+!  west
+
+          if(ibondi /= -1)then
+              ninterf=ninterf+1
+              nni=nni+nj+1
+          endif
+
+!  east
+
+          if(ibondi /= 1)then
+              ninterf=ninterf+1
+              nni=nni+nj+1
+          endif
+
+      endif
+
+!  south
+
+      if(ibondj /= -1.AND.ibondj /= 2)then
+          ninterf=ninterf+1
+          nni=nni+ni+1
+      endif
+
+!  north
+
+      if(ibondj /= 1.AND.ibondj /= 2)then
+          ninterf=ninterf+1
+          nni=nni+ni+1
+      endif
+
+      nnic=nni
+      ninterfc=ninterf
+
+
+!...second, the "corner-points"
+
+!...determination of the neighboorings, they depends on iperio
+!   boundary condition => local description : ipXX becomes ipXX2...
+
+      ibnw2 = ibnw
+      ibne2 = ibne
+      ibsw2 = ibsw
+      ibse2 = ibse
+
+!...iperio boundary condition effect
+
+      if(iperio == 1) then
+
+!...general case : Earth == infinite tube
+
+          ibnw2 = 1
+          ibne2 = 1
+          ibsw2 = 1
+          ibse2 = 1
+
+!...real boundary condition
+
+          if(ibondj == -1.OR.ibondj == 2) then
+              ibsw2 = 0
+              ibse2 = 0
+          endif
+
+          if(ibondj == 1.OR.ibondj == 2) then
+              ibnw2 = 0
+              ibne2 = 0
+          endif
+
+      endif
+
+!  la periodicite : pas de coin si nbondi = 2
+!  ET nperio != 1
+
+!  north-west
+
+      if(ibnw == 1)then
+          ninterfc=ninterfc+1
+          nnic=nnic+1
+      endif
+
+!  north-east
+
+      if(ibne == 1)then
+          ninterfc=ninterfc+1
+          nnic=nnic+1
+      endif
+
+!  south-west
+
+      if(ibsw == 1)then
+          ninterfc=ninterfc+1
+          nnic=nnic+1
+      endif
+
+!  south-east
+
+      if(ibse == 1)then
+          ninterfc=ninterfc+1
+          nnic=nnic+1
+      endif
+
+!       write(0,*)'  nbre de voisins =',ninterf
+!       write(0,*)'  longueur des interfaces =',nni
+!       write(0,*)'  longueur des interfaces =',nnic
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_subound(ni,nj,ildi,ilei,ildj,ilej,   &
+          imoi,ibondi,ibondj,iperio,   &
+          ninterf,ninterfc,   &
+          iowe,ioea,ioso,iono,   &
+          ibsw,ibnw,ibse,ibne,   &
+          ipsw,ipnw,ipse,ipne,   &
+          nsdvois,nsdvoisc,   &
+          plistin,nni,listin)
+
+      implicit none
+      integer ni,nj,ildi,ilei,ildj,ilej
+      integer imoi,ibondi,ibondj,iperio
+      integer iowe,ioea,ioso,iono
+      integer ibsw,ibnw,ibse,ibne
+      integer ipsw,ipnw,ipse,ipne
+      integer ninterf,ninterfc,nni
+      integer nsdvois(ninterf,3),nsdvoisc(ninterfc,3)
+      integer plistin(ninterfc+1),listin(nni)
+      integer     nint,nni0,ii,jj
+!     integer i,j,nint,nni0,ii,jj
+
+      external mynode
+      integer  mynode
+
+!  determination de la position du sous-domaine dans la grille
+!  cela depnd de ibondi et ibondj
+
+! liste des sous-domaines voisins et des noeuds interface
+
+! be carefull!!! in the FETI algorithm, area number is considered
+! instead of process number
+
+!  initialisation
+
+      nint=0
+      nni0=0
+      plistin(1)=0
+
+!...first, the "segment-points"
+
+      if((ibondi == 2).AND.(iperio /= 1))then
+
+!  la periodicite : pas d'interface east / west si nbondi = 2
+!  ET nperio != 1
+
+      elseif(iperio == 1) then
+
+!  west
+
+          nint=nint+1
+          nsdvoisc(nint,1)=imoi
+          do jj=1,nj+1
+            listin(nni0+jj)=(jj-1)*(ni+1)+1
+          end do
+          nni0=nni0+nj+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=1
+          nsdvoisc(nint,3)=2
+
+!  east
+
+          nint=nint+1
+          nsdvoisc(nint,1)=imoi
+          do jj=1,nj+1
+            listin(nni0+jj)=(jj-1)*(ni+1)+ilei
+          end do
+          nni0=nni0+nj+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=2
+          nsdvoisc(nint,3)=1
+
+      else
+
+!  west
+
+          if(ibondi /= -1)then
+              nint=nint+1
+              nsdvoisc(nint,1)=(iowe+1)
+              do jj=1,nj+1
+                listin(nni0+jj)=(jj-1)*(ni+1)+1
+              end do
+              nni0=nni0+nj+1
+              plistin(nint+1)=nni0
+              nsdvoisc(nint,2)=1
+              nsdvoisc(nint,3)=2
+          endif
+
+!  east
+
+          if(ibondi /= 1)then
+              nint=nint+1
+              nsdvoisc(nint,1)=(ioea+1)
+              do jj=1,nj+1
+                listin(nni0+jj)=(jj-1)*(ni+1)+ilei
+              end do
+              nni0=nni0+nj+1
+              plistin(nint+1)=nni0
+              nsdvoisc(nint,2)=2
+              nsdvoisc(nint,3)=1
+          endif
+
+      endif
+
+!  south
+
+      if(ibondj /= -1.AND.ibondj /= 2)then
+          nint=nint+1
+          nsdvoisc(nint,1)=(ioso+1)
+          do ii=1,ni+1
+            listin(nni0+ii)=ii
+          end do
+          nni0=nni0+ni+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=3
+          nsdvoisc(nint,3)=4
+      endif
+
+!  north
+
+      if(ibondj /= 1.AND.ibondj /= 2)then
+          nint=nint+1
+          nsdvoisc(nint,1)=(iono+1)
+          do ii=1,ni+1
+            listin(nni0+ii)=(ilej-1)*(ni+1)+ii
+          end do
+          nni0=nni0+ni+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=4
+          nsdvoisc(nint,3)=3
+      endif
+
+!...second, the "corner-points"
+
+!...determination of the neighboorings, they depends on iperio 
+!   boundary condition => local description : inimpp or inimpp2...
+
+!  la periodicite : pas de coin si nbondi = 2
+!  ET nperio != 1
+
+!!!!!!!!!verifier la definition des voisins-coin
+
+!  north-west
+
+      if(ibnw == 1)then
+          nint=nint+1
+          nsdvoisc(nint,1)=(ipnw+1)
+          listin(nni0+1)=(ilej-1)*(ni+1)+1
+          nni0=nni0+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=5
+          nsdvoisc(nint,3)=8
+      endif
+
+!  north-east
+
+      if(ibne == 1)then
+          nint=nint+1
+          nsdvoisc(nint,1)=(ipne+1)
+          listin(nni0+1)=(ilej-1)*(ni+1)+ilei
+          nni0=nni0+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=6
+          nsdvoisc(nint,3)=7
+      endif
+
+!  south-west
+
+      if(ibsw == 1)then
+          nint=nint+1
+          nsdvoisc(nint,1)=(ipsw+1)
+          listin(nni0+1)=1
+          nni0=nni0+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=7
+          nsdvoisc(nint,3)=6
+      endif
+
+!  south-east
+
+      if(ibse == 1)then
+          nint=nint+1
+          nsdvoisc(nint,1)=(ipse+1)
+          listin(nni0+1)=ilei
+          nni0=nni0+1
+          plistin(nint+1)=nni0
+          nsdvoisc(nint,2)=8
+          nsdvoisc(nint,3)=5
+      endif
+
+!...je compte les coins
+
+      do ii=1,ninterf
+        nsdvois(ii,1) = nsdvoisc(ii,1)
+        nsdvois(ii,2) = nsdvoisc(ii,2)
+        nsdvois(ii,3) = nsdvoisc(ii,3)
+      enddo
+
+
+!  impressions
+
+!     write(*,*)'  sous-domaine :',imoi
+!     write(*,*)'  nombre de sous-domaines voisins :',ninterfc
+!      do ii=1,ninterfc
+!      write(*,*)'  sous-domaine voisin :',nsdvoisc(ii,1)
+!     write(*,*)'  nombre de noeuds interface :',   &
+!         plistin(ii+1)-plistin(ii)
+!     write(*,*)'  noeuds interface :',(listin(jj),jj=plistin(ii)+1,   &
+!         plistin(ii+1))
+!     end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_subdir(ni,nj,noeuds,ndir,mgcnum)
+      implicit none 
+      integer ni,nj,noeuds,ndir
+      integer mgcnum(ni+1,nj+1)
+      integer i,j
+!     integer i,j,k
+
+!  determination de la position du sous-domaine dans la grille
+!  narea = (j-1)*iglo + i , avec 1<=i<=iglo et 1<=j<=jglo 
+
+
+
+! 1. NUMBER THE GRID-POINTS USING BMASK
+! -------------------------------------
+
+
+      ndir=0
+      do j=1,nj+1
+        do i=1,ni+1
+          ndir=ndir+1-mgcnum(i,j)
+!      do k=1,noeuds
+!        ndir=ndir+1-mgcnum(k,1)
+        enddo
+      enddo
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_listdir(ni,nj,logdir,ndir,lisdir)
+      implicit none 
+      integer ni,nj,ndir
+      integer logdir(ni,nj),lisdir(ndir)
+      integer i0,ji,jj
+
+!  creation de la liste des degres de liberte bloques
+      i0=0
+      do ji=1,ni
+        do jj=1,nj
+          if(logdir(ji,jj) == 0) then
+              i0=i0+1
+              lisdir(i0)=ji+(jj-1)*ni
+          endif
+        end do
+      end do
+      if(i0 /= ndir) then
+!      write(*,*)'  nombre de ddl bloques/prevus :',i0,ndir
+!      write(*,*)'liste des ddl Dirichlet :',(lisdir(ji),ji=1,ndir)
+          stop
+      endif
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_blodir(n,x,ndlblo,list)
+      implicit none
+      integer n,ndlblo
+      integer list(ndlblo)
+      REAL(kind=8)  x(n)
+      integer i
+
+!  remise a zero des ddl bloques
+      do i=1,ndlblo
+        x(list(i))=0.e0
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_numblo(ndlblo,lisblo)
+      implicit none
+      external mynode
+!!    integer mynode,indlblog,iibidon
+      integer mynode
+      integer ndlblo
+      integer lisblo(ndlblo)
+!!    integer n
+
+!      indlblog=-ndlblo
+!      call mpp_min(indlblog,1,iibidon)
+!      indlblog=-indlblog
+!      if(mynode() == 0)THEN
+!      write(0,*)'  nombre de degres de liberte flottants :',ndlblo
+!      write(0,*)'  liste :',(lisblo(n),n=1,ndlblo)
+!      endif
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_blomat(ni,nj,a,ndlblo,lisblo)
+      implicit none
+      integer ni,nj
+      REAL(kind=8)  a(ni,nj,5)
+      integer ndlblo
+      integer lisblo(ndlblo)
+!!    integer i,j,k,l,n
+      integer i,j,k,n
+
+      do n=1,ndlblo
+!  degre de liberte bloque : lisblo(n) = (j-1)*ni + i
+        i=mod(lisblo(n)-1,ni)+1
+        j=((lisblo(n)-1)/ni)+1
+!  annulation des coefficients sur la ligne
+        do k=1,5
+          a(i,j,k)=0.e0
+        end do
+        a(i,j,3)=1.e0
+!  annulation des coefficients dans les colonnes correspondantes
+        if(i > 1) then
+            a(i-1,j,4)=0.e0
+        endif
+        if(i < ni) then
+            a(i+1,j,2)=0.e0
+        endif
+        if(j > 1) then
+            a(i,j-1,5)=0.e0
+        endif
+        if(j < nj) then
+            a(i,j+1,1)=0.e0
+        endif
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_blomat1(ni,nj,a,ndlblo,lisblo,nsp)
+      implicit none
+      integer ni,nj,ndlblo
+      REAL(kind=8)  a(ni,nj,5),nsp(ni,nj,ndlblo)
+      integer lisblo(ndlblo)
+!!    integer i,j,k,l,n
+      integer i,j,n
+
+      do n=1,ndlblo
+!  degre de liberte bloque : lisblo(n) = (j-1)*ni + i
+        i=mod(lisblo(n)-1,ni)+1
+        j=((lisblo(n)-1)/ni)+1
+!  annulation des coefficients dans les colonnes correspondantes
+        if(i > 1) then
+            nsp(i-1,j,n)=-a(i-1,j,4)
+        endif
+        if(i < ni) then
+            nsp(i+1,j,n)=-a(i+1,j,2)
+        endif
+        if(j > 1) then
+            nsp(i,j-1,n)=-a(i,j-1,5)
+        endif
+        if(j < nj) then
+            nsp(i,j+1,n)=-a(i,j+1,1)
+        endif
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_nullsp(noeuds,ni,nj,lpblo,blo,a,ndlblo,lisblo,nsp,z)
+!  calcul du noyau de la matrice
+      implicit none
+      integer noeuds,ni,nj,lpblo,ndlblo
+      REAL(kind=8)  a(ni,nj,5)
+      integer lisblo(ndlblo)
+      REAL(kind=8)  blo(lpblo),nsp(noeuds,ndlblo),z(noeuds)
+      external sdot
+      REAL(kind=8)  sdot,res
+      integer j,i
+
+!  calcul de [Aii]-1 * Aib
+      do j=1,ndlblo
+        call feti_resloc(noeuds,ni,nj,a,lpblo,blo,nsp(1,j),nsp(1,j),z)
+      end do
+!  remise a identite du bloc diagonal correspondant aux modes bloques
+      do i=1,ndlblo
+        do j=1,ndlblo
+          nsp(lisblo(i),j)=0.e0
+        end do
+        nsp(lisblo(i),i)=1.e0
+      end do
+!  verifications
+      do j=1,ndlblo
+        call feti_proax(noeuds,ni,nj,a,nsp(1,j),z)
+        res=sqrt(sdot(noeuds,z,1,z,1)/   &
+            sdot(noeuds,nsp(1,j),1,nsp(1,j),1))
+!       write(0,*)'  residu de la colonne ',j,' du noyau :',res
+!       write(0,*)'  vecteur colonne :'
+!       call prvec(noeuds,nsp(1,j))
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_project(gint,pgint,nspdim,x,b,nmspdim,numit0   &
+          ,nitmax,gvec,agvec,d,ad,add,gamm,numnes,listnes,plistin,numins   &
+          ,listin,narea,numnos,nsp,v,w,bufin,bufout,work)
+
+      implicit none 
+
+      integer nitmax, nspdim
+      REAL(kind=8)  x(nspdim), b(nspdim)
+
+!...the Krylov optimisation used in PCG associated to the Coarse Solver
+!   involve to keep di & adi vectors in etesolve procedure
+!   the nmspdim parameter is introduced to avoid message "out of bound"
+!   arrising qhen the memory is checked!
+
+!   nmspdim  =   Max (nspdim(Ep)) <= memory management (f77 context)
+!               p=1,Np
+
+!      REAL(kind=8)  gvec(nspdim), agvec(nspdim),
+!     &       d(nspdim,0:nitmax-1), ad(nspdim,0:nitmax-1), 
+!     &       add(0:nitmax-1), gamm(0:nitmax-1)
+
+      integer nmspdim
+      REAL(kind=8)  gvec(nspdim), agvec(nspdim),   &
+          d(nmspdim,0:nitmax-1), ad(nmspdim,0:nitmax-1),    &
+          add(0:nitmax-1), gamm(0:nitmax-1)
+
+      integer numnes,numins,narea,  numnos, numit0
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  nsp(numnos,nspdim), v(numnos),    &
+          w(numins), gint(numins), pgint(numins) 
+      REAL(kind=8)  bufin(numins), bufout(numins)
+      REAL(kind=8)  work(0:nitmax-1)
+
+
+      call feti_proet(numnes,listnes,plistin,numins,listin,numnos,   &
+          gint,nspdim,nsp,b,v)
+      call feti_etesolv(nspdim,x,b,nmspdim,numit0,nitmax,gvec,agvec,d,ad   &
+          ,add,gamm,numnes,listnes,plistin,numins,listin,narea,numnos   &
+          ,nsp,v,w,bufin,bufout,work)
+      call feti_proe(numnes,listnes,plistin,numins,listin,narea,numnos,   &
+          nspdim,nsp,x,v,w,bufin,bufout)
+      call feti_vsub(numins,gint,w,pgint)
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_etesolv(nspdim,x,b,nmspdim,numit0,nitmax,gvec    &
+          ,agvec,d,ad,add,gamm,numnes,listnes,plistin,numins,listin    &
+          ,narea,numnos,nsp,v,w,bufin,bufout,work)
+
+!     INPUTS :   nspdim  =   dimension of null space : LOCAL
+!                x       =   initial solution
+!                b       =   right hand side
+!               nmspdim  =   Max (nspdim(Ep)) <= memory management
+!                            p=1,Np
+!               numit0   =   number of previous direction vectors, at most
+!                            nitmax
+!               nitmax   =   number of maximum direction vectors for 
+!                            reconjugation  
+!               gvec     =   gradient vector
+!               agvec    =   A * g
+!               d        =   direction vector
+!               ad       =   A * d
+!               add      =   dot products (Ad,d)
+!               gamm     =   GAMMA coefficients
+!               numnes   =   number of neighbouring subdomains
+!               listnes  =   list of neighbouring subdomains
+!               plistin  =   pointer of sublists of interface nodes
+!               numins   =   number of interface nodes
+!               listin   =   list of interface nodes
+!               narea    =   subdomain number
+!               numnos   =   number of nodes in the subdomain
+
+!     WORKSPACE : bufin  =  contributions of local fields on interface
+!                 bufout =  contributions of outer fields on interface
+!                 work   =  workspace for mpp_sum calls
+
+      implicit none 
+
+      integer nitmax, nspdim
+      REAL(kind=8)  x(nspdim), b(nspdim)
+
+!...the Krylov optimisation involve to keep di & adi vectors
+!   the nmspdim parameter is introduce to avoid message "out of bound"
+!   arrising qhen the memory is checked!
+
+!      REAL(kind=8)  gvec(nspdim), agvec(nspdim),
+!     &       d(nspdim,0:nitmax-1), ad(nspdim,0:nitmax-1), 
+!     &       rho, temp1(2), temp2(2), add(0:nitmax-1),
+!     &       gamm(0:nitmax-1), facg0, facgn, facst, eps
+
+      integer nmspdim
+      REAL(kind=8)  gvec(nmspdim), agvec(nmspdim),    &
+          d(nspdim,0:nitmax-1), ad(nspdim,0:nitmax-1),     &
+          rho, temp1(2), temp2(2), add(0:nitmax-1),    &
+          gamm(0:nitmax-1), facg0, facgn, facst, eps
+
+      integer numnes,numins,narea,  numnos
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  nsp(numnos,nspdim), v(numnos), w(numins)
+      REAL(kind=8)  bufin(numins), bufout(numins)
+      REAL(kind=8)  work(0:nitmax-1)
+
+      integer i, j, n, numit0, nn, n1, numit1
+
+      external sdot
+      REAL(kind=8)  sdot
+
+!    initialisation 
+
+      do 1 i=1,nspdim
+        x(i) = 0.e0
+        gvec(i) = -b(i)
+ 1    continue
+      facg0 = sdot( nspdim, gvec, 1, gvec , 1)
+      call mpp_sum(facg0,1,work)
+
+      if( facg0  ==  0.e0 ) return
+
+      eps=1.e-24
+      facst=facg0*eps
+
+!    initial projection 
+
+      if(numit0 > 0) then
+          do 91 j = 0 , numit0
+            gamm(j) = - sdot(nspdim,gvec,1,d(1,j),1) / add(j)
+ 91       continue
+          call mpp_sum(gamm,numit0+1,work)
+          call feti_mxvadd( nspdim, numit0+1, d, gamm, x )
+          call feti_mxvadd( nspdim, numit0+1, ad, gamm, gvec )
+
+!  test residual after initial projection
+
+          facgn = sdot( nspdim, gvec, 1, gvec, 1 )
+          call mpp_sum(facgn,1,work)
+          if( facgn <= facst ) then
+!             write(0,*) 'residual after initial projection for feti_etesolv='   &
+!                 ,facgn/facg0
+              return
+          endif
+
+      endif
+
+!     compute (Et E) * gvec
+
+      call feti_proe(numnes,listnes,plistin,numins,listin,narea,numnos,   &
+          nspdim,nsp,gvec,v,w,bufin,bufout)
+      call feti_proet(numnes,listnes,plistin,numins,listin,numnos,w,   &
+          nspdim,nsp,agvec,v)
+
+!   conjugate d .
+
+      if(numit0 > 0) then
+          numit1=min0(numit0+1,nitmax-1)
+          do 94 i=0,numit0
+            gamm(i) = -sdot(nspdim,gvec,1,ad(1,i),1)/ add(i)
+ 94       continue
+          call mpp_sum(gamm,numit0+1,work)
+
+          call feti_osaxpy( nspdim,gamm(numit0),d(1,numit0),   &
+              gvec,d(1,numit1))
+          call feti_osaxpy( nspdim,gamm(numit0),ad(1,numit0),   &
+              agvec,ad(1,numit1))
+
+          call feti_mxvadd( nspdim, numit1-1, d, gamm, d(1,numit1) )
+          call feti_mxvadd( nspdim, numit1-1, ad, gamm, ad(1,numit1) )
+      else
+          numit1=0
+
+          do 20 i = 1, nspdim
+            d(i,numit1) = gvec(i)
+ 20       continue
+
+          do 30 i = 1, nspdim
+            ad(i,numit1) = agvec(i)
+ 30       continue
+      endif
+
+!     computing rho
+
+      do 50 nn = numit1, nitmax
+        n=min0(nn,nitmax-1)
+        temp1(1) = sdot( nspdim, gvec, 1, d(1,n), 1 )
+        temp1(2) = sdot( nspdim, ad(1,n), 1, d(1,n), 1 )
+        call mpp_sum(temp1,2,temp2)
+        add(n) = temp1(2)
+        rho = - temp1(1) / add(n)
+
+        call feti_osaxpy( nspdim, rho, d(1,n), x, x )
+        call feti_osaxpy( nspdim, rho, ad(1,n), gvec, gvec )
+
+!        test residual . 
+
+        facgn = sdot( nspdim, gvec, 1, gvec, 1 )
+        call mpp_sum(facgn,1,work)
+!        write(0,*) 'iteration =', nn+1, 'residual = ', facgn/facg0
+        if( facgn <= facst ) then
+            goto 999
+        endif
+
+!   reconjugation of gvec
+
+        do 60 i=0,n
+          gamm(i) = -sdot(nspdim,gvec,1,ad(1,i),1)/ add(i)
+ 60     continue
+        call mpp_sum(gamm,n+1,work)
+        n1=min0(nn+1,nitmax-1)
+
+        call feti_osaxpy( nspdim,gamm(n),d(1,n),gvec,d(1,n1))
+
+        call feti_mxvadd( nspdim, n1-1, d, gamm, d(1,n1) )
+
+!     compute (Et E) * d
+
+        call feti_proe(numnes,listnes,plistin,numins,listin,narea,   &
+            numnos,nspdim,nsp,d(1,n1),v,w,bufin,bufout)
+        call feti_proet(numnes,listnes,plistin,numins,listin,numnos,w,   &
+            nspdim,nsp,ad(1,n1),v)
+
+ 50   continue
+
+      if(narea == 1) then
+          write(0,*) 'No convergence for ete in ',nitmax,' iterations'
+          stop
+      endif
+
+
+ 999  continue
+      numit0=min0(n,nitmax-1)
+!     write(0,*) 'number of iterations for ete :', nn+1, ' ,  residual =', facgn
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_osaxpy( n, a, x, y, z )
+
+      implicit none
+
+      integer n
+      REAL(kind=8)  a, x(n), y(n), z(n)
+
+      integer i
+
+      do 10 i = 1, n
+        z(i) = y(i) + a * x(i)
+ 10   continue
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_proe(numnes,listnes,plistin,numins,listin,narea,   &
+          numnos,nspdim,nsp,alpha,v,w,bufin,   &
+          bufout)
+
+!  jump of a velocity field on the interfaces, in the case where 
+!  subdomain number i is allocated to processor number i-1 .
+!  the velocity field is Nsp * alpha, where Nsp is the nullspace .
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               narea     =  subdomain number
+!               numnos  =  number of nodes in the subdomain
+!               nspdim  =  dimension of the null space
+!               nsp     =  null space
+!               alpha   =  components of the velocity field in the null
+!                          space
+!               v       =  corresponding velocity field
+
+!     OUTPUTS :      w  =  jump on the interface
+
+!     WORKSPACE : bufin   =  contributions of local field on interface
+!                 bufout  =  contributions of outer fields on interface
+!                 work
+      implicit none 
+      integer numnes,numins,numnos,narea,nspdim
+      integer listnes(numnes,3), plistin(numnes+1), listin(numins)
+      REAL(kind=8)  v(numnos),w(numins)
+      REAL(kind=8)  bufin(numins),bufout(numins)
+      REAL(kind=8)  alpha(nspdim), nsp(numnos,nspdim)
+      integer i
+
+!  computing the values of the local velocity field 
+      do i=1,numnos
+        v(i)=0.e0
+      end do
+      call feti_mxvadd( numnos, nspdim, nsp, alpha, v )
+!  computing the jump on the interface
+      call feti_saut(numnes,listnes,plistin,numins,listin,   &
+                numnos,v,w,bufin,bufout)
+!!        narea,numnos,v,w,bufin,bufout)
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_proet(numnes,listnes,plistin,numins,listin,   &
+          numnos,w,nspdim,nsp,alpha,v)
+
+!  projection in the null space of the right-hand-side associated with
+!  a Lagrange multiplier w .
+
+!     INPUTS :      numins  =  number of interface nodes
+!               listin  =  list of interface nodes
+!               numnos  =  number of nodes in the subdomain
+!               w       =  Lagrange multiplier
+!               nspdim  =  dimension of the null space
+!               nsp     =  null space
+
+!     OUTPUTS :      v     =  local right-hand-side
+!               alpha =  projection of v in the null space
+
+      implicit none 
+      external sdot
+      REAL(kind=8)  sdot
+      integer numins,numnos,nspdim,numnes
+      integer listnes(numnes,3),plistin(numnes+1),listin(numins)
+      REAL(kind=8)  v(numnos),w(numins)
+      REAL(kind=8)  alpha(nspdim), nsp(numnos,nspdim)
+      integer i
+
+!  assembling the values of the Lagrange multiplier on the interface
+      call feti_probit(numnes,listnes,plistin,numins,listin,numnos,w,v)
+!  computing the projection of v in the null space .
+      do 1 i=1,nspdim
+        alpha(i)=sdot(numnos,v,1,nsp(1,i),1)
+ 1    continue
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_consrhs( vdim,nspdim,rhs,nsp,cb )
+
+
+      implicit none
+
+      external sdot
+      REAL(kind=8)  sdot
+      integer vdim, nspdim
+
+      REAL(kind=8)   rhs(vdim), nsp(vdim,nspdim), cb(nspdim)
+
+
+      integer i
+
+!  compute the right hand side for constraint 
+
+      do i=1,nspdim
+        cb(i)=-sdot(vdim,rhs,1,nsp(1,i),1)
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_dualschur(noeuds,ni,nj,a,lpblo,blo,   &
+          ninterf,ninterfc,nni,nnic,   &
+          ndvois,ndvoisc,plistin,listin,   &
+          poids,u,v,f,bitw,utilu,   &
+          lambda,g,pg,mg,nitmax,nmaxd,j0,wj,dwj,dwwj,   &
+          gamm,work,bufin,bufout,narea,epsilo,ndlblo,   &
+          lisblo,ndkerep,   &
+          xnul,ynul,numit0ete,nitmaxete,eteg,   &
+          eteag,eted,etead,eteadd,etegamm,nsp,etev,   &
+          etew,nnih,plistih,gh,w,dw,   &
+          residu,indic,jn)
+      implicit none
+!  nombre de ddl par noeuds, nombre de noeuds interne et interface
+      integer noeuds,ni,nj,nni,nnic
+!      integer jpj,jpi
+!  numero du sous-domaine = numero de processeur + 1 
+      integer narea
+!  tableaux descripteurs de la matrice locale
+      REAL(kind=8)  a(ni,nj,5)
+!  tableaux descripteurs de l'inverse de la matrice du probleme local
+      integer lpblo
+      REAL(kind=8)  blo(lpblo)
+!  tableaux descripteurs de l'interface
+      integer ninterf,ninterfc
+      integer ndvois(ninterf,3),ndvoisc(ninterfc,3)
+      integer plistin(ninterfc+1),listin(nnic)
+!  tableaux descripteurs de l'interface ajoutes pour nperio == 1
+      REAL(kind=8)  poids(noeuds)
+!  utilitaires pour les assemblages aux interfaces
+      REAL(kind=8)  bufin(nnic),bufout(nnic)
+!  vecteurs locaux
+      REAL(kind=8)  u(noeuds),v(noeuds),f(noeuds)
+      REAL(kind=8)  bitw(noeuds),utilu(noeuds)
+!  vecteurs inconnues aux interfaces
+!  mg est le gradient preconditionne : M = sum(Bi Ai Bit)
+      REAL(kind=8)  lambda(nni),g(nni),pg(nni),mg(nni)
+!  tableaux servant a gerer le stockage de la moitie des coefficients
+!  des tableaux des directions de descente sur chaque interface
+      integer nnih
+      integer plistih(ninterf+1)
+      REAL(kind=8)  gh(nnih)
+!  tableaux des directions de descente
+!  on appelle D la matrice condensee a l'interface : sum(Bi [Ai]-1 Bit)
+!  j0 est le nombre de vecteurs D orthogonaux deja stockes
+!  j0 est egal au plus a nmaxd-1
+!  lorsque le nomtre total d'iterations atteint nmaxd, seule la derniere
+!  direction calculee est stockee dans la colonne numero nmaxd
+      integer nitmax,nmaxd,j0
+      REAL(kind=8)  wj(nnih,nmaxd),dwj(nnih,nmaxd),dwwj(nmaxd)
+      REAL(kind=8)  w(nni),dw(nni)
+!  utilitaires pour les calculs de produits scalaires globaux
+      REAL(kind=8)  work(nmaxd),gamm(nmaxd)
+!  tableaux descripteurs du noyau de la matrice locale et tableaux 
+!  servant a la projection sur le noyau
+
+!...ndlblo is the dimension of the local nullspace .=<. the size of the
+!   memory of the superstructure associated to the nullspace : ndkerep
+!   indeed ndkerep = Max ndlblo = Max dim(Ker(Ep))
+!                                p=1,Np
+!   ndkerep is introduced to avoid messages "out of bounds" when memory
+!   is checked
+
+      integer ndkerep
+      integer ndlblo,numit0ete,nitmaxete
+      integer lisblo(ndlblo)
+      REAL(kind=8)  xnul(ndlblo),ynul(ndlblo),eteg(ndlblo),eteag(ndlblo)
+
+!...the Krylov optimisation used in PCG associated to the Coarse Solver
+!   involve to keep di & adi vectors in etesolve procedure
+!   the ndkerep parameter is introduced to avoid message "out of bound"
+!   arrising when the memory is checked!
+
+!   ndkerep  =   Max (ndlblo(Ep)) <= memory management (f77 context)
+!               p=1,Np
+
+!      REAL(kind=8)  eted(ndlblo,nitmaxete),etead(ndlblo,nitmaxete)
+
+      REAL(kind=8)  eted(ndkerep,nitmaxete),etead(ndkerep,nitmaxete)
+      REAL(kind=8)  eteadd(nitmaxete),etegamm(nitmaxete)
+      REAL(kind=8)  etev(noeuds),etew(nni),nsp(noeuds,ndlblo)
+!  indicateur de convergence
+
+      integer indic
+      REAL(kind=8)  residu
+      integer jn
+!  utilitaires
+!!    integer j,k,j1,ji,jj,jk
+      integer j,k,j1
+      REAL(kind=8)  scal(2),ff,roj,epsilo,epsilo2
+!  fonctions externes
+      external sdot
+      REAL(kind=8)  sdot
+!  booleen pour caracterisation
+!  numerique si llconv=1
+      integer llconv
+
+      llconv=0
+
+!...critere d'arret epsilo2 = epsilo **2 => evite sqrt
+
+      epsilo2 = epsilo * epsilo
+
+!  calcul du carre scalaire du second membre global
+
+      call feti_assemb(ninterfc,ndvoisc,plistin,nnic,listin,narea,noeuds   &
+          ,f,utilu,bufin,bufout)
+      ff=sdot(noeuds,utilu,1,utilu,1)
+      call mpp_sum(ff,1,work)
+!     write(90,*)'valeur du carre du second membre ds le Schur Dual :',ff
+
+!  calcul du second membre contraint 
+
+      call feti_consrhs(noeuds,ndlblo,f,nsp,ynul)
+
+!  calcul de lambda0 satisfaisant la contrainte
+ 
+!     call feti_vclr(nni,lambda)
+      call feti_etesolv(ndlblo,xnul,ynul,ndkerep,numit0ete,nitmaxete   &
+          ,eteg,eteag,eted,etead,eteadd,etegamm,ninterf,ndvois,plistin   &
+          ,nni,listin,narea,noeuds,nsp,etev,etew,bufin,bufout,work)
+
+      call feti_proe(ninterf,ndvois,plistin,nni,listin,narea,noeuds,   &
+          ndlblo,nsp,xnul,etev,lambda,bufin,bufout)
+
+!  calcul du nouveau second membre
+
+      call feti_probit(ninterf,ndvois,plistin,nni,listin,noeuds,lambda,bitw)
+
+      call feti_vadd(noeuds,bitw,f,bitw)
+
+
+!  calcul du champ local initial u0
+!     call feti_blodir(noeuds,bitw,ndlblo,lisblo)
+      call feti_resloc(noeuds,ni,nj,a,lpblo,blo,bitw,u,utilu)
+
+!  calcul du gradient initial g0 = feti_saut(u0)
+!!    call feti_saut(ninterf,ndvois,plistin,nni,listin,narea,noeuds,u,g   &
+      call feti_saut(ninterf,ndvois,plistin,nni,listin,      noeuds,u,g   &
+          ,bufin,bufout)
+
+!  reinitialisation de lambdaj0 par reconjugaison
+
+      call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea,g, gh)
+      do k=1,j0
+        gamm(k)=sdot(nnih,gh,1,wj(1,k),1)
+      end do
+      if(j0 >= 1) call mpp_sum(gamm,j0,work)
+      do k=1,j0
+        gamm(k)=-gamm(k)/dwwj(k)
+      end do
+      call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea, lambda,gh)
+      call feti_mxvadd(nnih,j0,wj,gamm,gh)
+      call feti_extend(ninterf,ndvois,plistin,nni,plistih,nnih,narea,gh, lambda)
+!  calcul du second membre associe a lambdaj0
+      if(j0 > 0) then
+          call feti_probit(ninterf,ndvois,plistin,nni,listin,noeuds, lambda,bitw)
+          call feti_vadd(noeuds,bitw,f,bitw)
+!  calcul du champ local associe uj0
+!         call feti_blodir(noeuds,bitw,ndlblo,lisblo)
+          call feti_resloc(noeuds,ni,nj,a,lpblo,blo,bitw,u,utilu)
+!  calcul du gradient initial gj0= feti_saut(uj0)
+!!        call feti_saut(ninterf,ndvois,plistin,nni,listin,narea,noeuds   &
+          call feti_saut(ninterf,ndvois,plistin,nni,listin,      noeuds   &
+              ,u,g,bufin,bufout)
+      endif
+!  calcul du gradient projete 
+!     call feti_vmov(nni,g,pg)
+      call feti_project(g,pg,ndlblo,xnul,ynul,ndkerep,numit0ete   &
+          ,nitmaxete,eteg,eteag,eted,etead,eteadd,etegamm,ninterf,ndvois   &
+          ,plistin,nni,listin,narea,noeuds,nsp,etev,etew,bufin,bufout,work)
+!  calcul du gradient preconditionne 
+!     call feti_vmov(nni,pg,mg)
+
+      call feti_probit(ninterf,ndvois,plistin,nni,listin,noeuds, pg,bitw)
+
+      call feti_proax(noeuds,ni,nj,a,bitw,v) 
+!!    call feti_saut(ninterf,ndvois,plistin,nni,listin,narea,noeuds,v, mg,bufin,bufout)
+      call feti_saut(ninterf,ndvois,plistin,nni,listin,      noeuds,v, mg,bufin,bufout)
+!  verification du residu initial 
+      residu=sdot(nni,mg,1,mg,1)
+      call mpp_sum(residu,1,work)
+      residu = (4. * residu) / ff
+      if(residu <= epsilo2)then
+!         residu=10.*sqrt(residu/ff)
+!         if(residu < epsilo)then
+          if(llconv == 1)then
+              if(narea == 1)then
+                  write(0,*)'  residu carre approche initial :',residu
+              endif
+          endif
+!  calcul du champ global moyenne aux interfaces et du residu global 
+          call feti_vsub(noeuds,u,etev,utilu)
+          call feti_moyen(ninterfc,ndvoisc,plistin,nnic,listin,narea,   &
+              noeuds,poids,utilu,utilu,bufin,bufout)
+          call feti_vmov(noeuds,utilu,u)
+          call feti_proax(noeuds,ni,nj,a,utilu,v) 
+          call feti_vsub(noeuds,v,f,v)
+          call feti_assemb(ninterfc,ndvoisc,plistin,nnic,listin,narea,   &
+              noeuds,v,utilu,bufin,bufout)
+          residu=sdot(noeuds,utilu,1,utilu,1)
+          call mpp_sum(residu,1,work)
+          residu=sqrt(residu/ff)
+!         residu=residu/ff
+          if(llconv == 1)then
+              if(narea == 1)then
+                  write(0,*)'  residu exact initial :',residu
+              endif
+          endif
+
+ 101      format(10d9.2)
+
+          return
+
+      endif
+
+
+!  calcul de la premiere direction de descente
+!  calcul du gradient preconditionne projete 
+      call feti_project(mg,mg,ndlblo,xnul,ynul,ndkerep,numit0ete   &
+          ,nitmaxete,eteg,eteag,eted,etead,eteadd,etegamm,ninterf,ndvois   &
+          ,plistin,nni,listin,narea,noeuds,nsp,etev,etew,bufin,bufout ,work)
+      call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea,   &
+          mg,wj(1,j0+1))
+      do k=1,j0
+        gamm(k)=sdot(nnih,wj(1,j0+1),1,dwj(1,k),1)
+      end do
+      if(j0 >= 1) call mpp_sum(gamm,j0,work)
+      do k=1,j0
+        gamm(k)=-gamm(k)/dwwj(k)
+      end do
+      call feti_mxvadd(nnih,j0,wj,gamm,wj(1,j0+1))
+
+!  iterations de gradient conjugue a l'interface
+
+
+!debug
+      do j=j0+1,j0+nitmax
+
+        if(llconv == 1.and.narea == 1) write(0,*)'etape numero',j-j0
+!  j1 est le numero de colonne de la derniere direction de descente
+!  j1 = j, numero d'iteration total, tant que j < nmaxd
+!  au-dela, j1 = nmaxd
+        j1=min0(j,nmaxd)
+!  calcul de Dwi , D = sum ( Bi [Ai]-1 tBi )
+        call feti_extend(ninterf,ndvois,plistin,nni,plistih,nnih,narea, wj(1,j1),w)
+        call feti_probit(ninterf,ndvois,plistin,nni,listin,noeuds, w,bitw)
+!       call feti_blodir(noeuds,bitw,ndlblo,lisblo)
+        call feti_resloc(noeuds,ni,nj,a,lpblo,blo,bitw,v,utilu)
+!!      call feti_saut(ninterf,ndvois,plistin,nni,listin,narea,noeuds,v   &
+        call feti_saut(ninterf,ndvois,plistin,nni,listin,      noeuds,v   &
+            ,dw,bufin,bufout)
+        call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea, dw,dwj(1,j1))
+!  calcul du coefficient de descente
+        call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea, g,gh)
+        scal(1)=sdot(nnih,gh,1,wj(1,j1),1)
+        scal(2)=sdot(nnih,dwj(1,j1),1,wj(1,j1),1)
+        call mpp_sum(scal,2,work)
+        roj=-scal(1)/scal(2)
+        dwwj(j1)=scal(2)
+!  remise a jour de lambda, g et u
+        call saxpy(nni,roj,w,1,lambda,1)
+        call saxpy(nni,roj,dw,1,g,1)
+        call saxpy(noeuds,roj,v,1,u,1)
+!  calcul du gradient projete 
+!       call feti_vmov(nni,g,pg)
+        call feti_project(g,pg,ndlblo,xnul,ynul,ndkerep,numit0ete   &
+            ,nitmaxete,eteg,eteag,eted,etead,eteadd,etegamm,ninterf   &
+            ,ndvois,plistin,nni,listin,narea,noeuds,nsp,etev,etew,bufin   &
+            ,bufout,work)
+!  calcul du gradient preconditionne Mg , M = sum ( Bi Ai tBi )
+!       call feti_vmov(nni,pg,mg)
+        call feti_probit(ninterf,ndvois,plistin,nni,listin,noeuds, pg,bitw)
+        call feti_proax(noeuds,ni,nj,a,bitw,v) 
+!!      call feti_saut(ninterf,ndvois,plistin,nni,listin,narea,noeuds,v   &
+        call feti_saut(ninterf,ndvois,plistin,nni,listin,      noeuds,v   &
+            ,mg,bufin,bufout)
+!  verification du residu global approche
+        residu=sdot(nni,mg,1,mg,1)
+        call mpp_sum(residu,1,work)
+!       residu=10.*sqrt(residu/ff)
+        residu = (4. * residu) / ff
+        if(llconv == 1.and.narea == 1)then
+            write(0,*)'  residu carre global approche apres ',   &
+                j-j0,' iterations :',residu
+        endif
+
+!       if(residu <  epsilo) then
+        if(residu <= epsilo2)then
+            if(llconv == 1.and.narea == 1)then
+                write(0,*)'residu carre global approche apres ',   &
+                    j-j0,' iterations :',residu
+            endif
+!  calcul du champ global moyenne aux interfaces et du residu global 
+            call feti_vsub(noeuds,u,etev,utilu)
+            call feti_moyen(ninterfc,ndvoisc,plistin,nnic,listin,narea,   &
+                noeuds,poids,utilu,utilu,bufin,bufout)
+            call feti_vmov(noeuds,utilu,u)
+            call feti_proax(noeuds,ni,nj,a,utilu,v) 
+            call feti_vsub(noeuds,v,f,v)
+            call feti_assemb(ninterfc,ndvoisc,plistin,nnic,listin,narea,   &
+                noeuds,v,utilu,bufin,bufout)
+            residu=sdot(noeuds,utilu,1,utilu,1)
+            call mpp_sum(residu,1,work)
+!           residu=residu/ff
+            residu=sqrt(residu/ff)
+            if(llconv == 1.and.narea == 1)then
+                write(0,*)'  residu global exact apres ',   &
+                    j-j0,' iterations :',residu
+            endif
+
+            jn = j - j0
+            j0=min0(j,nmaxd-1)
+            if(llconv == 1.and.narea == 1)then
+                write(0,*)'  nombre de directions orthogonales conservees :',j0
+            endif
+
+
+            return
+        endif
+!##################################################################
+!  calcul du champ global moyenne aux interfaces et du residu global 
+        call feti_vsub(noeuds,u,etev,utilu)
+        call feti_moyen(ninterfc,ndvoisc,plistin,nnic,listin,narea,   &
+            noeuds,poids,utilu,utilu,bufin,bufout)
+        call feti_proax(noeuds,ni,nj,a,utilu,v) 
+        call feti_vsub(noeuds,v,f,v)
+        call feti_assemb(ninterfc,ndvoisc,plistin,nnic,listin,narea,   &
+            noeuds,v,utilu,bufin,bufout)
+        residu=sdot(noeuds,utilu,1,utilu,1)
+        call mpp_sum(residu,1,work)
+!       residu=sqrt(residu/ff)
+        residu=residu/ff
+        if(llconv == 1.and.narea == 1)then
+            write(0,*)'  residu carre global exact apres ',   &
+                j-j0,' iterations :',residu
+        endif
+
+!#####################################################################
+!  calcul de la nouvelle direction de descente par reconjugaison
+!  calcul du gradient preconditionne projete 
+        call feti_project(mg,mg,ndlblo,xnul,ynul,ndkerep,numit0ete   &
+            ,nitmaxete,eteg,eteag,eted,etead,eteadd,etegamm,ninterf   &
+            ,ndvois,plistin,nni,listin,narea,noeuds,nsp,etev,etew,bufin   &
+            ,bufout,work)
+        call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea, mg,gh)
+        do k=1,j1
+          gamm(k)=sdot(nnih,gh,1,dwj(1,k),1)
+        end do
+        call mpp_sum(gamm,j1,work)
+        do k=1,j1
+          gamm(k)=-gamm(k)/dwwj(k)
+        end do
+        call feti_mxvadd(nnih,j1,wj,gamm,gh)
+        j1=min0(j1+1,nmaxd)
+
+!%%%%%%%%%%stabilisation numerique %%%%%%%%%%%%%%%%%%%%%%%%%
+        call feti_extend(ninterf,ndvois,plistin,nni,plistih,nnih,narea, gh,w)
+        call feti_project(w,w,ndlblo,xnul,ynul,ndkerep,numit0ete   &
+            ,nitmaxete,eteg,eteag,eted,etead,eteadd,etegamm,ninterf   &
+            ,ndvois,plistin,nni,listin,narea,noeuds,nsp,etev,etew,bufin   &
+            ,bufout,work)
+        call feti_restri(ninterf,ndvois,plistin,nni,plistih,nnih,narea, w,gh)
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+        call feti_vmov(nnih,gh,wj(1,j1))
+
+      end do
+
+      residu = sqrt(residu)
+      if(narea == 1) then
+          write(0,*)'  residu global approche apres ',nitmax,   &
+              '  iterations :',residu
+      endif
+      indic=-2
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_extend(numnes,listnes,   &
+          plistin,numins,plistih,   &
+          numinh,narea,wh,w)
+
+!  reassembling an half interface field 
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               lint    =  list of inner interfaces
+!               lext    =  list of extern ibnterfaces
+!               plistin =  pointer of sublists of interface nodes
+!               plistih =  pointer of half-sublists of interface nodes
+!               numins  =  number of interface nodes
+!               numinh  =  half number of interface nodes
+!               narea    =  subdomain number
+!               wh      =  half interface vector 
+
+!     OUTPUTS :      w  =  complete interface vector
+
+!     WORKSPACE : work
+      implicit none 
+!      external irecv
+!!    integer irecv, work(100)
+      integer numnes,numins,numinh,narea
+      integer listnes(numnes,3), plistin(numnes+1), plistih(numnes+1)
+      REAL(kind=8)  wh(numinh),w(numins)
+      integer i,l,lin,lout
+      integer mesg
+
+      mesg=128*10
+!  if subdomains i < j are neighbours, subdomain i manage the first
+!  half of the interface, and subdomain j the remaining part
+
+!  receiving the values of the outer fields on the interface
+!  sending the values of the inner field on the interface
+
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))
+!        if(narea < listnes(i)) then
+        if(listnes(i,3) < listnes(i,2))then
+            lout=(l-(l/2))
+            lin=(l/2)
+!           work(i)=irecv(mesg+listnes(i)-1,w(plistin(i)+(l/2)+1), lout*8)
+!           call mppsend(mesg+narea-1,wh(plistih(i)+1),lin*8,listnes(i) -1,0)
+            call mppsend(mesg+listnes(i,3)-1,wh(plistih(i)+1),lin*8, listnes(i,1)-1,0)
+            call feti_vmov(lin,wh(plistih(i)+1),w(plistin(i)+1))
+        else
+            lout=(l/2)
+            lin=(l-(l/2))
+!           work(i)=irecv(mesg+listnes(i)-1,w(plistin(i)+1),lout*8)
+!           call mppsend(mesg+narea-1,wh(plistih(i)+1),lin*8,listnes(i)-1,0)
+            call mppsend(mesg+listnes(i,3)-1,wh(plistih(i)+1),lin*8, listnes(i,1)-1,0)
+            call feti_vmov(lin,wh(plistih(i)+1),w(plistin(i)+(l/2)+1))
+        endif
+      enddo
+!  waiting for the completion on each interface 
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))
+!       if(narea < listnes(i)) then
+        if(listnes(i,3) < listnes(i,2))then
+            lout=(l-(l/2))
+!           call mpprecv(mesg+listnes(i)-1,w(plistin(i)+(l/2)+1), lout*8)
+            call mpprecv(mesg+listnes(i,2)-1,w(plistin(i)+(l/2)+1), lout*8)
+            call feti_vneg(lout,w(plistin(i)+(l/2)+1),   &
+                w(plistin(i)+(l/2)+1))
+        else
+            lout=(l/2)
+!           call mpprecv(mesg+listnes(i)-1,w(plistin(i)+1),lout*8)
+            call mpprecv(mesg+listnes(i,2)-1,w(plistin(i)+1),lout*8)
+            call feti_vneg(lout,w(plistin(i)+1),w(plistin(i)+1))
+        endif
+      end do
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_restri(numnes,listnes,plistin,numins,plistih,   &
+          numinh,narea,w,wh)
+
+!  restriction of an interface field to one half on each interface
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               plistin =  pointer of sublists of interface nodes
+!               plistih =  pointer of half-sublists of interface nodes
+!               numins  =  number of interface nodes
+!               numinh  =  half number of interface nodes
+!               narea    =  subdomain number
+!               w       =  complete interface vector 
+
+!     OUTPUTS :      wh  =  half interface vector
+
+!     WORKSPACE : work
+      implicit none 
+      integer numnes,numins,numinh,narea
+      integer listnes(numnes,3), plistin(numnes+1), plistih(numnes+1)
+      REAL(kind=8)  wh(numinh),w(numins)
+      integer i,l,lin
+
+!  if subdomains i < j are neighbours, subdomain i manage the first
+!  half of the interface, and subdomain j the remaining part
+
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))
+!       if(narea < listnes(i)) then
+        if(listnes(i,3) < listnes(i,2))then
+            lin=(l/2)
+            call feti_vmov(lin,w(plistin(i)+1),wh(plistih(i)+1))
+        else
+            lin=(l-(l/2))
+            call feti_vmov(lin,w(plistin(i)+(l/2)+1),wh(plistih(i)+1))
+        endif
+      end do
+
+      return
+      end
+!**********************************************************************c
+!!    subroutine feti_halfint(numnes,listnes,plistin,numins,plistih   &
+!!        ,numinh,narea)
+      subroutine feti_halfint(numnes,listnes,plistin,       plistih   &
+          ,numinh      )
+
+!  construction of the pointer of the restriction of an interface 
+!  field to one half on each interface
+
+!     INPUTS :      numnes  =  number of neighbouring subdomains
+!               listnes =  list of neighbouring subdomains
+!               plistin =  pointer of sublists of interface nodes
+!               numins  =  number of interface nodes
+!               narea    =  subdomain number
+
+!     OUTPUTS :      numinh  =  half number of interface nodes
+!               plistih =  pointer of half-sublists of interface nodes
+
+!     WORKSPACE : work
+      implicit none 
+!!    integer numnes,numins,numinh,narea
+      integer numnes,       numinh
+      integer listnes(numnes,3), plistin(numnes+1), plistih(numnes+1)
+      integer i,l
+
+!  if subdomains i < j are neighbours, subdomain i manage the first
+!  half of the interface, and subdomain j the remaining part
+
+      plistih(1)=0
+      numinh=0
+      do i=1,numnes
+        l=(plistin(i+1)-plistin(i))
+!        if(narea < listnes(i,1)) then
+        if(listnes(i,3) < listnes(i,2)) then
+!          write(*,*)'je gere interface avec : ',listnes(i,1)
+            plistih(i+1)=plistih(i)+(l/2)
+        else
+!          write(*,*)'il gere interface avec : ',listnes(i,1)
+            plistih(i+1)=plistih(i)+(l-(l/2))
+        endif
+      end do
+      numinh=plistih(numnes+1)
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_front(n,ni,nj,a,lcmat,cmat,d,v,w,ndlblo,lisblo   &
+          ,nmdlblo)
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension a(n,5)
+!  routine de calcul de la decomposition frontale par blocs de
+!  la matrice pentadiagonale a .
+!  cmat contient les termes des blocs diagonaux factorises .
+      dimension cmat(lcmat),d(n)
+
+!...ndlblo nombre de liberte bloques = nombre de pivots nuls = dim(Ker(Ep))
+
+!...nmdlblo = Max (ndlblo(Ep)) <= superstructure management in f77 context
+!            p=1,Np
+
+      integer ndlblo,nmdlblo
+      integer lisblo(nmdlblo)
+
+!  d ne contient pas, en sortie, l'inverse de la diagonale de Crout .
+!  v est un tableau servant a stocker la partie triangulaire inferieure
+!  stricte d'un bloc diagonal , et w un tableau servant a stocker un
+!  bloc sur-diagonal plein .
+!  de dimension egale a la largeur maximale d'un front .
+      dimension v(ni,ni),w(ni)
+!!!
+      ndimd=ni
+      lbd=ndimd*ndimd
+
+!      lecture du tout premier bloc diagonal
+
+      nb=1
+!  adresse du bloc diagonal courant
+      iac=1
+      call feti_liblod(n,ni,a,ndimd,nb,cmat(iac))
+!  inversion du premier bloc diagonal .
+!     write(*,*)'  inversion du premier bloc diagonal '
+      j0=0
+      call feti_ldlt(ndimd,cmat(iac),d(1),w,ndlblo,lisblo,nmdlblo,j0)
+      call feti_calinv(ndimd,cmat(iac),v)
+
+!  contraction puis inversion des blocs diagonaux de la la matrice
+!  front par front .
+
+      do 2 nb=2,nj
+!       write(*,*)'  front numero ',nb
+!  adresse du bloc diagonal precedent
+        iap=iac
+        iac=(nb-1)*lbd+1
+
+!      lecture du bloc sur-diagonal precedent: passage bande-vecteur
+
+        call feti_liblos(n,a,ndimd,nb-1,w)
+
+!  elimination du bloc extra-diagonal .
+
+!   lecture du bloc diagonal courant: passage bande-plein
+
+        call feti_liblod(n,ni,a,ndimd,nb,cmat(iac))
+
+!  calcul du nouveau bloc diagonal courant .
+
+!       write(*,*)'  calcul du nouveau bloc diagonal courant '
+        call feti_nbdia(ndimd,w,cmat(iap),cmat(iac))
+
+!  inversion du nouveau bloc diagonal courant .
+
+!       write(*,*)'  factorisation du nouveau bloc diagonal courant '
+        j0=(nb-1)*ndimd
+        call feti_ldlt(ndimd,cmat(iac),d((nb-1)*ndimd+1),w,ndlblo,   &
+            lisblo,nmdlblo,j0)
+        call feti_calinv(ndimd,cmat(iac),v)
+
+ 2    continue
+
+      return
+      end
+!**********************************************************************c
+      subroutine feti_calinv(dim,a,b)
+!  calcul de la partie triangulaire inferieure du bloc :
+!  b = [a]-1 puis recopie dans a complet .
+      implicit none
+      integer dim
+      REAL(kind=8)  a(dim,dim),b(dim,dim)
+      integer i,j
+
+      call feti_vclr(dim*dim,b)
+      do j=1,dim
+        b(j,j)=1.e0
+        call feti_desremo(dim,j-1,a,b(1,j),b(1,j))
+      end do
+      do j=1,dim
+        do i=j,dim
+          a(i,j)=b(i,j)
+          a(j,i)=b(i,j)
+        end do
+      end do
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_nbdia(n,d,w,v)
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension d(n),v(n,n),w(n,n)
+
+      do 1 j=1,n
+        do 2 i=1,n
+          v(i,j)=v(i,j)-d(i)*w(i,j)*d(j)
+ 2      continue
+ 1    continue
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_liblod(n,ni,a,ndimd,nb,db)
+
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension db(ndimd,ndimd)
+!  tableaux descripteurs de la structure morse de la matrice .
+      dimension a(n,5)
+
+      call feti_vclr(ndimd*ndimd,db)
+!       do i=1,ndimd*ndimd
+!         db(i,1)=0.e0
+!8     continue
+      n0=(nb-1)*ndimd
+!  lecture de la diagonale db(i,i) .
+      do 3 i=1,ndimd
+        db(i,i)=a(n0+i,3)
+ 3    continue
+!  lecture de la premiere sur-diagonale db(i,i+1) .
+      do 4 i=1,ndimd-1
+        db(i,i+1)=a(n0+i,4)
+ 4    continue
+!  lecture de la premiere sous-diagonale db(i,i-1) .
+      do 2 i=2,ndimd
+        db(i,i-1)=a(n0+i,2)
+ 2    continue
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_liblos(n,a,ndimd,nb,v)
+
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension v(ndimd)
+!  tableaux descripteurs de la structure morse de la matrice .
+      dimension a(n,5)
+
+      n0=(nb-1)*ndimd
+!  lecture de la deuxieme sur-diagonale v(i) .
+      do 5 i=1,ndimd
+        v(i)=a(n0+i,5)
+ 5    continue
+
+      return
+      end
+!***********************************************************************
+      subroutine feti_resloc(n,ni,nj,a,lcmat,cmat,y,x,z)
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension a(n,5)
+!  routine de resolution utilisant la decomposition frontale par blocs
+!  de la matrice heptadiagonale a .
+!  cmat contient les termes des blocs diagonaux factorises .
+      dimension cmat(lcmat)
+!  d contient l'inverse de la diagonale de Crout .
+      dimension y(n),x(n),z(n)
+!
+      call feti_vmov(n,y,z)
+      ndimd=ni
+      lbd=ndimd*ndimd
+!  descente du systeme .
+      do nb=1,nj-1
+!  calcul du second membre condense : z(i+1)=y(i+1)- FD-1 z(i) .
+        iacmat=(nb-1)*lbd+1
+        n0=(nb-1)*ndimd
+        call feti_mxv(ndimd,ndimd,cmat(iacmat),z(n0+1),x(n0+1))
+        call feti_pbloi(n,ni,nj,a,x,z,nb)
+      end do
+!  inversion du dernier bloc diagonal .
+      iacmat=(nj-1)*lbd+1
+      n0=(nj-1)*ndimd
+      call feti_mxv(ndimd,ndimd,cmat(iacmat),z(n0+1),x(n0+1))
+!  remontee du systeme par bloc .
+      do nb=nj-1,1,-1
+!  calcul du second membre condense : z(i)=z(i)- E x(i+1) .
+        call feti_pblos(n,ni,nj,a,x,z,nb)
+!  calcul de la solution pour le bloc diagonal courant .
+        iacmat=(nb-1)*lbd+1
+        n0=(nb-1)*ndimd
+        call feti_mxv(ndimd,ndimd,cmat(iacmat),z(n0+1),x(n0+1))
+      end do
+
+      end
+!***********************************************************************
+      subroutine feti_pblos(n,ni,nj,a,x,y,nb)
+!  calcul du produit matrice-vecteur morse : y = y - A x .
+!  produit par le bloc superieur numero nb .
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension a(n,5)
+      dimension x(n),y(n)
+
+      n0=(nb-1)*ni
+!  produit par la deuxieme sur-diagonale a(i,i+ni) .
+      do i=n0+1,n0+ni
+        y(i)=y(i)-x(i+ni)*a(i,5)
+      end do
+
+      end subroutine feti_pblos
+!***********************************************************************
+      subroutine feti_pbloi(n,ni,nj,a,x,y,nb)
+!  calcul du produit matrice-vecteur morse : y = y - A x .
+!  produit par le bloc inferieur numero nb .
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension a(n,5)
+      dimension x(n),y(n)
+
+      n0=nb*ni
+!  produit par la deuxieme sous-diagonale a(i,i-ni) .
+      do i=n0+1,n0+ni
+        y(i)=y(i)-x(i-ni)*a(i,1)
+      end do
+
+      end subroutine feti_pbloi
+!***********************************************************************
+      subroutine feti_proax(n,ni,nj,a,x,y)
+!  calcul du produit matrice-vecteur morse par la matrice heptadiagonale
+!  a stockee par bandes .
+      implicit REAL(kind=8) (a-h,o-z)
+      dimension a(n,5)
+      dimension x(n),y(n)
+
+!  produit par la diagonale .
+      do i=1,n
+        y(i)=x(i)*a(i,3)
+      end do
+!  produit par la premiere sur-diagonale a(i,i+1) .
+      do i=1,n-1
+        y(i)=y(i)+x(i+1)*a(i,4)
+      end do
+!  produit par la deuxieme sur-diagonale a(i,i+ni) .
+      do i=1,n-ni
+        y(i)=y(i)+x(i+ni)*a(i,5)
+      end do
+! produit par la premiere sous-diagonale a(i,i-1)
+      do i=2,n
+          y(i)=y(i)+x(i-1)*a(i,2)
+      end do
+! produit par la deuxieme sous-diagonale a(i,i-ni)
+      do i=1+ni,n
+          y(i)=y(i)+x(i-ni)*a(i,1)
+      end do
+
+      end subroutine feti_proax
+
+#else
+   !! no use of FETI librairy
+#endif
+
+   !!======================================================================
+END MODULE lib_feti
Index: /branches/nemo/NEMO/OPA_SRC/lib_io_fdir.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/lib_io_fdir.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/lib_io_fdir.F90	(revision 4)
@@ -0,0 +1,660 @@
+MODULE lib_io_fdir
+   !!======================================================================
+   !!   ???
+   !!======================================================================
+#if defined key_fdir
+   !!======================================================================
+   !!  IO Routines for OPA
+   !!
+   !!  read2     read a direct access 2D field (jpiglo,jpjglo)
+   !!  read2d    read a direct access 2D field (jpidta,jpjdta)
+   !!  read3     read a direct access 3D field (jpiglo,jpjglo,jpk)
+   !!  read3d    read a direct access 3D field (jpidta,jpjdta,jpk)
+   !!
+   !!  write2    write a direct access 2D field (jpiglo,jpjglo)
+   !!  write3    write a direct access 3D field (jpiglo,jpjglo,jpk)
+   !!  write4    write a 4bytes direct access 2D field (jpiglo,jpjglo)
+   !!
+   !!======================================================================
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain 
+   USE lib_mpp         ! distributed memory computing library
+
+   IMPLICIT NONE
+
+   !! * Module variables
+   INTEGER, PARAMETER ::            &
+      jpkmod  = 1 + (jpk-1)/jpnij      ! used for mpp outputs
+
+   REAL(wp), DIMENSION(jpi,jpj,jpnij,jpkmod) ::   &
+      tabio              ! i/o workspace array
+   REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
+      tabglo             ! global auxilary array
+   REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
+      tabdta             ! global auxilary array
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE read2( kunit, ptab, kdim, krec )
+   !!---------------------------------------------------------------------
+   !!                  ***  ROUTINE read2  ***
+   !!      
+   !! ** Purpose :   Opa standard input for a 2D array
+   !!
+   !! ** Method : - Read a binary array ( direct access file )
+   !!      If key_mpp is used, write with an auxilary array
+   !!
+   !! History
+   !!      original  : 93-09 (M. Imbard)
+   !!      additions : 96-05 (J. Escobar)
+   !!----------------------------------------------------------------------
+   !! * Arguments
+      INTEGER , INTENT( in  ) ::   &
+         kunit           ! output unit
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   &
+         ptab            ! variable array
+      INTEGER , INTENT( in  ) ::   &
+         kdim ,       &  ! record length
+         krec            ! record unit for direct access file
+
+#if defined key_mpp
+   !! * Local declarations
+      INTEGER ji, jj, jproc   ! dummy loop indices
+      INTEGER imess, ic
+      INTEGER ilci, ilcj, iilb, ijlb
+   !!---------------------------------------------------------------------
+
+   ! 1. Read global array
+   ! --------------------
+
+   ! only the main processor
+
+      IF( narea == 1 ) THEN
+         READ(kunit,REC=kdim*(krec-1)+1) tabglo
+         DO jproc = 1, jpnij
+            ilci = nlcit (jproc)
+            ilcj = nlcjt (jproc)
+            iilb = nimppt(jproc)
+            ijlb = njmppt(jproc)
+            DO jj = 1, ilcj
+               DO ji = 1, ilci
+                  tabio(ji,jj,jproc,1) = tabglo(ji+iilb-1,jj+ijlb-1)
+               END DO
+             END DO
+         END DO
+      ENDIF
+      CALL mppsync
+
+   ! 2. Scaterring of auxilary array
+   ! -------------------------------
+
+      CALL mppscatter( tabio, 1, 0, ptab )
+      CALL mppsync
+
+      ! mask
+      DO jj = nlcj+1, jpj
+         DO ji = 1, nlci
+            ptab(ji,jj) = 0.e0
+         END DO
+      END DO
+      DO ji = nlci+1, jpi
+         ptab(ji,:) = 0.e0
+      END DO
+      CALL mppsync
+
+#  else
+     READ(kunit,REC=kdim*(krec-1)+1) ptab
+#endif
+
+   END SUBROUTINE read2
+
+
+   SUBROUTINE read2d( kunit, ptab, kdim, krec )
+   !!---------------------------------------------------------------------
+   !!                  ***  ROUTINE read2D  ***
+   !!
+   !! ** Purpose :   Opa standard input for a 2D data array
+   !!     (its possible to read only a subdomain - zoom )
+   !!
+   !! ** Method  :   Read a binary array ( direct access file )
+   !!      If key_mpp is used, write with an auxilary array
+   !!
+   !! ** Action :
+   !!
+   !! History :
+   !!      original  : 93-09 (M. Imbard)
+   !!      additions : 96-05 (j. Escobar)
+   !!      additions : 98-11 (J. Vialard) vpp
+   !!----------------------------------------------------------------------
+   !! * Arguments 
+      INTEGER , INTENT( in  ) ::   &
+         kunit           ! output unit
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   &
+         ptab            ! variable array
+      INTEGER , INTENT( in  ) ::   &      
+         kdim ,       &  ! record length
+         krec            ! record unit for direct access file
+
+#if defined key_mpp
+      INTEGER ji, jj, jproc
+      INTEGER imess, ic
+      INTEGER ilci, ilcj, iilb, ijlb
+   !!---------------------------------------------------------------------
+
+
+   ! 1. Read global array
+   ! --------------------
+
+   ! only the main processor
+
+      IF( narea == 1 ) THEN
+         READ(kunit,REC=kdim*(krec-1)+1) tabdta
+         DO jproc=1,jpnij
+            ilci = nlcit (jproc)
+            ilcj = nlcjt (jproc)
+            iilb = nimppt(jproc)
+            ijlb = njmppt(jproc)
+            DO jj = 1, ilcj
+               DO ji = 1, ilci
+                  tabio(ji,jj,jproc,1)=tabdta(ji+jpizoom-1+iilb-1,jj+jpjzoom-1+ijlb-1)
+               END DO
+            END DO
+         END DO
+      ENDIF
+      CALL mppsync
+
+   ! 2. Scaterring of auxilary array
+   ! -------------------------------
+
+      CALL mppscatter( tabio, 1, 0, ptab )
+
+   ! mask
+
+      DO jj = nlcj+1, jpj
+         DO ji = 1, nlci
+            ptab(ji,jj) = 0.e0
+         END DO
+      END DO
+      DO ji = nlci+1, jpi
+         ptab(ji,:) = 0.e0
+      END DO
+      CALL mppsync
+
+#  else
+
+      INTEGER ji, jj
+
+      READ(kunit,REC=kdim*(krec-1)+1) tabdta
+      DO jj = 1, jpj
+        DO ji = 1, jpi
+          ptab(ji,jj) = tabdta( mig(ji), mjg(jj) )
+        END DO
+      END DO
+#endif
+
+  END SUBROUTINE read2d
+
+
+   SUBROUTINE read3( kunit, ptab, krec )
+   !!---------------------------------------------------------------------
+   !!                  ***  ROUTINE read3  ***
+   !!                 
+   !! ** Purpose :   Opa standard input for a 3d array
+   !!
+   !! ** Method  :   Read a binary array ( direct access FILE )
+   !!      If key_mpp is used, write with an auxilary array
+   !!
+   !! ** Action :
+   !!
+   !! History :
+   !!      original  : 93-09 (M. Imbard)
+   !!----------------------------------------------------------------------
+   !! * Arguments 
+      INTEGER , INTENT( in  ) ::   &
+         kunit           ! output unit
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   &
+         ptab            ! variable array
+      INTEGER , INTENT( in  ) ::   &      
+         krec            ! record unit for direct access file
+
+#if defined key_mpp
+      INTEGER ji, jj, jk, jproc
+      INTEGER ikloc, ikpe
+      INTEGER ilci, ilcj, iilb, ijlb
+   !!---------------------------------------------------------------------
+
+
+   ! 1. Read horizontal slab by horizontal slab
+   ! -------------------------------------------
+   ! each slab is associed with a processor
+   ! the input is read in a auxilary array
+
+      DO jk = 1, jpk
+        ikloc = 1 + (jk-1) / jpnij
+        ikpe  = 1 + MOD( jk-1, jpnij )
+        IF( narea == ikpe ) THEN
+            READ(kunit,REC=jpk*(krec-1)+jk) tabglo
+            DO jproc = 1, jpnij
+              ilci = nlcit (jproc)
+              ilcj = nlcjt (jproc)
+              iilb = nimppt(jproc)
+              ijlb = njmppt(jproc)
+              DO jj = 1, ilcj
+                DO ji = 1, ilci
+                  tabio(ji,jj,jproc,ikloc) = tabglo(ji+iilb-1,jj+ijlb-1)
+                END DO
+              END DO
+            END DO
+        ENDIF
+      END DO
+      CALL mppsync
+
+   ! 2. Scaterring of auxilary array
+   ! -------------------------------
+
+      DO jk = 1,jpk
+        ikloc = 1 + (jk-1) / jpnij
+        ikpe  = 1 + MOD( jk-1, jpnij )
+        CALL mppscatter( tabio(1,1,1,ikloc), jk, ikpe-1, ptab(1,1,jk) )
+
+   ! mask
+
+        DO jj = nlcj+1, jpj
+          DO ji = 1, nlci
+            ptab(ji,jj,jk) = 0.e0
+          END DO
+        END DO
+        DO ji = nlci+1, jpi
+          DO jj = 1, jpj
+            ptab(ji,jj,jk) = 0.e0
+          END DO
+        END DO
+      END DO
+      CALL mppsync
+
+#  else
+
+      INTEGER jk
+
+      DO jk = 1, jpk
+         READ(kunit,REC=jpk*(krec-1)+jk) tabglo
+         ptab(:,:,jk) = tabglo(:,:)
+      END DO
+#endif
+
+   END SUBROUTINE read3
+
+
+   SUBROUTINE read3d( kunit, ptab, krec )
+   !!---------------------------------------------------------------------
+   !!                  ***  ROUTINE read3D  ***
+   !!  
+   !! ** Purpose :   Opa standard input for a 3D data array
+   !!     (its possible to read only a subdomain - zoom )
+   !!
+   !! ** Method  :   Read a binary array ( direct access file )
+   !!      IF key_mpp is used, write with an auxilary array
+   !!
+   !! ** Action :
+   !!
+   !! History :
+   !!      original  : 93-09 (M. Imbard)
+   !!      additions : 98-11 (J. Vialard) vpp
+   !!----------------------------------------------------------------------
+   !! * Arguments 
+      INTEGER , INTENT( in  ) ::   &
+         kunit           ! output unit
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   &
+         ptab            ! variable array
+      INTEGER , INTENT( in  ) ::   &      
+         krec            ! record unit for direct access file
+
+#if defined key_mpp
+      INTEGER ji, jj, jk, jproc
+      INTEGER ikloc, ikpe
+      INTEGER ilci, ilcj, iilb, ijlb
+   !!---------------------------------------------------------------------
+
+
+   ! 1. Read horizontal slab by horizontal slab
+   ! -------------------------------------------
+   ! each slab is associed with a processor
+   ! the input is read in a auxilary array
+
+      DO jk = 1,jpk
+        ikloc = 1 + (jk-1) / jpnij
+        ikpe  = 1 + MOD( jk-1, jpnij )
+        IF( narea == ikpe ) THEN
+            READ(kunit,REC=jpk*(krec-1)+jk) tabdta
+            DO jproc = 1, jpnij
+              ilci = nlcit (jproc)
+              ilcj = nlcjt (jproc)
+              iilb = nimppt(jproc)
+              ijlb = njmppt(jproc)
+              DO jj = 1, ilcj
+                DO ji = 1, ilci
+                  tabio(ji,jj,jproc,ikloc) = tabdta(ji+jpizoom-1+iilb-1,jj+jpjzoom-1+ijlb-1)
+                END DO
+              END DO
+            END DO
+        ENDIF
+      END DO
+      CALL mppsync
+
+   ! 2. Scaterring of auxilary array
+   ! -------------------------------
+
+      DO jk = 1, jpk
+         ikloc = 1 + (jk-1) / jpnij
+         ikpe  = 1 + MOD( jk-1, jpnij )
+         CALL mppscatter( tabio(1,1,1,ikloc), jk, ikpe-1, ptab(1,1,jk) )
+
+   ! mask
+
+         DO jj = nlcj+1, jpj
+            DO ji = 1,nlci
+               ptab(ji,jj,jk) = 0.e0
+            END DO
+         END DO
+         DO ji = nlci+1, jpi
+            ptab(ji,:,jk) = 0.e0
+         END DO
+      END DO
+      CALL mppsync
+
+#  else
+
+      INTEGER ji, jj, jk
+
+      DO jk = 1, jpk
+         READ(kunit,REC=jpk*(krec-1)+jk) tabdta
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ptab(ji,jj,jk) = tabdta( mig(ji), mjg(jj) )
+            END DO
+         END DO
+      END DO
+#endif
+
+   END SUBROUTINE read3d
+
+
+   SUBROUTINE write2( kunit, ptab, kdim, krec )
+   !!---------------------------------------------------------------------
+   !!                  ***  ROUTINE write2  ***
+   !!
+   !! ** Purpose :   OPA standard output for a 2D array
+   !!
+   !! ** Method  :   write a binary array
+   !!      If key_mpp is used, write with an auxilary array
+   !!
+   !! History :
+   !!       original  : 93-09 (M. Imbard)
+   !!       additions : 96-05 (J. Escobar)
+   !!----------------------------------------------------------------------
+   !! * Arguments 
+      INTEGER , INTENT( in  ) ::   &
+         kunit           ! output unit
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   &
+         ptab            ! variable array
+      INTEGER , INTENT( in  ) ::   &      
+         kdim ,       &  ! record length
+         krec            ! record unit for direct access file
+
+#if defined key_mpp
+      INTEGER ji,jj,jproc
+      INTEGER ildi,ilei,ildj,ilej
+      INTEGER iilb,ijlb
+   !!---------------------------------------------------------------------
+
+
+      tabglo(:,:) = 0.e0
+
+   ! 1. Receive of each subdomain array
+   ! ----------------------------------
+   ! processor position dependance
+   ! the main processor 0 receive each contribution
+
+      CALL mppgather( ptab, 1, 0, tabio )
+      CALL mppsync
+
+
+   ! 2. Write
+   ! --------
+
+   ! only the main processor
+
+      IF( narea == 1 ) THEN
+
+   !  write in an global auxilary array
+         DO jproc = 1, jpnij
+            ildi = nldit (jproc)   
+            ilei = nleit (jproc)   
+            ildj = nldjt (jproc)   
+            ilej = nlejt (jproc)   
+            iilb = nimppt(jproc)
+            ijlb = njmppt(jproc)
+            DO jj = ildj, ilej
+               DO ji = ildi, ilei
+                  tabglo(ji+iilb-1,jj+ijlb-1) = tabio(ji,jj,jproc,1)
+               END DO
+            END DO
+         END DO
+
+   ! global periodicity
+         IF( jperio == 1 ) THEN
+            tabglo(  1   ,:) = tabglo(jpiglo-1,:)
+            tabglo(jpiglo,:) = tabglo(   2    ,:)
+         ENDIF
+
+   ! write
+          WRITE(kunit,REC=kdim*(krec-1)+1) tabglo
+
+      ENDIF
+
+      CALL mppsync
+
+#  else
+      WRITE(kunit,REC=kdim*(krec-1)+1) ptab
+#endif
+
+   END SUBROUTINE write2
+
+
+   SUBROUTINE write3( kunit, ptab, krec )
+   !!---------------------------------------------------------------------
+   !!                  ***  ROUTINE write3  ***
+   !!             
+   !! ** Purpose :   OPA standard output for a 3D array
+   !!
+   !! ** Method  :   write a binary array
+   !!      If key_mpp is used, write with an auxilary array
+   !!
+   !! ** Action :
+   !!
+   !! History :
+   !!       original  : 93-09 (M. Imbard)
+   !!       additions : 96-05 (J. Escobar)
+   !!----------------------------------------------------------------------
+   !! * Arguments 
+      INTEGER , INTENT( in  ) ::   &
+         kunit           ! output unit
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   &
+         ptab            ! variable array
+      INTEGER , INTENT( in  ) ::   &      
+         krec            ! record unit for direct access file
+
+#if defined key_mpp
+      INTEGER ji,jj,jk,jproc
+      INTEGER ikloc,ikpe
+      INTEGER ildi,ilei,ildj,ilej
+      INTEGER iilb,ijlb
+   !!---------------------------------------------------------------------
+
+      tabglo(:,:) = 0.e0
+
+
+   ! 1. Receive of each subdomain array
+   ! ----------------------------------
+   ! processor position dependance
+   ! each processor receive the vertical slab which is attributed to it
+
+      DO jk = 1, jpk
+         ikloc = 1 + (jk-1) / jpnij
+         ikpe  = 1 + MOD( jk-1, jpnij )
+         CALL mppgather( ptab(1,1,jk), jk, ikpe-1, tabio(1,1,1,ikloc) )
+      END DO
+      CALL mppsync
+
+
+   ! 2. Write horizontal slab by horizontal slab
+   ! -------------------------------------------
+
+      DO jk = 1, jpk
+         ikloc = 1 + (jk-1) / jpnij
+         ikpe  = 1 + MOD( jk-1, jpnij )
+         IF( narea == ikpe ) THEN
+
+   !  write in an global auxilary array
+
+            DO jproc = 1, jpnij
+               ildi = nldit (jproc)   
+               ilei = nleit (jproc)   
+               ildj = nldjt (jproc)   
+               ilej = nlejt (jproc)   
+               iilb = nimppt(jproc)
+               ijlb = njmppt(jproc)
+               DO jj = ildj,ilej
+                  DO ji = ildi,ilei
+                     tabglo(ji+iilb-1,jj+ijlb-1) = tabio(ji,jj,jproc,ikloc)
+                  END DO
+               END DO
+            END DO
+
+   ! global periodicity
+
+            IF( jperio == 1 ) THEN
+               tabglo(  1   ,:) = tabglo(jpiglo-1,:)
+               tabglo(jpiglo,:) = tabglo(   2    ,:)
+            ENDIF
+
+   ! write
+
+            WRITE(kunit,REC=jpk*(krec-1)+jk) tabglo
+        ENDIF
+      END DO
+      CALL mppsync
+
+#  else
+
+      INTEGER  ::   ji,jj,jk
+      REAL(wp) ::   ztab(jpi,jpj)
+
+      DO jk = 1,jpk
+         ztab(:,:) = ptab(:,:,jk)
+         WRITE(kunit,REC=jpk*(krec-1)+jk) ztab
+      END DO
+#endif
+
+      END SUBROUTINE write3
+
+
+      SUBROUTINE write4( kunit, ptab, krec )
+   !!---------------------------------------------------------------------
+   !!                  ***  ROUTINE write4  ***
+   !!        
+   !! ** Purpose :   OPA ieee 4 bytes output for a 3D array
+   !!
+   !! ** Method  :   write a binary array
+   !!      If key_mpp is used, write with an auxilary array
+   !!
+   !! History :
+   !!       original  : 93-09 (M. Imbard)
+   !!       additions : 96-05 (J. Escobar)
+   !!      additions : 98-11 (J. Vialard) vpp
+   !!----------------------------------------------------------------------
+   !! * Arguments
+      INTEGER , INTENT( in  ) ::   &
+         kunit,       &  ! output unit
+         krec            ! record unit for direct access file
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   &
+         ptab            ! variable array
+
+#if defined key_mpp
+   !! * Local declarations
+      INTEGER jk, jproc
+      INTEGER ikloc, ikpe
+      INTEGER ildi,ilei,ildj,ilej
+      INTEGER iilb,ijlb
+   !!---------------------------------------------------------------------
+
+      tabglo(:,:) = 0.e0
+
+
+   ! 1. Receive of each subdomain array
+   ! ----------------------------------
+   ! processor position dependance
+   ! each processor receive the vertical slab which is attributed to it
+
+      DO jk = 1, jpk
+         ikloc = 1 + (jk-1) / jpnij
+         ikpe  = 1 + MOD( jk-1, jpnij )
+         CALL mppgather( ptab(1,1,jk), jk, ikpe-1, tabio(1,1,1,ikloc) )
+      END DO
+      CALL mppsync
+
+
+   ! 2. Write horizontal slab by horizontal slab
+   ! -------------------------------------------
+
+      DO jk = 1, jpk
+         ikloc = 1 + ( jk - 1 ) / jpnij
+         ikpe  = 1 + MOD( jk-1, jpnij )
+         IF( narea == ikpe ) THEN
+
+         ! write in an global auxilary array
+            DO jproc = 1, jpnij
+               ildi = nldit (jproc)   
+               ilei = nleit (jproc)   
+               ildj = nldjt (jproc)   
+               ilej = nlejt (jproc)   
+               iilb = nimppt(jproc)
+               ijlb = njmppt(jproc)
+               DO jj = ildj, ilej
+                  DO ji = ildi, ilei
+                     tabglo(ji+iilb-1,jj+ijlb-1) = tabio(ji,jj,jproc,ikloc)
+                  END DO
+               END DO
+            END DO
+
+         ! global periodicity
+            IF( jperio == 1 ) THEN
+               tabglo(  1   ,:) = tabglo(jpiglo-1,:)
+               tabglo(jpiglo,:) = tabglo(   2    ,:)
+            ENDIF
+
+   ! write
+            WRITE(kunit,REC=jpk*(krec-1)+jk) tabglo
+        ENDIF
+      END DO
+      CALL mppsync
+
+#  else
+
+      INTEGER jk
+      REAL(wp), DIMENSION(jpi,jpj) ::   ztab
+
+      DO jk = 1, jpk
+         ztab(:,:) = ptab(:,:,jk)
+         WRITE(kunit,REC=jpk*(krec-1)+jk) ztab
+      END DO
+#endif
+
+   END SUBROUTINE write4
+
+   !!======================================================================
+#endif
+END MODULE lib_io_fdir
Index: /branches/nemo/NEMO/OPA_SRC/lib_isml.f90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/lib_isml.f90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/lib_isml.f90	(revision 4)
@@ -0,0 +1,683 @@
+!
+! subroutines for PCG or SOR solvers
+! (used if the ISML library is not available)
+!
+! linrg
+!   gauss
+!   vmov
+!   desremopt
+!   dtrsv
+!   dger
+!   xerbla
+!   lsame
+! folr (empty)
+!
+!---------------------------------------------------------
+      SUBROUTINE linrg(kn,pa,klda,painv,kldainv)
+
+! compute inverse matrix
+
+      IMPLICIT NONE 
+      INTEGER kn,klda,kldainv
+      REAL (kind=8) ::   pa(kn,kn),painv(kn,kn)
+      REAL (kind=8) ::   zb(kn,kn)
+      REAL (kind=8) ::   zv(kn)
+      INTEGER iplin(kn)
+      INTEGER ji
+
+      IF (kn /= klda.or.kn /= kldainv) THEN 
+          write(0,*)'change your parameters'
+          STOP 
+      ENDIF 
+
+      CALL vmov(kn*kn,pa,painv)
+
+      CALL gauss(kn,painv,iplin,zv)
+
+      zb(:,:) = 0.0   
+      DO ji=1,kn
+        zb(ji,ji)=1.
+        CALL desremopt(kn,painv,iplin,zb(1,ji),zb(1,ji),zv)
+      END DO 
+      CALL vmov(kn*kn,zb,painv)
+
+      END SUBROUTINE linrg
+!---------------------------------------------------------
+      SUBROUTINE gauss(kn,pa,kplin,pv)
+
+      IMPLICIT NONE 
+      INTEGER kn
+      INTEGER ji,jj,jk
+      INTEGER ik,ipp
+      REAL (kind=8) ::   pa(kn,kn),pv(kn)
+!!    REAL (kind=8) ::   zpivmax,zalpha
+      REAL (kind=8) ::   zalpha
+      INTEGER kplin(kn)
+      INTEGER isamax
+      EXTERNAL isamax
+
+!  factorisation de Gauss de la matrice a avec pivot partiel . 
+!  initialisation des pointeurs .
+      DO ji=1,kn
+        kplin(ji)=ji
+      END DO 
+      DO jk=1,kn-1
+!  recherche du pivot maximal .
+!!      ik=jk
+!!      zpivmax=dabs(pa(jk,jk))
+!!        DO ji=jk,kn
+!!          IF(dabs(pa(ji,jk)) > zpivmax) THEN 
+!!            zpivmax=dabs(pa(ji,jk))
+!!            ik=ji
+!!          ENDIF 
+!!        END DO 
+        ik=isamax( kn-jk+1, pa(jk,jk) )+jk-1
+!  permutation de la ligne jk et de la ligne ik .
+        IF(jk == 58) THEN
+            PRINT *,'matrix ',(pa(jk,ji),ji=1,kn)
+            PRINT *,' pivot ',ik,kplin(ik),kplin(jk)
+        ENDIF 
+        ipp=kplin(ik)
+        kplin(ik)=kplin(jk)
+        kplin(jk)=ipp
+        DO jj=1,kn
+          pv(jj)=pa(ik,jj)
+          pa(ik,jj)=pa(jk,jj)
+          pa(jk,jj)=pv(jj)
+        END DO 
+        IF(jk == 58) THEN
+            PRINT *,'matrix ',(pa(jk,ji),ji=1,kn)
+            PRINT *,' pivot ',ik,kplin(ik),kplin(jk)
+        ENDIF 
+!  calcul des coefficients de la colonne k ligne a ligne .
+        DO ji=jk+1,kn
+          IF(pa(jk,jk) == 0) THEN 
+              PRINT *,'probleme diagonale nulle',jk,pa(jk,jk)
+              pa(ji,jk)=pa(ji,jk)/1.E-20
+          ENDIF 
+          IF(pa(jk,jk) /= 0) pa(ji,jk)=pa(ji,jk)/pa(jk,jk)
+        END DO 
+!!        DO ji=jk+1,kn
+!!          DO jj=jk+1,kn
+!!            pa(ji,jj)=pa(ji,jj)-pa(ji,jk)*pa(jk,jj)
+!!          END DO 
+!!        END DO 
+        zalpha=-1.
+        CALL dger(kn-jk,kn-jk,zalpha,pa(jk+1,jk),1,pa(jk,jk+1),kn,   &
+            pa(jk+1,jk+1),kn)
+      END DO 
+
+      END SUBROUTINE gauss
+!---------------------------------------------------------
+        FUNCTION isamax( I, X )
+        DIMENSION X(I)
+        ISAMAX=0
+        XMIN=-1E+50
+        DO 1 N=1,I
+        IF(ABS(X(N)) > XMIN) THEN
+        XMIN=X(N)
+        ISAMAX=N
+        ENDIF
+  1     CONTINUE
+        RETURN
+        END
+!---------------------------------------------------------
+      SUBROUTINE vmov(kn,px,py)
+
+      IMPLICIT NONE 
+      INTEGER kn
+      REAL (kind=8) ::   px(kn),py(kn)
+      INTEGER ji
+
+      DO ji=1,kn
+        py(ji)=px(ji)
+      END DO 
+
+      RETURN 
+      END 
+!---------------------------------------------------------
+      subroutine desremopt(n,a,plin,y,x,v)
+      implicit none
+      integer n,i,  j0
+!!    integer n,i,j,j0
+      real (kind=8) ::   a(n,n),x(n),y(n),v(n)
+      integer plin(n)
+!  descente remontee du systeme .
+!  initialisation du vecteur resultat .
+!  prise en compte de la permutation des lignes .
+      do i=1,n
+        v(i)=y(plin(i))
+      end do
+      do i=1,n
+        if(v(i) /= 0.) then
+          j0=i-1
+          goto 1
+        endif
+      end do
+1     continue
+!  descente du systeme L v = v , L est a diagonale unitaire .
+!!      do j=j0+1,n
+!!        do i=j+1,n
+!!          v(i)=v(i)-a(i,j)*v(j)
+!!        end do
+!!      end do
+      call dtrsv('L','N','U',n-j0,a(j0+1,j0+1),n,v(j0+1),1)
+!  remontee du systeme U v = v . 
+!!      do j=n,1,-1
+!!        v(j)=v(j)/a(j,j)
+!!        do i=1,j-1
+!!          v(i)=v(i)-a(i,j)*v(j)
+!!        end do
+!!      end do          
+      call dtrsv('U','N','N',n,a,n,v,1)
+!  prise en compte de la permutation des colonnes .
+      do i=1,n
+        x(i)=v(i)
+      end do
+
+      end SUBROUTINE desremopt
+!---------------------------------------------------------
+      SUBROUTINE DTRSV ( UPLO, TRANS, DIAG, N, A, LDA, X, INCX )
+!!    .. Scalar Arguments ..
+      INTEGER            INCX, LDA, N
+      CHARACTER (len=1) ::   DIAG, TRANS, UPLO
+!!    .. Array Arguments ..
+!     DOUBLE PRECISION   A( LDA, * ), X( * )
+      REAL (kind=8) ::     A( LDA, * ), X( * )
+!!    ..
+
+!! Purpose
+!! =======
+
+!! DTRSV  solves one of the systems of equations
+
+!!    A*x = b,   or   A'*x = b,
+
+!! where b and x are n element vectors and A is an n by n unit, or
+!! non-unit, upper or lower triangular matrix.
+
+!! No test for singularity or near-singularity is included in this
+!! routine. Such tests must be performed before calling this routine.
+
+!! Parameters
+!! ==========
+
+!! UPLO   - CHARACTER*1.
+!!          On entry, UPLO specifies whether the matrix is an upper or
+!!          lower triangular matrix as follows:
+
+!!             UPLO = 'U' or 'u'   A is an upper triangular matrix.
+
+!!             UPLO = 'L' or 'l'   A is a lower triangular matrix.
+
+!!          Unchanged on exit.
+
+!! TRANS  - CHARACTER*1.
+!!          On entry, TRANS specifies the equations to be solved as
+!!          follows:
+
+!!             TRANS = 'N' or 'n'   A*x = b.
+
+!!             TRANS = 'T' or 't'   A'*x = b.
+
+!!             TRANS = 'C' or 'c'   A'*x = b.
+
+!!          Unchanged on exit.
+
+!! DIAG   - CHARACTER*1.
+!!          On entry, DIAG specifies whether or not A is unit
+!!          triangular as follows:
+
+!!             DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+
+!!             DIAG = 'N' or 'n'   A is not assumed to be unit
+!!                                 triangular.
+
+!!          Unchanged on exit.
+
+!! N      - INTEGER.
+!!          On entry, N specifies the order of the matrix A.
+!!          N must be at least zero.
+!!          Unchanged on exit.
+
+!! A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+!!          Before entry with  UPLO = 'U' or 'u', the leading n by n
+!!          upper triangular part of the array A must contain the upper
+!!          triangular matrix and the strictly lower triangular part of
+!!          A is not referenced.
+!!          Before entry with UPLO = 'L' or 'l', the leading n by n
+!!          lower triangular part of the array A must contain the lower
+!!          triangular matrix and the strictly upper triangular part of
+!!          A is not referenced.
+!!          Note that when  DIAG = 'U' or 'u', the diagonal elements of
+!!          A are not referenced either, but are assumed to be unity.
+!!          Unchanged on exit.
+
+!! LDA    - INTEGER.
+!!          On entry, LDA specifies the first dimension of A as declared
+!!          in the calling (sub) program. LDA must be at least
+!!          max( 1, n ).
+!!          Unchanged on exit.
+
+!! X      - DOUBLE PRECISION array of dimension at least
+!!          ( 1 + ( n - 1 )*abs( INCX ) ).
+!!          Before entry, the incremented array X must contain the n
+!!          element right-hand side vector b. On exit, X is overwritten
+!!          with the solution vector x.
+
+!! INCX   - INTEGER.
+!!          On entry, INCX specifies the increment for the elements of
+!!          X. INCX must not be zero.
+!!          Unchanged on exit.
+
+
+!! Level 2 Blas routine.
+
+!! -- Written on 22-October-1986.
+!!    Jack Dongarra, Argonne National Lab.
+!!    Jeremy Du Croz, Nag Central Office.
+!!    Sven Hammarling, Nag Central Office.
+!!    Richard Hanson, Sandia National Labs.
+
+
+!!    .. Parameters ..
+!     DOUBLE PRECISION   ZERO
+!     PARAMETER        ( ZERO = 0.0D+0 )
+      REAL (kind=8) ::                 ZERO
+      PARAMETER        ( ZERO = 0.0 )
+!!    .. Local Scalars ..
+!     DOUBLE PRECISION   TEMP
+      REAL (kind=8) ::                 TEMP
+      INTEGER            I, INFO, IX, J, JX, KX
+      LOGICAL            NOUNIT
+!!    .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+!!    .. External Subroutines ..
+      EXTERNAL           XERBLA
+!!    .. Intrinsic Functions ..
+      INTRINSIC          MAX
+!!    ..
+!!    .. Executable Statements ..
+
+!!    Test the input parameters.
+
+      INFO = 0
+      IF     ( .NOT.LSAME( UPLO , 'U' ).AND.   &
+               .NOT.LSAME( UPLO , 'L' )      )THEN
+         INFO = 1
+      ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND.   &
+               .NOT.LSAME( TRANS, 'T' ).AND.   &
+               .NOT.LSAME( TRANS, 'C' )      )THEN
+         INFO = 2
+      ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND.   &
+               .NOT.LSAME( DIAG , 'N' )      )THEN
+         INFO = 3
+      ELSE IF( N < 0 )THEN
+         INFO = 4
+      ELSE IF( LDA < MAX( 1, N ) )THEN
+         INFO = 6
+      ELSE IF( INCX == 0 )THEN
+         INFO = 8
+      END IF
+      IF( INFO /= 0 )THEN
+         CALL XERBLA( 'DTRSV ', INFO )
+         RETURN
+      END IF
+
+!!    Quick return if possible.
+
+      IF( N == 0 )   RETURN
+
+      NOUNIT = LSAME( DIAG, 'N' )
+
+!!    Set up the start point in X if the increment is not unity. This
+!!    will be  ( N - 1 )*INCX  too small for descending loops.
+
+      IF( INCX <= 0 )THEN
+         KX = 1 - ( N - 1 )*INCX
+      ELSE IF( INCX /= 1 )THEN
+         KX = 1
+      END IF
+
+!!    Start the operations. In this version the elements of A are
+!!    accessed sequentially with one pass through A.
+
+      IF( LSAME( TRANS, 'N' ) )THEN
+
+!!       Form  x := inv( A )*x.
+
+         IF( LSAME( UPLO, 'U' ) )THEN
+            IF( INCX == 1 )THEN
+               DO 20, J = N, 1, -1
+                  IF( X( J ) /= ZERO )THEN
+                     IF( NOUNIT )   X( J ) = X( J )/A( J, J )
+                     TEMP = X( J )
+                     DO 10, I = J - 1, 1, -1
+                        X( I ) = X( I ) - TEMP*A( I, J )
+   10                CONTINUE
+                  END IF
+   20          CONTINUE
+            ELSE
+               JX = KX + ( N - 1 )*INCX
+               DO 40, J = N, 1, -1
+                  IF( X( JX ) /= ZERO )THEN
+                     IF( NOUNIT )  X( JX ) = X( JX )/A( J, J )
+                     TEMP = X( JX )
+                     IX   = JX
+                     DO 30, I = J - 1, 1, -1
+                        IX      = IX      - INCX
+                        X( IX ) = X( IX ) - TEMP*A( I, J )
+   30                CONTINUE
+                  END IF
+                  JX = JX - INCX
+   40          CONTINUE
+            END IF
+         ELSE
+            IF( INCX == 1 )THEN
+               DO 60, J = 1, N
+                  IF( X( J ) /= ZERO )THEN
+                     IF( NOUNIT )   X( J ) = X( J )/A( J, J )
+                     TEMP = X( J )
+                     DO 50, I = J + 1, N
+                        X( I ) = X( I ) - TEMP*A( I, J )
+   50                CONTINUE
+                  END IF
+   60          CONTINUE
+            ELSE
+               JX = KX
+               DO 80, J = 1, N
+                  IF( X( JX ) /= ZERO )THEN
+                     IF( NOUNIT )   X( JX ) = X( JX )/A( J, J )
+                     TEMP = X( JX )
+                     IX   = JX
+                     DO 70, I = J + 1, N
+                        IX      = IX      + INCX
+                        X( IX ) = X( IX ) - TEMP*A( I, J )
+   70                CONTINUE
+                  END IF
+                  JX = JX + INCX
+   80          CONTINUE
+            END IF
+         END IF
+      ELSE
+
+!!       Form  x := inv( A' )*x.
+
+         IF( LSAME( UPLO, 'U' ) )THEN
+            IF( INCX == 1 )THEN
+               DO 100, J = 1, N
+                  TEMP = X( J )
+                  DO 90, I = 1, J - 1
+                     TEMP = TEMP - A( I, J )*X( I )
+   90             CONTINUE
+                  IF( NOUNIT )   TEMP = TEMP/A( J, J )
+                  X( J ) = TEMP
+  100          CONTINUE
+            ELSE
+               JX = KX
+               DO 120, J = 1, N
+                  TEMP = X( JX )
+                  IX   = KX
+                  DO 110, I = 1, J - 1
+                     TEMP = TEMP - A( I, J )*X( IX )
+                     IX   = IX   + INCX
+  110             CONTINUE
+                  IF( NOUNIT )   TEMP = TEMP/A( J, J )
+                  X( JX ) = TEMP
+                  JX      = JX   + INCX
+  120          CONTINUE
+            END IF
+         ELSE
+            IF( INCX == 1 )THEN
+               DO 140, J = N, 1, -1
+                  TEMP = X( J )
+                  DO 130, I = N, J + 1, -1
+                     TEMP = TEMP - A( I, J )*X( I )
+  130             CONTINUE
+                  IF( NOUNIT )    TEMP = TEMP/A( J, J )
+                  X( J ) = TEMP
+  140          CONTINUE
+            ELSE
+               KX = KX + ( N - 1 )*INCX
+               JX = KX
+               DO 160, J = N, 1, -1
+                  TEMP = X( JX )
+                  IX   = KX
+                  DO 150, I = N, J + 1, -1
+                     TEMP = TEMP - A( I, J )*X( IX )
+                     IX   = IX   - INCX
+  150             CONTINUE
+                  IF( NOUNIT )    TEMP = TEMP/A( J, J )
+                  X( JX ) = TEMP
+                  JX      = JX   - INCX
+  160          CONTINUE
+            END IF
+         END IF
+      END IF
+
+      RETURN
+
+!!    End of DTRSV .
+
+      END
+!---------------------------------------------------------
+      SUBROUTINE DGER  ( M, N, ALPHA, X, INCX, Y, INCY, A, LDA )
+!!    .. Scalar Arguments ..
+!     DOUBLE PRECISION   ALPHA
+      REAL (kind=8) ::                 ALPHA
+      INTEGER            INCX, INCY, LDA, M, N
+!!    .. Array Arguments ..
+!     DOUBLE PRECISION   A( LDA, * ), X( * ), Y( * )
+      REAL (kind=8) ::   A( LDA, * ), X( * ), Y( * )
+!!    ..
+
+!! Purpose
+!! =======
+
+!! DGER   performs the rank 1 operation
+
+!!    A := alpha*x*y' + A,
+
+!! where alpha is a scalar, x is an m element vector, y is an n element
+!! vector and A is an m by n matrix.
+
+!! Parameters
+!! ==========
+
+!! M      - INTEGER.
+!!          On entry, M specifies the number of rows of the matrix A.
+!!          M must be at least zero.
+!!          Unchanged on exit.
+
+!! N      - INTEGER.
+!!          On entry, N specifies the number of columns of the matrix A.
+!!          N must be at least zero.
+!!          Unchanged on exit.
+
+!! ALPHA  - DOUBLE PRECISION.
+!!          On entry, ALPHA specifies the scalar alpha.
+!!          Unchanged on exit.
+
+!! X      - DOUBLE PRECISION array of dimension at least
+!!          ( 1 + ( m - 1 )*abs( INCX ) ).
+!!          Before entry, the incremented array X must contain the m
+!!          element vector x.
+!!          Unchanged on exit.
+
+!! INCX   - INTEGER.
+!!          On entry, INCX specifies the increment for the elements of
+!!          X. INCX must not be zero.
+!!          Unchanged on exit.
+
+!! Y      - DOUBLE PRECISION array of dimension at least
+!!          ( 1 + ( n - 1 )*abs( INCY ) ).
+!!          Before entry, the incremented array Y must contain the n
+!!          element vector y.
+!!          Unchanged on exit.
+
+!! INCY   - INTEGER.
+!!          On entry, INCY specifies the increment for the elements of
+!!          Y. INCY must not be zero.
+!!          Unchanged on exit.
+
+!! A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
+!!          Before entry, the leading m by n part of the array A must
+!!          contain the matrix of coefficients. On exit, A is
+!!          overwritten by the updated matrix.
+
+!! LDA    - INTEGER.
+!!          On entry, LDA specifies the first dimension of A as declared
+!!          in the calling (sub) program. LDA must be at least
+!!          max( 1, m ).
+!!          Unchanged on exit.
+
+
+!! Level 2 Blas routine.
+
+!! -- Written on 22-October-1986.
+!!    Jack Dongarra, Argonne National Lab.
+!!    Jeremy Du Croz, Nag Central Office.
+!!    Sven Hammarling, Nag Central Office.
+!!    Richard Hanson, Sandia National Labs.
+
+
+!!    .. Parameters ..
+!     DOUBLE PRECISION   ZERO
+!     PARAMETER        ( ZERO = 0.0D+0 )
+      REAL (kind=8) ::                 ZERO
+      PARAMETER        ( ZERO = 0.0 )
+!!    .. Local Scalars ..
+!     DOUBLE PRECISION   TEMP
+      REAL (kind=8) ::                 TEMP
+      INTEGER            I, INFO, IX, J, JY, KX
+!!    .. External Subroutines ..
+      EXTERNAL           XERBLA
+!!    .. Intrinsic Functions ..
+      INTRINSIC          MAX
+!!    ..
+!!    .. Executable Statements ..
+
+!!    Test the input parameters.
+
+      INFO = 0
+      IF     ( M < 0 )THEN
+         INFO = 1
+      ELSE IF( N < 0 )THEN
+         INFO = 2
+      ELSE IF( INCX == 0 )THEN
+         INFO = 5
+      ELSE IF( INCY == 0 )THEN
+         INFO = 7
+      ELSE IF( LDA < MAX( 1, M ) )THEN
+         INFO = 9
+      END IF
+      IF( INFO /= 0 )THEN
+         CALL XERBLA( 'DGER  ', INFO )
+         RETURN
+      END IF
+
+!!    Quick return if possible.
+
+      IF( ( M == 0 ).OR.( N == 0 ).OR.( ALPHA == ZERO ) )   &
+         RETURN
+
+!!    Start the operations. In this version the elements of A are
+!!    accessed sequentially with one pass through A.
+
+      IF( INCY > 0 )THEN
+         JY = 1
+      ELSE
+         JY = 1 - ( N - 1 )*INCY
+      END IF
+      IF( INCX == 1 )THEN
+         DO 20, J = 1, N
+            IF( Y( JY ) /= ZERO )THEN
+               TEMP = ALPHA*Y( JY )
+               DO 10, I = 1, M
+                  A( I, J ) = A( I, J ) + X( I )*TEMP
+   10          CONTINUE
+            END IF
+            JY = JY + INCY
+   20    CONTINUE
+      ELSE
+         IF( INCX > 0 )THEN
+            KX = 1
+         ELSE
+            KX = 1 - ( M - 1 )*INCX
+         END IF
+         DO 40, J = 1, N
+            IF( Y( JY ) /= ZERO )THEN
+               TEMP = ALPHA*Y( JY )
+               IX   = KX
+               DO 30, I = 1, M
+                  A( I, J ) = A( I, J ) + X( IX )*TEMP
+                  IX        = IX        + INCX
+   30          CONTINUE
+            END IF
+            JY = JY + INCY
+   40    CONTINUE
+      END IF
+
+      RETURN
+
+!!    End of DGER  .
+
+      END
+!---------------------------------------------------------
+      SUBROUTINE XERBLA ( SRNAME, INFO )
+!!    ..    Scalar Arguments ..
+      INTEGER            INFO
+      CHARACTER (len=6) ::    SRNAME
+!!    ..
+
+!! Purpose
+!! =======
+
+!! XERBLA  is an error handler for the Level 2 BLAS routines.
+
+!! It is called by the Level 2 BLAS routines if an input parameter is
+!! invalid.
+
+!! Installers should consider modifying the STOP statement in order to
+!! call system-specific exception-handling facilities.
+
+!! Parameters
+!! ==========
+
+!! SRNAME - CHARACTER*6.
+!!          On entry, SRNAME specifies the name of the routine which
+!!          called XERBLA.
+
+!! INFO   - INTEGER.
+!!          On entry, INFO specifies the position of the invalid
+!!          parameter in the parameter-list of the calling routine.
+
+
+!! Auxiliary routine for Level 2 Blas.
+
+!! Written on 20-July-1986.
+
+!!    .. Executable Statements ..
+
+      WRITE (*,99999) SRNAME, INFO
+
+      STOP
+
+99999 FORMAT ( ' ** On entry to ', A6, ' parameter number ', I2,   &
+               ' had an illegal value' )
+
+!!    End of XERBLA.
+
+      END
+!-----------------------------------------------------------
+      FUNCTION lsame( c1, c2 )
+      logical lsame
+      CHARACTER (len=*), INTENT(in) ::   c1, c2
+      IF( c1 == c2 ) THEN
+          lsame=.TRUE.
+      ELSE
+          lsame=.FALSE.
+      ENDIF
+
+      END FUNCTION lsame
Index: /branches/nemo/NEMO/OPA_SRC/lib_mpp.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/lib_mpp.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/lib_mpp.F90	(revision 4)
@@ -0,0 +1,4563 @@
+MODULE lib_mpp
+  !!======================================================================
+  !!                       ***  MODULE  lib_mpp  ***
+  !! Ocean numerics:  massively parallel processing librairy
+  !!=====================================================================
+#if defined key_mpp
+  !!----------------------------------------------------------------------
+  !!   'key_mpp'                     massively parallel processing library
+  !!----------------------------------------------------------------------
+  !!   mynode
+  !!   mpparent
+  !!   mppspawn
+  !!   mppshmem
+  !!   mpp_lnk     : generic interface (defined in lbclnk) for :
+  !!                 mpp_lnk_2d, mpp_lnk_3d
+  !!   mpplnks
+  !!   mpprecv
+  !!   mppsend
+  !!   mppscatter
+  !!   mppgather
+  !!   mpp_isl    : generic inteface  for :
+  !!                mppisl_int , mppisl_a_int , mppisl_real, mppisl_a_real
+  !!   mpp_min    : generic interface for : 
+  !!                mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
+  !!   mpp_max    : generic interface for :
+  !!                mppmax_real, mppmax_a_real
+  !!   mpp_sum    : generic interface for :
+  !!                mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
+  !!   mppsync
+  !!   mppstop
+  !!   mppobc     : variant of mpp_lnk for open boundaries
+  !!   mpp_ini_north
+  !!   mpp_lbc_north
+  !!----------------------------------------------------------------------
+  !! History :
+  !!        !  94 (M. Guyon, J. Escobar, M. Imbard)  Original code
+  !!        !  97  (A.M. Treguier)  SHMEM additions
+  !!        !  98  (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI
+  !!   9.0  !  03  (J.-M. Molines, G. Madec)  F90, free form
+  !!----------------------------------------------------------------------
+  !!  OPA 9.0 , LODYC-IPSL (2003)
+  !!---------------------------------------------------------------------
+  !! * Modules used
+  USE dom_oce         ! ocean space and time domain 
+  USE in_out_manager  ! I/O manager
+
+  IMPLICIT NONE
+
+  !! * Interfaces
+  !! define generic interface for these routine as they are called sometimes
+  !!        with scalar arguments instead of array arguments, which causes problems
+  !!        for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ
+
+  INTERFACE mpp_isl
+     MODULE PROCEDURE mppisl_a_int, mppisl_int, mppisl_a_real, mppisl_real
+  END INTERFACE
+  INTERFACE mpp_min
+     MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real
+  END INTERFACE
+  INTERFACE mpp_max
+     MODULE PROCEDURE mppmax_a_real, mppmax_real
+  END INTERFACE
+  INTERFACE mpp_sum
+     MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real
+  END INTERFACE
+  INTERFACE mpp_lbc_north
+     MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 
+  END INTERFACE
+
+  !! * Module parameters
+  !! The processor number is a required power of two :
+  !!                       1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024,...
+  !! MPP dimension
+  INTEGER, PARAMETER ::   &
+       nprocmax = 2**10,    &  ! maximun dimension
+       ndim_mpp = jpnij        ! dimension for this simulation
+
+#if defined key_mpp_mpi
+  !! No MPI variable definition
+#else
+  !! * PVM and SHMEM version
+  CHARACTER (len=80), PARAMETER ::   simfile    = 'pvm3_ndim'   ! file name
+  CHARACTER (len=47), PARAMETER ::   executable = 'opa'         ! executable name
+# if defined key_mpp_shmem
+  CHARACTER, PARAMETER ::            opaall     = ""            ! group name (old def opaall*(*))
+# else
+  CHARACTER, PARAMETER ::            opaall     = "opaall"      ! group name
+# endif
+
+  !! PVM control
+  INTEGER, PARAMETER ::   &
+       mynode_print   = 0,  &  ! flag for print, mynode   routine
+       mpprecv_print  = 0,  &  ! flag for print, mpprecv  routine
+       mppsend_print  = 0,  &  ! flag for print, mppsend  routine
+       mppsync_print  = 0,  &  ! flag for print, mppsync  routine
+       mppsum_print   = 0,  &  ! flag for print, mpp_sum  routine
+       mppisl_print   = 0,  &  ! flag for print, mpp_isl  routine
+       mppmin_print   = 0,  &  ! flag for print, mpp_min  routine
+       mppmax_print   = 0,  &  ! flag for print, mpp_max  routine
+       mpparent_print = 0      ! flag for print, mpparent routine
+
+  !! Variable definition
+# if defined key_mpp_pvm
+  INTEGER, PARAMETER ::   & !!! PVM case
+       jpvmreal = 6,        &  ! specific pvm3 code for real4 and real8
+       !                       ! ( real4 = 4, real8 = 6 )
+  jpvmint  = 3            ! specific pvm3 code for integer4 and integer8
+  !                       ! ( integer4 = 3, integer8 = 21 : ext Cray)
+# else
+  INTEGER, PARAMETER ::     &  
+       jpvmreal = 6,        &  ! ???
+       jpvmint = 21            ! ???
+# endif
+
+# if defined key_mpp_shmem
+  ! Maximum  dimension of array to sum on the processors
+  INTEGER, PARAMETER ::   & !!! SHMEM case
+       jpmsec   = 50000,    &  ! ???
+       jpmpplat =    30,    &  ! ???
+       jpmppsum = MAX( jpisl*jpisl, jpmpplat*jpk, jpmsec )
+  !                       ! ???
+# endif
+#endif
+
+
+  !! * Module variables
+
+#if defined key_mpp_mpi
+  !! * MPI variable definition
+#  include <mpif.h>
+
+  INTEGER ::   &
+       size,     &  ! number of process
+       rank         ! process number  [ 0 - size-1 ]
+#else
+  !! * PVM and SHMEM version
+#  include  <fpvm3.h>
+
+  !! * PVM variable definition
+  INTEGER ::   &
+       npvm_ipas ,  &  ! pvm initialization flag
+       npvm_mytid,  &  ! pvm tid
+       npvm_me   ,  &  ! node number [ 0 - nproc-1 ]
+       npvm_nproc,  &  ! real number of nodes
+       npvm_inum       ! ???
+  INTEGER, DIMENSION(0:nprocmax-1) ::   &
+       npvm_tids       ! tids array [ 0 - nproc-1 ]
+
+  !! T3D variable definition
+  INTEGER ::   &
+       nt3d_ipas ,  &  ! pvm initialization flag
+       nt3d_mytid,  &  ! pvm tid
+       nt3d_me   ,  &  ! node number [ 0 - nproc-1 ]
+       nt3d_nproc      ! real number of nodes
+  INTEGER, DIMENSION(0:nprocmax-1) ::   &
+       nt3d_tids       ! tids array [ 0 - nproc-1 ]
+
+# if defined key_mpp_shmem
+  !! * SHMEM version
+#  include <mpp/shmem.fh>
+
+  !! real sum reduction
+  INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
+       nrs1sync_shmem,   &  ! 
+       nrs2sync_shmem
+  REAL(wp), DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
+       wrs1wrk_shmem,    &  !
+       wrs2wrk_shmem        !
+  REAL(wp), DIMENSION(jpmppsum) ::   wrstab_shmem
+
+  !! minimum and maximum reduction
+  INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
+       ni1sync_shmem,    &  ! 
+       ni2sync_shmem        ! 
+  REAL(wp), DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
+       wi1wrk_shmem
+  wi2wrk_shmem
+  REAL(wp), DIMENSION(jpmppsum) ::   &
+       wintab_shmem,     &  ! 
+       wi1tab_shmem,     &  ! 
+       wi2tab_shmem      &  ! 
+       
+       !! value not equal zero for barotropic stream function around islands
+  INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
+       ni11sync_shmem,   &  !
+       ni12sync_shmem,   &  !
+       ni21sync_shmem,   &  !
+       ni22sync_shmem       !
+  REAL(wp), DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
+       wi11wrk_shmem,    &  ! 
+       wi12wrk_shmem,    &  !
+       wi21wrk_shmem,    &  !
+       wi22wrk_shmem        !
+  REAL(wp), DIMENSION(jpmppsum) ::   &
+       wiltab_shmem ,    &  !
+       wi11tab_shmem,    &  !
+       wi12tab_shmem,    &  ! 
+       wi21tab_shmem,    &  ! 
+       wi22tab_shmem
+
+  INTEGER, DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
+       ni11wrk_shmem,    &  !
+       ni12wrk_shmem,    &  !
+       ni21wrk_shmem,    &  !
+       ni22wrk_shmem        !
+  INTEGER, DIMENSION(jpmppsum) ::   &
+       niitab_shmem ,    &  !
+       ni11tab_shmem,    &  !
+       ni12tab_shmem        !
+  INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
+       nis1sync_shmem,   &  !
+       nis2sync_shmem       !
+  INTEGER, DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
+       nis1wrk_shmem,    &  ! 
+       nis2wrk_shmem        !
+  INTEGER, DIMENSION(jpmppsum) ::   &
+       nistab_shmem
+
+  !! integer sum reduction
+  INTEGER, DIMENSION(SHMEM_REDUCE_SYNC_SIZE) ::   &
+       nil1sync_shmem,   &  !
+       nil2sync_shmem       !
+  INTEGER, DIMENSION( MAX( SHMEM_REDUCE_MIN_WRKDATA_SIZE, jpmppsum/2+1 ) ) ::   &
+       nil1wrk_shmem,    &  !
+       nil2wrk_shmem        !
+  INTEGER, DIMENSION(jpmppsum) ::   &
+       niltab_shmem
+
+# endif
+#endif
+#if defined  key_mpp_mpi
+  ! variables used in case of north fold condition in mpp_mpi with jpni > 1
+  INTEGER ::      &       !
+       ngrp_world,  &       ! group ID for the world processors
+       ngrp_north,  &       ! group ID for the northern processors (to be fold)
+       ncomm_north, &       ! communicator made by the processors belonging to ngrp_north
+       ndim_rank_north, &   ! number of 'sea' processor in the northern line (can be /= jpni !)
+       njmppmax             ! value of njmpp for the processors of the northern line
+  INTEGER ::      &       !
+       north_root           ! number (in the comm_world) of proc 0 in the northern comm
+  INTEGER, DIMENSION(:), ALLOCATABLE ::   &
+       nrank_north          ! dimension ndim_rank_north, number of the procs belonging to ncomm_north
+#endif
+
+  REAL(wp), DIMENSION(jpi,jprecj,jpk,2) ::   &
+       t3ns, t3sn  ! 3d message passing arrays north-south & south-north
+  REAL(wp), DIMENSION(jpj,jpreci,jpk,2) ::   &
+       t3ew, t3we  ! 3d message passing arrays east-west & west-east
+  REAL(wp), DIMENSION(jpi,jprecj,jpk,2) ::   &
+       t3p1, t3p2  ! 3d message passing arrays north fold
+  REAL(wp), DIMENSION(jpi,jprecj,2) ::   &
+       t2ns, t2sn  ! 2d message passing arrays north-south & south-north
+  REAL(wp), DIMENSION(jpj,jpreci,2) ::   &
+       t2ew, t2we  ! 2d message passing arrays east-west & west-east
+  REAL(wp), DIMENSION(jpi,jprecj,2) ::   &
+       t2p1, t2p2  ! 2d message passing arrays north fold
+  !!----------------------------------------------------------------------
+  !!  OPA 9.0 , LODYC-IPSL (2003)
+  !!---------------------------------------------------------------------
+
+CONTAINS
+
+  FUNCTION mynode()
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mynode  ***
+    !!                    
+    !! ** Purpose :   Find processor unit
+    !!
+    !!----------------------------------------------------------------------
+#if defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER ::   mynode, ierr
+    !!----------------------------------------------------------------------
+    ! Enroll in MPI
+    ! -------------
+    CALL mpi_init_opa( ierr )
+    CALL mpi_comm_rank( mpi_comm_world, rank, ierr )
+    CALL mpi_comm_size( mpi_comm_world, size, ierr )
+    mynode = rank
+#else
+    !! * Local variables   (PVM or SHMEM version)
+    INTEGER ::   mynode
+    INTEGER ::   &
+         imypid, imyhost, ji, info, iparent_tid
+    !!----------------------------------------------------------------------
+
+    IF( npvm_ipas /= nprocmax ) THEN
+       !         ---   first passage in mynode
+       !         -------------
+       !         enroll in pvm
+       !         -------------
+       CALL pvmfmytid( npvm_mytid )
+       IF( mynode_print /= 0 ) THEN
+          WRITE(nummpp,*) 'mynode, npvm_ipas=',npvm_ipas, ' nprocmax=',nprocmax
+          WRITE(nummpp,*) 'mynode, npvm_mytid=',npvm_mytid, ' after pvmfmytid'
+       ENDIF
+
+       !         ---------------------------------------------------------------
+       !         find out IF i am parent or child spawned processes have parents
+       !         ---------------------------------------------------------------
+       CALL mpparent( iparent_tid )
+       IF( mynode_print /= 0 ) THEN
+          WRITE(nummpp,*) 'mynode, npvm_mytid=',npvm_mytid,   &
+               ' after mpparent, npvm_tids(0) = ',   &
+               npvm_tids(0),' iparent_tid=', iparent_tid
+       ENDIF
+       IF(iparent_tid < 0 )  THEN
+          WRITE(nummpp,*) 'mynode, npvm_mytid=',npvm_mytid,   &
+               ' after mpparent, npvm_tids(0) = ',   &
+               npvm_tids(0),' iparent_tid=', iparent_tid
+          npvm_tids(0) = npvm_mytid
+          npvm_me = 0
+          IF( ndim_mpp > nprocmax ) THEN
+             WRITE(nummpp,*) 'npvm_mytid=',npvm_mytid,' too great'
+             STOP  ' mynode '
+          ELSE
+             npvm_nproc = ndim_mpp
+          ENDIF
+
+          ! -------------------------
+          ! start up copies of myself
+          ! -------------------------
+          IF( npvm_nproc > 1 ) THEN
+             CALL mppspawn(executable,pvmdefault,'*'   &
+                  ,npvm_nproc-1,npvm_tids(1),info)
+             IF(info /= npvm_nproc-1 ) THEN
+                WRITE(nummpp,*) 'mynode, problem in spawn '   &
+                     ,' info=', info,' executable=',executable
+                STOP
+             ENDIF
+             IF(mynode_print /= 0 ) THEN
+                WRITE(nummpp,*) 'mynode, npvm_mytid=',npvm_mytid,   &
+                     ' maitre=',executable,' info=',info   &
+                     ,' npvm_nproc=',npvm_nproc
+                WRITE(nummpp,*) 'mynode, npvm_mytid=',npvm_mytid,   &
+                     ' npvm_tids ',(npvm_tids(ji),ji=0,npvm_nproc-1)
+             ENDIF
+
+             ! ---------------------------
+             ! multicast tids array to children
+             ! ---------------------------
+             CALL pvmfinitsend( pvmdefault, info )
+             CALL pvmfpack(jpvmint,npvm_nproc,1,1,info)
+             CALL pvmfpack(jpvmint,npvm_tids,npvm_nproc,1,info)
+             CALL pvmfmcast(npvm_nproc-1,npvm_tids(1),10,info)
+          ENDIF
+       ELSE
+
+          ! ---------------------------------
+          ! receive the tids array and set me
+          ! ---------------------------------
+          IF(mynode_print /= 0 ) THEN
+             WRITE(nummpp,*) 'mynode, npvm_mytid=',npvm_mytid, ' pvmfrecv'
+          ENDIF
+          CALL pvmfrecv( iparent_tid, 10, info )
+          IF(mynode_print /= 0 ) THEN
+             WRITE(nummpp,*) 'mynode, npvm_mytid=',npvm_mytid, " fin pvmfrecv"
+          ENDIF
+          CALL pvmfunpack(jpvmint,npvm_nproc,1,1,info)
+          CALL pvmfunpack(jpvmint,npvm_tids,npvm_nproc,1,info)
+          IF( mynode_print /= 0 ) THEN
+             WRITE(nummpp,*) 'mynode, npvm_mytid=',npvm_mytid,   &
+                  ' esclave=', executable,' info=',info   &
+                  ,' npvm_nproc=',npvm_nproc
+             WRITE(nummpp,*) 'mynode, npvm_mytid=',npvm_mytid,   &
+                  'npvm_tids',(npvm_tids(ji),ji=0,npvm_nproc-1)
+          ENDIF
+          DO ji = 0, npvm_nproc-1
+             IF( npvm_mytid == npvm_tids(ji) ) npvm_me = ji
+          END DO
+       ENDIF
+
+       ! ------------------------------------------------------------
+       ! all nproc tasks are equal now
+       ! and can address each other by tids(0) thru tids(nproc-1)
+       ! for each process me => process number [0-(nproc-1)]
+       ! ------------------------------------------------------------
+       CALL pvmfjoingroup ("bidon", info)
+       CALL pvmfbarrier ("bidon", npvm_nproc, info)
+       DO ji=0, npvm_nproc-1
+          IF(ji == npvm_me ) THEN
+             CALL pvmfjoingroup (opaall, npvm_inum)
+             IF( npvm_inum /= npvm_me) WRITE(nummpp,*) 'mynode',   &
+                  ' not arrived in the good order for opaall'
+          ENDIF
+          CALL pvmfbarrier("bidon",npvm_nproc,info)
+       END DO
+       CALL pvmfbarrier(opaall,npvm_nproc,info)
+
+    ELSE
+       ! ---   other passage in mynode
+    ENDIF
+
+    npvm_ipas = nprocmax
+    mynode    = npvm_me
+    imypid    = npvm_mytid
+    imyhost   = npvm_tids(0)
+    IF( mynode_print /= 0 ) THEN
+       WRITE(nummpp,*)'mynode, npvm_mytid=',npvm_mytid   &
+            ,' npvm_me=',npvm_me,  ' npvm_nproc=',npvm_nproc ,' npvm_ipas=',npvm_ipas
+    ENDIF
+#endif
+  END FUNCTION mynode
+
+
+  SUBROUTINE mpparent( kparent_tid )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mpparent  ***
+    !!
+    !! ** Purpose :   If key_mpp_pvm then call pvmfparent fonction 
+    !!    else use an pvmfparent routine for T3E
+    !!   (default key or key_mpp_shmem)
+    !!    or  only RETURN -1 (key_mpp_mpi)
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER, INTENT(inout) ::   &
+         kparent_tid      ! ???
+
+#if defined key_mpp_pvm
+    !! * PVM version
+
+    CALL pvmfparent(kparent_tid)
+
+#elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+
+    kparent_tid=-1
+
+#else
+    !! * Local variables   (SHMEN or PVM onto T3E version)
+    INTEGER ::   &
+         it3d_my_pe, LEADZ, ji, info
+
+    CALL pvmfmytid( nt3d_mytid )
+    CALL pvmfgetpe( nt3d_mytid, it3d_my_pe )
+    IF( mpparent_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mpparent, nt3d_mytid= ', nt3d_mytid ,' it3d_my_pe=',it3d_my_pe
+    ENDIF
+    IF( it3d_my_pe == 0 ) THEN
+       !-----------------------------------------------------------------!
+       !     process = 0 => receive other tids                           !
+       !-----------------------------------------------------------------!
+       kparent_tid = -1
+       IF(mpparent_print /= 0 ) THEN
+          WRITE(nummpp,*) 'mpparent, nt3d_mytid=',nt3d_mytid ,' kparent_tid=',kparent_tid
+       ENDIF
+       !          --- END receive dimension ---
+       IF( ndim_mpp > nprocmax ) THEN
+          WRITE(nummpp,*) 'mytid=',nt3d_mytid,' too great'
+          STOP  ' mpparent '
+       ELSE
+          nt3d_nproc =  ndim_mpp
+       ENDIF
+       IF(mpparent_print /= 0 ) THEN
+          WRITE(nummpp,*) 'mpparent, nt3d_mytid=',nt3d_mytid ,' nt3d_nproc=',nt3d_nproc
+       ENDIF
+       !-------- receive tids from others process --------
+       DO ji = 1, nt3d_nproc-1
+          CALL pvmfrecv( ji , 100, info )
+          CALL pvmfunpack(jpvmint,nt3d_tids(ji),1,1,info)
+          IF(mpparent_print /= 0 ) THEN
+             WRITE(nummpp,*) 'mpparent, nt3d_mytid=',nt3d_mytid ,' receive=',nt3d_tids(ji),' from = ',ji
+          ENDIF
+       END DO
+       nt3d_tids(0) = nt3d_mytid
+       IF(mpparent_print /= 0 ) THEN
+          WRITE(nummpp,*) 'mpparent, nt3d_mytid=',nt3d_mytid ,' nt3d_tids(ji) =',(nt3d_tids(ji),   &
+               ji=0,nt3d_nproc-1)
+          WRITE(nummpp,*) 'mpparent, nt3d_mytid=',nt3d_mytid ,' kparent_tid=',kparent_tid
+       ENDIF
+
+    ELSE
+       !!----------------------------------------------------------------!
+       !     process <> 0 => send  other tids                            !
+       !!----------------------------------------------------------------!
+       kparent_tid = 0
+       CALL pvmfinitsend( pvmdataraw, info )
+       CALL pvmfpack( jpvmint, nt3d_mytid, 1, 1, info )
+       CALL pvmfsend( kparent_tid, 100, info )
+    ENDIF
+#endif
+
+  END SUBROUTINE mpparent
+
+  SUBROUTINE mppspawn( cdexec, kmod, cdwhere, kproc, ktids, kinfo )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppspawn  ***
+    !!
+    !! ** Purpose :   If key_mpp_pvm then call pvmfspawn fonction 
+    !!    else use an pvmfspawn routine for T3E
+    !!   (default key or key_mpp_shmem)
+    !!    or  only RETURN -1 (key_mpp_mpi)
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    CHARACTER(LEN=*) ::   cdexec,cdwhere
+    INTEGER ,DIMENSION(:) ::  ktids
+    INTEGER               ::  kmod,kproc,kinfo
+
+#if defined key_mpp_pvm
+    !! * PVM version
+
+    CALL pvmfspawn( cdexec, kmod, cdwhere, kproc, ktids, kinfo )
+
+#  elif defined key_mpp_mpi
+    !! * MPI version
+
+    kinfo=-1
+
+#else
+    !! * Lovcal variables   (SHMEM or PVM onto T3E version)
+    INTEGER :: ji
+
+    DO ji = 1, kproc
+       ktids(ji) = nt3d_tids(ji)
+    END DO
+    kinfo=kproc
+#endif
+
+  END SUBROUTINE mppspawn
+
+#if defined key_mpp_shmem
+
+  SUBROUTINE mppshmem
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppshmem  ***
+    !!
+    !! ** Purpose :   SHMEM ROUTINE
+    !!
+    !!----------------------------------------------------------------------
+    nrs1sync_shmem = SHMEM_SYNC_VALUE
+    nrs2sync_shmem = SHMEM_SYNC_VALUE
+    nis1sync_shmem = SHMEM_SYNC_VALUE
+    nis2sync_shmem = SHMEM_SYNC_VALUE
+    nil1sync_shmem = SHMEM_SYNC_VALUE
+    nil2sync_shmem = SHMEM_SYNC_VALUE
+    ni11sync_shmem = SHMEM_SYNC_VALUE
+    ni12sync_shmem = SHMEM_SYNC_VALUE
+    ni21sync_shmem = SHMEM_SYNC_VALUE
+    ni22sync_shmem = SHMEM_SYNC_VALUE
+    CALL barrier()
+
+  END SUBROUTINE mppshmem
+
+#endif
+
+  SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mpp_lnk_3d  ***
+    !!
+    !! ** Purpose :   Message passing manadgement
+    !!
+    !! ** Method  :   Use mppsend and mpprecv function for passing mask 
+    !!      between processors following neighboring subdomains.
+    !!            domain parameters
+    !!                    nlci   : first dimension of the local subdomain
+    !!                    nlcj   : second dimension of the local subdomain
+    !!                    nbondi : mark for "east-west local boundary"
+    !!                    nbondj : mark for "north-south local boundary"
+    !!                    noea   : number for local neighboring processors 
+    !!                    nowe   : number for local neighboring processors
+    !!                    noso   : number for local neighboring processors
+    !!                    nono   : number for local neighboring processors
+    !!
+    !! ** Action  :   ptab with update value at its periphery
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    CHARACTER(len=1) , INTENT( in ) ::   &
+         cd_type       ! define the nature of ptab array grid-points
+    !             ! = T , U , V , F , W points
+    !             ! = S : T-point, north fold treatment ???
+    !             ! = G : F-point, north fold treatment ???
+    REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+    !             !   = -1. , the sign is changed if north fold boundary
+    !             !   =  1. , the sign is kept  if north fold boundary
+
+
+    REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
+         ptab          ! 3D array on which the boundary condition is applied
+
+    !! * Local variables
+    INTEGER ::   ji, jj, jk, jl   ! dummy loop indices
+    INTEGER ::   imigr, iihom, ijhom, iloc, ijt, iju   ! temporary integers
+    !!----------------------------------------------------------------------
+
+    ! 1. standard boundary treatment
+    ! ------------------------------
+
+    ! East-West boundary conditions
+
+    IF( nbondi == 2.AND.(nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+       ! ... cyclic
+       ptab( 1 ,:,:) = ptab(jpim1,:,:)
+       ptab(jpi,:,:) = ptab(  2  ,:,:)
+    ELSE
+       ! ... closed
+
+       SELECT CASE ( cd_type )
+   
+       CASE ( 'T', 'U', 'V', 'W' )
+          iihom = nlci-jpreci
+          DO ji = 1,jpreci
+             ptab(ji,:,:) = 0.e0
+          END DO
+
+          DO ji = iihom+1,jpi
+             ptab(ji,:,:) = 0.e0
+          END DO
+
+       CASE ( 'F' )
+          iihom = nlci-jpreci
+          DO ji = iihom+1,jpi
+             ptab(ji,:,:) = 0.e0
+          END DO
+
+       END SELECT 
+    ENDIF
+    ! 
+    ! North-South boundary conditions
+
+
+    SELECT CASE ( cd_type )
+
+    CASE ( 'T', 'U', 'V', 'W' )
+       ijhom = nlcj-jprecj
+       DO jj = 1,jprecj
+          ptab(:,jj,:) = 0.e0
+       END DO
+
+       DO jj = ijhom+1,jpj
+          ptab(:,jj,:) = 0.e0
+       END DO
+
+    CASE ( 'F' )
+       ijhom = nlcj-jprecj
+       DO jj = ijhom+1,jpj
+          ptab(:,jj,:) = 0.e0
+       END DO
+    END SELECT
+
+
+    ! 2. East and west directions exchange
+    ! ------------------------------------
+
+    ! 2.1 Read Dirichlet lateral conditions
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1, 0, 1 )    ! all exept 2 
+       iihom = nlci-nreci
+       DO jl = 1, jpreci
+          t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+          t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+       END DO
+    END SELECT
+
+    ! 2.2 Migrations
+
+#if defined key_mpp_shmem
+    !! * SHMEM version
+
+    imigr = jpreci * jpj * jpk
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       CALL shmem_put(t3we(1,1,1,2),t3we(1,1,1,1),imigr,noea)
+
+    CASE ( 0 )
+       CALL shmem_put(t3ew(1,1,1,2),t3ew(1,1,1,1),imigr,nowe)
+       CALL shmem_put(t3we(1,1,1,2),t3we(1,1,1,1),imigr,noea)
+
+    CASE ( 1 )
+       CALL shmem_put(t3ew(1,1,1,2),t3ew(1,1,1,1),imigr,nowe)
+    END SELECT
+
+    CALL  barrier()
+    CALL  shmem_udcflush()
+
+#elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+
+    imigr=jpreci*jpj*jpk
+
+    SELECT CASE ( nbondi ) 
+
+    CASE ( -1 )
+       CALL mppsend(2,t3we(1,1,1,1),imigr,noea,0)
+       CALL mpprecv(1,t3ew(1,1,1,2),imigr)
+
+    CASE ( 0 )
+       CALL mppsend(1,t3ew(1,1,1,1),imigr,nowe,0)
+       CALL mppsend(2,t3we(1,1,1,1),imigr,noea,0)
+       CALL mpprecv(1,t3ew(1,1,1,2),imigr)
+       CALL mpprecv(2,t3we(1,1,1,2),imigr)
+
+    CASE ( 1 )
+       CALL mppsend(1,t3ew(1,1,1,1),imigr,nowe,0)
+       CALL mpprecv(2,t3we(1,1,1,2),imigr)
+    END SELECT
+
+#  else
+    !! * Local variables   (PVM version)
+
+    imigr=jpreci*jpj*jpk*jpbyt
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       CALL mppsend(2,t3we(1,1,1,1),imigr,noea,0)
+       CALL mpprecv(1,t3ew(1,1,1,2),imigr)
+
+    CASE ( 0 )
+       CALL mppsend(1,t3ew(1,1,1,1),imigr,nowe,0)
+       CALL mppsend(2,t3we(1,1,1,1),imigr,noea,0)
+       CALL mpprecv(1,t3ew(1,1,1,2),imigr)
+       CALL mpprecv(2,t3we(1,1,1,2),imigr)
+
+    CASE ( 1 )
+       CALL mppsend(1,t3ew(1,1,1,1),imigr,nowe,0)
+       CALL mpprecv(2,t3we(1,1,1,2),imigr)
+    END SELECT
+
+#endif
+
+    ! 2.3 Write Dirichlet lateral conditions
+
+    iihom = nlci-jpreci
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       DO jl = 1, jpreci
+          ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+       END DO
+
+    CASE ( 0 ) 
+       DO jl = 1, jpreci
+          ptab(jl      ,:,:) = t3we(:,jl,:,2)
+          ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+       END DO
+
+    CASE ( 1 )
+       DO jl = 1, jpreci
+          ptab(jl      ,:,:) = t3we(:,jl,:,2)
+       END DO
+    END SELECT
+
+
+    ! 3. North and south directions
+    ! -----------------------------
+
+    ! 3.1 Read Dirichlet lateral conditions
+
+    IF( nbondj /= 2 ) THEN
+       ijhom = nlcj-nrecj
+
+       DO jl = 1, jprecj
+          t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+          t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+       END DO
+    ENDIF
+
+    ! 3.2 Migrations
+
+#if defined key_mpp_shmem
+    !! * SHMEM version
+
+    imigr=jprecj*jpi*jpk
+
+    SELECT CASE ( nbondj )
+
+    CASE ( -1 )
+       CALL shmem_put(t3sn(1,1,1,2),t3sn(1,1,1,1),imigr,nono)
+
+    CASE ( 0 )
+       CALL shmem_put(t3ns(1,1,1,2),t3ns(1,1,1,1),imigr,noso)
+       CALL shmem_put(t3sn(1,1,1,2),t3sn(1,1,1,1),imigr,nono)
+
+    CASE ( 1 )
+       CALL shmem_put(t3ns(1,1,1,2),t3ns(1,1,1,1),imigr,noso)
+
+    END SELECT
+    CALL  barrier()
+    CALL  shmem_udcflush()
+
+#elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+
+    imigr=jprecj*jpi*jpk
+
+    SELECT CASE ( nbondj )     
+
+    CASE ( -1 )
+       CALL mppsend(4,t3sn(1,1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t3ns(1,1,1,2),imigr)
+
+    CASE ( 0 )
+       CALL mppsend(3,t3ns(1,1,1,1),imigr,noso,0)
+       CALL mppsend(4,t3sn(1,1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t3ns(1,1,1,2),imigr)
+       CALL mpprecv(4,t3sn(1,1,1,2),imigr)
+
+    CASE ( 1 ) 
+       CALL mppsend(3,t3ns(1,1,1,1),imigr,noso,0)
+       CALL mpprecv(4,t3sn(1,1,1,2),imigr)
+    END SELECT
+
+#else
+    !! * Local variables   (PVM version)
+
+    imigr=jprecj*jpi*jpk*jpbyt
+
+    SELECT CASE ( nbondj )
+
+    CASE ( -1 ) 
+       CALL mppsend(4,t3sn(1,1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t3ns(1,1,1,2),imigr)
+
+    CASE ( 0 )
+       CALL mppsend(3,t3ns(1,1,1,1),imigr,noso,0)
+       CALL mppsend(4,t3sn(1,1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t3ns(1,1,1,2),imigr)
+       CALL mpprecv(4,t3sn(1,1,1,2),imigr)
+
+    CASE ( 1 )
+       CALL mppsend(3,t3ns(1,1,1,1),imigr,noso,0)
+       CALL mpprecv(4,t3sn(1,1,1,2),imigr)
+    END SELECT
+
+#endif
+
+    ! 3.3 Write Dirichlet lateral conditions
+
+    ijhom = nlcj-jprecj
+
+    SELECT CASE ( nbondj )
+
+    CASE ( -1 )
+       DO jl = 1, jprecj
+          ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+       END DO
+
+    CASE ( 0 ) 
+       DO jl = 1, jprecj
+          ptab(:,jl      ,:) = t3sn(:,jl,:,2)
+          ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+       END DO
+
+    CASE ( 1 )
+       DO jl = 1, jprecj
+          ptab(:,jl,:) = t3sn(:,jl,:,2)
+       END DO
+
+    END SELECT
+
+
+
+    ! 4. north fold treatment
+    ! -----------------------
+
+    ! 4.1 treatment without exchange (jpni odd)
+    !     T-point pivot  
+
+    SELECT CASE ( jpni )
+
+    CASE ( 1 )  ! only one proc along I, no mpp exchange
+
+       SELECT CASE ( npolj )
+  
+       CASE ( 4 )    ! T pivot
+          iloc=jpiglo-2*(nimpp-1)
+
+          SELECT CASE ( cd_type )
+
+          CASE ( 'T' , 'S' )
+             DO jk = 1, jpk
+                DO ji = 2, nlci
+                   ijt=iloc-ji+2
+                   ptab(ji,nlcj,jk) = psgn * ptab(ijt,nlcj-2,jk)
+                END DO
+                DO ji = nlci/2+1, nlci
+                   ijt=iloc-ji+2
+                   ptab(ji,nlcj-1,jk) = psgn * ptab(ijt,nlcj-1,jk)
+                END DO
+             END DO
+          
+          CASE ( 'U' )
+             DO jk = 1, jpk
+                DO ji = 1, nlci-1
+                   iju=iloc-ji+1
+                   ptab(ji,nlcj,jk) = psgn * ptab(iju,nlcj-2,jk)
+                END DO
+                DO ji = nlci/2, nlci-1
+                   iju=iloc-ji+1
+                   ptab(ji,nlcj-1,jk) = psgn * ptab(iju,nlcj-1,jk)
+                END DO
+             END DO
+
+          CASE ( 'V' )
+             DO jk = 1, jpk
+                DO ji = 2, nlci
+                   ijt=iloc-ji+2
+                   ptab(ji,nlcj-1,jk) = psgn * ptab(ijt,nlcj-2,jk)
+                   ptab(ji,nlcj  ,jk) = psgn * ptab(ijt,nlcj-3,jk)
+                END DO
+             END DO
+
+          CASE ( 'F', 'G' )
+             DO jk = 1, jpk
+                DO ji = 1, nlci-1
+                   iju=iloc-ji+1
+                   ptab(ji,nlcj-1,jk) = ptab(iju,nlcj-2,jk)
+                   ptab(ji,nlcj  ,jk) = ptab(iju,nlcj-3,jk)
+                END DO
+             END DO
+
+          END SELECT
+       
+       CASE ( 6 ) ! F pivot
+          iloc=jpiglo-2*(nimpp-1)
+
+          SELECT CASE ( cd_type )
+
+          CASE ( 'T' , 'S' )
+             DO jk = 1, jpk
+                DO ji = 1, nlci
+                   ijt=iloc-ji+1
+                   ptab(ji,nlcj,jk) = psgn * ptab(ijt,nlcj-1,jk)
+                END DO
+             END DO
+
+          CASE ( 'U' )
+             DO jk = 1, jpk
+                DO ji = 1, nlci-1
+                   iju=iloc-ji
+                   ptab(ji,nlcj,jk) = psgn * ptab(iju,nlcj-1,jk)
+                END DO
+             END DO
+
+          CASE ( 'V' )
+             DO jk = 1, jpk
+                DO ji = 1, nlci
+                   ijt=iloc-ji+1
+                   ptab(ji,nlcj  ,jk) = psgn * ptab(ijt,nlcj-2,jk)
+                END DO
+                DO ji = nlci/2+1, nlci
+                   ijt=iloc-ji+1
+                   ptab(ji,nlcj-1,jk) = psgn * ptab(ijt,nlcj-1,jk)
+                END DO
+             END DO
+
+          CASE ( 'F', 'G' )
+             DO jk = 1, jpk
+                DO ji = 1, nlci-1
+                   iju=iloc-ji
+                   ptab(ji,nlcj,jk) = ptab(iju,nlcj-2,jk)
+                   ptab(ji,nlcj  ,jk) = ptab(iju,nlcj-3,jk)
+                END DO
+                DO ji = nlci/2+1, nlci-1
+                   iju=iloc-ji
+                   ptab(ji,nlcj-1,jk) = psgn * ptab(iju,nlcj-1,jk)
+                END DO
+             END DO
+          END SELECT  ! cd_type
+
+       END SELECT     !  npolj
+
+    CASE DEFAULT ! more than 1 proc along I
+      IF ( npolj /= 0 ) CALL mpp_lbc_north (ptab, cd_type, psgn)  ! only for northern procs.
+
+    END SELECT ! jpni 
+
+
+    ! 5. East and west directions exchange
+    ! ------------------------------------
+
+    SELECT CASE ( npolj )
+
+    CASE ( 3, 4, 5, 6 )
+
+       ! 5.1 Read Dirichlet lateral conditions
+
+       SELECT CASE ( nbondi )
+
+       CASE ( -1, 0, 1 )
+          iihom = nlci-nreci
+          DO jl = 1, jpreci
+             t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+             t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+          END DO
+
+       END SELECT
+
+       ! 5.2 Migrations
+
+#if defined key_mpp_shmem
+       !! *  SHMEM version
+
+       imigr=jpreci*jpj*jpk
+
+       SELECT CASE ( nbondi )
+
+       CASE ( -1 )
+          CALL shmem_put(t3we(1,1,1,2),t3we(1,1,1,1),imigr,noea)
+
+       CASE ( 0 )
+          CALL shmem_put(t3ew(1,1,1,2),t3ew(1,1,1,1),imigr,nowe)
+          CALL shmem_put(t3we(1,1,1,2),t3we(1,1,1,1),imigr,noea)
+
+       CASE ( 1 )
+          CALL shmem_put(t3ew(1,1,1,2),t3ew(1,1,1,1),imigr,nowe)
+
+       END SELECT
+       CALL  barrier()
+       CALL  shmem_udcflush()
+
+#elif defined key_mpp_mpi
+       !! * Local variables   (MPI version)
+
+       imigr=jpreci*jpj*jpk
+
+       SELECT CASE ( nbondi )
+
+       CASE ( -1 )
+          CALL mppsend(2,t3we(1,1,1,1),imigr,noea,0)
+          CALL mpprecv(1,t3ew(1,1,1,2),imigr)
+
+       CASE ( 0 )
+          CALL mppsend(1,t3ew(1,1,1,1),imigr,nowe,0)
+          CALL mppsend(2,t3we(1,1,1,1),imigr,noea,0)
+          CALL mpprecv(1,t3ew(1,1,1,2),imigr)
+          CALL mpprecv(2,t3we(1,1,1,2),imigr)
+
+       CASE ( 1 )
+          CALL mppsend(1,t3ew(1,1,1,1),imigr,nowe,0)
+          CALL mpprecv(2,t3we(1,1,1,2),imigr)
+       END SELECT
+
+#else
+       !! * PVM version
+
+       imigr=jpreci*jpj*jpk*jpbyt
+
+       SELECT CASE ( nbondi )
+
+       CASE ( -1 )
+          CALL mppsend(2,t3we(1,1,1,1),imigr,noea,0)
+          CALL mpprecv(1,t3ew(1,1,1,2),imigr)
+
+       CASE ( 0 )
+          CALL mppsend(1,t3ew(1,1,1,1),imigr,nowe,0)
+          CALL mppsend(2,t3we(1,1,1,1),imigr,noea,0)
+          CALL mpprecv(1,t3ew(1,1,1,2),imigr)
+          CALL mpprecv(2,t3we(1,1,1,2),imigr)
+
+       CASE ( 1 )
+          CALL mppsend(1,t3ew(1,1,1,1),imigr,nowe,0)
+          CALL mpprecv(2,t3we(1,1,1,2),imigr)
+       END SELECT
+
+#endif
+
+       ! 5.3 Write Dirichlet lateral conditions
+
+       iihom = nlci-jpreci
+
+       SELECT CASE ( nbondi)
+
+       CASE ( -1 )
+          DO jl = 1, jpreci
+             ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+          END DO
+
+       CASE ( 0 ) 
+          DO jl = 1, jpreci
+             ptab(jl      ,:,:) = t3we(:,jl,:,2)
+             ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+          END DO
+
+       CASE ( 1 )
+          DO jl = 1, jpreci
+             ptab(jl      ,:,:) = t3we(:,jl,:,2)
+          END DO
+       END SELECT
+    END SELECT    ! npolj 
+
+  END SUBROUTINE mpp_lnk_3d
+
+
+  SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mpp_lnk_2d  ***
+    !!                  
+    !! ** Purpose :   Message passing manadgement for 2d array
+    !!
+    !! ** Method  :   Use mppsend and mpprecv function for passing mask 
+    !!      between processors following neighboring subdomains.
+    !!            domain parameters
+    !!                    nlci   : first dimension of the local subdomain
+    !!                    nlcj   : second dimension of the local subdomain
+    !!                    nbondi : mark for "east-west local boundary"
+    !!                    nbondj : mark for "north-south local boundary"
+    !!                    noea   : number for local neighboring processors 
+    !!                    nowe   : number for local neighboring processors
+    !!                    noso   : number for local neighboring processors
+    !!                    nono   : number for local neighboring processors
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    CHARACTER(len=1) , INTENT( in ) ::   &
+         cd_type       ! define the nature of pt2d array grid-points
+    !             !  = T , U , V , F , W 
+    !             !  = S : T-point, north fold treatment
+    !             !  = G : F-point, north fold treatment
+    REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+    !             !   = -1. , the sign is changed if north fold boundary
+    !             !   =  1. , the sign is kept  if north fold boundary
+
+    REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
+         pt2d          ! 2D array on which the boundary condition is applied
+
+    !! * Local variables
+    INTEGER  ::   ji, jj, jl      ! dummy loop indices
+    INTEGER  ::   &
+         imigr, iihom, ijhom,    &  ! temporary integers
+         iloc, ijt, iju             !    "          "
+    !!----------------------------------------------------------------------
+
+    ! 1. standard boundary treatment
+    ! ------------------------------
+
+    !                                        ! East-West boundaries
+    !                                        ! ====================
+
+    IF( nbondi == 2.AND.(nperio == 1 .OR. nperio == 4 .OR. nperio == 6)) THEN
+       ! ... cyclic
+       pt2d( 1 ,:) = pt2d(jpim1,:)
+       pt2d(jpi,:) = pt2d(  2  ,:)
+    ELSE
+       ! ... closed
+
+       SELECT CASE ( cd_type )
+
+       CASE ( 'T', 'U', 'V', 'W' )
+          iihom = nlci-jpreci
+          DO ji = 1,jpreci
+             pt2d(ji,:) = 0.e0
+          END DO
+
+          DO ji = iihom+1,jpi
+             pt2d(ji,:) = 0.e0
+          END DO
+
+       CASE ( 'F' ,'I' )
+          iihom = nlci-jpreci
+          DO ji = iihom+1,jpi
+             pt2d(ji,:) = 0.e0
+          END DO
+
+       END SELECT
+    ENDIF
+    !                                        ! North-South boundaries
+    !                                        ! ======================
+
+    SELECT CASE ( cd_type )
+
+    CASE ( 'T', 'U', 'V', 'W' )
+       ijhom = nlcj-jprecj
+       DO jj = 1,jprecj
+          pt2d(:,jj) = 0.e0
+       END DO
+
+       DO jj = ijhom+1,jpj
+          pt2d(:,jj) = 0.e0
+       END DO
+
+    CASE ( 'F' )
+       ijhom = nlcj-jprecj
+       DO jj = ijhom+1,jpj
+          pt2d(:,jj) = 0.e0
+       END DO
+    END SELECT
+
+
+    ! 
+    ! 2. East and west directions
+    ! ---------------------------
+
+    ! 2.1 Read Dirichlet lateral conditions
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1, 0, 1 )    ! all except 2
+       iihom = nlci-nreci
+       DO jl = 1, jpreci
+          t2ew(:,jl,1) = pt2d(jpreci+jl,:)
+          t2we(:,jl,1) = pt2d(iihom +jl,:)
+       END DO
+    END SELECT
+
+    ! 2.2 Migrations
+
+#if defined key_mpp_shmem
+    !! * SHMEM version
+
+    imigr=jpreci*jpj
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       CALL shmem_put(t2we(1,1,2),t2we(1,1,1),imigr,noea)
+
+    CASE ( 0 )
+       CALL shmem_put(t2ew(1,1,2),t2ew(1,1,1),imigr,nowe)
+       CALL shmem_put(t2we(1,1,2),t2we(1,1,1),imigr,noea)
+  
+    CASE ( 1 )
+       CALL shmem_put(t2ew(1,1,2),t2ew(1,1,1),imigr,nowe)
+    END SELECT
+
+    CALL  barrier()
+    CALL  shmem_udcflush()
+
+#elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+
+    imigr=jpreci*jpj
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+       CALL mpprecv(1,t2ew(1,1,2),imigr)
+
+    CASE ( 0 )
+       CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+       CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+       CALL mpprecv(1,t2ew(1,1,2),imigr)
+       CALL mpprecv(2,t2we(1,1,2),imigr)
+
+    CASE ( 1 )
+       CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+       CALL mpprecv(2,t2we(1,1,2),imigr)
+    END SELECT
+
+#else
+    !! * PVM version
+
+    imigr=jpreci*jpj*jpbyt
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+       CALL mpprecv(1,t2ew(1,1,2),imigr)
+
+    CASE ( 0 )
+       CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+       CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+       CALL mpprecv(1,t2ew(1,1,2),imigr)
+       CALL mpprecv(2,t2we(1,1,2),imigr)
+
+    CASE ( 1 )
+       CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+       CALL mpprecv(2,t2we(1,1,2),imigr)
+    END SELECT 
+
+#endif
+
+    ! 2.3 Write Dirichlet lateral conditions
+
+    iihom = nlci-jpreci
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       DO jl = 1, jpreci
+          pt2d(iihom+jl,:) = t2ew(:,jl,2)
+       END DO
+
+    CASE ( 0 )
+       DO jl = 1, jpreci
+          pt2d(jl      ,:) = t2we(:,jl,2)
+          pt2d(iihom+jl,:) = t2ew(:,jl,2)
+       END DO
+
+    CASE ( 1 )
+       DO jl = 1, jpreci
+          pt2d(jl      ,:) = t2we(:,jl,2)
+       END DO
+    END SELECT
+
+
+    ! 3. North and south directions
+    ! -----------------------------
+
+    ! 3.1 Read Dirichlet lateral conditions
+
+    IF( nbondj /= 2 ) THEN
+       ijhom = nlcj-nrecj
+
+       DO jl = 1, jprecj
+          t2sn(:,jl,1) = pt2d(:,ijhom +jl)
+          t2ns(:,jl,1) = pt2d(:,jprecj+jl)
+       END DO
+    ENDIF
+
+    ! 3.2 Migrations
+
+#if defined key_mpp_shmem
+    !! * SHMEM version
+
+    imigr=jprecj*jpi
+
+    SELECT CASE ( nbondj )
+
+    CASE ( -1 )
+       CALL shmem_put(t2sn(1,1,2),t2sn(1,1,1),imigr,nono)
+
+    CASE ( 0 )
+       CALL shmem_put(t2ns(1,1,2),t2ns(1,1,1),imigr,noso)
+       CALL shmem_put(t2sn(1,1,2),t2sn(1,1,1),imigr,nono)
+
+    CASE ( 1 )
+       CALL shmem_put(t2ns(1,1,2),t2ns(1,1,1),imigr,noso)
+
+    END SELECT 
+    CALL  barrier()
+    CALL  shmem_udcflush()
+
+#elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+
+    imigr=jprecj*jpi
+
+    SELECT CASE ( nbondj)
+
+    CASE ( -1 )
+       CALL mppsend(4,t2sn(1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t2ns(1,1,2),imigr)
+
+    CASE ( 0 )
+       CALL mppsend(3,t2ns(1,1,1),imigr,noso,0)
+       CALL mppsend(4,t2sn(1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t2ns(1,1,2),imigr)
+       CALL mpprecv(4,t2sn(1,1,2),imigr)
+
+    CASE ( 1 )
+       CALL mppsend(3,t2ns(1,1,1),imigr,noso,0)
+       CALL mpprecv(4,t2sn(1,1,2),imigr)
+    END SELECT
+
+#else
+    !! * PVM version
+
+    imigr=jprecj*jpi*jpbyt
+
+    SELECT CASE ( nbondj ) 
+
+    CASE ( -1 )
+       CALL mppsend(4,t2sn(1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t2ns(1,1,2),imigr)
+
+    CASE ( 0 )
+       CALL mppsend(3,t2ns(1,1,1),imigr,noso,0)
+       CALL mppsend(4,t2sn(1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t2ns(1,1,2),imigr)
+       CALL mpprecv(4,t2sn(1,1,2),imigr)
+
+    CASE ( 1 )
+       CALL mppsend(3,t2ns(1,1,1),imigr,noso,0)
+       CALL mpprecv(4,t2sn(1,1,2),imigr)
+    END SELECT
+
+#endif
+
+    ! 3.3 Write Dirichlet lateral conditions
+
+    ijhom = nlcj-jprecj
+
+    SELECT CASE ( nbondj )
+
+    CASE ( -1 )
+       DO jl = 1, jprecj
+          pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+       END DO
+
+    CASE ( 0 )
+       DO jl = 1, jprecj
+          pt2d(:,jl      ) = t2sn(:,jl,2)
+          pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+       END DO
+
+    CASE ( 1 ) 
+       DO jl = 1, jprecj
+          pt2d(:,jl      ) = t2sn(:,jl,2)
+       END DO
+
+    END SELECT 
+
+    ! 4. north fold treatment
+    ! -----------------------
+
+    ! 4.1 treatment without exchange (jpni odd)
+    !   
+    
+    SELECT CASE ( jpni )
+
+    CASE ( 1 ) ! only one proc along I, no mpp exchange
+
+       SELECT CASE ( npolj )
+
+       CASE ( 4 )   !  T pivot
+          iloc=jpiglo-2*(nimpp-1)
+
+          SELECT CASE ( cd_type )
+
+          CASE ( 'T' , 'S' )
+             DO ji = 2, nlci
+                ijt=iloc-ji+2
+                pt2d(ji,nlcj) = psgn * pt2d(ijt,nlcj-2)
+             END DO
+             DO ji = nlci/2+1, nlci
+                ijt=iloc-ji+2
+                pt2d(ji,nlcj-1) = psgn * pt2d(ijt,nlcj-1)
+             END DO
+
+          CASE ( 'U' )
+             DO ji = 1, nlci-1
+                iju=iloc-ji+1
+                pt2d(ji,nlcj) = psgn * pt2d(iju,nlcj-2)
+             END DO
+             DO ji = nlci/2, nlci-1
+                iju=iloc-ji+1
+                pt2d(ji,nlcj-1) = psgn * pt2d(iju,nlcj-1)
+             END DO
+
+          CASE ( 'V' )
+             DO ji = 2, nlci
+                ijt=iloc-ji+2
+                pt2d(ji,nlcj-1) = psgn * pt2d(ijt,nlcj-2)
+                pt2d(ji,nlcj  ) = psgn * pt2d(ijt,nlcj-3)
+             END DO
+
+          CASE ( 'F', 'G' )
+             DO ji = 1, nlci-1
+                iju=iloc-ji+1
+                pt2d(ji,nlcj-1) = pt2d(iju,nlcj-2)
+                pt2d(ji,nlcj  ) = pt2d(iju,nlcj-3)
+             END DO
+
+          CASE ( 'I' )                                  ! ice U-V point
+             pt2d(2,nlcj) = psgn * pt2d(3,nlcj-1)
+             DO ji = 3, nlci
+                iju = iloc - ji + 3
+                pt2d(ji,nlcj) = psgn * pt2d(iju,nlcj-1)
+             END DO
+
+          END SELECT
+
+       CASE (6) ! F pivot
+          iloc=jpiglo-2*(nimpp-1)
+
+          SELECT CASE (cd_type )
+
+          CASE ( 'T', 'S' )
+             DO ji = 1, nlci
+                ijt=iloc-ji+1
+                pt2d(ji,nlcj) = psgn * pt2d(ijt,nlcj-1)
+             END DO
+
+          CASE ( 'U' )
+             DO ji = 1, nlci-1
+                iju=iloc-ji
+                pt2d(ji,nlcj) = psgn * pt2d(iju,nlcj-1)
+             END DO
+
+          CASE ( 'V' )
+             DO ji = 1, nlci
+                ijt=iloc-ji+1
+                pt2d(ji,nlcj  ) = psgn * pt2d(ijt,nlcj-2)
+             END DO
+             DO ji = nlci/2+1, nlci
+                ijt=iloc-ji+1
+                pt2d(ji,nlcj-1) = psgn * pt2d(ijt,nlcj-1)
+             END DO
+
+          CASE ( 'F', 'G' )
+             DO ji = 1, nlci-1
+                iju=iloc-ji
+                pt2d(ji,nlcj) = pt2d(iju,nlcj-2)
+                pt2d(ji,nlcj  ) = pt2d(iju,nlcj-3)
+             END DO
+             DO ji = nlci/2+1, nlci-1
+                iju=iloc-ji
+                pt2d(ji,nlcj-1) = psgn * pt2d(iju,nlcj-1)
+             END DO
+
+          CASE ( 'I' )                                  ! ice U-V point
+                pt2d( 2 ,nlcj) = 0.e0           !!bug  ???
+             DO ji = 1 , nlci-1            !!bug rob= 2,jpim1
+                ijt = iloc - ji            !!bug rob= ijt=jpi-ji+2   ???
+                pt2d(ji,nlcj)= 0.5 * ( pt2d(ji,nlcj-1) + psgn * pt2d(ijt,nlcj-1) )
+             END DO
+
+          END SELECT   ! cd_type
+
+       END SELECT  ! npolj
+
+    CASE DEFAULT ! more than 1 proc along I
+      IF ( npolj /= 0 ) CALL mpp_lbc_north (pt2d, cd_type, psgn)  ! only for northern procs.
+
+    END SELECT ! jpni
+
+
+    ! 5. East and west directions
+    ! ---------------------------
+
+    SELECT CASE ( npolj )
+
+    CASE ( 3, 4, 5, 6 )
+
+       ! 5.1 Read Dirichlet lateral conditions
+
+       SELECT CASE ( nbondi )
+
+       CASE ( -1, 0, 1 )
+          iihom = nlci-nreci
+
+          DO jl = 1, jpreci
+             DO jj = 1, jpj
+                t2ew(jj,jl,1) = pt2d(jpreci+jl,jj)
+                t2we(jj,jl,1) = pt2d(iihom +jl,jj)
+             END DO
+          END DO
+
+       END SELECT
+
+       ! 5.2 Migrations
+
+#if defined key_mpp_shmem
+       !! * SHMEM version
+
+       imigr=jpreci*jpj
+
+       SELECT CASE ( nbondi )
+
+       CASE ( -1 )
+          CALL shmem_put(t2we(1,1,2),t2we(1,1,1),imigr,noea)
+
+       CASE ( 0 )
+          CALL shmem_put(t2ew(1,1,2),t2ew(1,1,1),imigr,nowe)
+          CALL shmem_put(t2we(1,1,2),t2we(1,1,1),imigr,noea)
+
+       CASE ( 1 )
+          CALL shmem_put(t2ew(1,1,2),t2ew(1,1,1),imigr,nowe)
+
+       END SELECT
+       CALL  barrier()
+       CALL  shmem_udcflush()
+
+#elif defined key_mpp_mpi
+       !! * Local variables   (MPI version)
+
+       imigr=jpreci*jpj
+
+       SELECT CASE ( nbondi )
+
+       CASE ( -1 )
+          CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+          CALL mpprecv(1,t2ew(1,1,2),imigr)
+
+       CASE ( 0 )
+          CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+          CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+          CALL mpprecv(1,t2ew(1,1,2),imigr)
+          CALL mpprecv(2,t2we(1,1,2),imigr)
+
+       CASE ( 1 )
+          CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+          CALL mpprecv(2,t2we(1,1,2),imigr)
+       END SELECT 
+
+#else
+       !! * PVM version
+
+       imigr=jpreci*jpj*jpbyt
+
+       SELECT CASE ( nbondi )
+ 
+       CASE ( -1 )
+          CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+          CALL mpprecv(1,t2ew(1,1,2),imigr)
+
+       CASE ( 0 )
+          CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+          CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+          CALL mpprecv(1,t2ew(1,1,2),imigr)
+          CALL mpprecv(2,t2we(1,1,2),imigr)
+
+       CASE ( 1 )
+          CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+          CALL mpprecv(2,t2we(1,1,2),imigr)
+       END SELECT 
+
+#endif
+
+       ! 5.3 Write Dirichlet lateral conditions
+
+       iihom = nlci-jpreci
+
+       SELECT CASE ( nbondi )
+
+       CASE ( -1 )
+          DO jl = 1, jpreci
+             pt2d(iihom+jl,:) = t2ew(:,jl,2)
+          END DO
+
+       CASE ( 0 )
+          DO jl = 1, jpreci
+             pt2d(jl      ,:) = t2we(:,jl,2)
+             pt2d(iihom+jl,:) = t2ew(:,jl,2)
+          END DO
+
+       CASE ( 1 )
+          DO jl = 1, jpreci
+             pt2d(jl,:) = t2we(:,jl,2)
+          END DO
+       END SELECT 
+    END SELECT   ! npolj
+
+  END SUBROUTINE mpp_lnk_2d
+
+
+  SUBROUTINE mpplnks( ptab )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mpplnks  ***
+    !!
+    !! ** Purpose :   Message passing manadgement for add 2d array local boundary
+    !!
+    !! ** Method  :   Use mppsend and mpprecv function for passing mask between
+    !!       processors following neighboring subdomains.
+    !!            domain parameters
+    !!                    nlci   : first dimension of the local subdomain
+    !!                    nlcj   : second dimension of the local subdomain
+    !!                    nbondi : mark for "east-west local boundary"
+    !!                    nbondj : mark for "north-south local boundary"
+    !!                    noea   : number for local neighboring processors 
+    !!                    nowe   : number for local neighboring processors
+    !!                    noso   : number for local neighboring processors
+    !!                    nono   : number for local neighboring processors
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   &
+         ptab                     ! 2D array
+
+    !! * Local variables
+    INTEGER ::   ji, jj, jl     ! dummy loop indices
+    INTEGER ::   &
+         imigr, iihom, ijhom      ! temporary integers
+    !!----------------------------------------------------------------------
+
+
+    ! 1. north fold treatment
+    ! -----------------------
+
+    ! 1.1 treatment without exchange (jpni odd)
+    !   
+    SELECT CASE ( npolj )
+
+    CASE ( 4 )
+       DO ji = 1, nlci
+          ptab(ji,nlcj-2) = ptab(ji,nlcj-2)+t2p1(ji,1,1)
+       END DO
+
+    CASE ( 6 )
+       DO ji = 1, nlci
+          ptab(ji,nlcj-1) = ptab(ji,nlcj-1)+t2p1(ji,1,1)
+       END DO
+
+    ! 1.2 treatment with exchange (jpni greater than 1)
+    ! 
+    CASE ( 3 )
+
+#if defined key_mpp_shmem
+
+       !! * SHMEN version
+
+       imigr=jprecj*jpi
+
+       CALL shmem_put(t2p1(1,1,2),t2p1(1,1,1),imigr,nono)
+       CALL barrier()
+       CALL shmem_udcflush()
+
+#  elif defined key_mpp_mpi
+       !! * Local variables   (MPI version)
+
+       imigr=jprecj*jpi
+
+       CALL mppsend(3,t2p1(1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t2p1(1,1,2),imigr)
+
+#  else
+       !! * PVM version
+
+       imigr=jprecj*jpi*jpbyt
+
+       CALL mppsend(3,t2p1(1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t2p1(1,1,2),imigr)
+
+#endif      
+
+       ! Write north fold conditions
+
+       DO ji = 1, nlci
+          ptab(ji,nlcj-2) = ptab(ji,nlcj-2)+t2p1(ji,1,2)
+       END DO
+
+    CASE ( 5 )
+
+#if defined key_mpp_shmem
+
+       !! * SHMEN version
+
+       imigr=jprecj*jpi
+
+       CALL shmem_put(t2p1(1,1,2),t2p1(1,1,1),imigr,nono)
+       CALL barrier()
+       CALL shmem_udcflush()
+
+#  elif defined key_mpp_mpi
+       !! * Local variables   (MPI version)
+
+       imigr=jprecj*jpi
+
+       CALL mppsend(3,t2p1(1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t2p1(1,1,2),imigr)
+
+#  else
+       !! * PVM version
+
+       imigr=jprecj*jpi*jpbyt
+
+       CALL mppsend(3,t2p1(1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t2p1(1,1,2),imigr)
+
+#endif      
+
+       ! Write north fold conditions
+
+       DO ji = 1, nlci
+          ptab(ji,nlcj-1) = ptab(ji,nlcj-1)+t2p1(ji,1,2)
+       END DO
+
+    END SELECT
+
+
+    ! 2. East and west directions
+    ! ---------------------------
+
+    ! 2.1 Read Dirichlet lateral conditions
+
+    iihom = nlci-jpreci
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1, 0, 1 )  ! all except 2
+       DO jl = 1, jpreci
+             t2ew(:,jl,1) = ptab(  jl    ,:)
+             t2we(:,jl,1) = ptab(iihom+jl,:)
+       END DO
+    END SELECT
+
+    ! 2.2 Migrations
+
+#if defined key_mpp_shmem
+
+    !! * SHMEN version
+
+    imigr=jpreci*jpj
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       CALL shmem_put(t2we(1,1,2),t2we(1,1,1),imigr,noea)
+
+    CASE ( 0 )
+       CALL shmem_put(t2ew(1,1,2),t2ew(1,1,1),imigr,nowe)
+       CALL shmem_put(t2we(1,1,2),t2we(1,1,1),imigr,noea)
+
+    CASE ( 1 )
+       CALL shmem_put(t2ew(1,1,2),t2ew(1,1,1),imigr,nowe)
+
+    END SELECT
+    CALL  barrier()
+    CALL  shmem_udcflush()
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+
+    imigr=jpreci*jpj
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+       CALL mpprecv(1,t2ew(1,1,2),imigr)
+
+    CASE ( 0 )
+       CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+       CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+       CALL mpprecv(1,t2ew(1,1,2),imigr)
+       CALL mpprecv(2,t2we(1,1,2),imigr)
+
+    CASE ( 1 )
+       CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+       CALL mpprecv(2,t2we(1,1,2),imigr)
+
+    END SELECT
+
+#  else
+    !! * PVM version
+
+    imigr=jpreci*jpj*jpbyt
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+       CALL mpprecv(1,t2ew(1,1,2),imigr)
+
+    CASE ( 0 )
+       CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+       CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+       CALL mpprecv(1,t2ew(1,1,2),imigr)
+       CALL mpprecv(2,t2we(1,1,2),imigr)
+
+    CASE ( 1 )
+       CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+       CALL mpprecv(2,t2we(1,1,2),imigr)
+
+    END SELECT
+
+#endif
+
+    ! 2.3 Write Dirichlet lateral conditions
+
+       iihom = nlci-nreci
+
+    SELECT CASE ( nbondi )
+
+    CASE ( -1 )
+       DO jl = 1, jpreci
+             ptab(iihom +jl,:) = ptab(iihom +jl,:)+t2ew(:,jl,2)
+       END DO
+
+    CASE ( 0 )
+       DO jl = 1, jpreci
+             ptab(jpreci+jl,:) = ptab(jpreci+jl,:)+t2we(:,jl,2)
+             ptab(iihom +jl,:) = ptab(iihom +jl,:)+t2ew(:,jl,2)
+       END DO
+
+    CASE ( 1 )
+       DO jl = 1, jpreci
+             ptab(jpreci+jl,:) = ptab(jpreci+jl,:)+t2we(:,jl,2)
+       END DO
+    END SELECT
+
+
+    ! 3. North and south directions
+    ! -----------------------------
+
+    ! 3.1 Read Dirichlet lateral conditions
+
+    ijhom = nlcj-jprecj
+
+    SELECT CASE ( nbondj )
+
+    CASE ( -1, 0, 1 )
+       DO jl = 1, jprecj
+             t2sn(:,jl,1) = ptab(:,ijhom+jl)
+             t2ns(:,jl,1) = ptab(:,   jl   )
+       END DO
+
+    END SELECT 
+
+    ! 3.2 Migrations
+
+#if defined key_mpp_shmem
+
+    !! * SHMEN version
+
+    imigr=jprecj*jpi
+
+    SELECT CASE ( nbondj )
+
+    CASE ( -1 )
+       CALL shmem_put(t2sn(1,1,2),t2sn(1,1,1),imigr,nono)
+
+    CASE ( 0 )
+       CALL shmem_put(t2ns(1,1,2),t2ns(1,1,1),imigr,noso)
+       CALL shmem_put(t2sn(1,1,2),t2sn(1,1,1),imigr,nono)
+
+    CASE ( 1 )
+       CALL shmem_put(t2ns(1,1,2),t2ns(1,1,1),imigr,noso)
+
+    END SELECT
+    CALL  barrier()
+    CALL  shmem_udcflush()
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+
+    imigr=jprecj*jpi
+
+    SELECT CASE ( nbondj )
+
+    CASE ( -1 )
+       CALL mppsend(4,t2sn(1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t2ns(1,1,2),imigr)
+
+    CASE ( 0 )
+       CALL mppsend(3,t2ns(1,1,1),imigr,noso,0)
+       CALL mppsend(4,t2sn(1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t2ns(1,1,2),imigr)
+       CALL mpprecv(4,t2sn(1,1,2),imigr)
+
+    CASE ( 1 )
+       CALL mppsend(3,t2ns(1,1,1),imigr,noso,0)
+       CALL mpprecv(4,t2sn(1,1,2),imigr)
+    END SELECT
+
+#  else
+    !! * PVM version
+
+    imigr=jprecj*jpi*jpbyt
+
+    SELECT CASE ( nbondj )
+ 
+    CASE ( -1 )
+       CALL mppsend(4,t2sn(1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t2ns(1,1,2),imigr)
+
+    CASE ( 0 )
+       CALL mppsend(3,t2ns(1,1,1),imigr,noso,0)
+       CALL mppsend(4,t2sn(1,1,1),imigr,nono,0)
+       CALL mpprecv(3,t2ns(1,1,2),imigr)
+       CALL mpprecv(4,t2sn(1,1,2),imigr)
+
+    CASE ( 1 )
+       CALL mppsend(3,t2ns(1,1,1),imigr,noso,0)
+       CALL mpprecv(4,t2sn(1,1,2),imigr)
+    END SELECT
+#endif
+
+    ! 3.3 Write Dirichlet lateral conditions
+
+       ijhom = nlcj-nrecj
+
+    SELECT CASE ( nbondj )
+
+    CASE ( -1 )
+       DO jl = 1, jprecj
+             ptab(:,ijhom +jl) = ptab(:,ijhom +jl)+t2ns(:,jl,2)
+       END DO
+
+    CASE ( 0 )
+       DO jl = 1, jprecj
+             ptab(:,jprecj+jl) = ptab(:,jprecj+jl)+t2sn(:,jl,2)
+             ptab(:,ijhom +jl) = ptab(:,ijhom +jl)+t2ns(:,jl,2)
+       END DO
+
+    CASE ( 1 ) 
+       DO jl = 1, jprecj
+             ptab(:,jprecj+jl) = ptab(:,jprecj+jl)+t2sn(:,jl,2)
+       END DO
+
+    END SELECT
+
+  END SUBROUTINE mpplnks
+
+
+  SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, kid )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppsend  ***
+    !!                   
+    !! ** Purpose :   Send messag passing array
+    !!
+    !!   Input :
+    !!      argument                :
+    !!                   ktyp   -> Tag of the message
+    !!                   pmess  -> array of real to send
+    !!                   kbytes -> size of pmess in real
+    !!                   kdest  -> receive process number
+    !!                   kid    _> ? (note used)
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    REAL(wp) ::  pmess(*)
+    INTEGER :: kbytes,kdest,ktyp,kid
+
+#if defined key_mpp_shmem
+    !! * SHMEM version  :    routine not used
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER :: iflag
+    INTEGER :: itid_dest,info
+
+    CALL mpi_send(pmess,kbytes,mpi_real8,kdest,ktyp,   &
+         mpi_comm_world,iflag)
+
+#  else
+    !! * Local variables   ( PVM version)
+    INTEGER :: iflag
+    INTEGER :: itid_dest,info
+
+    itid_dest = npvm_tids(kdest)
+    IF( mppsend_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mytid=',npvm_mytid, ' ========== mppsend ========== '
+       WRITE(nummpp,*) 'mytid=',npvm_mytid, ' kbytes=',kbytes,' kdest=',kdest   &
+            ,' ktyp=',ktyp,' iflag=',iflag
+    ENDIF
+
+    CALL pvmfinitsend(pvmdataraw, info)
+    CALL pvmfpack( byte1, pmess, kbytes, 1, info )
+
+    IF( info < 0 ) STOP ' mppsend : problem in pvmfpack '
+    CALL pvmfsend  ( itid_dest , ktyp , iflag )
+    IF( iflag < 0 ) STOP ' mppsend : problem in pvmfsend '
+    IF(mppsend_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mytid=',npvm_mytid,' after:itid_dest=' ,itid_dest,' iflag=',iflag
+    ENDIF
+#endif
+  END SUBROUTINE mppsend
+
+
+  SUBROUTINE mpprecv( ktyp, pmess, kbytes )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mpprecv  ***
+    !!
+    !! ** Purpose :   Receive messag passing array
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    REAL(wp), INTENT(inout) ::   pmess(*)       ! array of real
+    INTEGER , INTENT( in  ) ::   kbytes,     &  ! suze of the array pmess
+         ktyp           ! Tag of the recevied message
+
+#if defined key_mpp_shmem
+    !! * SHMEM version  :    routine not used
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER :: istatus(mpi_status_size)
+    INTEGER :: iflag
+
+    CALL mpi_recv( pmess, kbytes, mpi_real8, mpi_any_source, ktyp,   &
+         mpi_comm_world, istatus, iflag )
+
+#  else
+    !! * Local variables   ( PVM version)
+    INTEGER ::   itid_kexp, info, ibufid
+
+    itid_kexp = -1
+    IF( mpprecv_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mytid=',npvm_mytid, ' ============= mpprecv ============'
+       WRITE(nummpp,*) 'mytid=',npvm_mytid, ' mpprecv, pvmfrecv, itid_kexp=',itid_kexp
+    ENDIF
+    CALL pvmfrecv  ( itid_kexp , ktyp , ibufid )
+    IF( mpprecv_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mytid=',npvm_mytid,' mpprecv,END pvmfrecv'   &
+            ,'ibufid=',ibufid,' npvm_me=',npvm_me
+    ENDIF
+    CALL pvmfunpack( byte1, pmess, kbytes, 1, info )
+    IF( info < 0 ) kbytes = info
+#endif
+
+  END SUBROUTINE mpprecv
+
+
+  SUBROUTINE mppgather( ptab, kk, kp, pio )
+    !!----------------------------------------------------------------------
+    !!                       routine mppgather
+    !!                     *********************
+    !! ** Purpose :
+    !!     Transfert between a local subdomain array and a work array 
+    !!     which is distributed following the vertical level.
+    !!
+    !! ** Method :
+    !!
+    !!   Input :
+    !!      argument
+    !!           ptab   : subdomain array input
+    !!           kk     : vertical level
+    !!           kp     : record length
+    !!
+    !!   Output :
+    !!      argument 
+    !!           pio    : output array
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    REAL(wp), DIMENSION(jpi,jpj), INTENT( in ) ::   &
+         ptab             ! subdomain input array
+    INTEGER, INTENT( in ) ::   kk     ! vertical level
+    INTEGER, INTENT( in ) ::   kp     ! record length
+    REAL(wp), DIMENSION(jpi,jpj,jpnij), INTENT( out ) ::   &
+         pio              ! subdomain input array
+    !!---------------------------------------------------------------------
+
+#if defined key_mpp_shmem
+    !! * SHMEM version
+
+    CALL barrier()
+    CALL shmem_put(pio(1,1,npvm_me+1),ptab,jpi*jpj,kp)
+    CALL barrier()
+
+#elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER :: itaille,ierror
+
+    itaille=jpi*jpj
+    CALL mpi_gather(ptab,itaille,mpi_real8,pio,itaille   &
+         ,mpi_real8,kp,mpi_comm_world,ierror) 
+#else
+    !! * Local variables   (PVM version)
+
+    INTEGER :: imess,ic
+    INTEGER :: ji,jj
+    INTEGER :: ii
+
+    IF(jpnij == 1 ) THEN
+       DO jj = 1, jpj
+          DO ji = 1, jpi
+             pio(ji,jj,1) = ptab(ji,jj)
+          END DO
+       END DO
+       RETURN
+    ENDIF
+    CALL mppsync
+    IF( npvm_me /= kp ) THEN 
+
+       !     send data to the root member
+
+       imess=kk+ 100000*npvm_me
+       CALL  mppsend(imess,ptab,jpi*jpj*jpbyt,kp,0)
+    ELSE 
+
+       !     receive message form other member
+       !     of the group
+
+       DO ji=0,npvm_nproc-1
+          IF  (ji == npvm_me ) THEN 
+             pio(:,:,ji+1) = ptab(:,:)
+          ELSE 
+             imess=kk+ 100000*ji
+             CALL mpprecv(imess,pio(1,1,ji+1),jpi*jpj*jpbyt)
+          ENDIF
+       END DO
+    ENDIF
+    CALL  mppsync
+#endif
+
+  END SUBROUTINE mppgather
+
+
+  SUBROUTINE mppscatter( pio, kk, kp, ptab )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppscatter  ***
+    !!
+    !! ** Purpose :   Transfert between awork array which is distributed 
+    !!      following the vertical level and the local subdomain array.
+    !!
+    !! ** Method :
+    !!
+    !!   Input :
+    !!      argument
+    !!          pio    -> output array
+    !!           kk     -> process number
+    !!           kp     -> Tag (not used with MPI
+    !!
+    !!   Output :
+    !!      argument 
+    !!           ptab   : subdomain array input
+    !!
+    !!----------------------------------------------------------------------
+    INTEGER :: kk,kp
+    REAL(wp),DIMENSION(jpi,jpj)        ::  ptab
+    REAL(wp),DIMENSION(jpi,jpj,jpnij)  ::  pio
+    !!---------------------------------------------------------------------
+
+#if defined key_mpp_shmem
+    !! * SHMEM version
+
+    CALL barrier()
+    CALL shmem_get(ptab,pio(1,1,npvm_me+1),jpi*jpj,kp)
+    CALL barrier()
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER :: itaille, ierror
+
+    itaille=jpi*jpj
+
+    CALL mpi_scatter(pio,itaille,mpi_real8,ptab,itaille,   &
+         mpi_real8,kp,mpi_comm_world,ierror)
+
+#  else
+    !! * Local variables (PVM version)
+    INTEGER :: imess,ic
+    INTEGER :: ji,jj
+
+    IF(jpnij == 1 ) THEN
+       DO jj = 1, jpj
+          DO ji = 1, jpi
+             ptab(ji,jj) = pio(ji,jj,1)
+          END DO
+       END DO
+       RETURN
+    ENDIF
+    CALL  mppsync
+    imess=kk
+    CALL pvmfscatter(ptab,pio,jpi*jpj,jpvmreal,imess,opaall,kp,ic)
+    IF(ic /= 0 ) THEN
+       WRITE(nummpp,*) "problem pvmfscatter  kk=", kk, " kp=", kp
+    ENDIF
+    CALL  mppsync
+#endif
+
+  END SUBROUTINE mppscatter
+
+
+  SUBROUTINE mppisl_a_int( ktab, kdim )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppisl_a_int  ***
+    !!                   
+    !! ** Purpose :   Massively parallel processors
+    !!                Find the  non zero value
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER, INTENT( in  )                  ::   kdim       ! ???
+    INTEGER, INTENT(inout), DIMENSION(kdim) ::   ktab       ! ???
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    INTEGER :: ji
+    INTEGER, SAVE :: ibool=0
+
+    IF( kdim > jpmppsum ) THEN
+       WRITE(numout,*) 'mppisl_a_int routine : kdim is too big'
+       WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+       STOP 'mppisl_a_int'
+    ENDIF
+
+    DO ji = 1, kdim
+       niitab_shmem(ji) = ktab(ji)
+    END DO
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_int8_min_to_all (ni11tab_shmem,niitab_shmem,kdim,0   &
+            ,0,N$PES,ni11wrk_shmem,ni11sync_shmem)
+       CALL shmem_int8_max_to_all (ni12tab_shmem,niitab_shmem,kdim,0   &
+            ,0,N$PES,ni12wrk_shmem,ni12sync_shmem)
+    ELSE
+       CALL shmem_int8_min_to_all (ni11tab_shmem,niitab_shmem,kdim,0   &
+            ,0,N$PES,ni21wrk_shmem,ni21sync_shmem)
+       CALL shmem_int8_max_to_all (ni12tab_shmem,niitab_shmem,kdim,0   &
+            ,0,N$PES,ni22wrk_shmem,ni22sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    DO ji = 1, kdim
+       IF( ni11tab_shmem(ji) /= 0. ) THEN
+          ktab(ji) = ni11tab_shmem(ji)
+       ELSE
+          ktab(ji) = ni12tab_shmem(ji)
+       ENDIF
+    END DO
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    LOGICAL  :: lcommute
+    INTEGER, DIMENSION(kdim) ::   iwork
+    INTEGER  :: mpi_isl,ierror
+
+    lcommute=.TRUE.
+    CALL mpi_op_create(lc_isl,lcommute,mpi_isl,ierror)
+    CALL mpi_allreduce(ktab,iwork,kdim,mpi_integer   &
+         ,mpi_isl,mpi_comm_world,ierror)
+    ktab(:) = iwork(:)
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmIsl2
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij == 1) RETURN
+    IF(mppisl_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mppisl_a_int me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmIsl2, ktab, kdim, jpvmint,   &
+         itype, opaall, iroot,info)
+    IF(iroot == npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmint,ktab,kdim,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mppisl_a_int'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mppisl_a_int'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmint,ktab,kdim,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mppisl_a_int'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+#endif
+
+  END SUBROUTINE mppisl_a_int
+
+
+  SUBROUTINE mppisl_int( ktab )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppisl_int  ***
+    !!                   
+    !! ** Purpose :   Massively parallel processors
+    !!                Find the non zero value
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER , INTENT( inout ) ::   ktab        ! 
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    INTEGER, SAVE :: ibool=0
+
+    niitab_shmem(1) = ktab
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_int8_min_to_all (ni11tab_shmem,niitab_shmem,1,0   &
+            ,0,N$PES,ni11wrk_shmem,ni11sync_shmem)
+       CALL shmem_int8_max_to_all (ni12tab_shmem,niitab_shmem,1,0   &
+            ,0,N$PES,ni12wrk_shmem,ni12sync_shmem)
+    ELSE
+       CALL shmem_int8_min_to_all (ni11tab_shmem,niitab_shmem,1,0   &
+            ,0,N$PES,ni21wrk_shmem,ni21sync_shmem)
+       CALL shmem_int8_max_to_all (ni12tab_shmem,niitab_shmem,1,0   &
+            ,0,N$PES,ni22wrk_shmem,ni22sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    IF( ni11tab_shmem(1) /= 0. ) THEN
+       ktab = ni11tab_shmem(1)
+    ELSE
+       ktab = ni12tab_shmem(1)
+    ENDIF
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    LOGICAL :: lcommute
+    INTEGER :: mpi_isl,ierror
+    INTEGER ::   iwork
+
+    lcommute = .TRUE.
+    CALL mpi_op_create(lc_isl,lcommute,mpi_isl,ierror)
+    CALL mpi_allreduce(ktab, iwork, 1,mpi_integer   &
+         ,mpi_isl,mpi_comm_world,ierror)
+    ktab = iwork
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmIsl2
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij == 1) RETURN
+    IF(mppisl_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mppisl_int me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmIsl2, ktab, 1, jpvmint,   &
+         itype, opaall, iroot,info)
+    IF(iroot == npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmint,ktab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mppisl_int'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mppisl_int'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmint,ktab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mppisl_int'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+#endif
+
+  END SUBROUTINE mppisl_int
+
+  SUBROUTINE PvmIsl2( kdtatyp, kx, ky, kdim, knfo )
+    INTEGER , INTENT( in    ) ::   kdim        ! size of others arguments
+    INTEGER , DIMENSION(kdim), INTENT( inout ) ::   &
+         kx,            &
+         ky
+    INTEGER :: knfo,kdtatyp,ji
+    DO ji = 1, kdim
+       IF(ky(ji) /= 0) kx(ji) = ky(ji)
+    END DO
+  END SUBROUTINE PvmIsl2
+
+
+  SUBROUTINE mppmin_a_int( ktab, kdim )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppmin_a_int  ***
+    !! 
+    !! ** Purpose :   Find minimum value in an integer layout array
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER , INTENT( in  )                  ::   kdim        ! size of array
+    INTEGER , INTENT(inout), DIMENSION(kdim) ::   ktab        ! input array
+
+#if defined key_mpp_shmem
+    !! * Local declarations    (SHMEM version)
+    INTEGER :: ji
+    INTEGER, SAVE :: ibool=0
+
+    IF( kdim > jpmppsum ) THEN
+       WRITE(numout,*) 'mppmin_a_int routine : kdim is too big'
+       WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+       STOP 'min_a_int'
+    ENDIF
+
+    DO ji = 1, kdim
+       niltab_shmem(ji) = ktab(ji)
+    END DO
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_int8_min_to_all (niltab_shmem,niltab_shmem,kdim,0,0   &
+            ,N$PES,nil1wrk_shmem,nil1sync_shmem )
+    ELSE
+       CALL shmem_int8_min_to_all (niltab_shmem,niltab_shmem,kdim,0,0   &
+            ,N$PES,nil2wrk_shmem,nil2sync_shmem )
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    DO ji = 1, kdim
+       ktab(ji) = niltab_shmem(ji)
+    END DO
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER :: ierror
+    INTEGER, DIMENSION(kdim) ::   iwork
+
+    CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer,   &
+         &                mpi_min, mpi_comm_world, ierror )
+
+    ktab(:) = iwork(:)
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmMin
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij == 1) RETURN
+    IF(mppmin_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mppmin_a_int me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmMin,ktab, kdim, jpvmint,   &
+         itype, opaall, iroot, info)
+    IF(iroot == npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmint,ktab,kdim,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mppmin_a_int'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mppmin_a_int'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmint,ktab,kdim,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mppmin_a_int'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+#endif
+
+  END SUBROUTINE mppmin_a_int
+
+  SUBROUTINE mppmin_int( ktab )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppmin_int  ***
+    !!
+    !! ** Purpose :
+    !!     Massively parallel processors
+    !!     Find minimum value in an integer layout array
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER, INTENT(inout) ::   ktab      ! ???
+
+    !! * Local declarations
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    INTEGER :: ji
+    INTEGER, SAVE :: ibool=0
+
+    niltab_shmem(1) = ktab
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_int8_min_to_all (niltab_shmem,niltab_shmem, 1,0,0   &
+            ,N$PES,nil1wrk_shmem,nil1sync_shmem )
+    ELSE
+       CALL shmem_int8_min_to_all (niltab_shmem,niltab_shmem, 1,0,0   &
+            ,N$PES,nil2wrk_shmem,nil2sync_shmem )
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    ktab = niltab_shmem(1)
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER ::  ierror, iwork
+
+    CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   &
+         &              ,mpi_min,mpi_comm_world,ierror)
+
+    ktab = iwork
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmMin
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij == 1) RETURN
+    IF(mppmin_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mppmin_int me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmMin,ktab,  1, jpvmint,   &
+         itype, opaall, iroot, info)
+    IF(iroot == npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmint,ktab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mppmin_int'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mppmin_int'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmint,ktab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mppmin_int'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+#endif
+
+  END SUBROUTINE mppmin_int
+
+  SUBROUTINE mppsum_a_int( ktab, kdim )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppsum_a_int  ***
+    !!                    
+    !! ** Purpose :   Massively parallel processors
+    !!                Global integer sum
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER, INTENT( in  )                   ::   kdim      ! ???
+    INTEGER, INTENT(inout), DIMENSION (kdim) ::   ktab      ! ???
+
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    INTEGER :: ji
+    INTEGER, SAVE :: ibool=0
+
+    IF( kdim > jpmppsum ) THEN
+       WRITE(numout,*) 'mppsum_a_int routine : kdim is too big'
+       WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+       STOP 'mppsum_a_int'
+    ENDIF
+
+    DO ji = 1, kdim
+       nistab_shmem(ji) = ktab(ji)
+    END DO
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_int8_sum_to_all(nistab_shmem,nistab_shmem,kdim,0,0,   &
+            N$PES,nis1wrk_shmem,nis1sync_shmem)
+    ELSE
+       CALL shmem_int8_sum_to_all(nistab_shmem,nistab_shmem,kdim,0,0,   &
+            N$PES,nis2wrk_shmem,nis2sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool = ibool + 1
+    ibool = MOD( ibool, 2 )
+    DO ji = 1, kdim
+       ktab(ji) = nistab_shmem(ji)
+    END DO
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER :: ierror
+    INTEGER, DIMENSION (kdim) ::  iwork
+
+    CALL mpi_allreduce(ktab, iwork,kdim,mpi_integer   &
+         ,mpi_sum,mpi_comm_world,ierror)
+
+    ktab(:) = iwork(:)
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmSum
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij == 1) RETURN
+    IF(mppsum_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mppsum_a_int me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmSum, ktab, kdim, jpvmint,   &
+         itype, opaall, iroot, info)
+    IF(iroot == npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmint,ktab,kdim,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mppsum_a_int'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mppsum_a_int'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmint,ktab,kdim,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mppsum_a_int'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+
+#endif
+
+  END SUBROUTINE mppsum_a_int
+
+  SUBROUTINE mppsum_int( ktab )
+    !!----------------------------------------------------------------------
+    !!                 ***  routine mppsum_int  ***
+    !!                  
+    !! ** Purpose :   Global integer sum
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER, INTENT(inout) ::   ktab
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    INTEGER, SAVE :: ibool=0
+
+    nistab_shmem(1) = ktab
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_int8_sum_to_all(nistab_shmem,nistab_shmem, 1,0,0,   &
+            N$PES,nis1wrk_shmem,nis1sync_shmem)
+    ELSE
+       CALL shmem_int8_sum_to_all(nistab_shmem,nistab_shmem, 1,0,0,   &
+            N$PES,nis2wrk_shmem,nis2sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    ktab = nistab_shmem(1)
+    ! 
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER :: ierror, iwork
+
+    CALL mpi_allreduce(ktab,iwork, 1,mpi_integer   &
+         ,mpi_sum,mpi_comm_world,ierror)
+
+    ktab = iwork
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmSum
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij == 1) RETURN
+    IF(mppsum_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mppsum_int me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmSum, ktab,  1, jpvmint,   &
+         itype, opaall, iroot, info)
+    IF(iroot == npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmint,ktab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mppsum_int'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mppsum_int'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmint,ktab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mppsum_int'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+
+#endif
+
+  END SUBROUTINE mppsum_int
+
+
+  SUBROUTINE mppisl_a_real( ptab, kdim )
+    !!----------------------------------------------------------------------
+    !!                 ***  routine mppisl_a_real  ***
+    !!         
+    !! ** Purpose :   Massively parallel processors
+    !!           Find the non zero island barotropic stream function value
+    !!
+    !!   Modifications:
+    !!        !  93-09 (M. Imbard)
+    !!        !  96-05 (j. Escobar)
+    !!        !  98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI 
+    !!----------------------------------------------------------------------
+    INTEGER , INTENT( in  )                  ::   kdim      ! ???
+    REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab      ! ???
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    INTEGER :: ji
+    INTEGER, SAVE :: ibool=0
+
+    IF( kdim > jpmppsum ) THEN
+       WRITE(numout,*) 'mppisl_a_real routine : kdim is too big'
+       WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+       STOP 'mppisl_a_real'
+    ENDIF
+
+    DO ji = 1, kdim
+       wiltab_shmem(ji) = ptab(ji)
+    END DO
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_min_to_all (wi1tab_shmem,wiltab_shmem,kdim,0   &
+            ,0,N$PES,wi11wrk_shmem,ni11sync_shmem)
+       CALL shmem_real8_max_to_all (wi2tab_shmem,wiltab_shmem,kdim,0   &
+            ,0,N$PES,wi12wrk_shmem,ni12sync_shmem)
+    ELSE
+       CALL shmem_real8_min_to_all (wi1tab_shmem,wiltab_shmem,kdim,0   &
+            ,0,N$PES,wi21wrk_shmem,ni21sync_shmem)
+       CALL shmem_real8_max_to_all (wi2tab_shmem,wiltab_shmem,kdim,0   &
+            ,0,N$PES,wi22wrk_shmem,ni22sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    DO ji = 1, kdim
+       IF(wi1tab_shmem(ji) /= 0. ) THEN
+          ptab(ji) = wi1tab_shmem(ji)
+       ELSE
+          ptab(ji) = wi2tab_shmem(ji)
+       ENDIF
+    END DO
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    LOGICAL ::   lcommute = .TRUE.
+    INTEGER ::   mpi_isl, ierror
+    REAL(wp), DIMENSION(kdim) ::  zwork
+
+    CALL mpi_op_create(lc_isl,lcommute,mpi_isl,ierror)
+    CALL mpi_allreduce(ptab, zwork,kdim,mpi_real8   &
+         ,mpi_isl,mpi_comm_world,ierror)
+    ptab(:) = zwork(:)
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmIsl
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij == 1) RETURN
+    IF(mppisl_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mppisl_a_real me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmIsl, ptab, kdim, jpvmreal,   &
+         itype, opaall, iroot,info)
+    IF(iroot == npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmreal,ptab,kdim,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mppisl_a_real'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mppisl_a_real'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmreal,ptab,kdim,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mppisl_a_real'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+#endif
+
+  END SUBROUTINE mppisl_a_real
+
+  SUBROUTINE mppisl_real( ptab )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppisl_real  ***
+    !!                  
+    !! ** Purpose :   Massively parallel processors
+    !!     Find the  non zero island barotropic stream function value
+    !!
+    !!   Modifications:
+    !!        !  93-09 (M. Imbard)
+    !!        !  96-05 (j. Escobar)
+    !!        !  98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI 
+    !!----------------------------------------------------------------------
+    REAL(wp), INTENT(inout) ::   ptab
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    INTEGER, SAVE :: ibool=0
+
+    wiltab_shmem(1) = ptab
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_min_to_all (wi1tab_shmem,wiltab_shmem, 1,0   &
+            ,0,N$PES,wi11wrk_shmem,ni11sync_shmem)
+       CALL shmem_real8_max_to_all (wi2tab_shmem,wiltab_shmem, 1,0   &
+            ,0,N$PES,wi12wrk_shmem,ni12sync_shmem)
+    ELSE
+       CALL shmem_real8_min_to_all (wi1tab_shmem,wiltab_shmem, 1,0   &
+            ,0,N$PES,wi21wrk_shmem,ni21sync_shmem)
+       CALL shmem_real8_max_to_all (wi2tab_shmem,wiltab_shmem, 1,0   &
+            ,0,N$PES,wi22wrk_shmem,ni22sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    IF(wi1tab_shmem(1) /= 0. ) THEN
+       ptab = wi1tab_shmem(1)
+    ELSE
+       ptab = wi2tab_shmem(1)
+    ENDIF
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    LOGICAL  ::   lcommute = .TRUE.
+    INTEGER  ::   mpi_isl, ierror
+    REAL(wp) ::   zwork
+
+    CALL mpi_op_create(lc_isl,lcommute,mpi_isl,ierror)
+    CALL mpi_allreduce(ptab, zwork, 1,mpi_real8   &
+         &               ,mpi_isl,mpi_comm_world,ierror)
+    ptab = zwork
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmIsl
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij == 1) RETURN
+    IF(mppisl_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mppisl_real me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmIsl, ptab,  1, jpvmreal,   &
+         itype, opaall, iroot,info)
+    IF(iroot == npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmreal,ptab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mppisl_real'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mppisl_real'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmreal,ptab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mppisl_real'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+#endif
+
+  END SUBROUTINE mppisl_real
+  !CCMPPJM end
+
+  SUBROUTINE PvmIsl( kdtatyp, px, py, kdim, knfo )
+    INTEGER :: kdim
+    REAL(wp),DIMENSION(kdim) ::  px,py
+    INTEGER :: knfo,kdtatyp,ji
+    DO ji = 1, kdim
+       IF(py(ji) /= 0.) px(ji) = py(ji)
+    END DO
+  END SUBROUTINE PvmIsl
+
+
+  FUNCTION lc_isl( py, px, kdim, kdtatyp )
+    INTEGER :: kdim
+    REAL(wp),DIMENSION(kdim) ::  px,py
+    INTEGER :: kdtatyp,ji
+    INTEGER :: lc_isl
+    DO ji = 1, kdim
+       IF(py(ji) /= 0.) px(ji) = py(ji)
+    END DO
+    lc_isl=0
+
+  END FUNCTION lc_isl
+
+
+  SUBROUTINE mppmax_a_real( ptab, kdim )
+    !!----------------------------------------------------------------------
+    !!                 ***  routine mppmax_a_real  ***
+    !!                  
+    !! ** Purpose :   Maximum
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER , INTENT( in  )                  ::   kdim
+    REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    INTEGER :: ji
+    INTEGER, SAVE :: ibool=0
+
+    IF( kdim > jpmppsum ) THEN
+       WRITE(numout,*) 'mppmax_a_real routine : kdim is too big'
+       WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+       STOP 'mppmax_a_real'
+    ENDIF
+
+    DO ji = 1, kdim
+       wintab_shmem(ji) = ptab(ji)
+    END DO
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_max_to_all (wintab_shmem,wintab_shmem,kdim,0   &
+            ,0,N$PES,wi1wrk_shmem,ni1sync_shmem)
+    ELSE
+       CALL shmem_real8_max_to_all (wintab_shmem,wintab_shmem,kdim,0   &
+            ,0,N$PES,wi2wrk_shmem,ni2sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    DO ji = 1, kdim
+       ptab(ji) = wintab_shmem(ji)
+    END DO
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER :: ierror
+    REAL(wp), DIMENSION(kdim) ::  zwork
+
+    CALL mpi_allreduce(ptab, zwork,kdim,mpi_real8   &
+         ,mpi_max,mpi_comm_world,ierror)
+    ptab(:) = zwork(:)
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmMax
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij  ==  1) RETURN
+    IF(mppmax_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mppmax_a_real me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmMax, ptab, kdim, jpvmreal,   &
+         itype, opaall, iroot, info)
+    IF(iroot  ==  npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmreal,ptab,kdim,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mppmax_a_real'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mppmax_a_real'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmreal,ptab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mppmax_a_real'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+
+#endif
+
+  END SUBROUTINE mppmax_a_real
+
+  SUBROUTINE mppmax_real( ptab )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppmax_real  ***
+    !!                    
+    !! ** Purpose :   Maximum
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    REAL(wp), INTENT(inout) ::   ptab      ! ???
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    INTEGER, SAVE :: ibool=0
+
+    wintab_shmem(1) = ptab
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_max_to_all (wintab_shmem,wintab_shmem, 1,0   &
+            ,0,N$PES,wi1wrk_shmem,ni1sync_shmem)
+    ELSE
+       CALL shmem_real8_max_to_all (wintab_shmem,wintab_shmem, 1,0   &
+            ,0,N$PES,wi2wrk_shmem,ni2sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    ptab = wintab_shmem(1)
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER  ::   ierror
+    REAL(wp) ::   zwork
+
+    CALL mpi_allreduce(ptab, zwork, 1,mpi_real8   &
+         ,mpi_max,mpi_comm_world,ierror)
+    ptab = zwork
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmMax
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij  ==  1) RETURN
+    IF(mppmax_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mppmax_real me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmMax, ptab,  1, jpvmreal,   &
+         itype, opaall, iroot, info)
+    IF(iroot  ==  npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmreal,ptab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mppmax_real'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mppmax_real'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmreal,ptab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mppmax_real'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+
+#endif
+
+  END SUBROUTINE mppmax_real
+
+
+  SUBROUTINE mppmin_a_real( ptab, kdim )
+    !!----------------------------------------------------------------------
+    !!                 ***  routine mppmin_a_real  ***
+    !!                  
+    !! ** Purpose :   Minimum
+    !!
+    !!-----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER , INTENT( in  )                  ::   kdim
+    REAL(wp), INTENT(inout), DIMENSION(kdim) ::   ptab
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    INTEGER :: ji
+    INTEGER, SAVE :: ibool=0
+
+    IF( kdim > jpmppsum ) THEN
+       WRITE(numout,*) 'mpprmin routine : kdim is too big'
+       WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+       STOP 'mpprmin'
+    ENDIF
+
+    DO ji = 1, kdim
+       wintab_shmem(ji) = ptab(ji)
+    END DO
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_min_to_all (wintab_shmem,wintab_shmem,kdim,0   &
+            ,0,N$PES,wi1wrk_shmem,ni1sync_shmem)
+    ELSE
+       CALL shmem_real8_min_to_all (wintab_shmem,wintab_shmem,kdim,0   &
+            ,0,N$PES,wi2wrk_shmem,ni2sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    DO ji = 1, kdim
+       ptab(ji) = wintab_shmem(ji)
+    END DO
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER :: ierror
+    REAL(wp), DIMENSION(kdim) ::   zwork
+
+    CALL mpi_allreduce(ptab, zwork,kdim,mpi_real8   &
+         ,mpi_min,mpi_comm_world,ierror)
+    ptab(:) = zwork(:)
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmMin
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij  ==  1) RETURN
+    IF(mppmin_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mpprmin me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmMin, ptab, kdim, jpvmreal,   &
+         itype, opaall, iroot, info)
+    IF(iroot  ==  npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmreal,ptab,kdim,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mpprmin'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mpprmin'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmreal,ptab,kdim,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mpprmin'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+
+#endif
+
+  END SUBROUTINE mppmin_a_real
+
+
+  SUBROUTINE mppmin_real( ptab )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppmin_real  ***
+    !! 
+    !! ** Purpose :   minimum in Massively Parallel Processing
+    !!                REAL scalar case
+    !!
+    !!-----------------------------------------------------------------------
+    !! * Arguments
+    REAL(wp), INTENT( inout ) ::   ptab        ! 
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    INTEGER, SAVE :: ibool=0
+
+    wintab_shmem(1) = ptab
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_min_to_all (wintab_shmem,wintab_shmem, 1,0   &
+            ,0,N$PES,wi1wrk_shmem,ni1sync_shmem)
+    ELSE
+       CALL shmem_real8_min_to_all (wintab_shmem,wintab_shmem, 1,0   &
+            ,0,N$PES,wi2wrk_shmem,ni2sync_shmem)
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    ptab = wintab_shmem(1)
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER  ::   ierror
+    REAL(wp) ::   zwork
+
+    CALL mpi_allreduce( ptab, zwork, 1,mpi_real8   &
+         &               ,mpi_min,mpi_comm_world,ierror)
+    ptab = zwork
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmMin
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij  ==  1) RETURN
+    IF(mppmin_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mpprmin me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmMin, ptab,  1, jpvmreal,   &
+         itype, opaall, iroot, info)
+    IF(iroot  ==  npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmreal,ptab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mpprmin'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mpprmin'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmreal,ptab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mpprmin'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+
+#endif
+
+  END SUBROUTINE mppmin_real
+
+
+  SUBROUTINE mppsum_a_real( ptab, kdim )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppsum_a_real  ***
+    !! 
+    !! ** Purpose :   global sum in Massively Parallel Processing
+    !!                REAL ARRAY argument case
+    !!
+    !!-----------------------------------------------------------------------
+    INTEGER , INTENT( in )                     ::   kdim      ! size of ptab
+    REAL(wp), DIMENSION(kdim), INTENT( inout ) ::   ptab      ! input array
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    INTEGER :: ji
+    INTEGER, SAVE :: ibool=0
+
+    IF( kdim > jpmppsum ) THEN
+       WRITE(numout,*) 'mppsum_a_real routine : kdim is too big'
+       WRITE(numout,*) 'change jpmppsum dimension in mpp.h'
+       STOP 'mppsum_a_real'
+    ENDIF
+
+    DO ji = 1, kdim
+       wrstab_shmem(ji) = ptab(ji)
+    END DO
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_sum_to_all (wrstab_shmem,wrstab_shmem,kdim,0   &
+            ,0,N$PES,wrs1wrk_shmem,nrs1sync_shmem )
+    ELSE
+       CALL shmem_real8_sum_to_all (wrstab_shmem,wrstab_shmem,kdim,0   &
+            ,0,N$PES,wrs2wrk_shmem,nrs2sync_shmem )
+    ENDIF
+    CALL  barrier()
+    ibool=ibool+1
+    ibool=MOD( ibool,2)
+    DO ji = 1, kdim
+       ptab(ji) = wrstab_shmem(ji)
+    END DO
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER                   ::   ierror    ! temporary integer
+    REAL(wp), DIMENSION(kdim) ::   zwork     ! temporary workspace 
+
+    CALL mpi_allreduce(ptab, zwork,kdim,mpi_real8   &
+         &              ,mpi_sum,mpi_comm_world,ierror)
+    ptab(:) = zwork(:)
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmSum
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij == 1) RETURN
+    IF(mppsum_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mppsum_a_real me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmSum, ptab, kdim, jpvmreal,   &
+         itype, opaall, iroot, info)
+    IF(iroot == npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmreal,ptab,kdim,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mppsum_a_real'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mppsum_a_real'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmreal,ptab,kdim,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mppsum_a_real'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+
+#endif
+
+  END SUBROUTINE mppsum_a_real
+
+
+  SUBROUTINE mppsum_real( ptab )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppsum_real  ***
+    !!              
+    !! ** Purpose :   global sum in Massively Parallel Processing
+    !!                SCALAR argument case
+    !!
+    !!-----------------------------------------------------------------------
+    REAL(wp), INTENT(inout) ::   ptab        ! input scalar
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    INTEGER, SAVE :: ibool=0
+
+    wrstab_shmem(1) = ptab
+    CALL  barrier()
+    IF(ibool == 0 ) THEN 
+       CALL shmem_real8_sum_to_all (wrstab_shmem,wrstab_shmem, 1,0   &
+            ,0,N$PES,wrs1wrk_shmem,nrs1sync_shmem )
+    ELSE
+       CALL shmem_real8_sum_to_all (wrstab_shmem,wrstab_shmem, 1,0   &
+            ,0,N$PES,wrs2wrk_shmem,nrs2sync_shmem )
+    ENDIF
+    CALL  barrier()
+    ibool = ibool + 1
+    ibool = MOD( ibool, 2 )
+    ptab = wrstab_shmem(1)
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER  ::   ierror
+    REAL(wp) ::   zwork
+
+    CALL mpi_allreduce(ptab, zwork, 1,mpi_real8   &
+         &              ,mpi_sum,mpi_comm_world,ierror)
+    ptab = zwork
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: ityd
+    INTEGER :: info,itype,ibuf,iroot
+    EXTERNAL PvmSum
+
+    itype= 100
+    iroot=0
+    ityd=npvm_tids(npvm_me)
+    IF(jpnij == 1) RETURN
+    IF(mppsum_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mppsum_real me=',npvm_me,' ityd=',ityd
+    ENDIF
+    CALL pvmfreduce(PvmSum, ptab, 1, jpvmreal,   &
+         itype, opaall, iroot, info)
+    IF(iroot == npvm_me ) THEN
+       CALL pvmfinitsend(pvmdataraw, ibuf )
+       CALL pvmfpack(jpvmreal,ptab,1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfpack problem'
+          STOP 'mppsum_real'
+       ENDIF
+       CALL pvmfbcast(opaall,itype+1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfbcast problem'
+          STOP 'mppsum_real'
+       ENDIF
+    ELSE
+       CALL pvmfrecv(iroot,itype+1,ibuf)
+       CALL pvmfunpack(jpvmreal,ptab, 1,1,info)
+       IF(info /= 0 ) THEN
+          WRITE(nummpp,*) 'me=',npvm_me,' pvmfunpack problem'
+          STOP 'mppsum_real'
+       ENDIF
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+
+#endif
+
+  END SUBROUTINE mppsum_real
+
+
+  SUBROUTINE mppsync()
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppsync  ***
+    !!                   
+    !! ** Purpose :   Massively parallel processors, synchroneous
+    !!
+    !!-----------------------------------------------------------------------
+
+#if defined key_mpp_shmem
+    !! * Local variables   (SHMEM version)
+    CALL barrier()
+
+#  elif defined key_mpp_mpi
+    !! * Local variables   (MPI version)
+    INTEGER :: ierror
+
+    CALL mpi_barrier(mpi_comm_world,ierror)
+
+#  else
+    !! * Local variables   (PVM version)
+    INTEGER :: info
+
+    IF(jpnij == 1) RETURN
+    IF(mppsync_print /= 0 ) THEN
+       WRITE(nummpp,*) 'mppsync me=',npvm_me
+    ENDIF
+    CALL pvmfbarrier(opaall,npvm_nproc,info)
+    IF(info /= 0 ) THEN
+       WRITE(nummpp,*) 'me=',npvm_me,' barrier problem'
+       STOP 'mppsync'
+    ENDIF
+#endif
+
+  END SUBROUTINE mppsync
+
+
+  SUBROUTINE mppstop
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppstop  ***
+    !!                   
+    !! ** purpose :   Stop massilively parallel processors method
+    !!
+    !!----------------------------------------------------------------------
+    !! * Local declarations
+    INTEGER :: info
+    !!----------------------------------------------------------------------
+
+    CALL mppsync
+
+    ! 1. Unit close
+    ! -------------
+
+    CLOSE( numnam )       ! namelist
+    CLOSE( numout )       ! standard model output file
+    CLOSE( numstp )       ! time-step file
+    CLOSE( numwrs )       ! ocean restart file
+
+!!!bug      IF(lwp .AND. l_isl ) CLOSE( numisp )
+
+    IF( lk_dtatem )   CLOSE( numtdt )
+    IF( lk_dtasal )   CLOSE( numsdt )
+    IF( lk_dtasst )   CLOSE( numsst )
+
+     !!bug      CLOSE( numfl1 )
+
+    IF(lwp) CLOSE( numsol )
+
+    IF( lk_cpl ) THEN
+       CLOSE( numlhf )
+       CLOSE( numlts )
+    ENDIF
+
+
+    ! 2. Mpp synchroneus
+    ! ------------------
+
+    CLOSE( numwri )
+    CALL mppsync
+#    if defined key_mpp_mpi
+    CALL mpi_finalize(info)
+#      else
+    CALL pvmfexit( info )
+#    endif
+
+  END SUBROUTINE mppstop
+
+
+  SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij )
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mppobc  ***
+    !! 
+    !! ** Purpose :   Message passing manadgement for open boundary
+    !!     conditions array
+    !!
+    !! ** Method  :   Use mppsend and mpprecv function for passing mask
+    !!       between processors following neighboring subdomains.
+    !!       domain parameters
+    !!                    nlci   : first dimension of the local subdomain
+    !!                    nlcj   : second dimension of the local subdomain
+    !!                    nbondi : mark for "east-west local boundary"
+    !!                    nbondj : mark for "north-south local boundary"
+    !!                    noea   : number for local neighboring processors 
+    !!                    nowe   : number for local neighboring processors
+    !!                    noso   : number for local neighboring processors
+    !!                    nono   : number for local neighboring processors
+    !!
+    !! History :
+    !!        !  98-07 (J.M. Molines) Open boundary conditions
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    INTEGER , INTENT( in ) ::   &
+         kd1, kd2,   &  ! starting and ending indices
+         kl ,        &  ! index of open boundary
+         kk,         &  ! vertical dimension
+         ktype,      &  ! define north/south or east/west cdt
+         !              !  = 1  north/south  ;  = 2  east/west
+         kij            ! horizontal dimension
+    REAL(wp), DIMENSION(kij,kk), INTENT( inout )  ::   &
+         ptab           ! variable array
+
+    !! * Local variables
+    INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+    INTEGER  ::   &
+         iipt0, iipt1, ii, ilpt1, &  ! temporary integers
+         ijpt0, ijpt1, ij,        &  !    "          "
+         imigr, iihom, ijhom         !    "          "
+    REAL(wp), DIMENSION(jpi,jpj) ::   &
+         ztab                        ! temporary workspace
+    !!----------------------------------------------------------------------
+
+
+    ! boundary condition initialization
+    ! ---------------------------------
+
+    ztab(:,:) = 0.e0
+
+    IF( ktype==1 ) THEN                                  ! north/south boundaries
+       iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci     ) )
+       iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) )
+       ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci     ) )
+       ijpt0 = MAX( 1, MIN(kl  - njmpp+1, nlcj     ) )
+       ijpt1 = MAX( 0, MIN(kl  - njmpp+1, nlcj - 1 ) )
+    ELSEIF( ktype==2 ) THEN                              ! east/west boundaries
+       iipt0 = MAX( 1, MIN(kl  - nimpp+1, nlci     ) )
+       iipt1 = MAX( 0, MIN(kl  - nimpp+1, nlci - 1 ) )
+       ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj     ) )
+       ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) )
+       ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) )
+    ELSE
+       IF(lwp)WRITE(numout,*) 'mppobc: bad ktype'
+       STOP 'mppobc'
+    ENDIF
+
+    DO jk = 1, kk
+       IF( ktype==1 ) THEN                               ! north/south boundaries
+          DO jj = ijpt0, ijpt1
+             DO ji = iipt0, iipt1
+                ztab(ji,jj) = ptab(ji,jk)
+             END DO
+          END DO
+       ELSEIF( ktype==2 ) THEN                           ! east/west boundaries
+          DO jj = ijpt0, ijpt1
+             DO ji = iipt0, iipt1
+                ztab(ji,jj) = ptab(jj,jk)
+             END DO
+          END DO
+       ENDIF
+
+
+       ! 1. East and west directions
+       ! ---------------------------
+
+       ! 1.1 Read Dirichlet lateral conditions
+
+       IF( nbondi /= 2 ) THEN
+          iihom = nlci-nreci
+
+          DO jl = 1, jpreci
+             t2ew(:,jl,1) = ztab(jpreci+jl,:)
+             t2we(:,jl,1) = ztab(iihom +jl,:)
+          END DO
+       ENDIF
+
+       ! 1.2 Migrations
+
+#if defined key_mpp_shmem
+       !! *  (SHMEM version)
+       imigr=jpreci*jpj*jpbyt
+
+       IF( nbondi == -1 ) THEN
+          CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr/jpbyt, noea )
+       ELSEIF( nbondi == 0 ) THEN
+          CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr/jpbyt, nowe )
+          CALL shmem_put( t2we(1,1,2), t2we(1,1,1), imigr/jpbyt, noea )
+       ELSEIF( nbondi == 1 ) THEN
+          CALL shmem_put( t2ew(1,1,2), t2ew(1,1,1), imigr/jpbyt, nowe )
+       ENDIF
+       CALL barrier()
+       CALL shmem_udcflush()
+
+#  elif key_mpp_mpi
+       !! * (MPI version)
+
+       imigr=jpreci*jpj
+
+       IF( nbondi == -1 ) THEN
+          CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+          CALL mpprecv(1,t2ew(1,1,2),imigr)
+       ELSEIF( nbondi == 0 ) THEN
+          CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+          CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+          CALL mpprecv(1,t2ew(1,1,2),imigr)
+          CALL mpprecv(2,t2we(1,1,2),imigr)
+       ELSEIF( nbondi == 1 ) THEN
+          CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+          CALL mpprecv(2,t2we(1,1,2),imigr)
+       ENDIF
+
+# else
+       !! *  (PVM version)
+
+       imigr=jpreci*jpj*jpbyt
+
+       IF( nbondi == -1 ) THEN
+          CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+          CALL mpprecv(1,t2ew(1,1,2),imigr)
+       ELSEIF( nbondi == 0 ) THEN
+          CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+          CALL mppsend(2,t2we(1,1,1),imigr,noea,0)
+          CALL mpprecv(1,t2ew(1,1,2),imigr)
+          CALL mpprecv(2,t2we(1,1,2),imigr)
+       ELSEIF( nbondi == 1 ) THEN
+          CALL mppsend(1,t2ew(1,1,1),imigr,nowe,0)
+          CALL mpprecv(2,t2we(1,1,2),imigr)
+       ENDIF
+
+#endif
+
+
+       ! 1.3 Write Dirichlet lateral conditions
+
+       iihom = nlci-jpreci
+       IF( nbondi == 0 .OR. nbondi == 1 ) THEN
+          DO jl = 1, jpreci
+             ztab(jl,:) = t2we(:,jl,2)
+          END DO
+       ENDIF
+
+       IF( nbondi == -1 .OR. nbondi == 0 ) THEN
+          DO jl = 1, jpreci
+             ztab(iihom+jl,:) = t2ew(:,jl,2)
+          END DO
+       ENDIF
+
+
+       ! 2. North and south directions
+       ! -----------------------------
+
+       ! 2.1 Read Dirichlet lateral conditions
+
+       IF( nbondj /= 2 ) THEN
+          ijhom = nlcj-nrecj
+          DO jl = 1, jprecj
+             t2sn(:,jl,1) = ztab(:,ijhom +jl)
+             t2ns(:,jl,1) = ztab(:,jprecj+jl)
+          END DO
+       ENDIF
+
+       ! 2.2 Migrations
+
+#if defined key_mpp_shmem
+       !! * SHMEM version
+
+       imigr=jprecj*jpi*jpbyt
+
+       IF( nbondj == -1 ) THEN
+          CALL shmem_put( t2sn(1,1,2), t2sn(1,1,1), imigr/jpbyt, nono )
+       ELSEIF( nbondj == 0 ) THEN
+          CALL shmem_put( t2ns(1,1,2), t2ns(1,1,1), imigr/jpbyt, noso )
+          CALL shmem_put( t2sn(1,1,2), t2sn(1,1,1), imigr/jpbyt, nono )
+       ELSEIF( nbondj == 1 ) THEN
+          CALL shmem_put( t2ns(1,1,2), t2ns(1,1,1), imigr/jpbyt, noso )
+       ENDIF
+       CALL barrier()
+       CALL shmem_udcflush()
+
+#  elif key_mpp_mpi
+       !! * Local variables   (MPI version)
+
+       imigr=jprecj*jpi
+
+       IF( nbondj == -1 ) THEN
+          CALL mppsend(4,t2sn(1,1,1),imigr,nono,0)
+          CALL mpprecv(3,t2ns(1,1,2),imigr)
+       ELSEIF( nbondj == 0 ) THEN
+          CALL mppsend(3,t2ns(1,1,1),imigr,noso,0)
+          CALL mppsend(4,t2sn(1,1,1),imigr,nono,0)
+          CALL mpprecv(3,t2ns(1,1,2),imigr)
+          CALL mpprecv(4,t2sn(1,1,2),imigr)
+       ELSEIF( nbondj == 1 ) THEN
+          CALL mppsend(3,t2ns(1,1,1),imigr,noso,0)
+          CALL mpprecv(4,t2sn(1,1,2),imigr)
+       ENDIF
+
+#else
+       !! * (PVM version)
+
+       imigr=jprecj*jpi*jpbyt
+
+       IF( nbondj == -1 ) THEN
+          CALL mppsend( 4, t2sn(1,1,1), imigr, nono, 0 )
+          CALL mpprecv( 3, t2ns(1,1,2), imigr )
+       ELSEIF( nbondj == 0 ) THEN
+          CALL mppsend( 3, t2ns(1,1,1), imigr, noso, 0 )
+          CALL mppsend( 4, t2sn(1,1,1), imigr, nono, 0 )
+          CALL mpprecv( 3, t2ns(1,1,2), imigr )
+          CALL mpprecv( 4, t2sn(1,1,2), imigr )
+       ELSEIF( nbondj == 1 ) THEN
+          CALL mppsend( 3, t2ns(1,1,1), imigr, noso, 0 )
+          CALL mpprecv( 4, t2sn(1,1,2), imigr )
+       ENDIF
+
+#endif
+
+       ! 2.3 Write Dirichlet lateral conditions
+
+       ijhom = nlcj - jprecj
+       IF( nbondj == 0 .OR. nbondj == 1 ) THEN
+          DO jl = 1, jprecj
+             ztab(:,jl) = t2sn(:,jl,2)
+          END DO
+       ENDIF
+
+       IF( nbondj == 0 .OR. nbondj == -1 ) THEN
+          DO jl = 1, jprecj
+             ztab(:,ijhom+jl) = t2ns(:,jl,2)
+          END DO
+       ENDIF
+
+       IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN
+          ! north/south boundaries
+          DO jj = ijpt0,ijpt1
+             DO ji = iipt0,ilpt1
+                ptab(ji,jk) = ztab(ji,jj)  
+             END DO
+          END DO
+       ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN
+          ! east/west boundaries
+          DO jj = ijpt0,ilpt1
+             DO ji = iipt0,iipt1
+                ptab(jj,jk) = ztab(ji,jj) 
+             END DO
+          END DO
+       ENDIF
+
+    END DO
+
+  END SUBROUTINE mppobc
+
+  SUBROUTINE mpp_ini_north
+    !!----------------------------------------------------------------------
+    !!               ***  routine mpp_ini_north  ***
+
+    !! ** Purpose :
+    !!      Initialize special communicator for north folding condition
+    !!      together with global variables needed in the mpp folding
+    !!
+    !! ** Method :
+    !!       Look for northern processors
+    !!       Put their number in nrank_north
+    !!       Create groups for the world processors and the north processors
+    !!       Create a communicator for northern processors
+    !!
+    !! ** input
+    !!      none
+    !! 
+    !! ** output
+    !!      njmppmax = njmpp for northern procs
+    !!      ndim_rank_north = number of processors in the northern line
+    !!      nrank_north (ndim_rank_north) = number  of the northern procs.
+    !!      ngrp_world = group ID for the world processors
+    !!      ngrp_north = group ID for the northern processors
+    !!      ncomm_north = communicator for the northern procs.
+    !!      north_root = number (in the world) of proc 0 in the northern comm.
+    !!
+    !! History :
+    !!        !  03-09 (J.M. Molines, MPI only )
+    !!----------------------------------------------------------------------
+
+#ifdef key_mpp_shmem
+    IF (lwp) THEN
+       WRITE(numout,*) ' mpp_ini_north not available in SHMEM'
+       STOP
+    ENDIF
+# elif key_mpp_mpi
+    INTEGER :: ierr
+    INTEGER :: jproc
+    INTEGER :: ii,ji
+
+
+    njmppmax=MAXVAL(njmppt)
+
+    ! Look for how many procs on the northern boundary
+    !
+    ndim_rank_north=0
+    DO jproc=1,jpnij
+       IF ( njmppt(jproc) == njmppmax ) THEN
+          ndim_rank_north = ndim_rank_north + 1
+       END IF
+    END DO
+
+
+    ! Allocate the right size to nrank_north
+    !
+    ALLOCATE(nrank_north(ndim_rank_north))
+
+    ! Fill the nrank_north array with proc. number of northern procs.
+    ! Note : the rank start at 0 in MPI
+    !
+    ii=0
+    DO ji=1,jpnij
+       IF ( njmppt(ji) == njmppmax   ) THEN
+          ii=ii+1
+          nrank_north(ii)=ji-1
+       END IF
+    END DO
+    ! create the world group
+    !
+    CALL MPI_COMM_GROUP(mpi_comm_world,ngrp_world,ierr)
+    !
+    ! Create the North group from the world group
+    CALL MPI_GROUP_INCL(ngrp_world,ndim_rank_north,nrank_north,ngrp_north,ierr)
+
+    ! Create the North communicator , ie the pool of procs in the north group
+    !
+    CALL MPI_COMM_CREATE(mpi_comm_world,ngrp_north,ncomm_north,ierr)
+
+
+    ! find proc number in the world of proc 0 in the north
+    CALL MPI_GROUP_TRANSLATE_RANKS(ngrp_north,1,0,ngrp_world,north_root,ierr)
+
+# else
+    ! PVM
+    IF (lwp) THEN
+       WRITE(numout,*) ' mpp_ini_north not available in PVM'
+       STOP
+    ENDIF
+#endif
+  END SUBROUTINE mpp_ini_north
+
+
+  SUBROUTINE mpp_lbc_north_3d ( pt3d, cd_type, psgn)
+    !!---------------------------------------------------------------------
+    !!                   ***  routine mpp_lbc_north_3d  ***
+    !!
+    !! ** Purpose :
+    !!      Ensure proper north fold horizontal bondary condition in mpp configuration
+    !!      in case of jpn1 > 1
+    !!
+    !! ** Method :
+    !!      Gather the 4 northern lines of the global domain on 1 processor and 
+    !!      apply lbc north-fold on this sub array. Then scatter the fold array 
+    !!      back to the processors.
+    !!
+    !! History :
+    !!   8.5  !  03-09  (J.M. Molines ) For mpp folding condition at north
+    !!                                  from lbc routine
+    !!   9.0  !  03-12  (J.M. Molines ) encapsulation into lib_mpp, coding rules of lbc_lnk
+    !!----------------------------------------------------------------------
+
+    !! * Arguments
+    CHARACTER(len=1), INTENT( in ) ::   &
+         cd_type       ! nature of pt3d grid-points
+    !             !   = T ,  U , V , F or W  gridpoints
+    REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::   &
+         pt3d          ! 3D array on which the boundary condition is applied
+    REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+    !             !   = -1. , the sign is changed if north fold boundary
+    !             !   =  1. , the sign is kept  if north fold boundary
+
+    !! * Local declarations
+
+    INTEGER :: ji, jj, jk, jr, jproc
+    INTEGER :: ierr
+    INTEGER :: ildi,ilei,iilb
+    INTEGER :: ijpj,ijpjm1,ij,ijt,iju
+    INTEGER :: itaille
+
+    REAL(wp), DIMENSION(jpiglo,4,jpk) :: ztab
+    REAL(wp), DIMENSION(jpi,4,jpk,jpni) :: znorthgloio
+    REAL(wp), DIMENSION(jpi,4,jpk) :: znorthloc
+    !!----------------------------------------------------------------------
+    !!  OPA 8.5, LODYC-IPSL (2002)
+    !!----------------------------------------------------------------------
+    ! If we get in this routine it s because : North fold condition and mpp with more
+    !   than one proc across i : we deal only with the North condition
+
+    ! 0. Sign setting
+    ! ---------------
+
+    ijpj=4
+    ijpjm1=3
+
+    ! put in znorthloc the last 4 jlines of pt3d
+    DO jk = 1, jpk 
+       DO jj = nlcj - ijpj +1, nlcj
+          ij = jj - nlcj + ijpj
+          znorthloc(:,ij,jk)=pt3d(:,jj,jk)
+       END DO
+    END DO
+
+
+
+    IF (npolj /= 0 ) THEN
+       ! Build in proc 0 of ncomm_north the znorthgloio
+       znorthgloio(:,:,:,:) = 0_wp
+
+#ifdef key_mpp_shmem
+       not done : compiler error
+#elif defined key_mpp_mpi
+       itaille=jpi*jpk*ijpj
+       CALL MPI_GATHER(znorthloc,itaille,MPI_REAL8,znorthgloio,itaille,MPI_REAL8,0,ncomm_north,ierr)
+#else
+       not done : compiler error
+#endif
+
+    ENDIF
+
+    IF (narea == north_root+1 ) THEN
+       ! recover the global north array
+       ztab(:,:,:) = 0_wp
+
+       DO jr = 1, ndim_rank_north
+          jproc=nrank_north(jr)+1
+          ildi=nldit (jproc)
+          ilei=nleit (jproc)
+          iilb=nimppt(jproc)
+          DO jk = 1 , jpk 
+             DO jj=1,4
+                DO ji=ildi,ilei
+                   ztab(ji+iilb-1,jj,jk)=znorthgloio(ji,jj,jk,jr)
+                END DO
+             END DO
+          END DO
+       END DO
+
+
+       ! Horizontal slab
+       ! ===============
+
+       DO jk = 1, jpk 
+
+
+          ! 2. North-Fold boundary conditions
+          ! ----------------------------------
+
+          SELECT CASE ( npolj )
+
+          CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+
+             ztab( 1    ,ijpj,jk) = 0.e0
+             ztab(jpiglo,ijpj,jk) = 0.e0
+
+             SELECT CASE ( cd_type )
+
+             CASE ( 'T' , 'W' )                         ! T-, W-point
+                DO ji = 2, jpiglo
+                   ijt = jpiglo-ji+2
+                   ztab(ji,ijpj,jk) = psgn * ztab(ijt,ijpj-2,jk)
+                END DO
+                DO ji = jpiglo/2+1, jpiglo
+                   ijt = jpiglo-ji+2
+                   ztab(ji,ijpjm1,jk) = psgn * ztab(ijt,ijpjm1,jk)
+                END DO
+
+             CASE ( 'U' )                               ! U-point
+                DO ji = 1, jpiglo-1
+                   iju = jpiglo-ji+1
+                   ztab(ji,ijpj,jk) = psgn * ztab(iju,ijpj-2,jk)
+                END DO
+                DO ji = jpiglo/2, jpiglo-1
+                   iju = jpiglo-ji+1
+                   ztab(ji,ijpjm1,jk) = psgn * ztab(iju,ijpjm1,jk)
+                END DO
+
+             CASE ( 'V' )                               ! V-point
+                DO ji = 2, jpiglo
+                   ijt = jpiglo-ji+2
+                   ztab(ji,ijpj-1,jk) = psgn * ztab(ijt,ijpj-2,jk)
+                   ztab(ji,ijpj  ,jk) = psgn * ztab(ijt,ijpj-3,jk)
+                END DO
+
+             CASE ( 'F' )                               ! F-point
+                DO ji = 1, jpiglo-1
+                   iju = jpiglo-ji+1
+                   ztab(ji,ijpj-1,jk) = ztab(iju,ijpj-2,jk)
+                   ztab(ji,ijpj  ,jk) = ztab(iju,ijpj-3,jk)
+                END DO
+
+             END SELECT
+
+          CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+
+             ztab( 1    ,ijpj,jk) = 0.e0
+             ztab(jpiglo,ijpj,jk) = 0.e0
+
+             SELECT CASE ( cd_type )
+
+             CASE ( 'T' , 'W' )                         ! T-, W-point
+                DO ji = 1, jpiglo
+                   ijt = jpiglo-ji+1
+                   ztab(ji,ijpj,jk) = psgn * ztab(ijt,ijpj-1,jk)
+                END DO
+
+             CASE ( 'U' )                               ! U-point
+                DO ji = 1, jpiglo-1
+                   iju = jpiglo-ji
+                   ztab(ji,ijpj,jk) = psgn * ztab(iju,ijpj-1,jk)
+                END DO
+
+             CASE ( 'V' )                               ! V-point
+                DO ji = 1, jpiglo
+                   ijt = jpiglo-ji+1
+                   ztab(ji,ijpj,jk) = psgn * ztab(ijt,ijpj-2,jk)
+                END DO
+                DO ji = jpiglo/2+1, jpiglo
+                   ijt = jpiglo-ji+1
+                   ztab(ji,ijpjm1,jk) = psgn * ztab(ijt,ijpjm1,jk)
+                END DO
+
+             CASE ( 'F' )                               ! F-point
+                DO ji = 1, jpiglo-1
+                   iju = jpiglo-ji
+                   ztab(ji,ijpj  ,jk) = ztab(iju,ijpj-2,jk)
+                END DO
+                DO ji = jpiglo/2+1, jpiglo-1
+                   iju = jpiglo-ji
+                   ztab(ji,ijpjm1,jk) = ztab(iju,ijpjm1,jk)
+                END DO
+
+             END SELECT
+
+          CASE DEFAULT                           ! *  closed
+
+             SELECT CASE ( cd_type) 
+
+             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+                ztab(:, 1  ,jk) = 0.e0
+                ztab(:,ijpj,jk) = 0.e0
+
+             CASE ( 'F' )                               ! F-point
+                ztab(:,ijpj,jk) = 0.e0
+
+             END SELECT
+
+          END SELECT
+
+          !     End of slab
+          !     ===========
+
+       END DO
+
+       !! Scatter back to pt3d
+       DO jr = 1, ndim_rank_north
+          jproc=nrank_north(jr)+1
+          ildi=nldit (jproc)
+          ilei=nleit (jproc)
+          iilb=nimppt(jproc)
+          DO jk=  1, jpk
+             DO jj=1,ijpj
+                DO ji=ildi,ilei
+                   znorthgloio(ji,jj,jk,jr)=ztab(ji+iilb-1,jj,jk)
+                END DO
+             END DO
+          END DO
+       END DO
+
+    ENDIF      ! only done on proc 0 of ncomm_north
+
+#ifdef key_mpp_shmem
+    not done yet in shmem : compiler error
+#elif key_mpp_mpi
+    IF ( npolj /= 0 ) THEN
+       itaille=jpi*jpk*ijpj
+       CALL MPI_SCATTER(znorthgloio,itaille,MPI_REAL8,znorthloc,itaille,MPI_REAL8,0,ncomm_north,ierr)
+    ENDIF
+#else
+    not done yet in PVM
+#endif
+
+    ! put in the last ijpj jlines of pt3d znorthloc
+    DO jk = 1 , jpk 
+       DO jj = nlcj - ijpj + 1 , nlcj
+          ij = jj - nlcj + ijpj
+          pt3d(:,jj,jk)= znorthloc(:,ij,jk)
+       END DO
+    END DO
+
+  END SUBROUTINE mpp_lbc_north_3d
+
+
+  SUBROUTINE mpp_lbc_north_2d ( pt2d, cd_type, psgn)
+    !!---------------------------------------------------------------------
+    !!                   ***  routine mpp_lbc_north_2d  ***
+    !!
+    !! ** Purpose :
+    !!      Ensure proper north fold horizontal bondary condition in mpp configuration
+    !!      in case of jpn1 > 1 (for 2d array )
+    !!
+    !! ** Method :
+    !!      Gather the 4 northern lines of the global domain on 1 processor and 
+    !!      apply lbc north-fold on this sub array. Then scatter the fold array 
+    !!      back to the processors.
+    !!
+    !! History :
+    !!   8.5  !  03-09  (J.M. Molines ) For mpp folding condition at north
+    !!                                  from lbc routine
+    !!   9.0  !  03-12  (J.M. Molines ) encapsulation into lib_mpp, coding rules of lbc_lnk
+    !!----------------------------------------------------------------------
+
+    !! * Arguments
+    CHARACTER(len=1), INTENT( in ) ::   &
+         cd_type       ! nature of pt2d grid-points
+    !             !   = T ,  U , V , F or W  gridpoints
+    REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) ::   &
+         pt2d          ! 2D array on which the boundary condition is applied
+    REAL(wp), INTENT( in ) ::   &
+         psgn          ! control of the sign change
+    !             !   = -1. , the sign is changed if north fold boundary
+    !             !   =  1. , the sign is kept  if north fold boundary
+
+
+    !! * Local declarations
+
+    INTEGER :: ji, jj,  jr, jproc
+    INTEGER :: ierr
+    INTEGER :: ildi,ilei,iilb
+    INTEGER :: ijpj,ijpjm1,ij,ijt,iju
+    INTEGER :: itaille
+
+    REAL(wp), DIMENSION(jpiglo,4) :: ztab
+    REAL(wp), DIMENSION(jpi,4,jpni) :: znorthgloio
+    REAL(wp), DIMENSION(jpi,4) :: znorthloc
+    !!----------------------------------------------------------------------
+    !!  OPA 8.5, LODYC-IPSL (2002)
+    !!----------------------------------------------------------------------
+    ! If we get in this routine it s because : North fold condition and mpp with more
+    !   than one proc across i : we deal only with the North condition
+
+    ! 0. Sign setting
+    ! ---------------
+
+    ijpj=4
+    ijpjm1=3
+
+
+    ! put in znorthloc the last 4 jlines of pt2d
+    DO jj = nlcj - ijpj +1, nlcj
+       ij = jj - nlcj + ijpj
+       znorthloc(:,ij)=pt2d(:,jj)
+    END DO
+
+
+
+    IF (npolj /= 0 ) THEN
+       ! Build in proc 0 of ncomm_north the znorthgloio
+       znorthgloio(:,:,:) = 0_wp
+
+#ifdef key_mpp_shmem
+       not done : compiler error
+#elif defined key_mpp_mpi
+       itaille=jpi*ijpj
+       CALL MPI_GATHER(znorthloc,itaille,MPI_REAL8,znorthgloio,itaille,MPI_REAL8,0,ncomm_north,ierr)
+#else
+       not done : compiler error
+#endif
+
+    ENDIF
+
+    IF (narea == north_root+1 ) THEN
+       ! recover the global north array
+       ztab(:,:) = 0_wp
+
+       DO jr = 1, ndim_rank_north
+          jproc=nrank_north(jr)+1
+          ildi=nldit (jproc)
+          ilei=nleit (jproc)
+          iilb=nimppt(jproc)
+          DO jj=1,4
+             DO ji=ildi,ilei
+                ztab(ji+iilb-1,jj)=znorthgloio(ji,jj,jr)
+             END DO
+          END DO
+       END DO
+
+
+       ! 2. North-Fold boundary conditions
+       ! ----------------------------------
+
+       SELECT CASE ( npolj )
+
+       CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+
+          ztab( 1    ,ijpj) = 0.e0
+          ztab(jpiglo,ijpj) = 0.e0
+
+          SELECT CASE ( cd_type )
+
+          CASE ( 'T' , 'W' , 'S' )                         ! T-, W-point
+             DO ji = 2, jpiglo
+                ijt = jpiglo-ji+2
+                ztab(ji,ijpj) = psgn * ztab(ijt,ijpj-2)
+             END DO
+             DO ji = jpiglo/2+1, jpiglo
+                ijt = jpiglo-ji+2
+                ztab(ji,ijpjm1) = psgn * ztab(ijt,ijpjm1)
+             END DO
+
+          CASE ( 'U' )                               ! U-point
+             DO ji = 1, jpiglo-1
+                iju = jpiglo-ji+1
+                ztab(ji,ijpj) = psgn * ztab(iju,ijpj-2)
+             END DO
+             DO ji = jpiglo/2, jpiglo-1
+                iju = jpiglo-ji+1
+                ztab(ji,ijpjm1) = psgn * ztab(iju,ijpjm1)
+             END DO
+
+          CASE ( 'V' )                               ! V-point
+             DO ji = 2, jpiglo
+                ijt = jpiglo-ji+2
+                ztab(ji,ijpj-1) = psgn * ztab(ijt,ijpj-2)
+                ztab(ji,ijpj  ) = psgn * ztab(ijt,ijpj-3)
+             END DO
+
+          CASE ( 'F' , 'G' )                               ! F-point
+             DO ji = 1, jpiglo-1
+                iju = jpiglo-ji+1
+                ztab(ji,ijpj-1) = ztab(iju,ijpj-2)
+                ztab(ji,ijpj  ) = ztab(iju,ijpj-3)
+             END DO
+
+          CASE ( 'I' )                                  ! ice U-V point
+             ztab(2,ijpj) = psgn * ztab(3,ijpj-1)
+             DO ji = 3, jpiglo
+                iju = jpiglo - ji + 3
+                ztab(ji,ijpj) = psgn * ztab(iju,ijpj-1)
+             END DO
+
+          END SELECT
+
+       CASE ( 5, 6 )                        ! *  North fold  F-point pivot
+
+          ztab( 1 ,ijpj) = 0.e0
+          ztab(jpiglo,ijpj) = 0.e0
+
+          SELECT CASE ( cd_type )
+
+          CASE ( 'T' , 'W' ,'S' )                         ! T-, W-point
+             DO ji = 1, jpiglo
+                ijt = jpiglo-ji+1
+                ztab(ji,ijpj) = psgn * ztab(ijt,ijpj-1)
+             END DO
+
+          CASE ( 'U' )                               ! U-point
+             DO ji = 1, jpiglo-1
+                iju = jpiglo-ji
+                ztab(ji,ijpj) = psgn * ztab(iju,ijpj-1)
+             END DO
+
+          CASE ( 'V' )                               ! V-point
+             DO ji = 1, jpiglo
+                ijt = jpiglo-ji+1
+                ztab(ji,ijpj) = psgn * ztab(ijt,ijpj-2)
+             END DO
+             DO ji = jpiglo/2+1, jpiglo
+                ijt = jpiglo-ji+1
+                ztab(ji,ijpjm1) = psgn * ztab(ijt,ijpjm1)
+             END DO
+
+          CASE ( 'F' , 'G' )                               ! F-point
+             DO ji = 1, jpiglo-1
+                iju = jpiglo-ji
+                ztab(ji,ijpj  ) = ztab(iju,ijpj-2)
+             END DO
+             DO ji = jpiglo/2+1, jpiglo-1
+                iju = jpiglo-ji
+                ztab(ji,ijpjm1) = ztab(iju,ijpjm1)
+             END DO
+
+          END SELECT
+
+       CASE DEFAULT                           ! *  closed : the code probably never go through
+
+          SELECT CASE ( cd_type) 
+
+          CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+             ztab(:, 1 ) = 0.e0
+             ztab(:,ijpj) = 0.e0
+
+          CASE ( 'F' )                               ! F-point
+             ztab(:,ijpj) = 0.e0
+
+          CASE ( 'I' )                                  ! ice U-V point
+             ztab(:, 1 ) = 0.e0
+             ztab(:,ijpj) = 0.e0
+
+          END SELECT
+
+       END SELECT
+
+       !     End of slab
+       !     ===========
+
+       !! Scatter back to pt2d
+       DO jr = 1, ndim_rank_north
+          jproc=nrank_north(jr)+1
+          ildi=nldit (jproc)
+          ilei=nleit (jproc)
+          iilb=nimppt(jproc)
+          DO jj=1,ijpj
+             DO ji=ildi,ilei
+                znorthgloio(ji,jj,jr)=ztab(ji+iilb-1,jj)
+             END DO
+          END DO
+       END DO
+
+    ENDIF      ! only done on proc 0 of ncomm_north
+
+#ifdef key_mpp_shmem
+    not done yet in shmem : compiler error
+#elif key_mpp_mpi
+    IF ( npolj /= 0 ) THEN
+       itaille=jpi*ijpj
+       CALL MPI_SCATTER(znorthgloio,itaille,MPI_REAL8,znorthloc,itaille,MPI_REAL8,0,ncomm_north,ierr)
+    ENDIF
+#else
+    not done yet in PVM
+#endif
+
+    ! put in the last ijpj jlines of pt2d znorthloc
+    DO jj = nlcj - ijpj + 1 , nlcj
+       ij = jj - nlcj + ijpj
+       pt2d(:,jj)= znorthloc(:,ij)
+    END DO
+
+  END SUBROUTINE mpp_lbc_north_2d
+
+
+!!!!!
+
+
+  !! 
+  !!    This is valid on IBM machine ONLY. 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -*- Mode: F90 -*- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !! mpi_init_opa.f90 : Redefinition du point d'entree MPI_INIT de la bibliotheque
+  !!                MPI afin de faire, en plus de l'initialisation de
+  !!                l'environnement MPI, l'allocation d'une zone tampon
+  !!                qui sera ulterieurement utilisee automatiquement lors
+  !!                de tous les envois de messages par MPI_BSEND
+  !!
+  !! Auteur : CNRS/IDRIS
+  !! Date   : Tue Nov 13 12:02:14 2001
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE mpi_init_opa(code)
+    IMPLICIT NONE
+#include <mpif.h>
+
+    INTEGER                                 :: code,rang
+
+    ! La valeur suivante doit etre au moins egale a la taille
+    ! du plus grand message qui sera transfere dans le programme
+    ! (de toute facon, il y aura un message d'erreur si cette
+    ! valeur s'avere trop petite)
+    INTEGER                                 :: taille_tampon
+    CHARACTER(len=9)                        :: taille_tampon_alphanum
+    REAL(kind=8), ALLOCATABLE, DIMENSION(:) :: tampon
+
+    ! Le point d'entree dans la bibliotheque MPI elle-meme
+    CALL mpi_init(code)
+
+    ! La definition de la zone tampon pour les futurs envois
+    ! par MPI_BSEND (on alloue une fois pour toute cette zone
+    ! tampon, qui sera automatiquement utilisee lors de chaque
+    ! appel  a MPI_BSEND).
+    ! La desallocation sera implicite quand on sortira de
+    ! l'environnement MPI.
+
+    ! Recuperation de la valeur de la variable d'environnement
+    ! BUFFER_LENGTH
+    ! qui, si elle est definie, doit contenir une valeur superieure
+    ! a  la taille en octets du plus gros message
+    CALL getenv('BUFFER_LENGTH',taille_tampon_alphanum)
+
+    ! Si la variable BUFFER_LENGTH n'est pas positionnee, on lui met par
+    ! defaut la plus grande valeur de la variable MP_EAGER_LIMIT, soit
+    ! 65 536 octets
+    IF (taille_tampon_alphanum == ' ') THEN
+       taille_tampon = 65536
+    ELSE
+       READ(taille_tampon_alphanum,'(i9)') taille_tampon
+    END IF
+
+    ! On est limite en mode d'adressage 32 bits a  1750 Mo pour la zone
+    ! "data" soit 7 segments, c.-a -d. 1750/8 = 210 Mo
+    IF (taille_tampon > 210000000) THEN
+       PRINT *,'Attention la valeur BUFFER_LENGTH doit etre <= 210000000'
+       CALL mpi_abort(MPI_COMM_WORLD,2,code)
+    END IF
+
+    CALL mpi_comm_rank(MPI_COMM_WORLD,rang,code)
+    IF (rang == 0 ) PRINT *,'Taille du buffer alloue : ',taille_tampon
+
+    ! Allocation du tampon et attachement
+    ALLOCATE(tampon(taille_tampon))
+    CALL mpi_buffer_attach(tampon,taille_tampon,code)
+
+  END SUBROUTINE mpi_init_opa
+
+
+#else
+  !!----------------------------------------------------------------------
+  !!   Default case                                 share memory computing
+  !!----------------------------------------------------------------------
+
+  IMPLICIT NONE
+  PRIVATE
+
+  !! * Routine accessibility
+  PUBLIC mynode
+
+CONTAINS
+
+  FUNCTION mynode() RESULT (function_value)
+    !!----------------------------------------------------------------------
+    !!                  ***  routine mynode  ***
+    !!                    
+    !! ** Purpose :   Find processor unit
+    !!
+    !! ** Method  :   share memory computing, return 0 as unit
+    !!
+    !!----------------------------------------------------------------------
+    !! * Local variables
+    INTEGER :: function_value
+    !!----------------------------------------------------------------------
+    function_value = 0
+  END FUNCTION mynode
+
+#endif
+  !!----------------------------------------------------------------------
+END MODULE lib_mpp
Index: /branches/nemo/NEMO/OPA_SRC/lib_print.f90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/lib_print.f90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/lib_print.f90	(revision 4)
@@ -0,0 +1,270 @@
+MODULE lib_print
+   !!======================================================================
+   !!                    ***  MODULE  lib_print  ***
+   !! print librairy :  formated real and integer array print
+   !!=====================================================================
+      
+   !!----------------------------------------------------------------------
+   !!   prihin       : print an integer 2D horizontal field
+   !!   prihre       : print an real 2D horizontal field
+   !!   prizre       : print an real 2D vertical field
+   !!----------------------------------------------------------------------
+   !! * Mules used
+   USE par_kind      ! kind parameters
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC prihin, prihre, prizre
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE prihin( ktab, ki   , kj   , kideb, kifin ,   &
+                      kind, kjdeb, kjfin, kjnd , kscale, kumout )
+      !!----------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  prihre  ***
+      !!  
+      !! ** purpose :   Print an integer field
+      !!
+      !! ** method :   format of print is selected with the dummy argument kscale
+      !!
+      !! History :
+      !!        !  90-04 (0. Marti)  Original code
+      !!        !  92-02 (M. Imbard)
+      !!        !  03-07 (G. Madec)  F90, free form
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   &
+         ki, kj,                 &  ! array dimensions
+         kideb, kifin, kind,     &  ! first and last index, increment for i 
+         kjdeb, kjfin, kjnd,     &  ! first and last index, increment for j
+         kscale,                 &  ! kscale=0 or > 5  print ktab with format i8
+      !                             !         kscale=1 print ktab with format i1
+      !                             !         kscale=2 print ktab with format i2
+      !                             !         kscale=3 print ktab with format i3
+      !                             !         kscale=4 print ktab with format i4
+      !                             !         kscale=5 print ktab with format i5
+         kumout                     ! unit in which print
+      INTEGER, DIMENSION(ki,kj), INTENT( in ) ::   &
+         ktab                       ! integer 2D array to be print
+
+      !! * local declarations
+      INTEGER ::   ji, jj, jn       ! dummy loop indices
+      INTEGER ::   isca, il1, il2   ! temporary integers
+      INTEGER ::   iind, ijnd       ! temporary integers
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0, LODYC (2003)
+      !!----------------------------------------------------------------------
+
+      isca = 10
+      IF( kscale == 0 )   isca = 10
+      IF( kscale == 1 )   isca = 100
+      IF( kscale == 2 )   isca = 60
+      IF( kscale == 3 )   isca = 40
+      IF( kscale == 4 )   isca = 30
+      IF( kscale == 5 )   isca = 20
+
+      iind = MAX( 1, kind )
+      ijnd = MAX( 1, kjnd )
+
+      il1 = kideb
+
+      DO jn = 1, (kifin-kideb+1)/(iind*isca) + 1
+
+        IF( il1 > kifin ) RETURN
+        WRITE(kumout,'(/)')
+        il2 = il1+iind*(isca-1)
+        IF( il2 > kifin )   il2 = kifin
+
+        IF( kscale == 1 ) THEN
+            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)') il1, il2, iind
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,100i1)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSEIF( kscale == 2 ) THEN
+            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)')il1, il2, iind
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,60i2)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSEIF( kscale == 3 ) THEN
+            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)')il1, il2, iind
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,40i3)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSEIF( kscale == 4 ) THEN
+            WRITE(kumout,'(4x,30i4,/)') ( ji, ji = il1, il2, iind )
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,30i4)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSEIF( kscale == 5 ) THEN
+            WRITE(kumout,'(4x,20i5,/)') ( ji, ji = il1, il2, iind )
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,20i5)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSE
+            WRITE(kumout,'(4x,10i8,/)') ( ji, ji = il1, il2, iind )
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,10i8)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ENDIF
+
+        il1 = il1 + iind * isca
+      END DO  
+
+   END SUBROUTINE prihin
+
+
+   SUBROUTINE prihre( ptab, ki   , kj   , kideb, kifin ,   &
+                      kind, kjdeb, kjfin, kjnd , pscale, kumout )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE prihre  ***
+      !!      
+      !! ** purpose :   Print a real field with the format 10e12.4 or 20f6.2
+      !!
+      !! ** method  :   the print format is selected with the pscale argument
+      !!
+      !! History :
+      !!   1.0  !  86-01  (P. Andrich)  Original code
+      !!        !  89-11  (C. Levy)
+      !!        !  92-02  (M. Imbard)
+      !!        !  92-06  (M. Imbard)
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   &
+         ki, kj,                 &  ! array dimensions
+         kideb, kifin, kind,     &  ! first and last index, increment for i
+         kjdeb, kjfin, kjnd,     &  ! first and last index, increment for j
+         kumout                     ! unit in which print
+      REAL(wp), INTENT( in ) ::   &
+         pscale                     ! = 0  print        ptab with e13.5 format
+         !                          ! else print pscale*ptab with f6.2 format
+      REAL(wp), DIMENSION(ki,kj), INTENT( in ) ::   &
+         ptab                       ! integer 2D array to be print
+
+      !! * Local variables
+      INTEGER ::   ji, jj, jn       ! dummy loop indices
+      INTEGER ::   isca, il1, il2   ! temporary integers
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0, LODYC-IPSL (2003)
+      !!----------------------------------------------------------------------
+
+      isca = 10
+      IF( pscale /= 0. )   isca=20
+
+      il1 = kideb
+
+      DO jn = 1, (kifin-kideb+1)/(kind*isca) + 1
+
+        IF( il1 > kifin )   RETURN
+
+        WRITE(kumout,9100)
+
+        il2 = il1+kind*(isca-1)
+        IF(il2 > kifin) il2 = kifin
+        IF( pscale == 0.) THEN
+            WRITE(kumout,9101) ( ji, ji = il1, il2, kind )
+            DO jj = kjfin, kjdeb, -kjnd
+              WRITE(kumout,9102) jj, ( ptab(ji,jj), ji = il1, il2, kind )
+            END DO  
+        ELSE
+            WRITE(kumout,9103) ( ji, ji = il1, il2, kind )
+            DO jj = kjfin, kjdeb, -kjnd
+              WRITE(kumout,9104) jj, ( pscale*ptab(ji,jj), ji = il1, il2, kind )
+            END DO  
+        ENDIF
+        il1 = il1+kind*isca
+
+      END DO  
+
+      ! formats
+ 9100 FORMAT(/)
+ 9101 FORMAT(10i12, /)
+ 9102 FORMAT(1x, i3, 10(1pe12.4))
+ 9103 FORMAT(3x, 20i6, /)
+ 9104 FORMAT(1x, i3, 1x, 20f6.2)
+
+   END SUBROUTINE prihre
+
+
+   SUBROUTINE prizre( ptab , ki   , kj   , kk   , kjcut ,   &
+                      kideb, kifin, kid  , kkdeb, kkfin ,   &
+                      kkd  , pscale, kumout )
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE prizre  ***
+      !!
+      !! ** purpose :   Print a vertical slab from a tridimentional real field
+      !!
+      !!   METHOD :
+      !! ** method  :   the print format is selected with the argument pscale
+      !!
+      !! History :
+      !!      original : 86-01 (o. Marti)
+      !!      addition : 92-02 (M. Imbard)
+      !!      addition : 92-06 (M. Imbard)
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   &
+         ki, kj, kk,             &  ! array dimensions
+         kjcut,                  &  ! index j for the vertical slab
+         kideb, kifin, kid,      &  ! first and last index, increment for i
+         kkdeb, kkfin, kkd,      &  ! first and last index, increment for k
+         kumout                     ! unit in which print
+      REAL(wp), INTENT( in ) ::   &
+         pscale                     ! = 0  print        ptab with e12.4 format
+         !                          ! else print pscale*ptab with f6.2 format
+      REAL(wp), DIMENSION(ki,kj,kk), INTENT( in ) ::   &
+         ptab                       ! integer 3D array to be print
+
+      !! * Local variables
+      INTEGER ::   ji, jn, jk       ! dummy loop indices
+      INTEGER ::   isca, il1, il2   ! temporary integers
+      INTEGER ::   iind, iknd       !    "          "
+      !!----------------------------------------------------------------------
+      !!  OPA8, LODYC (15/11/96)
+      !!----------------------------------------------------------------------
+
+
+      iind = kid
+      iknd = kkd
+      isca = 10
+      IF( pscale /= 0.) isca = 20
+
+      IF (iind == 0) iind = 1
+      IF (iknd == 0) iknd = 1
+
+      il1 = kideb
+
+      DO jn = 1, (kifin-kideb+1)/(iind*isca) + 1
+
+        IF(il1 > kifin) RETURN
+        WRITE(kumout,9100)
+        il2 = il1+iind*(isca-1)
+        IF(il2 > kifin) il2 = kifin
+
+        IF( pscale == 0.) THEN
+            WRITE(kumout,9101) ( ji, ji = il1, il2, iind )
+            DO jk = kkdeb, kkfin, iknd
+              WRITE (kumout,9102) jk, ( ptab(ji,kjcut,jk), ji = il1, il2, iind )
+            END DO  
+        ELSE
+            WRITE (kumout,9103) ( ji, ji = il1, il2, iind )
+            DO jk = kkdeb, kkfin, iknd
+              WRITE(kumout,9104)jk, ( pscale*ptab(ji,kjcut,jk), ji = il1, il2, iind )
+            END DO  
+        ENDIF
+
+        il1 = il1+iind*isca
+      END DO      
+
+ 9100 FORMAT(/)
+ 9101 FORMAT(10i12, /)
+ 9102 FORMAT(1x, i3, 10(1pe12.4))
+ 9103 FORMAT(3x, 20i6, /)
+ 9104 FORMAT(1x, i3, 1x, 20f6.1)
+
+      END SUBROUTINE prizre
+
+   !!======================================================================
+END MODULE lib_print
Index: /branches/nemo/NEMO/OPA_SRC/model.f90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/model.f90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/model.f90	(revision 4)
@@ -0,0 +1,19 @@
+PROGRAM model
+   !!----------------------------------------------------------------------
+   !!                     ***  PROGRAM model  ***
+   !!
+   !! ** Purpose :   encapsulate the opa model so that opa can also be 
+   !!      called together with the adjoint and linear tangent models
+   !!
+   !! History :
+   !!   8.0  !  01-02  (M. Imbard, A. Weaver)  Original code
+   !!   9.0  !  03-10  (G. Madec) F90
+   !!----------------------------------------------------------------------
+   USE opa                  ! OPA system     (opa_model routine)
+   !!----------------------------------------------------------------------
+   !!  OPA 8.5, LODYC-IPSL (2002)
+   !!----------------------------------------------------------------------
+ 
+   CALL opa_model           ! OPA system
+ 
+END PROGRAM model
Index: /branches/nemo/NEMO/OPA_SRC/module_example
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/module_example	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/module_example	(revision 4)
@@ -0,0 +1,207 @@
+MODULE exampl
+   !!======================================================================
+   !!                       ***  MODULE  example  ***
+   !! Ocean physics:  brief description of the purpose of the module
+   !!                 (please no more than 2 lines)
+   !!=====================================================================
+#if defined key_example
+   !!----------------------------------------------------------------------
+   !!   'key_example'  :                brief description of the key option
+   !!----------------------------------------------------------------------
+   !!   exa_mpl      : liste of module subroutine (caution, never use the
+   !!   exa_mpl_init : name of the module for a routine)
+   !!   exa_mpl_stp  : Please try to use 3 letter block for routine names
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE module_name1            ! brief description of the used module
+   USE module_name2            ! ....
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! *  Routine accessibility
+   PUBLIC exa_mpl    ! routine called in xxx.F90 module
+
+   !! * Share Module variables
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &
+      var1    ,   &  !: var1 description (CAUTION always use !: to describe a 
+      !              !  PUBLIC variable simplify the search of where it is declared
+      var2           !: var2 description
+
+   !! * Module variables
+   INTEGER ::                 & !!! ** toto namelist (namtoto) **
+      nflag  =  1                ! default value of nflag 
+   REAL(wp) ::                & !!! ** toto namlist (namtoto) **
+      var3  = 2._wp / 9._wp      ! default value of var3
+   REAL(wp) ::   &  
+      var4          ! var4 description (local permanent variable)
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+      tab1          ! coefficient used for horizontal smoothing
+
+   !! * Substitutions
+#  include "exampl_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+# if defined key_autotasking
+   !!----------------------------------------------------------------------
+   !!   'key_autotasking'                              autotasking (j-slab)
+   !!----------------------------------------------------------------------
+#  include "exampl_autotsk.h90"
+
+# else
+   !!----------------------------------------------------------------------
+   !!   Default option :                           vector opt. (k-j-i loop)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE exa_mpl( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE exa_mpl  ***
+      !!
+      !! ** Purpose :   Brief description of the routine
+      !!
+      !! ** Method  :   description of the methodoloy used to achieve the
+      !!      objectives of the routine. Be as clear as possible!
+      !!
+      !! ** Action  : - first action (share memory array/varible modified
+      !!                in this routine
+      !!              - second action .....
+      !!              - .....
+      !!
+      !! References :
+      !!   Give references if exist otherwise suppress these lines
+      !!
+      !! History :
+      !!   9.0  !  03-08  (Autor Names)  Original code
+      !!        !  02-08  (Author names)  brief description of modifications
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE toto_module                ! description od the module
+
+      !! * arguments
+      INTEGER, INTENT( in  ) ::   &  
+         kt                          ! describe it!!!
+
+      !! * local declarations
+      INTEGER ::   ji, jj, jk        ! dummy loop arguments
+      INTEGER ::   &
+         itoto, itata,            &  ! temporary integers
+         ititi                       ! please do not forget the DOCTOR rule:
+         !                           ! local integer: name start with i
+      REAL(wp) ::   &
+         zmlmin, zbbrau,          &  ! temporary scalars
+         zfact1, zfact2, zfact3,  &  !    "         "
+         zbn2, zesurf,            &  ! local scalar: name start with z
+         zemxl                       !
+      REAL(wp), DIMENSION(jpi,jpk) ::   &
+         ztoto                       ! temporary workspace
+      !!--------------------------------------------------------------------
+
+
+
+      IF( kt == nit000  )   CALL zdf_tke_init    ! Initialization (first time-step only)
+
+      ! Local constant initialization
+      zmlmin = 1.e-8
+      zbbrau =  .5 * ebb / rau0
+      zfact1 = -.5 * rdt * efave
+      zfact2 = 1.5 * rdt * ediss
+      zfact3 = 0.5 * rdt * ediss
+
+
+      SELECT CASE ( npdl )
+
+      CASE ( 0 )           ! describe case 1
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avmv(ji,jj,jk) = ....
+               END DO
+            END DO
+         END DO
+
+      CASE ( 1 )           ! describe case 2
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avmv(ji,jj,jk) = ...
+               END DO
+            END DO
+         END DO
+
+      END SELECT
+
+      ! Lateral boundary conditions (avmu)   (unchanged sign)
+      CALL mpplnk2( avmu, 'U', 1. )
+
+   END SUBROUTINE exa_mpl
+
+# endif
+
+   SUBROUTINE exa_mpl_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE exa_mpl_init  ***
+      !!                   
+      !! ** Purpose :   initialization of ....
+      !!
+      !! ** Method  :   blah blah blah ...
+      !!
+      !! ** input   :   Namlist namexa
+      !!
+      !! ** Action  :   ...  
+      !!
+      !! history :
+      !!   9.0  !  03-08  (Autor Names)  Original code
+      !!----------------------------------------------------------------------
+      !! * local declarations
+      INTEGER ::   ji, jj, jk, jit   ! dummy loop indices
+
+      NAMELIST/namexa/ exa_v1, exa_v2, nexa_0  
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist namexa : example parameters
+      REWIND ( numnam )
+      READ   ( numnam, namexa )
+
+
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'exa_mpl_init : example '
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '          Namelist namexa : set example parameters'
+         WRITE(numout,*) '             brief desciption               exa_v1  = ', exa_v1
+         WRITE(numout,*) '             brief desciption               exa_v1  = ', exa_v1
+         WRITE(numout,*) '             brief desciption               nexa_0  = ', nexa_0
+      ENDIF
+
+      ! Parameter control
+#if defined key_toto
+      IF(lwp) WRITE(numout,cform_err)
+      IF(lwp) WRITE(numout,*) '          this part and key_toto are incompatible'
+      nstop = nstop + 1
+#endif
+
+      ! Check nexa_0 values
+      IF( nexa_0 < 0 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag: nmxl is < 0 or > 3 '
+         nstop = nstop + 1
+      ENDIF
+
+   END SUBROUTINE zdf_tke_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE exa_mpl              ! Empty routine
+   END SUBROUTINE exa_mpl
+#endif
+
+   !!======================================================================
+END MODULE exampl
Index: /branches/nemo/NEMO/OPA_SRC/mppini.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/mppini.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/mppini.F90	(revision 4)
@@ -0,0 +1,493 @@
+MODULE mppini
+   !!==============================================================================
+   !!                       ***  MODULE mppini   ***
+   !! Ocean initialization : distributed memory computing initialization
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   mpp_init       : Lay out the global domain over processors
+   !!   mpp_init2      : Lay out the global domain over processors 
+   !!                    with land processor elimination
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain 
+   USE in_out_manager  ! I/O Manager
+   USE sol_oce         ! ocean elliptic solver
+   USE lib_mpp         ! distribued memory computing library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC mpp_init       ! called by opa.F90
+   PUBLIC mpp_init2      ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL  (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if ! defined key_mpp
+   !!----------------------------------------------------------------------
+   !!   Default option :                            shared memory computing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Shared memory computing, set the local processor
+      !!      variables to the value of the global domain
+      !!
+      !! History :
+      !!   9.0  !  04-01  (G. Madec, J.M. Molines)  F90 : free form, north fold jpni >1
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0, LODYC-IPSL (2004)
+      !!----------------------------------------------------------------------
+      ! No mpp computation
+
+      nimpp  = 1
+      njmpp  = 1
+      nlci   = jpi
+      nlcj   = jpj
+      nldi   = 1
+      nldj   = 1
+      nlei   = jpi
+      nlej   = jpj
+      nperio = jperio
+      nbondi = 2
+      nbondj = 2
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing'
+         WRITE(numout,*) '~~~~~~~~~~~: '
+         WRITE(numout,*) '         nperio = ', nperio
+         WRITE(numout,*) '         nimpp  = ', nimpp
+         WRITE(numout,*) '         njmpp  = ', njmpp
+      ENDIF
+
+      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) THEN
+          IF(lwp)WRITE(numout,cform_err)
+          IF(lwp)WRITE(numout,*) 'equality  jpni = jpnj = jpnij = 1 is not satisfied'
+          IF(lwp)WRITE(numout,*) 'the domain is lay out for distributed memory computing! '
+          nstop = nstop + 1
+      ENDIF
+
+   END SUBROUTINE mpp_init
+
+
+   SUBROUTINE mpp_init2 
+      CALL mpp_init                             ! same routine as mpp_init
+   END SUBROUTINE mpp_init2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   'key_mpp' :                            distributed memory computing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!                    
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!      Periodic condition is a function of the local domain position
+      !!      (global boundary or neighbouring domain) and of the global
+      !!      periodic
+      !!      Type :         jperio global periodic condition
+      !!                     nperio local  periodic condition
+      !!
+      !! ** Action  : - set domain parameters
+      !!                    nimpp     : longitudinal index 
+      !!                    njmpp     : latitudinal  index
+      !!                    nperio    : lateral condition type 
+      !!                    narea     : number for local area
+      !!                    nlci      : first dimension
+      !!                    nlcj      : second dimension
+      !!                    nbondi    : mark for "east-west local boundary"
+      !!                    nbondj    : mark for "north-south local boundary"
+      !!                    nproc     : number for local processor
+      !!                    noea      : number for local neighboring processor
+      !!                    nowe      : number for local neighboring processor
+      !!                    noso      : number for local neighboring processor
+      !!                    nono      : number for local neighboring processor
+      !!
+      !! History :
+      !!        !  94-11  (M. Guyon)  Original code
+      !!        !  95-04  (J. Escobar, M. Imbard)
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+      !!   8.5  !  02-08  (G. Madec)  F90 : free form
+      !!----------------------------------------------------------------------
+      !! * Local variables
+      INTEGER ::   ji, jj, jn               ! dummy loop indices
+      INTEGER ::   &
+         ii, ij, ifreq, il1, il2,        &  ! temporary integers
+         iresti, irestj, ijm1, imil,     &  !    "          "
+         inum                               ! temporary logical unit
+
+      INTEGER, DIMENSION(jpnij) ::       &
+         ibonit, ibonjt                     ! temporary workspace
+      INTEGER, DIMENSION(jpni,jpnj) ::   &
+         iimppt, ijmppt, ilcit, ilcjt       ! temporary workspace
+      REAL(wp) ::   zidom, zjdom            ! temporary scalars
+      !!----------------------------------------------------------------------
+
+#if defined key_mpp_pvm
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing PVM'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~'
+#endif
+#if defined key_mpp_shmem
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing PVM T3E + SHMEM'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~'
+
+      CALL mppshmem                           ! Initialisation of shmem array
+
+#endif
+#if defined key_mpp_mpi
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~'
+#endif
+#if ! defined key_mpp_pvm &&  ! defined key_mpp_mpi && ! defined key_mpp_shmem
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing PVM onto T3E'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~'
+#endif
+
+
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+      !  Computation of local domain sizes ilcit() ilcjt()
+      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
+      !  The subdomains are squares leeser than or equal to the global
+      !  dimensions divided by the number of processors minus the overlap
+      !  array (cf. par_oce.F90).
+      
+      nreci  = 2 * jpreci
+      nrecj  = 2 * jprecj
+      iresti = MOD( jpiglo - nreci , jpni )
+      irestj = MOD( jpjglo - nrecj , jpnj )
+
+      IF(  iresti == 0 )   iresti = jpni
+      DO jj = 1, jpnj
+         DO ji = 1, iresti
+            ilcit(ji,jj) = jpi
+         END DO
+         DO ji = iresti+1, jpni
+            ilcit(ji,jj) = jpi -1
+         END DO
+      END DO
+      
+      IF( irestj == 0 )   irestj = jpnj
+      DO ji = 1, jpni
+         DO jj = 1, irestj
+            ilcjt(ji,jj) = jpj
+         END DO
+         DO jj = irestj+1, jpnj
+            ilcjt(ji,jj) = jpj -1
+         END DO
+      END DO
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '           defines mpp subdomains'
+         WRITE(numout,*) '           ----------------------'
+         WRITE(numout,*) '              iresti=',iresti,' irestj=',irestj
+         WRITE(numout,*) '              jpni=',jpni,' jpnj=',jpnj
+         ifreq = 4
+         il1   = 1
+         DO jn = 1, (jpni-1)/ifreq+1
+            il2 = MIN( jpni, il1+ifreq-1 )
+            WRITE(numout,*)
+            WRITE(numout,9201) (ji,ji = il1,il2)
+            WRITE(numout,9200) ('***',ji = il1,il2-1)
+            DO jj = 1, jpnj
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9200) ('***',ji = il1,il2-1)
+            END DO
+            il1 = il1+ifreq
+         END DO
+ 9200    FORMAT('     ***',20('*************',a3))
+ 9203    FORMAT('     *     ',20('         *   ',a3))
+ 9201    FORMAT('        ',20('   ',i3,'          '))
+ 9202    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+      ENDIF
+
+      zidom = nreci
+      DO ji = 1, jpni
+         zidom = zidom + ilcit(ji,1) - nreci
+      END DO
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo
+      
+      zjdom = nrecj
+      DO jj = 1, jpnj
+         zjdom = zjdom + ilcjt(1,jj) - nrecj
+      END DO
+      IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo
+      IF(lwp) WRITE(numout,*)
+      
+
+      !  2. Index arrays for subdomains
+      ! -------------------------------
+      
+      iimppt(:,:) = 1
+      ijmppt(:,:) = 1
+      
+      IF( jpni > 1 ) THEN
+         DO jj = 1, jpnj
+            DO ji = 2, jpni
+               iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
+            END DO
+         END DO
+      ENDIF
+
+      IF( jpnj > 1 ) THEN
+         DO jj = 2, jpnj
+            DO ji = 1, jpni
+               ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
+            END DO
+         END DO
+      ENDIF
+      
+      ! 3. Subdomain description
+      ! ------------------------
+
+      DO jn = 1, jpnij
+         ii = 1 + MOD( jn-1, jpni )
+         ij = 1 + (jn-1) / jpni
+         nimppt(jn) = iimppt(ii,ij)
+         njmppt(jn) = ijmppt(ii,ij)
+         nlcit (jn) = ilcit (ii,ij)     
+         nlci       = nlcit (jn)     
+         nlcjt (jn) = ilcjt (ii,ij)     
+         nlcj       = nlcjt (jn)
+         nbondj = -1                                   ! general case
+         IF( jn   >  jpni          )   nbondj = 0      ! first row of processor
+         IF( jn   >  (jpnj-1)*jpni )   nbondj = 1      ! last  row of processor
+         IF( jpnj == 1             )   nbondj = 2      ! one processor only in j-direction
+         ibonjt(jn) = nbondj
+         
+         nbondi = 0                                    ! 
+         IF( MOD( jn, jpni ) == 1 )   nbondi = -1      !
+         IF( MOD( jn, jpni ) == 0 )   nbondi =  1      !
+         IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction
+         ibonit(jn) = nbondi
+         
+         nldi =  1   + jpreci
+         nlei = nlci - jpreci
+         IF( nbondi == -1 .OR. nbondi == 2 )   nldi = 1
+         IF( nbondi ==  1 .OR. nbondi == 2 )   nlei = nlci
+         nldj =  1   + jprecj
+         nlej = nlcj - jprecj
+         IF( nbondj == -1 .OR. nbondj == 2 )   nldj = 1
+         IF( nbondj ==  1 .OR. nbondj == 2 )   nlej = nlcj
+         nldit(jn) = nldi
+         nleit(jn) = nlei
+         nldjt(jn) = nldj
+         nlejt(jn) = nlej
+      END DO
+      
+
+      ! 4. From global to local
+      ! -----------------------
+
+      nperio = 0
+      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
+
+
+      ! 5. Subdomain neighbours
+      ! ----------------------
+
+      nproc = narea - 1
+      noso  = nproc - jpni
+      nowe  = nproc - 1
+      noea  = nproc + 1
+      nono  = nproc + jpni
+      ! great neighbours
+      npnw = nono - 1
+      npne = nono + 1
+      npsw = noso - 1
+      npse = noso + 1
+      nbsw = 1
+      nbnw = 1
+      IF( MOD( nproc, jpni ) == 0 ) THEN
+         nbsw = 0
+         nbnw = 0
+      ENDIF
+      nbse = 1
+      nbne = 1
+      IF( MOD( nproc, jpni ) == jpni-1 ) THEN
+         nbse = 0
+         nbne = 0
+      ENDIF
+      IF(nproc < jpni) THEN
+         nbsw = 0
+         nbse = 0
+      ENDIF
+      IF( nproc >= (jpnj-1)*jpni ) THEN
+         nbnw = 0
+         nbne = 0
+      ENDIF
+      nlcj = nlcjt(narea)  
+      nlci = nlcit(narea)  
+      nldi = nldit(narea)
+      nlei = nleit(narea)
+      nldj = nldjt(narea)
+      nlej = nlejt(narea)
+      nbondi = ibonit(narea)
+      nbondj = ibonjt(narea)
+      nimpp  = nimppt(narea)  
+      njmpp  = njmppt(narea)  
+
+     ! Save processor layout in layout.dat file 
+       IF (lwp) THEN
+        inum = 11    
+
+        OPEN(inum,FILE='layout.dat')
+        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
+        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
+
+        DO  jn = 1, jpnij
+         WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
+                                      nldit(jn), nldjt(jn), &
+                                      nleit(jn), nlejt(jn), &
+                                      nimppt(jn), njmppt(jn)
+        END DO
+        CLOSE(inum)   
+      END IF
+
+
+      ! w a r n i n g  narea (zone) /= nproc (processors)!
+
+      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+         IF( jpni == 1 )THEN
+            nbondi = 2
+            nperio = 1
+         ELSE
+            nbondi = 0
+         ENDIF
+         IF( MOD( narea, jpni ) == 0 ) THEN
+            noea = nproc-(jpni-1)
+            npne = npne-jpni
+            npse = npse-jpni
+         ENDIF
+         IF( MOD( narea, jpni ) == 1 ) THEN
+            nowe = nproc+(jpni-1)
+            npnw = npnw+jpni
+            npsw = npsw+jpni
+         ENDIF
+         nbsw = 1
+         nbnw = 1
+         nbse = 1
+         nbne = 1
+         IF( nproc < jpni ) THEN
+            nbsw = 0
+            nbse = 0
+         ENDIF
+         IF( nproc >= (jpnj-1)*jpni ) THEN
+            nbnw = 0
+            nbne = 0
+         ENDIF
+      ENDIF
+      npolj = 0
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         ijm1 = jpni*(jpnj-1)
+         imil = ijm1+(jpni+1)/2
+         IF( narea > ijm1 ) npolj = 3
+         IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
+         IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
+      ENDIF
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+          ijm1 = jpni*(jpnj-1)
+          imil = ijm1+(jpni+1)/2
+          IF( narea > ijm1) npolj = 5
+          IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
+          IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
+      ENDIF
+
+      ! FETI method
+
+      IF( nperio == 1 .AND. nsolv == 3 ) THEN 
+         
+         ! general case : Earth == infinite tube
+         
+         nbnw = 1
+         npnw = narea
+         nbne = 1
+         npne = narea
+         nbsw = 1
+         npsw = (narea-2)
+         nbse = 1
+         npse = (narea-2)
+         
+         ! REAL boundary condition
+         
+         IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
+            nbsw = 0
+            nbse = 0
+         ENDIF
+         
+         IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
+            nbsw = 0
+            nbse = 0
+         ENDIF
+         
+         IF( nbondj == 1  .OR. nbondj == 2 ) THEN 
+            nbnw = 0
+            nbne = 0
+         ENDIF
+      ENDIF
+
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc  = ', nproc
+         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
+         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
+         WRITE(numout,*) ' nbondi = ', nbondi
+         WRITE(numout,*) ' nbondj = ', nbondj
+         WRITE(numout,*) ' npolj  = ', npolj
+         WRITE(numout,*) ' nperio = ', nperio
+         WRITE(numout,*) ' nlci   = ', nlci
+         WRITE(numout,*) ' nlcj   = ', nlcj
+         WRITE(numout,*) ' nimpp  = ', nimpp
+         WRITE(numout,*) ' njmpp  = ', njmpp
+         WRITE(numout,*) ' nbse   = ', nbse  , ' npse   = ', npse
+         WRITE(numout,*) ' nbsw   = ', nbsw  , ' npsw   = ', npsw
+         WRITE(numout,*) ' nbne   = ', nbne  , ' npne   = ', npne
+         WRITE(numout,*) ' nbnw   = ', nbnw  , ' npnw   = ', npnw
+      ENDIF
+
+      IF( nperio == 1 .AND. jpni /= 1 )THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' mpp_init: error on cyclicity'
+         nstop = nstop + 1
+      ENDIF
+
+      ! Prepare mpp north fold
+
+      IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+      END IF
+
+
+   END SUBROUTINE mpp_init
+
+
+#  include "mppini_2.h90"
+
+#endif
+   !!======================================================================
+END MODULE mppini
Index: /branches/nemo/NEMO/OPA_SRC/mppini_2.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/mppini_2.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/mppini_2.h90	(revision 4)
@@ -0,0 +1,628 @@
+   SUBROUTINE mpp_init2
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init2  ***
+      !!
+      !! * Purpose :   Lay out the global domain over processors.
+      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
+      !!     FOR DEFINING BETTER CUTTING OUT.
+      !!       This routine is used with a the bathymetry file.
+      !!       In this version, the land processors are avoided and the adress
+      !!     processor (nproc, narea,noea, ...) are calculated again.
+      !!     The jpnij parameter can be lesser than jpni x jpnj
+      !!     and this jpnij parameter must be calculated before with an
+      !!     algoritmic preprocessing program.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!      Periodic condition is a function of the local domain position
+      !!      (global boundary or neighbouring domain) and of the global
+      !!      periodic
+      !!      Type :         jperio global periodic condition
+      !!                     nperio local  periodic condition
+      !!
+      !! ** Action :        nimpp     : longitudinal index 
+      !!                    njmpp     : latitudinal  index
+      !!                    nperio    : lateral condition type 
+      !!                    narea     : number for local area
+      !!                    nlci      : first dimension
+      !!                    nlcj      : second dimension
+      !!                    nproc     : number for local processor
+      !!                    noea      : number for local neighboring processor
+      !!                    nowe      : number for local neighboring processor
+      !!                    noso      : number for local neighboring processor
+      !!                    nono      : number for local neighboring processor
+      !!
+      !! History :
+      !!        !  94-11  (M. Guyon)  Original code
+      !!        !  95-04  (J. Escobar, M. Imbard)
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
+      !!----------------------------------------------------------------------
+      !! Local variables
+      CHARACTER (len=25) ::   clexp           ! temporary name
+      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
+      INTEGER ::   inum = 11                  ! temporary logical unit
+      INTEGER ::   &
+         ii, ij, ifreq, il1, il2,          &  ! temporary integers
+         iim, ijm, icont, ili, ilj,        &  !    "          "
+         isurf, ijm1, imil,                &  !    "          "
+         iino, ijno, iiso, ijso,           &  !    "          " 
+         iiea, ijea, iiwe, ijwe,           &  !    "          "
+         iinw, ijnw, iine, ijne,           &  !    "          "
+         iisw, ijsw, iise, ijse,           &  !    "          "
+         iresti, irestj, iproc                !    "          "
+      INTEGER, DIMENSION(jpnij) ::   &
+         iin, ijn          
+      INTEGER, DIMENSION(jpni,jpnj) ::   &
+         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace
+         ipproc, ibondj, ibondi, ipolj ,   &  !    "           "
+         ilei  , ilej  , ildi  , ildj  ,   &  !    "           "
+         ioea  , iowe  , ioso  , iono  ,   &  !    "           "
+         ione  , ionw  , iose  , iosw  ,   &  !    "           "
+         ibne  , ibnw  , ibse  , ibsw         !    "           "
+      INTEGER, DIMENSION(jpidta,jpjdta) ::   &
+         idata                                ! temporary data workspace
+      INTEGER, DIMENSION(jpiglo,jpjglo) ::   &
+         imask                                ! temporary global workspace
+      REAL(wp) ::   zidom , zjdom             ! temporary scalars
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+#if defined key_mpp_pvm
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing PVM'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~'
+#endif
+#if defined key_mpp_shmem
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing PVM T3E + SHMEM'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~'
+      IF(lwp)WRITE(numout,*) ' '
+
+      CALL mppshmem     ! Initialisation of shmem array
+
+#endif
+#if defined key_mpp_mpi
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~'
+      IF(lwp)WRITE(numout,*) ' '
+#endif
+#if ! defined key_mpp_pvm &&  ! defined key_mpp_mpi && ! defined key_mpp_shmem
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing PVM onto T3E'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~'
+#endif
+
+
+      IF( jpni*jpnj < jpnij ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' jpnij > jpni x jpnj impossible'
+         nstop = nstop + 1
+      ENDIF
+
+
+      ! 0. initialisation
+      ! -----------------
+
+      ! open the file
+      IF(lwp) WRITE(numout,*) '           bathymetry file in levels'
+      CALL ctlopn( inum, 'bathymetry', 'OLD', 'FORMATTED', 'SEQUENTIAL',   &
+                   1      , numout      , lwp  , 1                          )
+
+      ! read bathymetry file
+      REWIND inum
+      READ(inum,9001) clexp, iim, ijm
+      READ(inum,'(/)')
+      ifreq=40
+      il1=1
+      DO jn=1,jpidta/ifreq+1
+         READ(inum,'(/)')
+         il2 = MIN( jpidta, il1+ifreq-1 )
+         READ(inum,9002) ( ii, ji = il1, il2, 5 )
+         READ(inum,'(/)')
+         DO jj = jpjdta, 1, -1
+            READ(inum,9003) ij, ( idata(ji,jj), ji = il1, il2 )
+         END DO
+         il1 = il1 + ifreq
+      END DO
+      CLOSE(inum)
+
+9001  FORMAT(1x,a15,2i8)
+9002  FORMAT(3x,13(i3,12x))
+9003  FORMAT(i3,41i3)
+
+      ! land/sea mask over the global/zoom domain
+      DO jj = 1, jpjglo
+         DO ji = 1, jpiglo
+            imask(ji,jj) = MIN(  1, MAX( 0, idata(ji+jpizoom-1,jj+jpjzoom-1) )  )
+         END DO
+      END DO
+      
+      
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+
+      !  Computation of local domain sizes ilci() ilcj()
+      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
+      !  The subdomains are squares leeser than or equal to the global
+      !  dimensions divided by the number of processors minus the overlap
+      !  array.
+      
+      nreci=2*jpreci
+      nrecj=2*jprecj
+      iresti = MOD( jpiglo - nreci , jpni )
+      irestj = MOD( jpjglo - nrecj , jpnj )
+
+      IF( iresti == 0 ) iresti = jpni
+      DO jj = 1, jpnj
+         DO ji = 1, iresti
+            ilci(ji,jj) = jpi
+         END DO
+         DO ji = iresti+1, jpni
+            ilci(ji,jj) = jpi - 1
+         END DO
+      END DO
+      
+      IF(irestj == 0) irestj = jpnj
+      DO ji = 1, jpni
+         DO jj = 1, irestj
+            ilcj(ji,jj) = jpj
+         END DO
+         DO jj = irestj+1, jpnj
+            ilcj(ji,jj) = jpj - 1
+         END DO
+      END DO
+      
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
+
+      zidom = nreci
+      DO ji = 1, jpni
+         zidom = zidom + ilci(ji,1) - nreci
+      END DO
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
+
+      zjdom = nrecj
+      DO jj = 1, jpnj
+         zjdom = zjdom + ilcj(1,jj) - nrecj
+      END DO
+      IF(lwp) WRITE(numout,*) ' sum ilci(1,j)=',zjdom,' jpjglo=',jpjglo
+      IF(lwp) WRITE(numout,*)
+
+
+      !  2. Index arrays for subdomains
+      ! -------------------------------
+
+      DO jj = 1, jpnj
+         DO ji = 1, jpni
+            iimppt(ji,jj) =  1
+            ijmppt(ji,jj) =  1
+            ipproc(ji,jj) = -1
+         END DO
+      END DO
+      
+      IF( jpni > 1 )THEN
+         DO jj = 1, jpnj
+            DO ji = 2, jpni
+               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
+            END DO
+         END DO
+      ENDIF
+
+      IF( jpnj > 1 )THEN
+         DO jj = 2, jpnj
+            DO ji = 1, jpni
+               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
+            END DO
+         END DO
+      ENDIF
+      
+      
+      ! 3. Subdomain description in the Regular Case
+      ! --------------------------------------------
+      
+      nperio = 0
+      icont = -1
+      DO jarea = 1, jpni*jpnj
+         ii = 1 + MOD(jarea-1,jpni)
+         ij = 1 +    (jarea-1)/jpni
+         ili = ilci(ii,ij)
+         ilj = ilcj(ii,ij)
+         
+         ibondj(ii,ij) = -1
+         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
+         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
+         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
+         
+         ibondi(ii,ij) = 0
+         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
+         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
+         IF( jpni            == 1 )   ibondi(ii,ij) =  2
+         
+         ! 2.4 Subdomain neighbors
+         
+         iproc = jarea - 1
+         ioso(ii,ij) = iproc - jpni
+         iowe(ii,ij) = iproc - 1
+         ioea(ii,ij) = iproc + 1
+         iono(ii,ij) = iproc + jpni
+         ildi(ii,ij) = 1 + jpreci
+         ilei(ii,ij) = ili -jpreci
+         ionw(ii,ij) = iono(ii,ij) - 1
+         ione(ii,ij) = iono(ii,ij) + 1
+         iosw(ii,ij) = ioso(ii,ij) - 1
+         iose(ii,ij) = ioso(ii,ij) + 1
+         ibsw(ii,ij) = 1
+         ibnw(ii,ij) = 1
+         IF( MOD(iproc,jpni) == 0 ) THEN
+            ibsw(ii,ij) = 0
+            ibnw(ii,ij) = 0
+         ENDIF
+         ibse(ii,ij) = 1
+         ibne(ii,ij) = 1
+         IF( MOD(iproc,jpni) == jpni-1 ) THEN
+            ibse(ii,ij) = 0
+            ibne(ii,ij) = 0
+         ENDIF
+         IF( iproc < jpni ) THEN
+            ibsw(ii,ij) = 0
+            ibse(ii,ij) = 0
+         ENDIF
+         IF( iproc >= (jpnj-1)*jpni ) THEN
+            ibnw(ii,ij) = 0
+            ibne(ii,ij) = 0
+         ENDIF
+         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
+         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
+         ildj(ii,ij) =  1  + jprecj
+         ilej(ii,ij) = ilj - jprecj
+         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
+         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
+         
+         ! warning ii*ij (zone) /= nproc (processors)!
+         
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+            IF( jpni == 1 )THEN
+               ibondi(ii,ij) = 2
+               nperio = 1
+            ELSE
+               ibondi(ii,ij) = 0
+            ENDIF
+            IF( MOD(jarea,jpni) == 0 ) THEN
+               ioea(ii,ij) = iproc - (jpni-1)
+               ione(ii,ij) = ione(ii,ij) - jpni
+               iose(ii,ij) = iose(ii,ij) - jpni
+            ENDIF
+            IF( MOD(jarea,jpni) == 1 ) THEN
+               iowe(ii,ij) = iproc + jpni - 1
+               ionw(ii,ij) = ionw(ii,ij) + jpni
+               iosw(ii,ij) = iosw(ii,ij) + jpni 
+            ENDIF
+            ibsw(ii,ij) = 1
+            ibnw(ii,ij) = 1
+            ibse(ii,ij) = 1
+            ibne(ii,ij) = 1
+            IF( iproc < jpni ) THEN
+               ibsw(ii,ij) = 0
+               ibse(ii,ij) = 0
+            ENDIF
+            IF( iproc >= (jpnj-1)*jpni ) THEN
+               ibnw(ii,ij) = 0
+               ibne(ii,ij) = 0
+            ENDIF
+         ENDIF
+         ipolj(ii,jj) = 0
+         IF( jperio == 3 .OR. jperio == 4 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
+            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1
+         ENDIF
+         IF( jperio == 5 .OR. jperio == 6 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1) ipolj(ii,ij) = 5
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
+            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1
+         ENDIF
+         
+         isurf = 0
+         DO jj = 1, ilj
+            DO  ji = 1, ili
+               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
+            END DO
+         END DO
+         IF(isurf /= 0) THEN
+            icont = icont + 1
+            ipproc(ii,ij) = icont
+            iin(icont+1) = ii
+            ijn(icont+1) = ij
+         ENDIF
+      END DO
+      
+      ! Control
+      IF(icont+1 /= jpnij) THEN
+         IF(lwp) THEN 
+            WRITE(numout,*) ' Eliminate land processors algorithm'
+            WRITE(numout,*)
+            WRITE(numout,*) ' jpni =',jpni,' jpnj =',jpnj
+            WRITE(numout,*) ' jpnij =',jpnij, '< jpni x jpnj' 
+            WRITE(numout,*)
+            WRITE(numout,*) ' E R R O R '
+            WRITE(numout,*) ' ***********, mpp_init2 finds jpnij=',icont+1
+            WRITE(numout,*) ' we stop'
+         ENDIF
+         STOP 'mpp_init2'
+      ENDIF
+      
+      
+      ! 4. Subdomain print
+      ! ------------------
+      
+      IF(lwp) THEN
+         ifreq = 4
+         il1 = 1
+         DO jn = 1,(jpni-1)/ifreq+1
+            il2 = MIN(jpni,il1+ifreq-1)
+            WRITE(numout,*)
+            WRITE(numout,9401) (ji,ji=il1,il2)
+            WRITE(numout,9400) ('***',ji=il1,il2-1)
+            DO jj = 1, jpnj
+               ! WRITE(numout,9400)
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
+               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9400) ('***',ji=il1,il2-1)
+               ! WRITE(numout,9400)
+            END DO
+            il1 = il1+ifreq
+         END DO
+ 9400     FORMAT('     ***',20('*************',a3))
+ 9403     FORMAT('     *     ',20('         *   ',a3))
+ 9401     FORMAT('        ',20('   ',i3,'          '))
+ 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+ 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
+      ENDIF
+
+
+      ! 5. neighbour treatment
+      ! ----------------------
+      
+      DO jarea = 1, jpni*jpnj
+         iproc = jarea-1
+         ii = 1 + MOD(jarea-1,jpni)
+         ij = 1 +    (jarea-1)/jpni
+         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
+            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
+            iino = 1 + MOD(iono(ii,ij),jpni)
+            ijno = 1 +    (iono(ii,ij))/jpni
+            IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2
+            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
+            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
+            iiso = 1 + MOD(ioso(ii,ij),jpni)
+            ijso = 1 +    (ioso(ii,ij))/jpni
+            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
+            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
+            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
+            iiea = 1 + MOD(ioea(ii,ij),jpni)
+            ijea = 1 +    (ioea(ii,ij))/jpni
+            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
+            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
+            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
+            iiwe = 1 + MOD(iowe(ii,ij),jpni)
+            ijwe = 1 +    (iowe(ii,ij))/jpni
+            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
+            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
+            iine = 1 + MOD(ione(ii,ij),jpni)
+            ijne = 1 +    (ione(ii,ij))/jpni
+            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
+            iisw = 1 + MOD(iosw(ii,ij),jpni)
+            ijsw = 1 +    (iosw(ii,ij))/jpni
+            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
+            iinw = 1 + MOD(ionw(ii,ij),jpni)
+            ijnw = 1 +    (ionw(ii,ij))/jpni
+            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
+            iise = 1 + MOD(iose(ii,ij),jpni)
+            ijse = 1 +    (iose(ii,ij))/jpni
+            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
+         ENDIF
+      END DO
+      
+      
+      ! 6. Change processor name
+      ! ------------------------
+      
+      nproc = narea-1
+      ii = iin(narea)
+      ij = ijn(narea)
+      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiso = 1 + MOD(ioso(ii,ij),jpni)
+         ijso = 1 +    (ioso(ii,ij))/jpni
+         noso = ipproc(iiso,ijso)
+      ENDIF
+      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiwe = 1 + MOD(iowe(ii,ij),jpni)
+         ijwe = 1 +    (iowe(ii,ij))/jpni
+         nowe = ipproc(iiwe,ijwe)
+      ENDIF
+      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiea = 1 + MOD(ioea(ii,ij),jpni)
+         ijea = 1 +    (ioea(ii,ij))/jpni
+         noea = ipproc(iiea,ijea)
+      ENDIF
+      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iino = 1 + MOD(iono(ii,ij),jpni)
+         ijno = 1 +    (iono(ii,ij))/jpni
+         nono = ipproc(iino,ijno)
+      ENDIF
+      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iise = 1 + MOD(iose(ii,ij),jpni)
+         ijse = 1 +    (iose(ii,ij))/jpni
+         npse = ipproc(iise,ijse)
+      ENDIF
+      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iisw = 1 + MOD(iosw(ii,ij),jpni)
+         ijsw = 1 +    (iosw(ii,ij))/jpni
+         npsw = ipproc(iisw,ijsw)
+      ENDIF
+      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iine = 1 + MOD(ione(ii,ij),jpni)
+         ijne = 1 +    (ione(ii,ij))/jpni
+         npne = ipproc(iine,ijne)
+      ENDIF
+      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iinw = 1 + MOD(ionw(ii,ij),jpni)
+         ijnw = 1 +    (ionw(ii,ij))/jpni
+         npnw = ipproc(iinw,ijnw)
+      ENDIF
+      nbnw = ibnw(ii,ij)
+      nbne = ibne(ii,ij)
+      nbsw = ibsw(ii,ij)
+      nbse = ibse(ii,ij)
+      nlcj = ilcj(ii,ij)  
+      nlci = ilci(ii,ij)  
+      nldi = ildi(ii,ij)
+      nlei = ilei(ii,ij)
+      nldj = ildj(ii,ij)
+      nlej = ilej(ii,ij)
+      nbondi = ibondi(ii,ij)
+      nbondj = ibondj(ii,ij)
+      nimpp = iimppt(ii,ij)  
+      njmpp = ijmppt(ii,ij)  
+      DO jproc = 1, jpnij
+         ii = iin(jproc)
+         ij = ijn(jproc)
+         nimppt(jproc) = iimppt(ii,ij)  
+         njmppt(jproc) = ijmppt(ii,ij)  
+         nlcjt(jproc) = ilcj(ii,ij)
+         nlcit(jproc) = ilci(ii,ij)
+         nldit(jproc) = ildi(ii,ij)
+         nleit(jproc) = ilei(ii,ij)
+         nldjt(jproc) = ildj(ii,ij)
+         nlejt(jproc) = ilej(ii,ij)
+      END DO
+
+      ! Save processor layout in ascii file
+      IF (lwp) THEN
+        OPEN(inum,FILE='layout.dat')
+        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
+        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
+
+        DO  jproc = 1, jpnij
+         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
+                                      nldit(jproc), nldjt(jproc), &
+                                      nleit(jproc), nlejt(jproc), &
+                                      nimppt(jproc), njmppt(jproc)
+        END DO
+        CLOSE(inum)   
+      END IF
+
+
+      ! FETI method
+      
+      IF( nperio == 1 .AND. nsolv == 3 ) THEN 
+         
+         ! general CASE : Earth == infinite tube
+         
+         nbnw = 1
+         npnw = narea
+         nbne = 1
+         npne = narea
+         nbsw = 1
+         npsw = (narea-2)
+         nbse = 1
+         npse = (narea-2)
+         
+         ! REAL boundary condition
+         
+         IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
+            nbsw = 0
+            nbse = 0
+         ENDIF
+         
+         IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
+            nbsw = 0
+            nbse = 0
+         ENDIF
+         
+         IF( nbondj ==  1 .OR. nbondj == 2 ) THEN 
+            nbnw = 0
+            nbne = 0
+         ENDIF
+      ENDIF
+      
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+      
+      IF(lwp) WRITE(numout,*) ' nproc=  ',nproc
+      IF(lwp) WRITE(numout,*) ' nowe=   ',nowe
+      IF(lwp) WRITE(numout,*) ' noea=   ',noea
+      IF(lwp) WRITE(numout,*) ' nono=   ',nono
+      IF(lwp) WRITE(numout,*) ' noso=   ',noso
+      IF(lwp) WRITE(numout,*) ' nbondi= ',nbondi
+      IF(lwp) WRITE(numout,*) ' nbondj= ',nbondj
+      IF(lwp) WRITE(numout,*) ' npolj=  ',npolj
+      IF(lwp) WRITE(numout,*) ' nperio= ',nperio
+      IF(lwp) WRITE(numout,*) ' nlci=   ',nlci
+      IF(lwp) WRITE(numout,*) ' nlcj=   ',nlcj
+      IF(lwp) WRITE(numout,*) ' nimpp=  ',nimpp
+      IF(lwp) WRITE(numout,*) ' njmpp=  ',njmpp
+      IF(lwp) WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse
+      IF(lwp) WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw
+      IF(lwp) WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne
+      IF(lwp) WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw
+
+      IF( nperio == 1 .AND.jpni /= 1 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' mpp_init2:  error on cyclicity'
+         nstop = nstop + 1
+      ENDIF
+
+      ! Prepare mpp north fold
+
+      IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
+      END IF
+
+      ! Defined npolj, either 0, 3 , 4 , 5 , 6
+      ! In this case the important thing is that npolj /= 0
+      ! Because if we go through these line it is because jpni >1 and thus
+      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
+
+      npolj = 0
+      ij = ijn(narea)
+
+      IF (jperio == 3 .OR. jperio == 4 ) THEN
+         IF ( ij == jpnj ) npolj = 3
+      ENDIF
+
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+         IF ( ij == jpnj ) npolj = 5
+      ENDIF
+
+
+   END SUBROUTINE mpp_init2
Index: /branches/nemo/NEMO/OPA_SRC/oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/oce.F90	(revision 4)
@@ -0,0 +1,82 @@
+MODULE oce
+   !!======================================================================
+   !!             ***  MODULE  oce  ***
+   !! Ocean        :  dynamics and active tracers defined in memory 
+   !!======================================================================
+   !! History :
+   !!   8.5  !  02-11  (G. Madec)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_oce      ! ocean parameters
+
+   IMPLICIT NONE
+
+   !! Physics and algorithm flags
+   !! ---------------------------
+#if defined key_vectopt_memory
+   LOGICAL ::   l_vopt   = .TRUE.   !: memory vector optimization flag
+#else
+   LOGICAL ::   l_vopt   = .FALSE.  !: memory vector optimization flag
+#endif
+
+   LOGICAL ::   ln_dynhpg_imp   = .FALSE.  ! semi-implicite hpg flag
+
+   !! dynamics and tracer fields
+   !! --------------------------
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+      ! before !  now      !  after  !
+      ub       ,  un       ,  ua     ,   &  !: i-horizontal velocity (m/s)
+      vb       ,  vn       ,  va     ,   &  !: j-horizontal velocity (m/s)
+                  wn       ,             &  !: vertical velocity (m/s)
+      rotb     ,  rotn     ,             &  !: relative vorticity (1/s)
+      hdivb    ,  hdivn    ,             &  !: horizontal divergence (1/s)
+      tb       ,  tn       ,  ta     ,   &  !: potential temperature (celcius)
+      sb       ,  sn       ,  sa            !: salinity (psu)
+   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
+      rhd ,                              &  !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units)
+      rhop,                              &  !: potential volumic mass (kg/m3)
+      rn2                                   !: brunt-vaisala frequency (1/s2)
+
+   !! surface pressure gradient
+   !! -------------------------
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      spgu, spgv             !: horizontal surface pressure gradient
+
+#if defined key_partial_steps     ||   defined key_esopa
+   !! interpolated gradient
+   !! ---------------------
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      gtu, gsu, gru,      &  !: t-, s- and rd horizontal gradient at u- and 
+      gtv, gsv, grv          !: v-points at bottom ocean level 
+#else
+   REAL(wp) ::   &
+      gtu, gsu, gru,      &  !: dummy scalars
+      gtv, gsv, grv          !:
+#endif
+
+#if defined key_dynspg_fsc   ||   defined key_esopa
+   !! free surface - constant volume formulation
+   !! ------------------------------------------
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      sshb, sshn,         &  !: before, now sea surface height (meters)
+      hu, hv                 !: depth at u- and v-points (meters)
+# if defined key_obc
+   REAL(wp) obcsurftot       !: Total lateral surface of open boundaries
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      obcumask, obcvmask     !: u-, v- Force filtering mask for the open 
+      !                      !  boundary condition on grad D
+# endif
+#endif
+#if defined key_dynspg_rl   ||   defined key_esopa
+   !! rigid-lid formulation
+   !! ---------------------
+   REAL(wp), DIMENSION(jpi,jpj) ::   &
+      hur, hvr,           &  !: inverse of u and v-points ocean depth (1/m)
+      bsfb, bsfn,         &  !: before, now barotropic streamfunction (m3/s)
+      bsfd                   !: now trend of barotropic streamfunction (m3/s2)
+#endif
+
+   !!----------------------------------------------------------------------
+END MODULE oce
Index: /branches/nemo/NEMO/OPA_SRC/ocfzpt.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/ocfzpt.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/ocfzpt.F90	(revision 4)
@@ -0,0 +1,70 @@
+MODULE ocfzpt
+   !!======================================================================
+   !!                       ***  MODULE  ocfzpt  ***
+   !! Ocean active tracers:  freezing point computation and freezing area
+   !!======================================================================
+   
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC oc_fz_pt        ! called by opa.F90 and step.F90
+
+   !! * Shared module variables   
+   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &
+      freeze, freezn,  &  !: after and now ice mask (0 or 1)
+      fzptb, fzptn        !: before and now freezing point
+   !!----------------------------------------------------------------------
+   !! OPA 8.5, LODYC-IPSL (2002)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE oc_fz_pt
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE oc_fz_pt  ***
+      !!
+      !! ** Purpose : - Calculate ocean surface freezing temperature
+      !!              - Calculate related boolean for now ice distribution 
+      !!
+      !! ** Method  :   Caution, freezing point only for jackett & McDougall eos
+      !!
+      !! ** Action  : - fzptn  : now freezing temperature at ocean surface
+      !!              - fzptb  : before freezing temperature at ocean surface
+      !!              - freezn : boolean indicating freezing conditions at the 
+      !!                ocean surface at time step "now"
+      !!
+      !! History :
+      !!        !  94-08  (M.-A. Filiberti)  Original code
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::  ji, jj      ! dummy loop indices
+      !!----------------------------------------------------------------------      
+
+!CDIR NOVERRCHK
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi
+            fzptb(ji,jj) = fzptn(ji,jj)        ! swap freezing point array
+
+            !                                  ! ocean local surface freezing temperature
+            !                                  ! sn >= 0 : this is verified in stpctl at each time step
+            fzptn (ji,jj) = ( -0.0575 + 1.710523e-3 * SQRT( sn(ji,jj,1) )   &
+                                      - 2.154996e-4 *       sn(ji,jj,1)   ) * sn(ji,jj,1)   !!   &
+            !!                        - 7.53e-4 * pressure
+
+            !                                  ! Define boolean related to freezing conditions
+            freezn(ji,jj) = tmask(ji,jj,1) * MAX( 0., SIGN( 1., fzptn(ji,jj) - tn(ji,jj,1) )  )
+         END DO
+      END DO
+
+   END SUBROUTINE oc_fz_pt
+
+   !!======================================================================
+END MODULE ocfzpt
Index: /branches/nemo/NEMO/OPA_SRC/opa.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/opa.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/opa.F90	(revision 4)
@@ -0,0 +1,268 @@
+MODULE opa
+   !!==============================================================================
+   !!                       ***  MODULE opa   ***
+   !! Ocean system   : OPA ocean dynamics (including on-line tracers and sea-ice)
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   opa_model      : solve ocean dynamics, tracer and/or sea-ice
+   !!   opa_flg        : initialisation of algorithm flag 
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space domain variables
+   USE oce             ! dynamics and tracers variables
+   USE daymod          ! calendar
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing
+
+   USE domcfg          ! domain configuration               (dom_cfg routine)
+   USE mppini          ! shared/distributed memory setting (mpp_init routine)
+   USE domain          ! domain initialization             (dom_init routine)
+   USE obc_par         ! open boundary cond. parameters
+   USE obcini          ! open boundary cond. initialization (obc_ini routine)
+   USE solver          ! solver initialization          (solver_init routine)
+   USE istate          ! initial state setting          (istate_init routine)
+   USE eosbn2          ! equation of state            (eos bn2 routine)
+   USE zpshde          ! partial step: hor. derivative (zps_hde routine)
+
+   ! ocean physics
+   USE traqsr          ! solar radiation penetration   (tra_qsr_init routine)
+   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine)
+   USE ldftra          ! lateral diffusivity setting    (ldftra_init routine)
+   USE zdfini
+!!!USE zdf_oce         ! ocean vertical physics            (zdf_init routine)
+
+   USE phycst          ! physical constant                  (par_cst routine)
+   USE iceini          ! initialization of sea-ice         (ice_init routine)
+   USE cpl             ! coupled ocean/atmos.              (cpl_init routine)
+   USE ocfzpt          ! ocean freezing point              (oc_fz_pt routine)
+   USE trddyn          ! ocean momentum trends         (trd_dyn_init routine)
+   USE trdtra          ! ocean active tracer trends    (trd_tra_init routine)
+   USE trdmld          ! ocean active tracer mixed layer trend ??? 
+   USE flxfwb          ! 
+
+   USE ptr             ! poleward transports           (dia_ptr_init routine)
+
+   USE step            ! OPA time-stepping                  (stp     routine)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC opa_model      ! called by model.F90
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE opa_model
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE opa  ***
+      !!
+      !! ** Purpose :   opa solves the primitive equations on an orthogonal 
+      !!      curvilinear mesh on the sphere.
+      !!
+      !! ** Method  : - model general initialization
+      !!              - launch the time-stepping (stp routine)
+      !!
+      !! References :
+      !!      Madec, Delecluse,Imbard, and Levy, 1997: reference manual.
+      !!              internal report, IPSL.
+      !!
+      !! History :
+      !!   4.0  !  90-10  (C. Levy, G. Madec)  Original code
+      !!   7.0  !  91-11  (M. Imbard, C. Levy, G. Madec)
+      !!   7.1  !  93-03  (M. Imbard, C. Levy, G. Madec, O. Marti,
+      !!                   M. Guyon, A. Lazar, P. Delecluse, C. Perigaud,
+      !!                   G. Caniaux, B. Colot, C. Maes ) release 7.1 
+      !!        !  92-06  (L.Terray) coupling implementation
+      !!        !  93-11  (M.A. Filiberti) IGLOO sea-ice 
+      !!   8.0  !  96-03  (M. Imbard, C. Levy, G. Madec, O. Marti,
+      !!                   M. Guyon, A. Lazar, P. Delecluse, L.Terray,
+      !!                   M.A. Filiberti, J. Vialar, A.M. Treguier,
+      !!                   M. Levy)  release 8.0
+      !!   8.1  !  97-06  (M. Imbard, G. Madec)
+      !!   8.2  !  99-11  (M. Imbard, H. Goosse)  LIM sea-ice model 
+      !!        !  99-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP 
+      !!        !  00-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
+      !!   9.0  !  02-08  (G. Madec)  F90: Free form and modules
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   istp       ! time step index
+#if defined key_coupled
+      INTEGER ::   itro, istp0        ! ???
+#endif
+      CHARACTER (len=64) ::        &
+         cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
+      !!----------------------------------------------------------------------
+      
+      
+      ! Initializations
+      ! ===============
+      
+      ! open listing and namelist units
+      IF ( numout /= 0 .AND. numout /= 6 ) THEN 
+         OPEN( UNIT=numout, FILE='ocean.output', FORM='FORMATTED' )
+      ENDIF
+#if defined key_mpp
+      OPEN( UNIT=nummpp, FILE='mpp.output', FORM='FORMATTED' )
+#endif
+
+
+      ! Nodes selection
+      narea = mynode()
+      narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 )
+      lwp   = narea == 1
+
+      OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '                 L O D Y C - I P S L'
+         WRITE(numout,*) '                     O P A model'
+         WRITE(numout,*) '            Ocean General Circulation Model'
+         WRITE(numout,*) '               version OPA 9.0  (2003)'
+         WRITE(numout,*)
+      ENDIF
+
+      !                                     ! ============================== !
+      !                                     !  Model general initialization  !
+      !                                     ! ============================== !
+
+      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
+
+                                            ! Domain decomposition
+      IF( jpni*jpnj == jpnij ) THEN
+         CALL mpp_init                          ! standard cutting out
+      ELSE
+         CALL mpp_init2                         ! eliminate land processors
+      ENDIF
+      
+      CALL phy_cst                          ! Physical constants
+
+      CALL dom_cfg                          ! Domain configuration
+      
+      CALL dom_init                         ! Domain
+
+      IF( lk_obc    )   CALL obc_init        ! Open boundaries 
+
+      CALL solver_init                      ! Elliptic solver
+
+      CALL day( nit000 )                    ! Calendar
+
+      CALL istate_init                      ! ocean initial state (Dynamics and tracers)
+!!add
+                       CALL eos( tb, sb, rhd, rhop )        ! before potential and in situ densities
+
+                       CALL bn2( tb, sb, rn2 )              ! before Brunt-Vaisala frequency
+
+      IF( lk_zps    )   CALL zps_hde( nit000, tb, sb, rhd,  &  ! Partial steps: before Horizontal DErivative
+                                          gtu, gsu, gru, &  ! of t, s, rd at the bottom ocean level
+                                          gtv, gsv, grv )
+
+!!add
+
+      CALL oc_fz_pt                         ! Surface freezing point
+
+#if defined key_ice_lim
+      CALL ice_init                         ! Sea ice model
+#endif
+
+#if defined key_passivetrc
+      CALL initrc                           ! Passive tracers
+#endif
+
+      !                                     ! Ocean physics
+
+      CALL tra_qsr_init                         ! Salor radiation penetration
+
+      CALL ldf_dyn_init                         ! Lateral ocean momentum physics
+
+      CALL ldf_tra_init                         ! Lateral ocean tracer physics
+
+      CALL zdf_init                             ! Vertical ocean physics
+
+      !                                     ! Ocean trends
+      IF( lk_trddyn )   CALL trd_dyn_init        ! momentum     
+      IF( lk_trdtra .OR. lk_trdmld )   &
+         &             CALL trd_tra_init        ! active tracers
+#if defined key_coupled
+      itro  = nitend - nit000 + 1           ! Coupled
+      istp0 = NINT( rdt )
+      CALL cpl_init( itro, nexco, istp0 )   ! Signal processing and process id exchange
+#endif
+
+      CALL flx_fwb_init                     ! FreshWater Budget correction
+
+#if defined key_diaptr
+      CALL dia_ptr_init                     ! Poleward TRansports
+#endif
+
+      !                                     ! =============== !
+      !                                     !  time stepping  !
+      !                                     ! =============== !
+
+      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
+
+      istp = nit000
+      DO WHILE ( istp <= nitend .AND. nstop == 0 )
+         CALL stp( istp )
+         istp = istp + 1
+      END DO
+      !                                     ! ========= !
+      !                                     !  Job end  !
+      !                                     ! ========= !
+
+      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
+
+      IF( nstop /= 0 ) THEN                 ! error print
+      IF(lwp) WRITE(numout,cform_err)
+      IF(lwp) WRITE(numout,*) nstop, ' error have been found' 
+      ENDIF
+
+#if defined key_mpp
+      CALL mppstop                          ! Close all files (mpp)
+#endif
+
+   END SUBROUTINE opa_model
+
+   SUBROUTINE opa_flg
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE opa  ***
+      !!
+      !! ** Purpose :   Initialize logical flags that control the choice of
+      !!      some algorithm or control print
+      !!
+      !! ** Method  :    Read in namilist namflg logical flags
+      !!
+      !! History :
+      !!   9.0  !  03-11  (G. Madec)  Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+
+      NAMELIST/namflg/ ln_dynhpg_imp
+      !!----------------------------------------------------------------------
+
+      ! Read Namelist namflg : algorithm FLaG 
+      ! --------------------
+      REWIND ( numnam )
+      READ   ( numnam, namflg )
+
+      ! Parameter control and print
+      ! ---------------------------
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'opa_flg : algorithm flag initialization'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '          Namelist namflg : set algorithm flags'
+         WRITE(numout,*)
+         WRITE(numout,*) '             centered (F) or semi-implicit (T)   ln_dynhpg_imp = ', ln_dynhpg_imp
+         WRITE(numout,*) '             hydrostatic pressure gradient'
+      ENDIF
+
+   END SUBROUTINE opa_flg
+
+   !!======================================================================
+END MODULE opa
Index: /branches/nemo/NEMO/OPA_SRC/par_EEL_R2.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/par_EEL_R2.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/par_EEL_R2.h90	(revision 4)
@@ -0,0 +1,84 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_EEL_R2.h90  ***
+   !!   Ocean Domain : 2 km resolution Channel (EEL_R2 configuration)
+   !!---------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::   &
+      cp_cfg = "eel"            ! name of the configuration
+   INTEGER, PARAMETER ::     &
+      jp_cfg = 2   ,         &  ! resolution of the configuration (km)
+
+      ! data size              !!! * size of all the input files *
+      jpidta  = 83,          &  ! 1st horizontal dimension ( >= jpi )
+      jpjdta  = 242,         &  ! 2nd    "            "    ( >= jpj )
+      jpkdta  = 30,          &  ! number of levels         ( >= jpk )
+
+      ! global domain size     !!! * full domain *
+      jpiglo  = jpidta,      &  ! 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  ! 2nd    "                  "    --> j
+      jpk     = jpkdta,      &  ! number of vertical levels
+      ! zoom starting position
+      jpizoom =   1   ,      &  ! left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  ! in data indices
+
+      ! Domain characteristics
+      jperio  =     1 ,      &  ! lateral cond. type (between 0 and 6)
+      jpisl   =     1 ,      &  ! number of islands
+      jpnisl  = jpiglo          ! maximum number of points per island
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER      ::  pp_not_used = 999999_wp  , &
+      &                    pp_to_be_computed = 0._wp
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER,PARAMETER   ::    & !
+      jphgr_msh = 3            ! type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 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  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) ,PARAMETER ::     &  !
+      ppglam0  =    0.0_wp,   &  ! longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =  -35.0_wp,   &  ! latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used ,   &  ! zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used ,   &  ! meridional grid-spacing (degrees)
+      !
+      ppe1_m   = 2000.0_wp,   &  ! zonal      grid-spacing (meters )
+      ppe2_m   = 2000.0_wp       ! meridional grid-spacing (meters )
+   !!
+   !!  Coefficients associated with the vertical coordinate system
+   !!
+
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -2033.194295283385_wp   ,  &  ! Computed in domzgr
+      &     ppa0  =  155.8325369664153_wp   ,  &  !
+      &     ppa1  =  146.3615918601890_wp   ,  &  !
+      !
+      &     ppkth =  17.28520372419791_wp   ,  &  ! (non dimensional): gives the approximate
+      !                                           !    layer number above which  stretching will
+      !                                           !    be maximum. Usually of order jpk/2.
+      &     ppacr =  5.000000000000000_wp         ! (non dimensional): stretching factor
+      !                                           !    for the grid. The highest zacr, the smallest
+      !                                           !    the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used              ,  &  ! (meters): depth of the top (first) model layer
+      !                                           !           depth of second "w" level
+      &     pphmax  = pp_not_used                    ! (meters):  maximum depth of the ocean
+      !                                           !            depth of the last "w" level
+
+   !!---------------------------------------------------------------------
Index: /branches/nemo/NEMO/OPA_SRC/par_EEL_R5.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/par_EEL_R5.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/par_EEL_R5.h90	(revision 4)
@@ -0,0 +1,83 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_EEL_R5.h90  ***   
+   !!   Ocean Domain : 5 km resolution Channel (EEL_R5 configuration)
+   !!---------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::   &
+      cp_cfg = "eel"            ! name of the configuration
+   INTEGER, PARAMETER ::     &
+      jp_cfg = 5      ,      &  ! resolution of the configuration (km)
+
+      ! data size              !!! * size of all the input files
+      jpidta  = 202   ,      &  ! first horizontal dimension > or = to jpi
+      jpjdta  = 104   ,      &  ! second                     > or = to jpj
+      jpkdta  =  40   ,      &  ! number of levels           > or = to jpk
+
+      ! total domain size      !!! * full domain *
+      jpiglo  = jpidta,      &  ! first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  ! second dimension of global domain --> j
+      jpk     = jpkdta,      &  ! number of vertical levels
+      ! zoom starting position
+      jpizoom =   1   ,      &  ! left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  ! in data indices
+
+      ! Domain characteristics
+      jperio  =   0   ,      &  ! lateral cond. type (between 0 and 6)
+      jpisl   =   1   ,      &  ! number of islands
+      jpnisl  = jpiglo          ! maximum number of points per island
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &
+      pp_not_used       = 999999._wp ,  &  !:
+      pp_to_be_computed =      0._wp       !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER,PARAMETER   ::    & !
+      jphgr_msh = 2            ! type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 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  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) ,PARAMETER ::     &  !
+      ppglam0  =    0.0_wp,   &  ! longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =  -35.0_wp,   &  ! latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  ! zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  ! meridional grid-spacing (degrees)
+      !
+      ppe1_m   = 5000.0_wp,   &  ! zonal      grid-spacing (meters)
+      ppe2_m   = 5000.0_wp       ! meridional grid-spacing (meters)
+   !!
+   !!  Coefficients associated with the vertical coordinate system
+   !!
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = pp_to_be_computed       ,  &  ! Computed in domzgr, set ppdzmin, pphmax below
+      &     ppa0  = pp_to_be_computed       ,  &  !
+      &     ppa1  = pp_to_be_computed       ,  &  !
+      !
+      &     ppkth = 20._wp                  ,  &  ! (non dimensional): gives the approximate
+      !                                           !    layer number above which  stretching will
+      !                                           !    be maximum. Usually of order jpk/2.
+      &     ppacr = 16.00000000000_wp             ! (non dimensional): stretching factor
+      !                                           !    for the grid. The highest zacr, the smallest
+      !                                           !    the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = 120._wp               ,  &  ! (meters): depth of the top (first) model layer
+      !                                           !           depth of second "w" level
+      &     pphmax  = 4000._wp                    ! (meters):  maximum depth of the ocean
+      !                                           !            depth of the last "w" level
+   !!---------------------------------------------------------------------
Index: /branches/nemo/NEMO/OPA_SRC/par_EEL_R6.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/par_EEL_R6.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/par_EEL_R6.h90	(revision 4)
@@ -0,0 +1,83 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_EEL_R6.h90  ***   
+   !!   Ocean Domain : 6 km resolution Channel (EEL_R6 configuration)
+   !!---------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::   &
+      cp_cfg = "eel"            ! name of the configuration
+   INTEGER, PARAMETER ::     &
+      jp_cfg = 6      ,      &  ! resolution of the configuration (km)
+
+      ! data size              !!! * size of all the input files *
+      jpidta  = 29,          &  ! 1st lateral dimension ( >= jpi )
+      jpjdta  = 83,          &  ! 2nd    "         "    ( >= jpj )
+      jpkdta  = 30,          &  ! number of levels      ( >= jpk )
+
+      ! global domain size     !!! * full domain *
+      jpiglo  = jpidta,      &  ! 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  ! 2nd    "                  "    --> j
+      jpk     = jpkdta,      &  ! number of vertical levels
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  ! left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  ! in data domain indices
+
+      ! Domain characteristics
+      jperio  =      1,      &  ! lateral cond. type (between 0 and 6)
+      jpisl   =      1,      &  ! number of islands
+      jpnisl  = jpiglo          ! maximum number of points per island
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER      ::  pp_not_used = 999999_wp , &
+      &                    pp_to_be_computed = 0._wp
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+
+   INTEGER,PARAMETER   ::    & !
+      jphgr_msh = 3            ! type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 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  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) ,PARAMETER ::     &  !
+      ppglam0  =    0.0_wp,   &  ! longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =  -35.0_wp,   &  ! latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  ! zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  ! meridional grid-spacing (degrees)
+      !
+      ppe1_m   = 6000.0_wp,   &  ! zonal      grid-spacing (meters )
+      ppe2_m   = 6000.0_wp       ! meridional grid-spacing (meters )
+   !!
+   !!  Coefficients associated with the vertical coordinate system
+   !!
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -2033.194295283385_wp   ,  &  ! Computed in domzgr
+      &     ppa0  =  155.8325369664153_wp   ,  &  !
+      &     ppa1  =  146.3615918601890_wp   ,  &  !
+      !
+      &     ppkth =  17.28520372419791_wp   ,  &  ! (non dimensional): gives the approximate
+      !                                           !    layer number above which  stretching will
+      !                                           !    be maximum. Usually of order jpk/2.
+      &     ppacr =  5.000000000000000_wp         ! (non dimensional): stretching factor
+      !                                           !    for the grid. The highest zacr, the smallest
+      !                                           !    the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  ! (meters): depth of the top (first) model layer
+      !                                           !           depth of second "w" level
+      &     pphmax  = pp_not_used                 ! (meters):  maximum depth of the ocean
+      !                                           !            depth of the last "w" level
+   !!---------------------------------------------------------------------
Index: /branches/nemo/NEMO/OPA_SRC/par_ORCA_R025.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/par_ORCA_R025.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/par_ORCA_R025.h90	(revision 4)
@@ -0,0 +1,80 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R025.h90  ***  
+   !!   Ocean Domain : 0.25 degrees resolution global ocean
+   !!                  (0RCA_R025 configuration)
+   !!---------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::   &
+      cp_cfg = "orca"           !: name of the configuration
+   INTEGER, PARAMETER ::     &
+      jp_cfg = 025  ,        &  !: resolution of the configuration (degrees)
+      ! Original data size
+      jpidta  = 1442,        &  !: first horizontal dimension > or = to jpi
+      jpjdta  = 1021,        &  !: second                     > or = to jpj
+      jpkdta  = 46 ,         &  !: number of levels           > or = to jpk
+      ! total domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =    4  ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =  150  ,      &  !: number of islands
+      jpnisl  = 3000            !: maximum number of points per island
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL,PARAMETER      ::  pp_not_used = 999999_wp , &
+      &                    pp_to_be_computed = 0._wp
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 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  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp), PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!  Coefficients associated with the vertical coordinate system
+
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = pp_to_be_computed ,  &  !: Computed in domzgr, set ppdzmin and pphmax below
+      &     ppa0  = pp_to_be_computed ,  &  !:    "           "
+      &     ppa1  = pp_to_be_computed ,  &  !:    "           "
+      !
+      &     ppkth =  23.563_wp        ,  &  !: (non dimensional): gives the approximate
+      !                                     !    layer number above which  stretching will
+      !                                     !    be maximum. Usually of order jpk/2.
+      &     ppacr =    9.00000000000_wp     !: (non dimensional): stretching factor
+      !                                     !    for the grid. The highest zacr, the smallest
+      !                                     !    the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = 6._wp           ,  &  !: (meters): depth of the top (first) model layer
+      !                                     !           depth of second "w" level
+      &     pphmax  = 5720._wp              !: (meters):  maximum depth of the ocean
+      !                                     !            depth of the last "w" level
+   !!---------------------------------------------------------------------
Index: /branches/nemo/NEMO/OPA_SRC/par_ORCA_R05.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/par_ORCA_R05.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/par_ORCA_R05.h90	(revision 4)
@@ -0,0 +1,106 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R05.h90  ***  
+   !!   Ocean Domain : 0.5 degrees resolution global ocean
+   !!                  (0RCA_R05 configuration)
+   !!---------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::   &
+      cp_cfg = "orca"           !: name of the configuration
+   INTEGER, PARAMETER ::     &
+      jp_cfg = 05  ,         &  !: resolution of the configuration (degrees)
+
+      ! data size              !!! * size of all the input files *
+      jpidta  = 722,         &  !: 1st lateral dimension > or = to jpiglo
+      jpjdta  = 511,         &  !: 2nd   "         "     > or = to jpjglo
+      jpkdta  =  31,         &  !: number of levels      > or = to jpkglo
+
+#if defined key_antarctic
+      ! zoom domain size       !!! * antarctic zoom *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = 187   ,      &  !: 2nd     "                 "    --> j 
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   1   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =   1   ,      &  !: number of islands
+      jpnisl  =   1             !: maximum number of points per island
+
+#elif defined key_arctic
+      ! zoom domain size       !!! *  arctic zoom  *
+      jpiglo  = 562,         &  !: 1st dimension of global domain --> i
+      jpjglo  = 202,         &  !: 2nd     "                 "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! zoom starting position
+      jpizoom =  81   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom = 301   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   5   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =   1   ,      &  !: number of islands
+      jpnisl  =   1             !: maximum number of points per island
+
+#else
+      ! global domain size     !!! * full domain *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd     "                 "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! zoom starting position    
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =    6  ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =   79  ,      &  !: number of islands
+      jpnisl  = 2000            !: maximum number of points per island
+#endif
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &
+      pp_not_used       = 999999._wp , &  !:
+      pp_to_be_computed = 0._wp          !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER, PARAMETER   ::   & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 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  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) , PARAMETER ::      &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!
+   !! Vertical grid parameter for domzgr
+   !! =====================================
+   !!
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -4762.96143546300_wp  ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp  ,  &  !: (default coefficients)
+      &     ppa1  =   245.58132232490_wp  ,  &  !:
+      &     ppkth =    21.43336197938_wp  ,  &  !:
+      &     ppacr =     3.00000000000_wp        !:
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used         ,  &  !: Minimum vertical spacing
+      &     pphmax  = pp_not_used               !: Maximum depth
+   !!---------------------------------------------------------------------
Index: /branches/nemo/NEMO/OPA_SRC/par_ORCA_R2.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/par_ORCA_R2.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/par_ORCA_R2.h90	(revision 4)
@@ -0,0 +1,107 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R2.h90  ***  
+   !!   Ocean Domain : 2 degrees resolution global ocean
+   !!                  (0RCA_R2 configuration)
+   !!---------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::    &
+      cp_cfg = "orca"           ! name of the configuration 
+   INTEGER, PARAMETER ::     &
+      jp_cfg = 2,            &  !: resolution of the configuration (degrees)
+
+      ! data size              !!! * size of all input files *
+      jpidta  = 182,         &  !: 1st lateral dimension ( >= jpiglo )
+      jpjdta  = 149,         &  !: 2nd    "       "      ( >= jpjglo )
+      jpkdta  = 31,          &  !: number of levels      ( >= jpk    )
+
+#if defined key_antarctic
+      ! zoom domain size       !!! *  antarctic zoom  * 
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = 50,          &  !: 2nd    "                  "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! zoom starting position
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   1   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =   3   ,      &  !: number of islands
+      jpnisl  = 400             !: maximum number of points per island
+
+#elif defined key_arctic
+      ! zoom domain size       !!! *  arctic zoom  *
+      jpiglo  = 142   ,      &  !: 1st dimension of global domain --> i
+      jpjglo  =  53   ,      &  !: 2nd    "                  "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! zoom starting position 
+      jpizoom =  21   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =  97   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   3   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =   7   ,      &  !: number of islands
+      jpnisl  = 400             !: maximum number of points per island
+
+#else
+      ! global domain size     !!! *  global domain  *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! starting position of the zoom 
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   4   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =  18   ,      &  !: number of islands
+      jpnisl  = 800             !: maximum number of points per island
+
+#endif
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &
+      pp_not_used       = 999999_wp , &  !:
+      pp_to_be_computed = 0._wp          !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER,PARAMETER   ::    & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 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  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) ,PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   !!
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
+      &     ppa1  =   245.58132232490_wp    ,  &  !:
+      &     ppkth =    21.43336197938_wp    ,  &  !:
+      &     ppacr =     3.00000000000_wp          !:
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: Minimum vertical spacing
+      &     pphmax  = pp_not_used                 !: Maximum depth
+   !!---------------------------------------------------------------------
Index: /branches/nemo/NEMO/OPA_SRC/par_ORCA_R4.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/par_ORCA_R4.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/par_ORCA_R4.h90	(revision 4)
@@ -0,0 +1,74 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R4.h90  ***   
+   !!   Ocean Domain : 4 degrees resolution global ocean
+   !!                  (0RCA_R4 configuration)
+   !!---------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER ::    &
+      cp_cfg = "orca"           !: name of the configuration
+   INTEGER, PARAMETER ::     &
+      jp_cfg = 4      ,      &  !: resolution of the configuration (degrees)
+      ! Original data size
+      jpidta  =  92   ,      &  !: first horizontal dimension > or = to jpi
+      jpjdta  =  76   ,      &  !: second                     > or = to jpj
+      jpkdta  =  31   ,      &  !: number of levels           > or = to jpk
+      ! global domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      jpk     = jpkdta,      &  !: number of vertical levels
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =   4   ,      &  !: lateral cond. type (between 0 and 6)
+      jpisl   =  11   ,      &  !: number of islands
+      jpnisl  = 800             !: maximum number of points per island
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &
+      pp_not_used       = 999999_wp , &  !:
+      pp_to_be_computed = 0._wp          !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 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  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) , PARAMETER ::      &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
+      &     ppa1  =  245.58132232490_wp     ,  &  !
+      &     ppkth =  21.43336197938_wp      ,  &  !
+      &     ppacr =    3.00000000000_wp           !
+
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: Minimum vertical spacing
+      &     pphmax  = pp_not_used                 !: Maximum depth
+   !!---------------------------------------------------------------------
Index: /branches/nemo/NEMO/OPA_SRC/par_kind.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/par_kind.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/par_kind.F90	(revision 4)
@@ -0,0 +1,37 @@
+MODULE par_kind
+   !!======================================================================
+   !!                   ***  MODULE par_kind  ***
+   !! Ocean :  define the kind of real for the whole model
+   !!======================================================================
+   !! History :
+   !!   8.5   02/06  (G. Madec)  Original code
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTEGER, PUBLIC, PARAMETER ::    &
+      jpbyt   = 8       ,           &  !: real size for mpp communications
+      jpbytda = 4       ,           &  !: real size in input data files 4 or 8
+      jpbi3e  = 4                      !: real size for T3E
+
+   ! Number model from which the SELECTED_*_KIND are requested:
+   !             4 byte REAL       8 byte REAL
+   ! CRAY:           -            precision = 13
+   !                              exponent = 2465
+   ! IEEE:      precision = 6     precision = 15
+   !            exponent = 37     exponent = 307
+
+   INTEGER, PUBLIC, PARAMETER ::        &  !  Floating point section
+      sp = SELECTED_REAL_KIND(6,37)  ,  &  !: single precision (real 4)
+      dp = SELECTED_REAL_KIND(12,307),  &  !: double precision (real 8)
+      wp = dp                              !: working precision
+
+   INTEGER, PUBLIC, PARAMETER ::        &  !  Integer section
+      i4 = SELECTED_INT_KIND(9) ,       &  !: single precision (integer 4)
+      i8 = SELECTED_INT_KIND(14)           !: double precision (integer 8)
+
+!!----------------------------------------------------------------------
+END MODULE par_kind
Index: /branches/nemo/NEMO/OPA_SRC/par_oce.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/par_oce.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/par_oce.F90	(revision 4)
@@ -0,0 +1,168 @@
+MODULE par_oce
+   !!======================================================================
+   !!                        ***  par_oce  ***
+   !! Ocean :   set the ocean parameters
+   !!======================================================================
+   !! History :
+   !!   4.0  !  91     (Imbard, Levy, Madec)  Original code
+   !!   9.0  !  04-01  (G. Madec, J.-M. Molines)  Free form and module
+   !!----------------------------------------------------------------------
+   !!  OPA 9.0, LODYC-IPSL (2004)
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind          !: kind parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!   Domain decomposition
+   !!----------------------------------------------------------------------
+   !! * if we dont use massively parallel computer (parameters jpni=jpnj=1)
+   !!      so jpiglo=jpi and jpjglo=jpj
+
+   INTEGER, PARAMETER ::            &
+      jpni   = 1,                   &  !: number of processors following i 
+      jpnj   = 1,                   &  !: number of processors following j
+      jpnij  = 1,                   &  !: nb of local domain = nb of processors 
+      !                                !  ( <= jpni x jpnj )
+      jpreci = 1,                   &  !: number of columns for overlap 
+      jprecj = 1                       !: number of rows    for overlap 
+
+   !! Ocean Domain sizes
+   !! ------------------
+   !!   data           domain   (jpidta,jpjdta)
+   !!   global or zoom domain   (jpiglo,jpjglo)
+   !!   local          domain   ( jpi  , jpj  )
+   
+#if   defined key_orca_r4
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r4'   :                           global ocean : ORCA R4
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R4.h90"
+#elif defined key_orca_r2
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r2'   :                           global ocean : ORCA R4
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R2.h90"
+#elif defined key_orca_r05
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r05'  :                          global ocean : ORCA R05
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R05.h90"
+#elif defined key_orca_r025
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r025' :                         global ocean : ORCA R025
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R025.h90"
+#elif defined key_eel_r2
+   !!---------------------------------------------------------------------
+   !!   'key_eel_r2'    :                                 channel : EEL R2
+   !!---------------------------------------------------------------------
+#             include "par_EEL_R2.h90"
+#elif defined key_eel_r5
+   !!---------------------------------------------------------------------
+   !!   'key_eel_r5'    :                                 channel : EEL R5
+   !!---------------------------------------------------------------------
+#             include "par_EEL_R5.h90"
+#elif defined key_eel_r6
+   !!---------------------------------------------------------------------
+   !!   'key_eel_r6'    :                                 channel : EEL R6
+   !!---------------------------------------------------------------------
+#             include "par_EEL_R6.h90"
+#else
+   !!---------------------------------------------------------------------
+   !!   default option  :                               small closed basin
+   !!---------------------------------------------------------------------
+   CHARACTER (len=16), PARAMETER :: &
+      cp_cfg = "default"               !: name of the configuration
+   INTEGER, PARAMETER ::            &
+      jp_cfg = 0  ,                 &  !: resolution of the configuration
+
+      ! data size                     !!! * size of all input files *
+      jpidta  = 10,                 &  !: 1st lateral dimension ( >= jpi )
+      jpjdta  = 10,                 &  !: 2nd    "         "    ( >= jpj )
+      jpkdta  = 31,                 &  !: number of levels      ( >= jpk )
+
+      ! global or zoom domain size    !!! * computational domain *
+      jpiglo  = jpidta,             &  !: 1st dimension of global domain --> i
+      jpjglo  = jpidta,             &  !: 2nd    "                  "    --> j
+      jpk     = jpkdta,             &  !: number of vertical levels
+      ! zoom starting position 
+      jpizoom =   1   ,             &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,             &  !: in data domain indices
+
+      ! Domain characteristics
+      jperio  =  0,                 &  !: lateral cond. type (between 0 and 6)
+      jpisl   =  0,                 &  !: number of islands (rigid-lid only)
+      jpnisl  =  0                     !: maximum number of points per island
+
+   !! Horizontal grid parameters for domhgr
+   !! =====================================
+
+   INTEGER, PARAMETER   ::   & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 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  with
+      !                        !      isotropic resolution (e1_deg)
+
+   REAL(wp) , PARAMETER ::    &  !
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =  -35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg =    1.0_wp,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg =    0.5_wp,   &  !: meridional grid-spacing (degrees)
+      ppe1_m   = 5000.0_wp,   &  !: zonal      grid-spacing (degrees)
+      ppe2_m   = 5000.0_wp       !: meridional grid-spacing (degrees)
+
+
+   !!
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   !!
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
+      &     ppa1  =   245.58132232490_wp    ,  &  !:
+      &     ppkth =    21.43336197938_wp    ,  &  !:
+      &     ppacr =     3.00000000000_wp          !:
+
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = 10._wp                ,  &  !: Minimum vertical spacing
+      &     pphmax  = 5000._wp                    !: Maximum depth
+
+   !!---------------------------------------------------------------------
+#endif
+
+   !!---------------------------------------------------------------------
+   !! Domain Matrix size
+   !!---------------------------------------------------------------------
+   INTEGER, PARAMETER ::            &
+      jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ,   &
+      !                                !: first  dimension of grid --> i
+      jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ,   &
+      !                                !: second dimension of grid --> j
+      jpim1 = jpi-1,                &  !:  jpi - 1
+      jpjm1 = jpj-1,                &  !:  jpj - 1
+      jpkm1 = jpk-1,                &  !:  jpk - 1
+      jpij  = jpi*jpj                  !:  jpi x jpj
+
+   !!---------------------------------------------------------------------
+   !! ESOPA control
+   !!---------------------------------------------------------------------
+#if defined key_esopa
+   LOGICAL, PARAMETER ::   lk_esopa = .TRUE.   !: flag to activate the all options
+#else
+   LOGICAL, PARAMETER ::   lk_esopa = .FALSE.  !: flag to activate the all options
+#endif
+
+   !!======================================================================
+END MODULE par_oce
Index: /branches/nemo/NEMO/OPA_SRC/phycst.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/phycst.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/phycst.F90	(revision 4)
@@ -0,0 +1,201 @@
+MODULE phycst
+   !!======================================================================
+   !!                    ***  MODULE  phycst  ***
+   !!     Definition of of both ocean and ice parameters used in the code
+   !!=====================================================================
+   !! * Modules used
+   USE par_oce          ! ocean parameters
+   USE in_out_manager   ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC phy_cst          ! routine called by inipar.F90
+
+   !! * Shared module variables
+   INTEGER, PUBLIC, DIMENSION(12) ::   &
+      nbiss = (/ 31, 29, 31, 30, 31, 30,      &  !: number of days per month
+         &       31, 31, 30, 31, 30, 31 /) ,  &  !  (leap-year)
+      nobis = (/ 31, 28, 31, 30, 31, 30,      &  !: number of days per month
+         &       31, 31, 30, 31, 30, 31 /)       !  (365 days a year)
+   
+   REAL(wp), PUBLIC ::                        &
+      rpi = 3.141592653589793_wp           ,  &  !: pi
+      rad = 3.141592653589793_wp / 180._wp ,  &  !: conversion from degre into radian
+      rsmall = 0.5 * EPSILON( 1. )               !: smallest real computer value
+   
+   REAL(wp), PUBLIC ::          &
+      rday = 24.*60.*60.  ,     & !: day (s)
+      rsiyea              ,     & !: sideral year (s)
+      rsiday              ,     & !: sideral day (s)
+      raajj = 365._wp     ,     & !: number of days in one year
+      raamo =  12._wp     ,     & !: number of months in one year
+      rjjhh =  24._wp     ,     & !: number of hours in one day
+      rhhmm =  60._wp     ,     & !: number of minutes in one hour
+      rmmss =  60._wp     ,     & !: number of seconds in one minute
+      raass               ,     & !: number of seconds in one year
+      rmoss               ,     & !: number of seconds in one month
+      rjjss               ,     & !: number of seconds in one day
+!!!   omega = 7.292115083046061e-5_wp ,  &  !: change the last digit!
+      omega               ,    &  !: earth rotation parameter
+      ra    = 6371229._wp ,    &  !: earth radius (meter)
+      g     = 9.80665_wp          !: gravity (m/s2)
+   
+   REAL(wp), PUBLIC ::         &
+      rtt      = 273.16_wp  ,  &  !: triple point of temperature (Kelvin)
+      rt0      = 273.15_wp  ,  &  !: freezing point of water (Kelvin)
+      rt0_snow = 273.15_wp  ,  &  !: melting point of snow  (Kelvin)
+      rt0_ice  = 273.05_wp  ,  &  !: melting point of ice   (Kelvin)
+      rau0     = 1020._wp   ,  &  !: volumic mass of reference (kg/m3)
+      rauw     = 1000._wp   ,  &  !: density of pure water (kg/m3)
+      rcp      =    4.e+3_wp,  &  !: ocean specific heat
+      ro0cpr                      !: = 1. / ( rau0 * rcp )
+
+   REAL(wp), PUBLIC ::            &
+      rcdsn   =   0.22_wp     ,   &  !: conductivity of the snow
+      rcdic   =   2.034396_wp ,   &  !: conductivity of the ice
+      rcpsn   =   6.9069e+5_wp,   &  !: density times specific heat for snow
+      rcpic   =   1.8837e+6_wp,   &  !: volumetric latent heat fusion of sea ice
+      xlsn    = 110.121e+6_wp ,   &  !: volumetric latent heat fusion of snow
+      xlic    = 300.33e+6_wp  ,   &  !: volumetric latent heat fusion of ice
+      xsn     =   2.8e+6      ,   &  !: latent heat of sublimation of snow
+      rhoic   = 900._wp       ,   &  !: density of sea ice (kg/m3)
+      rhosn   = 330._wp       ,   &  !: density of snow (kg/m3)
+      emic    =   0.97_wp     ,   &  !: emissivity of snow or ice
+      sice    =   6.0_wp      ,   &  !: salinity of ice (psu)
+      soce    =  34.7_wp      ,   &  !: salinity of sea (psu)
+      cevap   =   2.5e+6_wp   ,   &  !: latent heat of evaporation (water)
+      srgamma =   0.9_wp      ,   &  !: correction factor for solar radiation (Oberhuber, 1974)
+      vkarmn  =   0.4_wp      ,   &  !: von Karman constant
+      stefan  =   5.67e-8_wp         !: Stefan-Boltzmann constant 
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0, LODYC-IPSL (2003)
+      !!----------------------------------------------------------------------
+   
+CONTAINS
+   
+   SUBROUTINE phy_cst
+      !!----------------------------------------------------------------------
+      !!                       ***  ROUTINE phy_cst  ***
+      !!
+      !! ** Purpose :   Print model parameters and set and print the constants
+      !!
+      !! ** Method  :   no
+      !!
+      !! History :
+      !!        !  90-10  (C. Levy - G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  91-12  (M. Imbard)
+      !!   8.5  !  02-08  (G. Madec, C. Ethe)  F90, add ice constants 
+      !!----------------------------------------------------------------------
+      !! * Local variables
+      CHARACTER (len=64) ::   cform = "( 4(A13, I7) )" 
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+      IF(lwp) WRITE(numout,*)
+
+
+      ! Ocean Parameters
+      ! ----------------
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' parameter file'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' dimension of model'
+         WRITE(numout,*) ' local domain                              Global domain           Data domain '
+         WRITE(numout,cform) '   jpi     : ', jpi, '   jpim1   : ', jpim1, '   jpiglo  : ', jpiglo, '   jpidta  : ', jpidta
+         WRITE(numout,cform) '   jpj     : ', jpj, '   jpjm1   : ', jpjm1, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta
+         WRITE(numout,cform) '   jpk     : ', jpk, '   jpkm1   : ', jpkm1, '   jpk     : ', jpk   , '   jpkdta  : ', jpkdta
+         WRITE(numout,*)      '  jpij    : ', jpij
+         WRITE(numout,*)
+         WRITE(numout,*) ' mpp local domain info (mpp)'
+         WRITE(numout,*) '   jpni    : ', jpni, '   jpreci  : ', jpreci
+         WRITE(numout,*) '   jpnj    : ', jpnj, '   jprecj  : ', jprecj
+         WRITE(numout,*) '   jpnij   : ', jpnij
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' lateral domain boundary condition type : jperio  = ', jperio
+         WRITE(numout,*) ' domain island (use in rigid-lid case)  : jpisl   = ', jpisl 
+         WRITE(numout,*) '                                          jpnisl  = ', jpnisl
+      ENDIF
+
+
+      ! Define constants
+      ! ----------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' constants'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' mathematical constant rpi = ', rpi
+
+      rsiyea = 365.25 * rday * 2. * rpi / 6.283076
+      rsiday = rday / ( 1. + rday / rsiyea )
+      omega  = 2. * rpi / rsiday 
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' day          rday   = ', rday,   ' s'
+      IF(lwp) WRITE(numout,*) ' sideral year rsiyea = ', rsiyea, ' s'
+      IF(lwp) WRITE(numout,*) ' sideral day  rsiday = ', rsiday, ' s'
+      IF(lwp) WRITE(numout,*) ' omega        omega  = ', omega,  ' s-1'
+
+      rjjss = rjjhh * rhhmm * rmmss
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' nb of months per year    raamo = ', raamo, ' months'
+      IF(lwp) WRITE(numout,*) ' nb of hours per day      rjjhh = ', rjjhh, ' hours'
+      IF(lwp) WRITE(numout,*) ' nb of minutes per hour   rhhmm = ', rhhmm, ' mn'
+      IF(lwp) WRITE(numout,*) ' nb of seconds per minute rmmss = ', rmmss, ' s'
+      IF(lwp) WRITE(numout,*) ' nb of seconds per day    rjjss = ', rjjss, ' s'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' earth radius ra = ', ra, ' m'
+      IF(lwp) WRITE(numout,*) ' gravity      g  = ', g , ' m/s2'
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' triple point of temperature      rtt      = ', rtt     , ' K'
+      IF(lwp) WRITE(numout,*) ' freezing point of water ( C)     rt0      = ', rt0     , ' K'
+      IF(lwp) WRITE(numout,*) ' melting point of snow            rt0_snow = ', rt0_snow, ' K'
+      IF(lwp) WRITE(numout,*) ' melting point of ice             rt0_ice  = ', rt0_ice , ' K'
+
+      ro0cpr = 1. / ( rau0 * rcp )    ! 
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' volumic mass of pure water (kg/m3)  rauw   = ', rauw, ' kg/m3'
+      IF(lwp) WRITE(numout,*) ' volumic mass of reference  (kg/m3)  rau0   = ', rau0, ' kg/m3'
+      IF(lwp) WRITE(numout,*) ' ocean specific heat                 rcp    = ', rcp
+      IF(lwp) WRITE(numout,*) '               1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' thermal conductivity of the snow          = ', rcdsn   , ' J.s-1.m-1.K-1'
+         WRITE(numout,*) ' thermal conductivity of the ice           = ', rcdic   , ' J.s-1.m-1.K-1'
+         WRITE(numout,*) ' density times specific heat for snow      = ', rcpsn   , ' J.m-3.K-1' 
+         WRITE(numout,*) ' density times specific heat for ice       = ', rcpic   , ' J.m-3.K-1' 
+         WRITE(numout,*) ' volumetric latent heat fusion of sea ice  = ', xlic    , ' J.m-3' 
+         WRITE(numout,*) ' volumetric latent heat fusion of snow     = ', xlsn    , ' J.m-3' 
+         WRITE(numout,*) ' latent heat of sublimation of snow        = ', xsn     , ' J.kg-1' 
+         WRITE(numout,*) ' density of sea ice                        = ', rhoic   , ' kg.m-3'
+         WRITE(numout,*) ' density of snow                           = ', rhosn   , ' kg.m-3'
+         WRITE(numout,*) ' emissivity of snow or ice                 = ', emic  
+         WRITE(numout,*) ' salinity of ice                           = ', sice    , ' psu'
+         WRITE(numout,*) ' salinity of sea                           = ', soce    , ' psu'
+         WRITE(numout,*) ' latent heat of evaporation (water)        = ', cevap   , ' J.m-3' 
+         WRITE(numout,*) ' correction factor for solar radiation     = ', srgamma 
+         WRITE(numout,*) ' von Karman constant                       = ', vkarmn 
+         WRITE(numout,*) ' Stefan-Boltzmann constant                 = ', stefan  , ' J.s-1.m-2.K-4'
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' conversion: degre ==> radian rad = ', rad
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' smallest real computer value= ', rsmall
+      ENDIF
+
+   END SUBROUTINE phy_cst
+
+   !!======================================================================
+END MODULE phycst
Index: /branches/nemo/NEMO/OPA_SRC/restart.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/restart.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/restart.F90	(revision 4)
@@ -0,0 +1,429 @@
+MODULE restart
+   !!======================================================================
+   !!                     ***  MODULE  restart  ***
+   !! Ocean restart :  write the ocean restart file
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   rst_write  : write of the restart file
+   !!   rst_read   : read the restart file
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain
+   USE oce             ! ocean dynamics and tracers 
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+   USE sol_oce         ! ocean elliptic solver
+   USE zdf_oce         ! ???
+   USE zdftke          ! turbulent kinetic energy scheme
+   USE ice_oce         ! ice variables
+   USE blk_oce         ! bulk variables
+
+   USE dynspg_fsc,      ONLY : lk_dynspg_fsc       ! ( mpp version )
+   USE dynspg_fsc_atsk, ONLY : lk_dynspg_fsc_tsk   ! 
+   USE cpl_oce,         ONLY : lk_cpl              !
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC rst_write  ! routine called by step.F90
+   PUBLIC rst_read   ! routine called by inidtr.F90
+
+   !! * Module variables
+   CHARACTER (len=48) ::   &
+      crestart = 'initial.nc'   ! restart file name
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#if defined key_fdir
+   !!----------------------------------------------------------------------
+   !!   'key_fdir'                                       direct access file
+   !!----------------------------------------------------------------------
+#  include "restart_fdir.h90"
+
+#elif defined key_mpp
+   !!----------------------------------------------------------------------
+   !!                       direct acces file one per processor
+   !!                  (merging/splitting is done off-line, eventually)
+   !!-----------------------------------------------------------------------
+#  include "restart_mpp.h90"
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                          NetCDF file
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE rst_write( kt )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE rstwrite  ***
+      !!                     
+      !! ** Purpose :   Write restart fields in NetCDF format
+      !!
+      !! ** Method  :   Write in numwrs file each nstock time step in NetCDF
+      !!      file, save fields which are necessary for restart
+      !!
+      !! History :
+      !!        !  99-11  (M. Imbard)  Original code
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Arguments 
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+      !! * Local declarations
+      LOGICAL ::   llbon
+      CHARACTER (len=50) ::   clname, cln
+      INTEGER ::   &
+         ic, jc, itime
+      REAL(wp) :: zdate0, zinfo(10)
+
+      REAL(wp), DIMENSION(1) ::  &
+         zfice, zfblk                       ! used only in case of ice , bulk
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'rst_wri : write restart.output NetCDF file'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         zfice(1) = 1.e0   ;   zfblk(1) = 1.e0
+      ENDIF
+
+
+      IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN
+         
+         ! 0. Initializations
+         ! ------------------
+
+         IF(lwp) WRITE(numout,*) ' '
+         IF(lwp) WRITE(numout,*) 'rst_write : write the restart file in NetCDF format ',   &
+                                              'at it= ',kt,' date= ',ndastp
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+
+         ! Job informations
+         zinfo(1) = FLOAT( no        )   ! job number
+         zinfo(2) = FLOAT( kt        )   ! time-step
+         zinfo(3) = FLOAT( 2 - nsolv )   ! pcg solver
+         zinfo(4) = FLOAT( nsolv - 1 )   ! sor solver
+         IF( lk_zdftke ) THEN
+            zinfo(5) = 1.e0              ! TKE 
+         ELSE
+            zinfo(5) = 0.e0              ! no TKE 
+         ENDIF
+         zinfo(6) = FLOAT( ndastp )      ! date
+         zinfo(7) = adatrj               ! ???
+
+         ! delete the restart file if it exists 
+         INQUIRE( FILE=crestart, EXIST=llbon )
+         IF(llbon) THEN
+            OPEN( UNIT=numwrs, FILE=crestart, STATUS='old' )
+            CLOSE( numwrs, STATUS='delete' )
+         ENDIF
+
+         ! Name of the new restart file
+         ic     = 1
+         DO jc = 1, 16
+            IF( cexper(jc:jc) /= ' ' )   ic = jc
+         END DO
+         WRITE(cln,'("_",i4.4,i2.2,i2.2,"_restart")') nyear, nmonth, nday
+         clname = cexper(1:ic)//cln
+         ic = 1
+         DO jc = 1, 48
+            IF( clname(jc:jc) /= ' ' ) ic = jc
+         END DO
+         crestart = clname(1:ic)//".nc"
+         itime = 0
+         CALL ymds2ju( nyear, nmonth, nday, 0.e0, zdate0 )
+         CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpk, gdept, clname,   &
+                        itime, zdate0, rdt*nstock ,numwrs )
+
+         CALL restput( numwrs, 'info'   , 1  , 1  , 10 , 0, zinfo   )   ! restart informations
+         
+         CALL restput( numwrs, 'ub'     , jpi, jpj, jpk, 0, ub      )   ! prognostic variables
+         CALL restput( numwrs, 'vb'     , jpi, jpj, jpk, 0, vb      )
+         CALL restput( numwrs, 'tb'     , jpi, jpj, jpk, 0, tb      )
+         CALL restput( numwrs, 'sb'     , jpi, jpj, jpk, 0, sb      )
+         CALL restput( numwrs, 'rotb'   , jpi, jpj, jpk, 0, rotb    )
+         CALL restput( numwrs, 'hdivb'  , jpi, jpj, jpk, 0, hdivb   )
+         CALL restput( numwrs, 'un'     , jpi, jpj, jpk, 0, un      )
+         CALL restput( numwrs, 'vn'     , jpi, jpj, jpk, 0, vn      )
+         CALL restput( numwrs, 'tn'     , jpi, jpj, jpk, 0, tn      )
+         CALL restput( numwrs, 'sn'     , jpi, jpj, jpk, 0, sn      )
+         CALL restput( numwrs, 'rotn'   , jpi, jpj, jpk, 0, rotn    )
+         CALL restput( numwrs, 'hdivn'  , jpi, jpj, jpk, 0, hdivn   )
+
+         CALL restput( numwrs, 'gcx'    , jpi, jpj, 1  , 0, gcx     )   ! Read elliptic solver arrays
+         CALL restput( numwrs, 'gcxb'   , jpi, jpj, 1  , 0, gcxb    )
+# if defined key_dynspg_fsc
+         CALL restput( numwrs, 'sshb'   , jpi, jpj, 1  , 0, sshb    )   ! free surface formulation (ssh)
+         CALL restput( numwrs, 'sshn'   , jpi, jpj, 1  , 0, sshn    )
+# else
+         CALL restput( numwrs, 'bsfb'   , jpi, jpj, 1  , 0, bsfb    )   ! Rigid-lid formulation (bsf)
+         CALL restput( numwrs, 'bsfn'   , jpi, jpj, 1  , 0, bsfn    )
+         CALL restput( numwrs, 'bsfd'   , jpi, jpj, 1  , 0, bsfd    )
+# endif
+# if defined key_zdftke   ||   defined key_esopa
+         IF( lk_zdftke ) THEN
+            CALL restput( numwrs, 'en'     , jpi, jpj, jpk, 0, en      )   ! TKE arrays
+         ENDIF
+# endif
+# if defined key_ice_lim
+         zfice(1) = FLOAT( nfice )                                      ! Louvain La Neuve Sea Ice Model
+         CALL restput( numwrs, 'nfice'  ,   1,   1, 1  , 0, zfice   )
+         CALL restput( numwrs, 'sst_io' , jpi, jpj, 1  , 0, sst_io  )
+         CALL restput( numwrs, 'sss_io' , jpi, jpj, 1  , 0, sss_io  )
+         CALL restput( numwrs, 'u_io'   , jpi, jpj, 1  , 0, v_io    )
+         CALL restput( numwrs, 'v_io'   , jpi, jpj, 1  , 0, v_io    )
+# if defined key_coupled
+         CALL restput( numwrs, 'alb_ice', jpi, jpj, 1  , 0, alb_ice )
+# endif
+# endif
+# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+         zfblk(1) = FLOAT( nfbulk )                                 ! Bulk
+         CALL restput( numwrs, 'nfbulk' ,   1,   1, 1  , 0, zfblk   )
+         CALL restput( numwrs, 'gsst'   , jpi, jpj, 1  , 0, gsst    )
+# endif
+
+         CALL restclo( numwrs )                                         ! close the restart file
+         
+      ENDIF
+
+   END SUBROUTINE rst_write
+
+
+   SUBROUTINE rst_read
+      !!---------------------------------------------------------------------- 
+      !!                   ***  ROUTINE rst_read  ***
+      !! 
+      !! ** Purpose :   Read files for restart
+      !! 
+      !! ** Method  :   Read the previous fields on the NetCDF file 
+      !!      the first record indicates previous characterics
+      !!      after control with the present run, we read :
+      !!      - prognostic variables on the second record
+      !!      - elliptic solver arrays 
+      !!      - barotropic stream function arrays (default option)
+      !!        or free surface arrays ("key_dynspg_fsc" defined)
+      !!      - tke arrays (lk_zdftke=T)
+      !!      for this last three records,  the previous characteristics 
+      !!      could be different with those used in the present run. 
+      !!
+      !!   According to namelist parameter nrstdt,
+      !!       nrstdt = 0  no control on the date (nit000 is  arbitrary).
+      !!       nrstdt = 1  we verify that nit000 is equal to the last
+      !!                   time step of previous run + 1.
+      !!       In both those options, the  exact duration of the experiment
+      !!       since the beginning (cumulated duration of all previous restart runs)
+      !!       is not stored in the restart and is assumed to be (nit000-1)*rdt.
+      !!       This is valid is the time step has remained constant.
+      !!
+      !!       nrstdt = 2  the duration of the experiment in days (adatrj)
+      !!                    has been stored in the restart file.
+      !!
+      !! History :
+      !!        !  99-05  (M. Imbard)  Original code
+      !!   8.5  !  02-09  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE ioipsl
+
+      !! * Local declarations
+      LOGICAL ::   llog
+      CHARACTER (len=8 ) ::   clvnames(30)
+      CHARACTER (len=32) ::   clname = 'restart'
+      INTEGER  ::   &
+         itime, ibvar,     &  !
+         inum                 ! temporary logical unit
+      REAL(wp) ::   zdate0, zdt, zinfo(10)
+      REAL(wp) ::   zdept(jpk), zlamt(jpi,jpj), zphit(jpi,jpj)
+#   if defined key_ice_lim
+      INTEGER  ::   ios1, ji, jj, jn
+      REAL(wp) ::   zfice(1)
+#   endif
+# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+      INTEGER  ::   ios2, jk
+      REAL(wp) ::   zfblk(1)
+#   endif
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'rst_read : read the NetCDF restart file'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+
+      IF(lwp) WRITE(numout,*) ' Info on the present job : '
+      IF(lwp) WRITE(numout,*) '   job number          : ', no
+      IF(lwp) WRITE(numout,*) '   time-step           : ', nit000
+      IF(lwp) WRITE(numout,*) '   solver type         : ', nsolv
+      IF( lk_zdftke ) THEN
+         IF(lwp) WRITE(numout,*) '   tke option          : 1 '
+      ELSE
+         IF(lwp) WRITE(numout,*) '   tke option          : 0 '
+      ENDIF
+      IF(lwp) WRITE(numout,*) '   date ndastp         : ', ndastp
+      IF(lwp) WRITE(numout,*)
+
+      ! Time domain : restart
+      ! -------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' *** restart option'
+      SELECT CASE ( nrstdt )
+      CASE ( 0 ) 
+         IF(lwp) WRITE(numout,*) ' nrstdt = 0 no control of nit000'
+      CASE ( 1 ) 
+         IF(lwp) WRITE(numout,*) ' nrstdt = 1 we control the date of nit000'
+      CASE ( 2 )
+         IF(lwp) WRITE(numout,*) ' nrstdt = 2 the date adatrj is read in restart file'
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,*) '  ===>>>> nrstdt not equal 0, 1 or 2 : no control of the date'
+         IF(lwp) WRITE(numout,*) ' =======                   ========='
+      END SELECT
+
+      itime = 0
+      llog  = .FALSE.
+      zlamt(:,:) = 0.e0
+      zphit(:,:) = 0.e0
+      zdept(:)   = 0.e0
+      CALL restini( clname, jpi, jpj, zlamt, zphit, jpk, zdept, clname,   &
+         &          itime, zdate0, zdt, inum )
+
+      CALL ioget_vname( inum, ibvar, clvnames)
+      CALL restget( inum, 'info', 1, 1, 10, 0, llog, zinfo )
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' Info on the restart file read : '
+      IF(lwp) WRITE(numout,*) '   FILE name           : ', clname
+      IF(lwp) WRITE(numout,*) '   job number          : ', NINT( zinfo(1) )
+      IF(lwp) WRITE(numout,*) '   time-step           : ', NINT( zinfo(2) )
+      IF(lwp) WRITE(numout,*) '   solver type         : ', NINT( zinfo(4) ) + 1
+      IF(lwp) WRITE(numout,*) '   tke option          : ', NINT( zinfo(5) )
+      IF(lwp) WRITE(numout,*) '   date ndastp         : ', NINT( zinfo(6) )
+      IF(lwp) WRITE(numout,*) '   number of variables : ', ibvar
+      IF(lwp) WRITE(numout,*) '   NetCDF variables    : ', clvnames
+      IF(lwp) WRITE(numout,*)
+
+      ! Control of date
+      IF( nit000 - NINT( zinfo(2) )  /= 1 .AND. ABS( nrstdt ) == 1 ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' ===>>>> : problem with nit000 for the restart'
+         IF(lwp) WRITE(numout,*) ' verify the restart file or rerun with nrstdt = 0 (namelist)'
+         nstop = nstop + 1
+      ENDIF
+
+      ! re-initialisation of  adatrj0
+      adatrj0 =  ( FLOAT( nit000-1 ) * rdttra(1) ) / rday
+
+      IF ( nrstdt == 2 ) THEN
+!                             by default ndatsp has been set to ndate0 in dom_nam
+!                             ndate0 has been read in the namelist (standard OPA 8)
+!                             here when nrstdt=2 we keep the  final date of previous run
+        ndastp = NINT( zinfo(6) )
+        adatrj0 =  zinfo(7)
+      ENDIF
+
+
+
+      CALL restget( inum, 'ub'     , jpi, jpj, jpk, 0, llog, ub      )    ! Read prognostic variables
+      CALL restget( inum, 'vb'     , jpi, jpj, jpk, 0, llog, vb      )
+      CALL restget( inum, 'tb'     , jpi, jpj, jpk, 0, llog, tb      )
+      CALL restget( inum, 'sb'     , jpi, jpj, jpk, 0, llog, sb      )
+      CALL restget( inum, 'rotb'   , jpi, jpj, jpk, 0, llog, rotb    )
+      CALL restget( inum, 'hdivb'  , jpi, jpj, jpk, 0, llog, hdivb   )
+      CALL restget( inum, 'un'     , jpi, jpj, jpk, 0, llog, un      )
+      CALL restget( inum, 'vn'     , jpi, jpj, jpk, 0, llog, vn      )
+      CALL restget( inum, 'tn'     , jpi, jpj, jpk, 0, llog, tn      )
+      CALL restget( inum, 'sn'     , jpi, jpj, jpk, 0, llog, sn      )
+      CALL restget( inum, 'rotn'   , jpi, jpj, jpk, 0, llog, rotn    )
+      CALL restget( inum, 'hdivn'  , jpi, jpj, jpk, 0, llog, hdivn   )
+
+      CALL restget( inum, 'gcxb'   , jpi, jpj, 1  , 0, llog, gcxb    )   ! Read elliptic solver arrays
+      CALL restget( inum, 'gcx'    , jpi, jpj, 1  , 0, llog, gcx     )
+# if defined key_dynspg_fsc
+      CALL restget( inum, 'sshb'   , jpi, jpj, 1  , 0, llog, sshb    )   ! free surface formulation (ssh)
+      CALL restget( inum, 'sshn'   , jpi, jpj, 1  , 0, llog, sshn    )
+# else
+      CALL restget( inum, 'bsfb'   , jpi, jpj, 1  , 0, llog, bsfb    )   ! Rigid-lid formulation (bsf)
+      CALL restget( inum, 'bsfn'   , jpi, jpj, 1  , 0, llog, bsfn    )
+      CALL restget( inum, 'bsfd'   , jpi, jpj, 1  , 0, llog, bsfd    )
+# endif
+# if defined key_zdftke   ||   defined key_esopa
+      IF( lk_zdftke ) THEN
+         IF( NINT( zinfo(5) ) == 1 ) THEN                                ! Read tke arrays
+            CALL restget( inum, 'en',jpi,jpj, jpk,0  , llog, en )
+            ln_rstke = .FALSE.
+         ELSE
+            IF(lwp) WRITE(numout,*) ' ===>>>> : the previous restart file didnot used  tke scheme'
+            IF(lwp) WRITE(numout,*) ' =======                ======='
+            nrstdt = 2
+            ln_rstke = .TRUE.
+         ENDIF
+      ENDIF
+# endif
+# if defined key_ice_lim
+      ! Louvain La Neuve Sea Ice Model
+      ios1 = 0
+      DO jn = 1, 30
+         IF( clvnames(jn) == 'nfice' )  ios1 = 1
+      END DO
+      IF( ios1 == 1 ) THEN
+         CALL restget( inum, 'nfice' ,   1,   1, 1 , 0, llog, zfice  )
+         CALL restget( inum, 'sst_io', jpi, jpj, 1 , 0, llog, sst_io )
+         CALL restget( inum, 'sss_io', jpi, jpj, 1 , 0, llog, sss_io )
+         CALL restget( inum, 'u_io'  , jpi, jpj, 1 , 0, llog, u_io   )
+         CALL restget( inum, 'v_io'  , jpi, jpj, 1 , 0, llog, v_io   )
+#if defined key_coupled
+         CALL restget( inum, 'alb_ice', jpi, jpj, 1 , 0, llog, alb_ice )
+#endif
+      ENDIF
+      IF( zfice(1) /= FLOAT(nfice) .OR. ios1 == 0 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
+         IF(lwp) WRITE(numout,*)
+         sst_io(:,:) = ( nfice-1 )*( tn(:,:,1) + rt0 )          !!bug a explanation is needed here!
+         sss_io(:,:) = ( nfice-1 )*  sn(:,:,1)
+         DO jj = 2, jpj
+            DO ji = 2, jpi
+               u_io(ji,jj) = ( nfice-1 ) * 0.5 * ( un(ji-1,jj  ,1) + un(ji-1,jj-1,1) )
+               v_io(ji,jj) = ( nfice-1 ) * 0.5 * ( vn(ji  ,jj-1,1) + vn(ji-1,jj-1,1) )
+            END DO
+         END DO
+#    if defined key_coupled
+         alb_ice(:,:) = 0.8 * tmask(:,:,1)
+#    endif
+      ENDIF
+# endif
+# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+      ! Louvain La Neuve Sea Ice Model
+      ios2 = 0
+      DO jk = 1, 30
+         IF( clvnames(jk) == 'nfbulk' )  ios2 = 1
+      END DO
+      IF( ios2 == 1 ) THEN
+         CALL restget( inum, 'nfbulk',   1,   1, 1 , 0, llog, zfblk )
+         CALL restget( inum, 'gsst'  , jpi, jpj, 1 , 0, llog, gsst  )
+      ENDIF
+      IF( zfblk(1) /= FLOAT(nfbulk) .OR. ios2 == 0 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
+         IF(lwp) WRITE(numout,*)
+         gsst(:,:) = 0.
+         gsst(:,:) = gsst(:,:) + ( nfbulk-1 )*( tn(:,:,1) + rt0 )
+      ENDIF
+# endif
+      
+      CALL restclo( inum )
+
+   END SUBROUTINE rst_read
+
+#endif
+   !!=====================================================================
+END MODULE restart
Index: /branches/nemo/NEMO/OPA_SRC/restart_fdir.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/restart_fdir.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/restart_fdir.h90	(revision 4)
@@ -0,0 +1,227 @@
+   SUBROUTINE rst_write( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE rst_write  ***
+      !!
+      !! ** Purpose :   Write restart fields in direct access format
+      !!
+      !! ** Method :   restart.output file, each nstock time step , save
+      !!      fields which are necessary for restart
+      !!
+      !! History :
+      !!        !  91-03  ()  original code
+      !!        !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard)  correction restart file
+      !!        !  92-07  (M. Imbard)  split into diawri and rstwri
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  98-05  (G. Roullet)  free surface
+      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      !! * Arguments 
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+      !! * Local declarations
+      INTEGER ::   ino0, it0, ipcg0, isor0, itke0
+      INTEGER ::   ibloc, ilglo
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'rst_write : write restart.output direct access file'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+         ibloc = 4096
+         ilglo = ibloc*((jpiglo*jpjglo*jpbyt-1 )/ibloc+1)
+         CALL ctlopn( numwrs,'restart.output', 'UNKNOWN','UNFORMATTED','DIRECT', ilglo, numout, lwp, 1 )
+      ENDIF
+
+      IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN
+
+         ! 0. Initializations
+         ! ------------------
+
+         IF(lwp) THEN
+            WRITE(numout,*) '             output done in numwrs = ', numwrs,' at it= ',kt,' date= ',ndastp
+         ENDIF
+         
+         ino0  = no
+         it0   = kt
+         ipcg0 = 0
+         isor0 = 0
+         itke0 = 0
+         isor0 = nsolv - 1
+         ipcg0 = 2 - nsolv
+         IF( lk_zdftke )   itke0 = 1
+         ! FETI method
+         IF (nsolv == 3) THEN 
+            isor0 = 2
+            ipcg0 = 2
+         ENDIF
+
+         ! 1. Write in numwrs
+         ! ------------------
+         
+         IF(lwp) WRITE(numwrs,REC=1)   &                 ! first record
+            ino0, it0, isor0, ipcg0, itke0, ndastp
+         !                                               ! prognostic variables
+         CALL write3(numwrs,ub   ,2 )                       ! before fields
+         CALL write3(numwrs,vb   ,3 )
+         CALL write3(numwrs,tb   ,5 )
+         CALL write3(numwrs,sb   ,6 )
+         CALL write3(numwrs,rotb ,7 )
+         CALL write3(numwrs,hdivb,8 )
+         CALL write3(numwrs,un   ,9 )                       ! now fields
+         CALL write3(numwrs,vn   ,10)
+         CALL write3(numwrs,tn   ,12)
+         CALL write3(numwrs,sn   ,13)
+         CALL write3(numwrs,rotn ,14)
+         CALL write3(numwrs,hdivn,15)
+         CALL write2(numwrs,gcx ,jpk,17)                 ! Read elliptic solver arrays
+         CALL write2(numwrs,gcxb,jpk,18)
+#if defined key_dynspg_fsc
+         CALL write2(numwrs,sshb,jpk,4 )                 ! free surface formulation (ssh)
+         CALL write2(numwrs,sshn,jpk,11)
+#else
+         CALL write2(numwrs,bsfb,jpk,4 )                 ! Rigid-lid formulation (bsf)
+         CALL write2(numwrs,bsfn,jpk,11)
+         CALL write2(numwrs,bsfd,jpk,16)
+#endif
+         IF( lk_zdftke )   CALL write3(numwrs,en,19)     ! TKE arrays
+      ENDIF
+
+   END SUBROUTINE rst_write
+
+
+   SUBROUTINE rst_read
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE rst_read  ***
+      !!
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER :: ino0, it0, ipcg0, isor0, itke0
+      INTEGER :: ino1, it1, isor1, ipcg1, itke1, idast1
+      INTEGER ::   ibloc, ilglo
+      INTEGER ::   inum            ! temporary logical unit
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      ! open restart file
+      ibloc = 4096
+      ilglo = ibloc*((jpiglo*jpjglo*jpbyt-1 )/ibloc+1)
+      CALL ctlopn(inum,'restart','OLD','UNFORMATTED','DIRECT',   &
+                  ilglo,numout,lwp,1)
+      ! restart options
+      IF(nrstdt == 0) THEN
+         IF(lwp) WRITE(numout,*) ' nrstdt = 0 no control of nit000'
+      ELSE IF(nrstdt == 1) THEN
+         IF(lwp) WRITE(numout,*) ' nrstdt = 1 we control the date'
+      ELSE
+         IF(lwp) WRITE(numout,*) '  ===>>>> nrstdt not equal 0 or 1'
+         IF(lwp) WRITE(numout,*) ' =======                   ======'
+         IF(lwp) WRITE(numout,*) ' we dont control the date'
+      ENDIF
+
+
+      ! 0. Initialisations
+      ! ------------------
+      
+      ino0  = no
+      it0   = nit000
+      ipcg0 = 0
+      isor0 = 0
+      itke0 = 0
+      isor0 = nsolv-1
+      ipcg0 = 2-nsolv
+      IF( lk_zdftke ) itke0 = 1
+      ! FETI method
+      IF( nsolv == 3 ) THEN 
+          isor0=2
+          ipcg0=2
+      ENDIF
+
+      IF(lwp) THEN
+          WRITE(numout,*)
+          WRITE(numout,*) ' *** dtrlec:  beginning of restart'
+          WRITE(numout,*) ' '
+          WRITE(numout,*) ' the present run :'
+          WRITE(numout,*) '   job number : ', no 
+          WRITE(numout,*) '   with nit000 : ', nit000
+          WRITE(numout,*) '   with pcg option ipcg0 : ', ipcg0
+          WRITE(numout,*) '   with sor option isor0 : ', isor0
+          WRITE(numout,*) '   with FETI solver option ipcg0 & isor0 : ', ipcg0,' & ',isor0
+          WRITE(numout,*) '   with tke option itke0 : ', itke0
+      ENDIF
+
+      ! 1. Read inum
+      ! --------------
+
+      ! First record
+
+      READ(inum,REC=1) ino1, it1, isor1, ipcg1, itke1, idast1
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' READ inum with '
+         WRITE(numout,*) '   job number : ', ino1
+         WRITE(numout,*) '   with time step it : ', it1
+         WRITE(numout,*) '   with pcg option ipcg1 : ', ipcg1
+         WRITE(numout,*) '   with sor option isor1 : ', isor1
+         WRITE(numout,*) '   with tke option itke1 : ', itke1
+         WRITE(numout,*) '   with FETI solver option ipcg1 + isor1 : ', ipcg1 + isor1
+         WRITE(numout,*)
+      ENDIF
+
+      ! Control of date
+
+      IF( (it0-it1) /= 1 .AND. ABS(nrstdt) == 1 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) ' ===>>>> : problem with nit000 for the restart'
+            WRITE(numout,*) ' =======                               ======='
+            WRITE(numout,*) ' we stop. verify the file'
+            WRITE(numout,*) ' or rerun with the value  0 for the'
+            WRITE(numout,*) ' control of time parameter  nrstdt'
+            WRITE(numout,*)
+         ENDIF
+         STOP 'dtrlec'
+      ENDIF
+
+      CALL read3(inum,ub   ,2 )                  ! Read prognostic variables
+      CALL read3(inum,vb   ,3 )
+      CALL read3(inum,tb   ,5 )
+      CALL read3(inum,sb   ,6 )
+      CALL read3(inum,rotb ,7 )
+      CALL read3(inum,hdivb,8 )
+      CALL read3(inum,un   ,9 )
+      CALL read3(inum,vn   ,10)
+      CALL read3(inum,tn   ,12)
+      CALL read3(inum,sn   ,13)
+      CALL read3(inum,rotn ,14)
+      CALL read3(inum,hdivn,15)
+
+      CALL read2(inum,gcx ,jpk,17)               ! Read elliptic solver arrays
+      CALL read2(inum,gcxb,jpk,18)
+
+#   if defined key_dynspg_fsc
+      CALL read2(inum,sshb ,jpk,4 )              ! free surface formulation (ssh)
+      CALL read2(inum,sshn ,jpk,11)
+#   else
+      CALL read2(inum,bsfb ,jpk,4 )              ! Rigid-lid formulation (bsf)
+      CALL read2(inum,bsfn ,jpk,11)
+      CALL read2(inum,bsfd ,jpk,16)
+#   endif
+
+      IF( lk_zdftke ) THEN
+         IF( itke1 == 1 ) THEN                   ! Read tke arrays
+            CALL read3(inum,en,19)
+         ELSE
+            IF(lwp) WRITE(numout,*) ' ===>>>> : the previous restart file didnot used  tke scheme'
+            IF(lwp) WRITE(numout,*) ' =======                ======='
+            nrstdt = 2
+         ENDIF
+      ENDIF
+
+      CLOSE( inum )
+
+   END SUBROUTINE rst_read
Index: /branches/nemo/NEMO/OPA_SRC/restart_mpp.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/restart_mpp.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/restart_mpp.h90	(revision 4)
@@ -0,0 +1,542 @@
+  SUBROUTINE rst_write(kt)
+    !!---------------------------------------------------------------------
+    !!                  ***  ROUTINE rst_write  ***
+    !! 
+    !! ** Purpose :   Write restart fields in direct access format in mpp.
+    !!      one per process
+    !!
+    !! ** Method  :   each nstock time step , save fields which are necessary
+    !!      for restart
+    !!      Record #1 hold general information on the state of the run
+    !!      Data fields (either 3D or 2D ) starts ar record #2
+    !!
+    !! History :
+    !!        !  91-03  ()  original code
+    !!        !  91-11  (G. Madec)
+    !!        !  92-06  (M. Imbard)  correction restart file
+    !!        !  92-07  (M. Imbard)  split into diawri and rstwri
+    !!        !  98-02  (M. Guyon)  FETI method
+    !!        !  98-05  (G. Roullet)  free surface
+    !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl
+    !!   8.5  !  03-06  (J.M. Molines)  F90: Free form, mpp support
+    !!----------------------------------------------------------------------
+    !! * Arguments 
+    INTEGER, INTENT( in ) ::   kt         ! ocean time-step
+
+    !! * Local declarations
+    INTEGER :: ino0, it0, ipcg0, isor0, itke0
+    INTEGER :: irecl8, irec
+    INTEGER :: ji,jj, jk
+    INTEGER :: inum = 11        ! temporary logical unit
+    INTEGER :: ios1 , ios2      ! flag for ice and bulk in the current run
+    INTEGER :: ios3             ! flag for free surface.  0 = none 1 = yes.  0 = none 1 = yes
+    INTEGER :: ios4             ! flag for coupled (1) or not (0)
+
+    CHARACTER(LEN=80)  :: clres
+    !!----------------------------------------------------------------------
+    !!  OPA 8.5, LODYC-IPSL (2002)
+    !!----------------------------------------------------------------------
+
+    IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN
+
+       ! 0. Initializations
+       ! ------------------
+
+       IF(lwp) THEN
+          WRITE(numout,*) ' '
+          WRITE(numout,*) ' rst_write: output done in inum = ',   &
+               inum,' at it= ',kt,' date= ',ndastp
+          WRITE(numout,*) ' -------'
+       ENDIF
+
+       ! Open direct access file, with reclength for 2D wp fields
+       irecl8= jpi * jpj * wp
+       WRITE(clres,'(a,i3.3)') 'restart.output.',narea
+       OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl8 )
+
+
+       ino0  = no
+       it0   = kt
+       ipcg0 = 0
+       isor0 = 0
+       itke0 = 0
+       isor0 = nsolv - 1
+       ipcg0 = 2 - nsolv
+       IF ( lk_zdftke ) itke0=1
+       ! FETI method
+       IF (nsolv == 3) THEN 
+          isor0 = 2
+          ipcg0 = 2
+       ENDIF
+
+       ! 1. Write in inum
+       ! ------------------
+
+       ! first record
+       ios1 = 0
+       ios2 = 0
+       ios3 = 0
+       ios4 = 0
+       IF ( lk_ice_lim                           )   ios1 = 1
+       IF ( l_bulk                               )   ios2 = 1
+       IF ( lk_dynspg_fsc .OR. lk_dynspg_fsc_tsk )   ios3 = 1
+       IF ( lk_cpl                               )   ios4 = 1
+
+       WRITE(inum,REC=1) irecl8, ino0, it0, isor0, ipcg0, itke0, &
+          &              nfice, nfbulk , ios1, ios2, ios3, ios4, &
+          &              ndastp, adatrj, jpi, jpj, jpk,  &
+          &              jpni, jpnj, jpnij, narea, jpiglo, jpjglo, &
+          &              nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
+
+       ! prognostic variables
+
+       irec=2
+
+       ! 'before' fields
+
+       DO jk = 1, jpk
+          WRITE(inum,REC=irec) ub(:,:,jk)
+          irec = irec +1
+       END DO
+
+       DO jk = 1, jpk
+          WRITE(inum,REC=irec) vb(:,:,jk)
+          irec = irec +1
+       END DO
+
+       DO jk = 1, jpk
+          WRITE(inum,REC=irec) tb(:,:,jk)
+          irec = irec +1
+       END DO
+
+       DO jk = 1, jpk
+          WRITE(inum,REC=irec) sb(:,:,jk)
+          irec = irec +1
+       END DO
+
+       DO jk = 1, jpk
+          WRITE(inum,REC=irec) rotb(:,:,jk)
+          irec = irec +1
+       END DO
+
+       DO jk = 1, jpk
+          WRITE(inum,REC=irec) hdivb(:,:,jk)
+          irec = irec +1
+       END DO
+
+       ! 'now' fields
+
+       DO jk = 1, jpk
+          WRITE(inum,REC=irec) un(:,:,jk)
+          irec = irec +1
+       END DO
+
+       DO jk = 1, jpk
+          WRITE(inum,REC=irec) vn(:,:,jk)
+          irec = irec +1
+       END DO
+
+       DO jk = 1, jpk
+          WRITE(inum,REC=irec) tn(:,:,jk)
+          irec = irec +1
+       END DO
+
+       DO jk = 1, jpk
+          WRITE(inum,REC=irec) sn(:,:,jk)
+          irec = irec +1
+       END DO
+
+       DO jk = 1, jpk
+          WRITE(inum,REC=irec) rotn(:,:,jk)
+          irec = irec +1
+       END DO
+
+       DO jk = 1, jpk
+          WRITE(inum,REC=irec) hdivn(:,:,jk)
+          irec = irec +1
+       END DO
+
+       ! elliptic solver arrays
+       WRITE(inum,REC=irec ) gcx(:,:)
+       irec = irec +1
+
+       WRITE(inum,REC=irec ) gcxb(:,:)
+       irec = irec +1
+
+#if defined key_dynspg_fsc
+
+       ! free surface formulation (ssh)
+
+       WRITE(inum,REC=irec ) sshb(:,:)
+       irec = irec +1
+
+       WRITE(inum,REC=irec ) sshn(:,:)
+       irec = irec +1
+#else
+
+       ! Rigid-lid formulation (bsf)
+
+       WRITE(inum,REC=irec ) bsfb(:,:)
+       irec = irec +1
+
+       WRITE(inum,REC=irec ) bsfn(:,:)
+       irec = irec +1
+
+       WRITE(inum,REC=irec ) bsfd(:,:)
+       irec = irec +1
+
+#endif
+
+       ! TKE arrays
+
+       IF (lk_zdftke) THEN
+         DO jk = 1, jpk
+            WRITE(inum,REC=irec) en(:,:,jk) ; irec = irec + 1 
+         END DO
+       END IF
+
+#if defined key_ice_lim
+          WRITE(inum,REC=irec) fsst(:,:)  ; irec = irec + 1
+          WRITE(inum,REC=irec) fsss(:,:)  ; irec = irec + 1
+          WRITE(inum,REC=irec) fun (:,:)  ; irec = irec + 1
+          WRITE(inum,REC=irec) fvn (:,:)  ; irec = irec + 1
+#    if defined key_coupled
+          WRITE(inum,REC=irec) alb_ice(:,:)  ; irec = irec + 1
+#    endif
+#endif
+# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+          WRITE(inum,REC=irec) gsst(:,:)  ; irec = irec + 1
+# endif
+
+       CLOSE(inum)
+    ENDIF
+
+  END SUBROUTINE rst_write
+
+  SUBROUTINE rst_read
+    !!---------------------------------------------------------------------
+    !!                       ROUTINE rst_read
+    !!                     ******************
+    !! ** Purpose :
+    !!        Read restart fields in direct access format, one per process
+    !!
+    !! ** Method :
+    !!        Just does the oposit than rst_wri
+    !!
+    !! History :
+    !!        !  91-03  ()  original code
+    !!        !  91-11  (G. Madec)
+    !!        !  92-06  (M. Imbard)  correction restart file
+    !!        !  92-07  (M. Imbard)  split into diawri and rstwri
+    !!        !  98-02  (M. Guyon)  FETI method
+    !!        !  98-05  (G. Roullet)  free surface
+    !!        !  99-11  (M. Imbard)  NetCDF FORMAT with ioipsl
+    !!   8.5  !  03-06  (J.M. Molines)  F90: Free form, mpp support
+    !!----------------------------------------------------------------------
+
+
+    !!----------------------------------------------------------------------
+    USE lib_mpp
+    !! * Local declarations
+    INTEGER :: ino0, it0, ipcg0, isor0, itke0
+    INTEGER :: ino1, it1, isor1, ipcg1, itke1, idast1 
+    INTEGER :: iice1, ibulk1
+    INTEGER :: ipi,ipj,ipk, ipni,ipnj,ipnij,iarea
+    INTEGER :: irecl8, irec
+    INTEGER :: ji,jj,jk
+    INTEGER :: ick, iwork, inum
+    INTEGER :: ios1, ios2, ios3, ios4
+
+    CHARACTER(LEN=80)  :: clres
+
+    LOGICAL   :: lstop
+
+    !!----------------------------------------------------------------------
+    !!  OPA 8.5, LODYC-IPSL (2002)
+    !!----------------------------------------------------------------------
+
+
+    ! 0. Initialisations
+    ! ------------------
+
+    inum = 11
+    ino0  = no
+    it0   = nit000
+    ipcg0 = 0
+    isor0 = 0
+    itke0 = 0
+    isor0 = nsolv-1
+    ipcg0 = 2-nsolv
+    IF (lk_zdftke ) itke0 = 1
+    ! FETI method
+    IF( nsolv == 3 ) THEN 
+       isor0=2
+       ipcg0=2
+    ENDIF
+
+    IF(lwp) THEN
+       WRITE(numout,*)
+       WRITE(numout,*) ' *** rst_read:  beginning of restart'
+       WRITE(numout,*) ' '
+       WRITE(numout,*) ' the present run :'
+       WRITE(numout,*) '   job number : ', no 
+       WRITE(numout,*) '   with nit000 : ', nit000
+       WRITE(numout,*) '   with pcg option ipcg0 : ', ipcg0
+       WRITE(numout,*) '   with sor option isor0 : ', isor0
+       WRITE(numout,*) '   with FETI solver option ipcg0 & isor0 : ', ipcg0,' & ',isor0
+       WRITE(numout,*) '   with tke option itke0 : ', itke0
+       WRITE(numout,*) '   with nfice            : ', nfice
+       WRITE(numout,*) '   with nfbulk           : ', nfbulk
+    ENDIF
+
+    ! Open direct access file, with reclength for 2D wp fields
+    WRITE(clres,'(a,i3.3)') 'restart.',narea
+
+    OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=8 )
+    READ(inum,REC=1)irecl8
+    CLOSE(inum)
+
+    OPEN(inum,FILE=clres,FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl8 )
+
+    ! 1. Read inum
+    ! --------------
+
+
+    READ(inum,REC=1) irecl8, ino1, it1, isor1, ipcg1, itke1, &
+     &  iice1, ibulk1, ios1, ios2, ios3, ios4, &
+     &  idast1, adatrj0,  ipi,ipj,ipk,ipni,ipnj,ipnij,iarea
+
+    ! Performs checks on the file
+
+    ! processor layout changed ? check only on lwp
+    lstop =.FALSE.
+    IF ( ipni /= jpni ) THEN
+       lstop=.TRUE.
+       IF (lwp)  WRITE(numout,*) ' E R R O R : Processor splitting change along I '
+       IF (lwp)  WRITE(numout,*) ' =========='
+    END IF
+
+    IF ( ipnj /= jpnj ) THEN
+       lstop=.TRUE.
+       IF (lwp)  WRITE(numout,*) ' E R R O R : Processor splitting change along J '
+       IF (lwp)  WRITE(numout,*) ' =========='
+    END IF
+
+    IF ( ipnij /= jpnij ) THEN
+       lstop=.TRUE.
+       IF (lwp)  WRITE(numout,*) ' E R R O R : Total number of processors changed '
+       IF (lwp)  WRITE(numout,*) ' =========='
+    END IF
+
+    ick = narea -iarea
+#if defined key_mpp
+    CALL mpp_sum(ick)
+#endif
+
+    IF (ick /= 0 ) THEN
+       lstop=.TRUE.
+       IF (lwp)  WRITE(numout,*) ' E R R O R : mismatch in area numbering ...'
+       IF (lwp)  WRITE(numout,*) ' =========='
+    END IF
+
+    IF(lwp) THEN
+       WRITE(numout,*)
+       WRITE(numout,*) ' READ inum with '
+       WRITE(numout,*) '   job number : ', ino1
+       WRITE(numout,*) '   with time step it : ', it1
+       WRITE(numout,*) '   with pcg option ipcg1 : ', ipcg1
+       WRITE(numout,*) '   with sor option isor1 : ', isor1
+       WRITE(numout,*) '   with tke option itke1 : ', itke1
+       WRITE(numout,*) '   with FETI solver option ipcg1 + isor1 : ', ipcg1 + isor1
+       WRITE(numout,*)
+    ENDIF
+
+    ! Control of date
+
+    IF( (it0-it1) /= 1 .AND. ABS(nrstdt) == 1 ) THEN
+       lstop=.TRUE.
+       IF(lwp) THEN
+          WRITE(numout,*) ' ===>>>> : problem with nit000 for the restart'
+          WRITE(numout,*) ' =======                               ======='
+          WRITE(numout,*) ' we stop. verify the file'
+          WRITE(numout,*) ' or rerun with the value  0 for the'
+          WRITE(numout,*) ' control of time parameter  nrstdt'
+          WRITE(numout,*)
+       ENDIF
+    ENDIF
+
+    IF ( nrstdt /= 2 ) THEN  !  Compatibility with OPA8
+                             !  the beginning of the new run is ndate0 read in the namelist
+                             !  adatrj0 is recalculated assuming constant time step.
+
+       adatrj0 =  ( FLOAT( nit000-1 ) * rdttra(1) ) / rday
+    ELSE                 !  restart option nrstdt = 2
+                         !  both adatrj0 and ndastp are read in the restart file.
+       ndastp = idast1
+    ENDIF
+
+    IF (lstop ) STOP 'rst_read'
+
+    irec=2
+
+    ! 'before' fields
+
+    DO jk = 1, jpk
+       READ(inum,REC=irec) ub(:,:,jk)
+       irec = irec +1
+    END DO
+
+    DO jk = 1, jpk
+       READ(inum,REC=irec) vb(:,:,jk)
+       irec = irec +1
+    END DO
+
+    DO jk = 1, jpk
+       READ(inum,REC=irec) tb(:,:,jk)
+       irec = irec +1
+    END DO
+
+    DO jk = 1, jpk
+       READ(inum,REC=irec) sb(:,:,jk)
+       irec = irec +1
+    END DO
+
+    DO jk = 1, jpk
+       READ(inum,REC=irec) rotb(:,:,jk)
+       irec = irec +1
+    END DO
+
+    DO jk = 1, jpk
+       READ(inum,REC=irec) hdivb(:,:,jk)
+       irec = irec +1
+    END DO
+
+    ! 'now' fields
+
+    DO jk = 1, jpk
+       READ(inum,REC=irec) un(:,:,jk)
+       irec = irec +1
+    END DO
+
+    DO jk = 1, jpk
+       READ(inum,REC=irec) vn(:,:,jk)
+       irec = irec +1
+    END DO
+
+    DO jk = 1, jpk
+       READ(inum,REC=irec) tn(:,:,jk)
+       irec = irec +1
+    END DO
+
+    DO jk = 1, jpk
+       READ(inum,REC=irec) sn(:,:,jk)
+       irec = irec +1
+    END DO
+
+    DO jk = 1, jpk
+       READ(inum,REC=irec) rotn(:,:,jk)
+       irec = irec +1
+    END DO
+
+    DO jk = 1, jpk
+       READ(inum,REC=irec) hdivn(:,:,jk)
+       irec = irec +1
+    END DO
+
+    ! elliptic solver arrays
+    READ(inum,REC=irec ) gcx(:,:)
+    irec = irec +1
+
+    READ(inum,REC=irec ) gcxb(:,:)
+    irec = irec +1
+
+#if defined key_dynspg_fsc
+
+    ! free surface formulation (eta)
+
+    READ(inum,REC=irec ) sshb(:,:)
+    irec = irec +1
+
+    READ(inum,REC=irec ) sshn(:,:)
+    irec = irec +1
+#else
+
+    ! Rigid-lid formulation (bsf)
+
+    READ(inum,REC=irec ) bsfb(:,:)
+    irec = irec +1
+
+    READ(inum,REC=irec ) bsfn(:,:)
+    irec = irec +1
+
+    READ(inum,REC=irec ) bsfd(:,:)
+    irec = irec +1
+
+#endif
+
+    ! TKE arrays
+
+    IF (lk_zdftke) THEN
+    IF ( itke1 == 1 ) THEN
+       DO jk = 1, jpk
+          READ(inum,REC=irec) en(:,:,jk)
+          irec = irec +1
+       END DO
+    ELSE
+       IF(lwp) THEN
+          WRITE(numout,*) ' ===>>>> : the previous restart file didnot used  tke scheme'
+          WRITE(numout,*) ' =======                ======='
+       ENDIF
+       nrstdt = 2
+    ENDIF
+    ENDIF
+#if defined key_ice_lim
+    ! Louvain La Neuve Sea Ice Model 
+    ! check if it was in the previous run
+    IF ( ios1 == 1 ) THEN
+       READ(inum,REC=irec) fsst(:,:) ; irec = irec + 1
+       READ(inum,REC=irec) fsss(:,:) ; irec = irec + 1
+       READ(inum,REC=irec) fun (:,:) ; irec = irec + 1
+       READ(inum,REC=irec) fvn (:,:) ; irec = irec + 1
+#  if defined key_coupled
+       READ(inum,REC=irec) alb_ice(:,:) ; irec = irec + 1
+#  endif
+    ENDIF
+    IF ( iice1 /= nfice .OR. ios1 == 0 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'rst_read :  LLN sea Ice Model => Ice initialization'
+         IF(lwp) WRITE(numout,*)
+         fsst(:,:) = 0.
+         fsss(:,:) = 0.
+         fun (:,:) = 0.
+         fvn (:,:) = 0.
+         fsst(:,:) = fsst(:,:) + ( nfice-1 )*( tn(:,:,1) + rt0 )
+         fsss(:,:) = fsss(:,:) + ( nfice-1 )*  sn(:,:,1)
+         DO jj = 2, jpj
+            DO ji = 2, jpi
+               fun(ji,jj) = fun(ji,jj) + (nfice-1)*0.5*( un(ji-1,jj,1)+un(ji-1,jj-1,1) )
+               fvn(ji,jj) = fvn(ji,jj) + (nfice-1)*0.5*( vn(ji,jj-1,1)+vn(ji-1,jj-1,1) )
+            END DO
+         END DO
+#    if defined key_coupled
+         alb_ice(:,:) = 0.8 * tmask(:,:,1)
+#    endif
+    ENDIF
+  
+#endif
+# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily
+      ! bulk forcing 
+      IF( ios2 == 1 ) THEN
+         READ(inum,REC=irec) gsst (:,:) ; irec = irec + 1
+      ENDIF
+      IF( ibulk1 /= nfbulk  .OR. ios2 == 0 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'rst_read :  Bulk forcing ==> Initialization '
+         IF(lwp) WRITE(numout,*)
+         gsst(:,:) = 0.
+         gsst(:,:) = gsst(:,:) + ( nfbulk-1 )*( tn(:,:,1) + rt0 )
+      ENDIF
+# endif
+    CLOSE(inum)
+
+  END SUBROUTINE rst_read
Index: /branches/nemo/NEMO/OPA_SRC/step.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/step.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/step.F90	(revision 4)
@@ -0,0 +1,476 @@
+MODULE step
+   !!======================================================================
+   !!                       ***  MODULE step  ***
+   !! Time-stepping    : manager of the ocean, tracer and ice time stepping
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   stp            : OPA system time-stepping
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE zdf_oce         ! ocean vertical physics variables
+   USE ldftra_oce
+   USE ldfdyn_oce
+   USE cpl             ! coupled exchanges (???)
+   USE in_out_manager  ! I/O manager
+   USE lbclnk
+
+   USE daymod          ! calendar                         (day     routine)
+
+   USE dtatem          ! ocean temperature data           (dta_tem routine)
+   USE dtasal          ! ocean salinity    data           (dta_sal routine)
+   USE dtasst          ! ocean sea surface temerature     (dta_sst routine)
+   USE taumod          ! surface stress                   (tau     routine)
+   USE flxmod          ! thermohaline fluxes              (flx     routine)
+   USE ocesbc          ! thermohaline fluxes              (oce_sbc routine)
+   USE flxrnf          ! runoffs                          (flx_rnf routine)
+   USE flxfwb          ! freshwater budget correction     (flx_fwb routine)
+   USE closea          ! closed sea freshwater budget     (flx_clo routine)
+   USE ocfzpt          ! surface ocean freezing point    (oc_fz_pt routine)
+
+#if defined key_passivetrc
+!!bug trcstp          ! passive tracer time-stepping      (trc_stp routine)
+#endif
+
+   USE dynhpg          ! hydrostatic pressure grad.       (dyn_hpg routine)
+   USE dynhpg_atsk     ! hydrostatic pressure grad.  (dyn_hpg_atsk routine)
+   USE dynspg_fsc      ! surface pressure gradient   (dyn_spg_fsc  routine)
+   USE dynspg_fsc_atsk ! surface pressure gradient (dyn_spgfsc_atsk routine)
+   USE dynspg_rl       ! surface pressure gradient     (dyn_spg_rl routine)
+   USE dynkeg          ! kinetic energy gradient          (dyn_keg routine)
+   USE dynvor          ! vorticity term                   (dyn_vor routine)
+   USE dynzad          ! vertical advection               (dyn_adv routine)
+   USE dynldf_bilapg   ! lateral mixing            (dyn_ldf_bilapg routine)
+   USE dynldf_bilap    ! lateral mixing             (dyn_ldf_bilap routine)
+   USE dynldf_iso      ! lateral mixing               (dyn_ldf_iso routine)
+   USE dynldf_lap      ! lateral mixing               (dyn_ldf_lap routine)
+   USE dynzdf_imp      ! vertical diffusion: implicit     (dyn_zdf routine)
+   USE dynzdf_imp_atsk ! vertical diffusion: implicit     (dyn_zdf routine)
+   USE dynzdf_iso      ! vertical diffusion: isopycnal    (dyn_zdf routine)
+   USE dynzdf_exp      ! vertical diffusion: explicit (dyn_zdf_exp routine)
+   USE dynnxt          ! time-stepping                    (dyn_nxt routine)
+
+   USE trabbc          ! bottom boundary condition        (tra_bbc routine)
+   USE trabbl          ! bottom boundary layer            (tra_bbl routine)
+   USE tradmp          ! internal damping                 (tra_dmp routine)
+   USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine)
+   USE traldf_bilap    ! lateral mixing             (tra_ldf_bilap routine)
+   USE traldf_iso      ! lateral mixing               (tra_ldf_iso routine)
+   USE traldf_iso_zps  ! lateral mixing           (tra_ldf_iso_zps routine)
+   USE traldf_lap      ! lateral mixing               (tra_ldf_lap routine)
+   USE traqsr          ! solar radiation penetration      (tra_qsr routine)
+   USE tranpc          ! non-penetrative convection       (tra_npc routine)
+   USE tranxt          ! time-stepping                    (tra_nxt routine)
+   USE traadv_ctl      ! advection scheme control     (tra_adv_ctl routine)
+   USE traadv_cen2     ! 2nd order centered scheme   (tra_adv_cen2 routine)
+   USE traadv_tvd      ! TVD scheme                (tra_adv_tvd    routine)
+   USE traadv_muscl    ! MUSCL scheme              (tra_adv_muscl  routine)
+   USE traadv_muscl2   ! MUSCL2 scheme             (tra_adv_muscl2 routine)
+   USE cla             ! cross land advection             (tra_cla routine)
+   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp routine)
+   USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp routine)
+   USE trazdf_iso      ! vertical diffusion           (tra_zdf_exp routine)
+   USE trazdf_iso_vopt ! vertical diffusion           (tra_zdf_exp routine)
+   USE trasbc          ! surface boundary condition       (tra_sbc routine)
+
+   USE eosbn2          ! equation of state                (eos_bn2 routine)
+
+   USE obc_par         ! open boundary condition variables
+   USE obcdta          ! open boundary condition data     (obc_dta routine)
+   USE obcrst          ! open boundary cond. restart      (obc_rst routine)
+   USE obcrad          ! open boundary cond. radiation    (obc_rad routine)
+   USE obcspg          ! open boundary cond  spg          (obc_spg routine)
+
+   USE divcur          ! hor. divergence and curl      (div & cur routines)
+   USE cla_div         ! cross land: hor. divergence      (div_cla routine)
+   USE wzvmod          ! vertical velocity                (wzv     routine)
+
+   USE ldfslp          ! iso-neutral slopes               (ldf_slp routine)
+   USE ldfeiv          ! eddy induced velocity coef.      (ldf_eiv routine)
+
+   USE zdfbfr          ! bottom friction                  (zdf_bfr routine)
+   USE zdftke          ! TKE vertical mixing              (zdf_tke routine)
+   USE zdfddm          ! double diffusion mixing          (zdf_ddm routine)
+   USE zdfevd          ! enhanced vertical diffusion      (zdf_evd routine)
+   USE zdfric          ! Richardson vertical mixing       (zdf_ric routine)
+   USE zdfmxl          ! Mixed-layer depth                (zdf_mxl routine)
+
+   USE zpshde          ! partial step: hor. derivative     (zps_hde routine)
+   USE ice_oce         ! sea-ice variable
+   USE icestp          ! sea-ice time-stepping             (ice_stp routine)
+
+   USE diawri          ! Standard run outputs             (dia_wri routine)
+   USE trddyn          ! Ocean momentum trends            (trd_dyn routine)
+   USE trdtra          ! Ocean active tracer trends       (trd_tra routine)
+   USE diagap          ! hor. mean model-data gap         (dia_gap routine)
+   USE trdmld          ! mixed-layer trends               (trd_mld routine)
+   USE diahdy          ! dynamic height                   (dia_hdy routine)
+   USE ptr             ! poleward transports         (dia_ptr_init routine)
+   !                   !                                  (dia_ptr routine)
+   USE diahth          ! thermocline depth                (dia_hth routine)
+   USE diafwb          ! freshwater budget                (dia_fwb routine)
+   USE diaspr          ! suface pressure (rigid-lid)      (dia_spr routine)
+   USE flo_oce         ! floats variables
+   USE floats          ! floats computation               (flo_stp routine)
+
+   USE stpctl          ! time stepping control            (stp_ctl routine)
+   USE restart         ! ocean restart                  (rst_write routine)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC stp            ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , LODYC-IPSL (2003)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE stp( kstp )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE stp  ***
+      !!                      
+      !! ** Purpose : - Time stepping of OPA (momentum and active tracer eqs.)
+      !!              - Time stepping of LIM (dynamic and thermodynamic eqs.)
+      !!              - Tme stepping  of TRC (passive tracer eqs.)
+      !! 
+      !! ** Method  : -1- Update forcings and data  
+      !!              -2- Update ocean physics 
+      !!              -3- Compute the t and s trends 
+      !!              -4- Update t and s 
+      !!              -5- Compute the momentum trends
+      !!              -6- Update the horizontal velocity
+      !!              -7- Compute the diagnostics variables (rd,N2, div,cur,w)
+      !!              -8- Outputs and diagnostics
+      !!
+      !! History :
+      !!        !  91-03  ()  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard)  add a first output record
+      !!        !  96-04  (G. Madec)  introduction of dynspg
+      !!        !  96-04  (M.A. Foujols)  introduction of passive tracer
+      !!   8.0  !  97-06  (G. Madec)  new architecture of call
+      !!   8.2  !  97-06  (G. Madec, M. Imbard, G. Roullet)  free surface
+      !!   8.2  !  99-02  (G. Madec, N. Grima)  hpg implicit
+      !!   8.2  !  00-07  (J-M Molines, M. Imbard)  Open Bondary Conditions
+      !!   9.0  !  02-06  (G. Madec)  free form, suppress macro-tasking
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kstp   ! ocean time-step index
+
+      !! * local declarations
+      INTEGER ::   indic    ! error indicator if < 0
+      !! ---------------------------------------------------------------------
+
+      indic = 1                    ! reset to no error condition
+      adatrj = adatrj + rdt/86400._wp
+
+      CALL day( kstp )             ! Calendar
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Update data, open boundaries and Forcings
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+      IF( lk_dtatem  )   CALL dta_tem( kstp )         ! update 3D temperature data
+
+      IF( lk_dtasal  )   CALL dta_sal( kstp )         ! Salinity data
+
+      IF( lk_dtasst  )   CALL dta_sst( kstp )         ! Sea Surface Temperature data
+
+      IF( lk_obc     )   CALL obc_dta_psi( kstp )     ! update bsf data at open boundaries
+
+      IF( lk_obc     )   CALL obc_dta_uvt( kstp )     ! update u, v, t, s data at open boundaries
+
+      IF( lk_obc     )   CALL obc_rad( kstp )         ! compute phase velocities at open boundaries
+
+                         CALL tau( kstp )             ! wind stress
+
+                         CALL flx_rnf( kstp )         ! runoff data
+
+                         CALL flx( kstp )             ! heat and freshwater fluxes
+
+      IF( lk_ice_lim )   CALL ice_stp( kstp )         ! sea-ice model (Update stress & fluxes)
+
+                         CALL oce_sbc( kstp )         ! ocean surface boudaries
+
+      IF( ln_fwb     )   CALL flx_fwb( kstp )         ! freshwater budget
+
+      IF( nclosea == 1 ) CALL flx_clo( kstp )         ! closed sea in the domain (update freshwater fluxes)
+
+      IF( kstp == nit000 ) THEN 
+         IF( ninist == 1 ) THEN                       ! Output the initial state and forcings
+            CALL dia_wri_state( 'output.init' )
+         ENDIF
+         IF( lk_diaptr ) CALL dia_ptr_init            ! Poleward TRansport initialization
+      ENDIF
+
+      IF( l_ctl .AND. lwp ) THEN         ! print mean trends (used for debugging)
+         WRITE(numout,*) ' emp  -   : ', SUM( emp       * tmask(:,:,1) )
+         WRITE(numout,*) ' emps -   : ', SUM( emps      * tmask(:,:,1) )
+         WRITE(numout,*) ' qt   -   : ', SUM( qt        * tmask(:,:,1) )
+         WRITE(numout,*) ' qsr  -   : ', SUM( qsr       * tmask(:,:,1) )
+         WRITE(numout,*) ' runoff   : ', SUM( runoff    * tmask(:,:,1) )
+         WRITE(numout,*) ' tmask    : ', SUM( tmask                    )
+         WRITE(numout,*) ' sst  -   : ', SUM( tn(:,:,1) * tmask(:,:,1) )
+         WRITE(numout,*) ' sss  -   : ', SUM( sn(:,:,1) * tmask(:,:,1) )
+         WRITE(numout,*) ' tau  - x : ', SUM( taux ), ' - y : ', SUM( tauy )
+      ENDIF
+
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Ocean physics update
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !-----------------------------------------------------------------------
+      !  VERTICAL PHYSICS
+      !-----------------------------------------------------------------------
+      ! N.B. ua, va, ta, sa arrays are used as workspace in this section
+      !-----------------------------------------------------------------------
+
+                       CALL bn2( tb, sb, rn2 )              ! before Brunt-Vaisala frequency
+      
+      !                                                     ! Vertical eddy viscosity and diffusivity coefficients
+      IF( lk_zdfric )   CALL zdf_ric( kstp )                       ! Richardson number dependent Kz
+      IF( lk_zdftke )   CALL zdf_tke( kstp )                       ! TKE closure scheme for Kz
+      IF( lk_zdfcst )   avt (:,:,:) = avt0 * tmask(:,:,:)          ! Constant Kz (reset avt to the background value)
+
+      IF( cp_cfg == "orca" ) THEN                           ! ORCA: Reduce vertical mixing in some straits
+         SELECT CASE ( jp_cfg )
+            CASE ( 05 )                         ! ORCA R2 configuration
+               avt  (:,:,2) = avt  (:,:,2) + 1.e-3 * upsrnfh(:,:)   ! increase diffusivity of rivers mouths
+               IF( lk_zdfddm )   fsavs(:,:,2) = fsavs(:,:,2) + 1.e-3 * upsrnfh(:,:)   
+            CASE ( 2  )                         ! ORCA R2 configuration
+               avt( mi0(140):mi1(140) , mj0(102):mj1(102) , 2:jpkm1 ) =    &   ! Strait of Gibraltar
+               avt( mi0(140):mi1(140) , mj0(102):mj1(102) , 2:jpkm1 ) / 5.e0    
+               avt( mi0(161):mi1(161) , mj0( 88):mj1( 88) , 2:jpkm1 ) =    &   ! Strait of Bab el Mandeb
+               avt( mi0(161):mi1(161) , mj0( 88):mj1( 88) , 2:jpkm1 ) / 5.e0
+            CASE ( 4  )                         ! ORCA R4 configuration
+               avt( mi0( 71):mi1( 71) , mj0( 52):mj1( 52) , 2:jpkm1 ) =    &   ! Strait of Gibraltar
+               avt( mi0( 71):mi1( 71) , mj0( 52):mj1( 52) , 2:jpkm1 ) / 5.e0
+         END SELECT
+      ENDIF
+
+      IF( ln_zdfevd )   CALL zdf_evd( kstp )                 ! enhanced vertical eddy diffusivity
+
+      IF( lk_zdfddm )   CALL zdf_ddm( kstp )                 ! double diffusive mixing
+
+                        CALL zdf_bfr( kstp )                 ! Bottom boudary condition
+
+                        CALL zdf_mxl( kstp )                 ! mixed layer depth
+
+
+      !-----------------------------------------------------------------------
+      !  LATERAL PHYSICS
+      !-----------------------------------------------------------------------
+      ! N.B. ua, va, ta, sa arrays are used as workspace in this section
+      !-----------------------------------------------------------------------
+
+      IF( lk_ldfslp     )   CALL ldf_slp( kstp, rhd, rn2 )       ! before slope of the lateral mixing
+
+#if defined key_traldf_c2d
+      IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )                 ! eddy induced velocity coefficient
+#endif
+
+
+#if defined key_passivetrc
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Passive Tracer Model
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      ! N.B. ua, va, ta, sa arrays are used as workspace in this section
+      !-----------------------------------------------------------------------
+      IF( kstp == nit000 )   CALL trcdia( kstp, indic )     ! diagnostics init.
+
+                             CALL trc_stp( kstp )           ! time-stepping
+
+                             CALL trcwri( kstp )            ! outputs
+
+                             CALL trcdia( kstp, indic )     ! diagnostics
+#endif
+
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Active tracers
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      ! N.B. ua, va arrays are used as workspace in this section
+      !-----------------------------------------------------------------------
+
+                                ta(:,:,:) = 0.e0               ! set tracer trends to zero
+                                sa(:,:,:) = 0.e0
+
+                                CALL tra_sbc( kstp )           ! surface boundary condition
+
+      IF( ln_traqsr        )   CALL tra_qsr( kstp )           ! penetrative solar radiation qsr
+
+      IF( lk_trabbc        )   CALL tra_bbc( kstp )           ! bottom heat flux
+
+      IF( lk_trabbl_dif    )   CALL tra_bbl_dif( kstp )           ! diffusive bottom boundary layer scheme
+      IF( lk_trabbl_adv    )   CALL tra_bbl_adv( kstp )           ! advective (and/or diffusive) bottom boundary layer scheme
+
+      IF( lk_tradmp        )   CALL tra_dmp( kstp )            ! internal damping trends
+
+      !                                                        ! horizontal & vertical advection
+      IF( kstp == nit000   )   CALL tra_adv_ctl                    ! chose/control the scheme used
+      IF( ln_traadv_cen2   )   CALL tra_adv_cen2  ( kstp )         ! 2nd order centered scheme
+      IF( ln_traadv_tvd    )   CALL tra_adv_tvd   ( kstp )         ! TVD scheme
+      IF( ln_traadv_muscl  )   CALL tra_adv_muscl ( kstp )         ! MUSCL scheme
+      IF( ln_traadv_muscl2 )   CALL tra_adv_muscl2( kstp )         ! MUSCL2 scheme
+
+      IF( n_cla == 1       )   CALL tra_cla( kstp )            ! Cross Land Advection (Update Hor. advection)
+
+      !                                                        ! lateral mixing 
+      IF( l_traldf_lap      )   CALL tra_ldf_lap    ( kstp )           ! iso-level laplacian
+      IF( l_traldf_bilap    )   CALL tra_ldf_bilap  ( kstp )           ! iso-level bilaplacian 
+      IF( l_traldf_bilapg   )   CALL tra_ldf_bilapg ( kstp )           ! s-coord. horizontal bilaplacian
+      IF( l_traldf_iso      )   CALL tra_ldf_iso    ( kstp )           ! iso-neutral/geopot. laplacian 
+      IF( l_traldf_iso_zps  )   CALL tra_ldf_iso_zps( kstp )           ! partial step iso-neutral/geopot. laplacian
+
+      !                                                        ! vertical diffusion
+      IF( l_trazdf_exp      )   CALL tra_zdf_exp( kstp )               ! explicit time stepping (time splitting scheme)
+      IF( l_trazdf_imp      )   CALL tra_zdf_imp( kstp )               ! implicit time stepping (euler backward)
+      IF( l_trazdf_iso      )   CALL tra_zdf_iso( kstp )               ! isopycnal
+      IF( l_trazdf_iso_vo   )   CALL tra_zdf_iso_vopt( kstp )          ! vector opt. isopycnal
+
+                                CALL tra_nxt( kstp )           ! tracer fields at next time step
+
+      IF( ln_zdfnpc         )   CALL tra_npc( kstp )           ! update the new (t,s) fields by non
+      !                                                        ! penetrative convective adjustment
+
+      IF( ln_dynhpg_imp     ) THEN                             ! semi-implicit hpg 
+                                   CALL eos( ta, sa, rhd, rhop )   ! Time-filtered in situ density used in dynhpg module
+         IF( lk_zps    )           CALL zps_hde( kstp, ta, sa, rhd,  & ! Partial steps: time filtered hor. gradient 
+            &                                         gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level
+            &                                         gtv, gsv, grv )  
+      ELSE                                                     ! centered hpg (default case)
+                                  CALL eos( tb, sb, rhd, rhop )       ! now (swap=before) in situ density for dynhpg module
+         IF( lk_zps    )          CALL zps_hde( kstp, tb, sb, rhd,  & ! Partial steps: now horizontal gradient
+            &                                        gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level
+            &                                        gtv, gsv, grv )  
+      ENDIF
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Dynamics
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      ! N.B. ta, sa arrays are used as workspace in this section 
+      !-----------------------------------------------------------------------
+
+                            ua(:,:,:) = 0.e0                ! set dynamics trends to zero
+                            va(:,:,:) = 0.e0
+
+                            CALL dyn_keg( kstp )            ! horizontal gradient of kinetic energy
+
+      !                                                     ! vorticity term including Coriolis
+      IF( ln_dynvor_ens    )   CALL dyn_vor_enstrophy( kstp )        ! enstrophy conserving scheme
+      IF( ln_dynvor_ene    )   CALL dyn_vor_energy   ( kstp )        ! energy conserving scheme
+      IF( ln_dynvor_mix    )   CALL dyn_vor_mixed    ( kstp )        ! combined scheme
+
+      !                                                     ! lateral mixing 
+      IF( l_dynldf_lap     )   CALL dyn_ldf_lap    ( kstp )          ! iso-level laplacian
+      IF( l_dynldf_bilap   )   CALL dyn_ldf_bilap  ( kstp )          ! iso-level bilaplacian 
+      IF( l_dynldf_bilapg  )   CALL dyn_ldf_bilapg ( kstp )          ! s-coord. horizontal bilaplacian
+      IF( l_dynldf_iso     )   CALL dyn_ldf_iso    ( kstp )          ! iso-neutral laplacian 
+
+      !                                                     ! horizontal gradient of Hydrostatic pressure 
+      IF( l_dyn_hpg     )   CALL dyn_hpg     ( kstp )             ! default case  (k-j-i loop)
+      IF( l_dyn_hpg_tsk )   CALL dyn_hpg_atsk( kstp )             ! autatask case (j-k-i loop)
+
+                            CALL dyn_zad    ( kstp )        ! vertical advection       
+
+      !                                                     ! vertical diffusion
+      IF( l_dynzdf_exp     )   CALL dyn_zdf_exp    ( kstp )         ! explicit time stepping (time splitting scheme)
+      IF( l_dynzdf_imp     )   CALL dyn_zdf_imp    ( kstp )         ! implicit time stepping (euler backward)
+      IF( l_dynzdf_imp_tsk )   CALL dyn_zdf_imp_tsk( kstp )         ! autotask implicit time stepping (euler backward)
+      IF( l_dynzdf_iso     )   CALL dyn_zdf_iso    ( kstp )         ! iso-neutral case
+
+      IF( lk_dynspg_rl ) THEN 
+         IF( lk_obc    )       CALL obc_spg( kstp )                 ! surface pressure gradient at open boundaries
+      ENDIF
+                       indic=0
+      !                                                     ! surface pressure gradient
+!i bug lbc sur emp
+      CALL lbc_lnk( emp, 'T', 1. )
+!i
+      IF( lk_dynspg_fsc     )   CALL dyn_spg_fsc     ( kstp, indic )  ! free surface constant volume case
+      IF( lk_dynspg_fsc_tsk )   CALL dyn_spg_fsc_atsk( kstp, indic )  ! autotask free surface constant volume case
+      IF( lk_dynspg_rl      )   CALL dyn_spg_rl      ( kstp, indic )  ! rigid-lid case
+
+                       CALL dyn_nxt( kstp )                 ! lateral velocity at next time step 
+
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Computation of diagnostic variables
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      ! N.B. ua, va, ta, sa arrays are used as workspace in this section
+      !-----------------------------------------------------------------------
+
+                       CALL oc_fz_pt                        ! ocean surface freezing temperature
+
+                       CALL div_cur( kstp )                 ! Horizontal divergence & Relative vorticity
+
+      IF( n_cla == 1 ) CALL div_cla( kstp )                 ! Cross Land Advection (Update Hor. divergence)
+
+                       CALL wzv( kstp )                     ! Vertical velocity
+
+
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Control, diagnostics and outputs
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      ! N.B. ua, va, ta, sa arrays are used as workspace in this section
+      !-----------------------------------------------------------------------
+
+      ! Time loop: control and print
+      ! ----------------------------
+
+                       CALL stp_ctl( kstp, indic )
+
+      IF ( indic < 0 ) nstop = nstop + 1
+
+      IF ( nstop /= 0 ) RETURN
+
+      ! Diagnostics:
+      ! ------------
+
+      IF( lk_floats  )   CALL flo_stp( kstp )                 ! drifting Floats
+
+      IF( lk_trddyn  )   CALL trd_dyn( kstp )                 ! trends: dynamics 
+
+      IF( lk_trdtra  )   CALL trd_tra( kstp )                 ! trends: active tracers
+
+      IF( lk_trdmld  )   CALL trd_mld( kstp )                 ! trends: Mixed-layer 
+
+      IF( lk_diaspr  )   CALL dia_spr( kstp )                 ! Surface pressure diagnostics
+
+      IF( lk_diahth  )   CALL dia_hth( kstp )                 ! Thermocline depth (20 degres isotherm depth)
+
+      IF( lk_diaptr  )   CALL dia_ptr( kstp )                 ! Poleward TRansport diagnostics
+
+      IF( lk_diagap )   CALL dia_gap( kstp )                 ! basin averaged diagnostics
+
+      IF( lk_diahdy  )   CALL dia_hdy( kstp )                 ! dynamical heigh diagnostics
+
+      IF( lk_diafwb  )   CALL dia_fwb( kstp )                 ! Fresh water budget diagnostics
+#if defined key_diaptr
+      IF( MOD( kstp, nf_ptr ) == 0 )   CALL dia_ptr( kstp ) ! Poleward TRansports
+#endif
+
+   ! save and outputs
+   ! ----------------
+                        CALL rst_write( kstp )               ! ocean model: restart file output
+
+      IF( lk_obc     )   CALL obc_rst_wri(kstp)               ! ocean model: open boundary restart file output
+
+                        CALL dia_wri( kstp, indic )          ! ocean model: outputs
+#if defined key_coupled
+                        CALL stp_cmo( kstp )                 ! coupling fields
+#endif
+
+   END SUBROUTINE stp
+
+   !!======================================================================
+END MODULE step
Index: /branches/nemo/NEMO/OPA_SRC/stpctl.F90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/stpctl.F90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/stpctl.F90	(revision 4)
@@ -0,0 +1,191 @@
+MODULE stpctl
+   !!==============================================================================
+   !!                       ***  MODULE  stpctl  ***
+   !! Ocean run control :  gross check of the ocean time stepping
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   stp_ctl      : Control the run
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE sol_oce         ! ocean space and time domain variables 
+   USE in_out_manager  ! I/O manager
+   USE solisl          ! ???
+   USE diawri          ! ocean output file 
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! distributed memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC stp_ctl           ! routine called by step.F90
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE stp_ctl( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE stp_ctl  ***
+      !!                     
+      !! ** Purpose :   Control the run
+      !!
+      !! ** Method  : - Save the time step in numstp
+      !!              - Print it each 50 time steps
+      !!              - Print solver statistics in numsol 
+      !!              - Stop the run IF problem for the solver ( indec < 0 )
+      !!
+      !! History :
+      !!        !  91-03  ()
+      !!        !  91-11  (G. Madec)
+      !!        !  92-06  (M. Imbard)
+      !!        !  97-06  (A.M. Treguier)
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence
+
+      !! * local declarations
+      INTEGER  ::   ji, jj, jk              ! dummy loop indices
+      INTEGER  ::   ii, ij, ik              ! temporary integers
+      REAL(wp) ::   zumax, zsmin            ! temporary scalars
+      INTEGER, DIMENSION(3) ::   ilocu      ! 
+      INTEGER, DIMENSION(2) ::   ilocs      ! 
+#if defined key_dynspg_rl
+      INTEGER  ::   jni                     ! dummy loop indice
+      REAL(wp) ::   zfact                   ! temporary scalar
+#endif
+      !!----------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'stp_ctl : time-stepping control'
+         WRITE(numout,*) '~~~'
+         ! open time.step file
+         CALL ctlopn( numstp, 'time.step', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 )
+      ENDIF
+
+      ! save the current time step in numstp
+      ! ------------------------------------
+      IF(lwp) WRITE(numstp,9100) kt
+      IF(lwp) REWIND(numstp)
+9100  FORMAT(1x, i8)
+
+
+      ! elliptic solver statistics
+      ! -----------------------------
+      ! Solver
+      IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps
+9200  FORMAT(' it :', i8, ' niter :', i4, ' res :',e20.10,' b :',e20.10)
+
+      ! Islands (if exist)
+      IF( l_isl )   CALL isl_stp_ctl( kt, kindic )
+
+
+      ! Output in numwso and numwvo IF kindic<0
+      ! ---------------------------------------
+      !    (i.e. problem for the solver)
+      IF( kindic < 0 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode'
+            WRITE(numout,*) ' ====== '
+            WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps
+            WRITE(numout,*)
+            WRITE(numout,*) ' stpctl: output of last fields in numwso'
+            WRITE(numout,*) '                                  numwvo'
+            WRITE(numout,*) ' ======  *******************************'
+         ENDIF
+         CALL dia_wri( kt, kindic )
+      ENDIF
+
+      ! Test maximum of velocity (zonal only)
+      ! ------------------------
+      !! zumax = MAXVAL( ABS( un(:,:,:) ) )   ! slower than the following loop on NEC SX5
+      zumax = 0.0
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zumax = MAX(zumax,ABS(un(ji,jj,jk)))
+          END DO 
+        END DO 
+      END DO        
+#if defined key_mpp    
+      CALL mpp_max( zumax )
+#endif
+      IF( MOD( kt, nwrite ) == 1 ) THEN
+         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax
+      ENDIF
+      IF( zumax >  20.) THEN
+         ilocu = MAXLOC( ABS( un(:,:,:) ) )
+         ii = ilocu(1) + nimpp - 1
+         ij = ilocu(2) + njmpp - 1
+         ik = ilocu(3)
+#if defined key_mpp
+         CALL mpp_isl( ii )
+         CALL mpp_isl( ij )
+         CALL mpp_isl( ik )
+#endif
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'
+            WRITE(numout,*) ' ====== '
+            WRITE(numout,9400) kt, zumax, ii, ij, ik
+            WRITE(numout,*)
+            WRITE(numout,*) '          output of last fields in numwso'
+         ENDIF
+         kindic  = -3
+         CALL dia_wri( kt, kindic )
+      ENDIF
+9400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i4)
+
+
+      ! Test minimum of salinity
+      ! ------------------------
+      !! zsmin = MINVAL( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )    
+      !                slower than the following loop on NEC SX5
+      zsmin = 100.0
+      DO jj = 2, jpjm1
+         DO ji = 1, jpi
+            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,sn(ji,jj,1))
+         END DO
+      END DO
+#if defined key_mpp    
+      CALL mpp_min( zsmin )
+#endif
+      IF( MOD( kt, nwrite ) == 1 ) THEN
+         IF(lwp) WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin
+      ENDIF
+      IF( zsmin < 0.) THEN 
+         ilocs = MINLOC( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )
+         ii = ilocs(1) + nimpp - 1
+         ij = ilocs(2) + njmpp - 1
+#if defined key_mpp
+         CALL mpp_isl( ii )
+         CALL mpp_isl( ij )
+#endif
+         IF(lwp) THEN
+            WRITE(numout,cform_err)
+            WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity'
+            WRITE(numout,*) '======= '
+            WRITE(numout,9500) kt, zsmin, ii, ij
+            WRITE(numout,*)
+            WRITE(numout,*) '          output of last fields in numwso'
+         ENDIF
+         IF( kindic < 0 ) THEN
+            IF(lwp) WRITE(numout,*) ' stpctl diabort done. We wont do it again '
+         ELSE 
+            kindic  = -3
+            CALL dia_wri(kt,kindic)
+         ENDIF
+      ENDIF
+9500  FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i4)
+
+   END SUBROUTINE stp_ctl
+
+   !!======================================================================
+END MODULE stpctl
Index: /branches/nemo/NEMO/OPA_SRC/vectopt_loop_substitute.h90
===================================================================
--- /branches/nemo/NEMO/OPA_SRC/vectopt_loop_substitute.h90	(revision 4)
+++ /branches/nemo/NEMO/OPA_SRC/vectopt_loop_substitute.h90	(revision 4)
@@ -0,0 +1,13 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop starting and inding indices 
+   !!      to allow unrolling of do-loop using CPP macro.
+   !!----------------------------------------------------------------------
+#if defined key_vectopt_loop
+#  define fs_2     1
+#  define fs_jpim1 jpi
+#else
+#  define fs_2     2
+#  define fs_jpim1 jpim1
+#endif
